hs94.128x64x5/code/external_forcing.F

C $Header: /u/gcmpack/models/MITgcmUV/verification/hs94.128x64x5/code/external_forcing.F,v 1.3 2001/02/04 14:38:52 cnh Exp $
C $Name:  $

#include "CPP_OPTIONS.h"

CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_U(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
C     /==========================================================\
C     | S/R EXTERNAL_FORCING_U                                   |
C     | o Contains problem specific forcing for zonal velocity.  |
C     |==========================================================|
C     | Adds terms to gU for forcing by external sources         |
C     | e.g. wind stress, bottom friction etc..................  |
C     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     == Routine arguments ==
C     iMin - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid
CEndOfInterface

C     == Local variables ==
C     Loop counters
      INTEGER I, J
C     _RL uKf
C     _RL levelOfGround
C     _RL criticalLevel
C     _RL levelOfVelPoint
C     _RL dist1
C     _RL dist2
C     _RL decayFac
C     _RL velDragHeightFac
      _RL termP,kV,kF

C--   Forcing term(s)
      kF=1./86400.
      DO J=jMin,jMax
       DO I=iMin,iMax
        IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )
         termP=0.5*( rF(kLev) + rF(kLev+1) )
         kV=kF*MAX(0., (termP*recip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
         gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
     &                      -kV*uVel(i,j,kLev,bi,bj)
        ENDIF
       ENDDO
      ENDDO

      RETURN
      END
CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_V(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
C     /==========================================================\
C     | S/R EXTERNAL_FORCING_V                                   |
C     | o Contains problem specific forcing for merid velocity.  |
C     |==========================================================|
C     | Adds terms to gV for forcing by external sources         |
C     | e.g. wind stress, bottom friction etc..................  |
C     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"


C     == Routine arguments ==
C     iMin - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid
CEndOfInterface
C     == Local variables ==
C     Loop counters
      INTEGER I, J
C     _RL uKf
C     _RL levelOfGround
C     _RL criticalLevel
C     _RL levelOfVelPoint
C     _RL dist1
C     _RL dist2
C     _RL decayFac
C     _RL velDragHeightFac
      _RL termP,kV,kF

C--   Forcing term(s)
      kF=1./86400.
      DO J=jMin,jMax
       DO I=iMin,iMax
        IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
C        termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
C    &           min(H(I,J,bi,bj),H(I,J-1,bi,bj))            ) )
         termP=0.5*( rF(kLev) + rF(kLev+1) )
         kV=kF*MAX(0., (termP*recip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
         gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
     &                      -kV*vVel(i,j,kLev,bi,bj)
        ENDIF
       ENDDO
      ENDDO

      RETURN
      END
CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_T(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
C     /==========================================================\
C     | S/R EXTERNAL_FORCING_T                                   |
C     | o Contains problem specific forcing for temperature.     |
C     |==========================================================|
C     | Adds terms to gT for forcing by external sources         |
C     | e.g. heat flux, climatalogical relaxation..............  |
C     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     == Routine arguments ==
C     iMin - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid
CEndOfInterface

C     == Local variables ==
C     Loop counters
      INTEGER I, J
      _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf

C--   Forcing term(s)
      rSurf=1.E5
      ka=1./(40.*86400.)
      ks=1./(4. *86400.)
      DO J=jMin,jMax
       term1=60.*(sin(yC(1,J,bi,bj)*deg2rad)**2)
C      termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )
       termP=0.5*( rF(kLev) + rF(kLev+1) )
       term2=10.*log(termP/rSurf)
     &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)
       thetaLim = 200. / ((termP/rSurf)**(2./7.))
       thetaEq=315.-term1-term2
       thetaEq=MAX(thetaLim,thetaEq)
       DO I=iMin,iMax
        kT=ka+(ks-ka)
     &    *MAX(0., (termP*recip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
     &    *COS((yC(1,J,bi,bj)*deg2rad))**4
         gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
     &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
     &            *maskC(i,j,kLev,bi,bj)
       ENDDO
      ENDDO

      RETURN
      END
CStartOfInterface
      SUBROUTINE EXTERNAL_FORCING_S(
     I           iMin, iMax, jMin, jMax,bi,bj,kLev,
     I           myCurrentTime,myThid)
C     /==========================================================\
C     | S/R EXTERNAL_FORCING_S                                   |
C     | o Contains problem specific forcing for merid velocity.  |
C     |==========================================================|
C     | Adds terms to gS for forcing by external sources         |
C     | e.g. fresh-water flux, climatalogical relaxation.......  |
C     \==========================================================/
      IMPLICIT NONE

C     == Global data ==
#include "SIZE.h"
#include "EEPARAMS.h"
#include "PARAMS.h"
#include "GRID.h"
#include "DYNVARS.h"
#include "FFIELDS.h"

C     == Routine arguments ==
C     iMin - Working range of tile for applying forcing.
C     iMax
C     jMin
C     jMax
C     kLev
      INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
      _RL myCurrentTime
      INTEGER myThid
CEndOfInterface

C     == Local variables ==
C     Loop counters
      INTEGER I, J

C--   Forcing term(s)

      RETURN
      END
1	jmc	1.3.2.1	C $Header: /u/gcmpack/models/MITgcmUV/verification/hs94.128x64x5/code/external_forcing.F,v 1.3 2001/02/04 14:38:52 cnh Exp $
2			C $Name: $
3	adcroft	1.2
4			#include "CPP_OPTIONS.h"
5
6			CStartOfInterface
7			SUBROUTINE EXTERNAL_FORCING_U(
8			I iMin, iMax, jMin, jMax,bi,bj,kLev,
9			I myCurrentTime,myThid)
10			C /==========================================================\
11			C \| S/R EXTERNAL_FORCING_U \|
12			C \| o Contains problem specific forcing for zonal velocity. \|
13			C \|==========================================================\|
14			C \| Adds terms to gU for forcing by external sources \|
15			C \| e.g. wind stress, bottom friction etc.................. \|
16			C \==========================================================/
17			IMPLICIT NONE
18
19			C == Global data ==
20			#include "SIZE.h"
21			#include "EEPARAMS.h"
22			#include "PARAMS.h"
23			#include "GRID.h"
24			#include "DYNVARS.h"
25			#include "FFIELDS.h"
26
27			C == Routine arguments ==
28			C iMin - Working range of tile for applying forcing.
29			C iMax
30			C jMin
31			C jMax
32			C kLev
33			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
34			_RL myCurrentTime
35			INTEGER myThid
36			CEndOfInterface
37
38			C == Local variables ==
39			C Loop counters
40			INTEGER I, J
41			C _RL uKf
42			C _RL levelOfGround
43			C _RL criticalLevel
44			C _RL levelOfVelPoint
45			C _RL dist1
46			C _RL dist2
47			C _RL decayFac
48			C _RL velDragHeightFac
49			_RL termP,kV,kF
50
51	jmc	1.3.2.1	C-- Forcing term(s)
52	adcroft	1.2	kF=1./86400.
53			DO J=jMin,jMax
54			DO I=iMin,iMax
55			IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
56			C termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
57			C & min(H(I,J,bi,bj),H(I,J-1,bi,bj)) ) )
58			termP=0.5*( rF(kLev) + rF(kLev+1) )
59	jmc	1.3.2.1	kV=kFMAX(0., (termPrecip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
60	adcroft	1.2	gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
61			& -kV*uVel(i,j,kLev,bi,bj)
62			ENDIF
63			ENDDO
64			ENDDO
65
66			RETURN
67			END
68			CStartOfInterface
69			SUBROUTINE EXTERNAL_FORCING_V(
70			I iMin, iMax, jMin, jMax,bi,bj,kLev,
71			I myCurrentTime,myThid)
72			C /==========================================================\
73			C \| S/R EXTERNAL_FORCING_V \|
74			C \| o Contains problem specific forcing for merid velocity. \|
75			C \|==========================================================\|
76			C \| Adds terms to gV for forcing by external sources \|
77			C \| e.g. wind stress, bottom friction etc.................. \|
78			C \==========================================================/
79			IMPLICIT NONE
80
81			C == Global data ==
82			#include "SIZE.h"
83			#include "EEPARAMS.h"
84			#include "PARAMS.h"
85			#include "GRID.h"
86			#include "DYNVARS.h"
87			#include "FFIELDS.h"
88
89
90			C == Routine arguments ==
91			C iMin - Working range of tile for applying forcing.
92			C iMax
93			C jMin
94			C jMax
95			C kLev
96			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
97			_RL myCurrentTime
98			INTEGER myThid
99			CEndOfInterface
100			C == Local variables ==
101			C Loop counters
102			INTEGER I, J
103			C _RL uKf
104			C _RL levelOfGround
105			C _RL criticalLevel
106			C _RL levelOfVelPoint
107			C _RL dist1
108			C _RL dist2
109			C _RL decayFac
110			C _RL velDragHeightFac
111			_RL termP,kV,kF
112
113	jmc	1.3.2.1	C-- Forcing term(s)
114	adcroft	1.2	kF=1./86400.
115			DO J=jMin,jMax
116			DO I=iMin,iMax
117			IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
118			C termP=0.5*( rF(kLev) + min( rF(kLev+1) ,
119			C & min(H(I,J,bi,bj),H(I,J-1,bi,bj)) ) )
120			termP=0.5*( rF(kLev) + rF(kLev+1) )
121	jmc	1.3.2.1	kV=kFMAX(0., (termPrecip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
122	adcroft	1.2	gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
123			& -kV*vVel(i,j,kLev,bi,bj)
124			ENDIF
125			ENDDO
126			ENDDO
127
128			RETURN
129			END
130			CStartOfInterface
131			SUBROUTINE EXTERNAL_FORCING_T(
132			I iMin, iMax, jMin, jMax,bi,bj,kLev,
133			I myCurrentTime,myThid)
134			C /==========================================================\
135			C \| S/R EXTERNAL_FORCING_T \|
136			C \| o Contains problem specific forcing for temperature. \|
137			C \|==========================================================\|
138			C \| Adds terms to gT for forcing by external sources \|
139			C \| e.g. heat flux, climatalogical relaxation.............. \|
140			C \==========================================================/
141			IMPLICIT NONE
142
143			C == Global data ==
144			#include "SIZE.h"
145			#include "EEPARAMS.h"
146			#include "PARAMS.h"
147			#include "GRID.h"
148			#include "DYNVARS.h"
149			#include "FFIELDS.h"
150
151			C == Routine arguments ==
152			C iMin - Working range of tile for applying forcing.
153			C iMax
154			C jMin
155			C jMax
156			C kLev
157			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
158			_RL myCurrentTime
159			INTEGER myThid
160			CEndOfInterface
161
162			C == Local variables ==
163			C Loop counters
164			INTEGER I, J
165			_RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf
166
167	jmc	1.3.2.1	C-- Forcing term(s)
168	adcroft	1.2	rSurf=1.E5
169			ka=1./(40.*86400.)
170			ks=1./(4. *86400.)
171			DO J=jMin,jMax
172			term1=60.(sin(yC(1,J,bi,bj)deg2rad)**2)
173			C termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )
174			termP=0.5*( rF(kLev) + rF(kLev+1) )
175			term2=10.*log(termP/rSurf)
176			& (cos(yC(1,J,bi,bj)deg2rad)**2)
177			thetaLim = 200. / ((termP/rSurf)**(2./7.))
178			thetaEq=315.-term1-term2
179			thetaEq=MAX(thetaLim,thetaEq)
180			DO I=iMin,iMax
181			kT=ka+(ks-ka)
182	jmc	1.3.2.1	& MAX(0., (termPrecip_Rcol(I,J,bi,bj)-0.7)/(1.-0.7) )
183	adcroft	1.2	& COS((yC(1,J,bi,bj)deg2rad))**4
184			gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
185			& - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
186	jmc	1.3.2.1	& *maskC(i,j,kLev,bi,bj)
187	adcroft	1.2	ENDDO
188			ENDDO
189
190			RETURN
191			END
192			CStartOfInterface
193			SUBROUTINE EXTERNAL_FORCING_S(
194			I iMin, iMax, jMin, jMax,bi,bj,kLev,
195			I myCurrentTime,myThid)
196			C /==========================================================\
197			C \| S/R EXTERNAL_FORCING_S \|
198			C \| o Contains problem specific forcing for merid velocity. \|
199			C \|==========================================================\|
200			C \| Adds terms to gS for forcing by external sources \|
201			C \| e.g. fresh-water flux, climatalogical relaxation....... \|
202			C \==========================================================/
203			IMPLICIT NONE
204
205			C == Global data ==
206			#include "SIZE.h"
207			#include "EEPARAMS.h"
208			#include "PARAMS.h"
209			#include "GRID.h"
210			#include "DYNVARS.h"
211			#include "FFIELDS.h"
212
213			C == Routine arguments ==
214			C iMin - Working range of tile for applying forcing.
215			C iMax
216			C jMin
217			C jMax
218			C kLev
219			INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
220			_RL myCurrentTime
221			INTEGER myThid
222			CEndOfInterface
223
224			C == Local variables ==
225			C Loop counters
226			INTEGER I, J
227
228	jmc	1.3.2.1	C-- Forcing term(s)
229	adcroft	1.2
230			RETURN
231			END