/[MITgcm]/MITgcm/verification/hs94.1x64x5/code/external_forcing.F
ViewVC logotype

Diff of /MITgcm/verification/hs94.1x64x5/code/external_forcing.F

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph | View Patch Patch

revision 1.1 by adcroft, Tue Jan 23 16:23:06 2001 UTC revision 1.2 by adcroft, Fri Feb 2 21:36:34 2001 UTC
# Line 0  Line 1 
1    C $Header$
2    
3    #include "CPP_OPTIONS.h"
4    
5    CStartOfInterface
6          SUBROUTINE EXTERNAL_FORCING_U(
7         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
8         I           myCurrentTime,myThid)
9    C     /==========================================================\
10    C     | S/R EXTERNAL_FORCING_U                                   |
11    C     | o Contains problem specific forcing for zonal velocity.  |
12    C     |==========================================================|
13    C     | Adds terms to gU for forcing by external sources         |
14    C     | e.g. wind stress, bottom friction etc..................  |
15    C     \==========================================================/
16    
17    C     == Global data ==
18    #include "SIZE.h"
19    #include "EEPARAMS.h"
20    #include "PARAMS.h"
21    #include "GRID.h"
22    #include "DYNVARS.h"
23    #include "FFIELDS.h"
24    
25    #ifdef USE_FRANCO_PHYSICS
26    #include "atparam0.h"
27    #include "atparam1.h"
28          INTEGER NGP
29          INTEGER NLON
30          INTEGER NLAT
31          INTEGER NLEV
32          PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
33    #include "com_physvar.h"
34    #define _KDKA( KD ) Nr-KD+1
35    #endif
36    
37    C     == Routine arguments ==
38    C     iMin - Working range of tile for applying forcing.
39    C     iMax
40    C     jMin
41    C     jMax
42    C     kLev
43          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
44          _RL myCurrentTime
45          INTEGER myThid
46    CEndOfInterface
47    
48    C     == Local variables ==
49    C     Loop counters
50          INTEGER I, J
51    C     _RL uKf
52    C     _RL levelOfGround
53    C     _RL criticalLevel
54    C     _RL levelOfVelPoint
55    C     _RL dist1
56    C     _RL dist2
57    C     _RL decayFac
58    C     _RL velDragHeightFac
59          _RL termP,kV,kF
60    
61    C--   Forcing term(s)
62          kF=1./86400.
63          DO J=jMin,jMax
64           DO I=iMin,iMax
65            IF ( HFacW(i,j,kLev,bi,bj) .GT. 0. ) THEN
66             termP=0.5*( rF(kLev) + rF(kLev+1) )
67             kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )
68             gU(i,j,kLev,bi,bj)=gU(i,j,kLev,bi,bj)
69         &                      -kV*uVel(i,j,kLev,bi,bj)
70            ENDIF
71           ENDDO
72          ENDDO
73    
74          RETURN
75          END
76    CStartOfInterface
77          SUBROUTINE EXTERNAL_FORCING_V(
78         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
79         I           myCurrentTime,myThid)
80    C     /==========================================================\
81    C     | S/R EXTERNAL_FORCING_V                                   |
82    C     | o Contains problem specific forcing for merid velocity.  |
83    C     |==========================================================|
84    C     | Adds terms to gV for forcing by external sources         |
85    C     | e.g. wind stress, bottom friction etc..................  |
86    C     \==========================================================/
87          IMPLICIT NONE
88    
89    C     == Global data ==
90    #include "SIZE.h"
91    #include "EEPARAMS.h"
92    #include "PARAMS.h"
93    #include "GRID.h"
94    #include "DYNVARS.h"
95    #include "FFIELDS.h"
96    
97    
98    C     == Routine arguments ==
99    C     iMin - Working range of tile for applying forcing.
100    C     iMax
101    C     jMin
102    C     jMax
103    C     kLev
104          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
105          _RL myCurrentTime
106          INTEGER myThid
107    CEndOfInterface
108    C     == Local variables ==
109    C     Loop counters
110          INTEGER I, J
111    C     _RL uKf
112    C     _RL levelOfGround
113    C     _RL criticalLevel
114    C     _RL levelOfVelPoint
115    C     _RL dist1
116    C     _RL dist2
117    C     _RL decayFac
118    C     _RL velDragHeightFac
119          _RL termP,kV,kF
120    
121    C--   Forcing term(s)
122          kF=1./86400.
123          DO J=jMin,jMax
124           DO I=iMin,iMax
125            IF ( HFacS(i,j,kLev,bi,bj) .GT. 0. ) THEN
126             termP=0.5*( rF(kLev) + rF(kLev+1) )
127             kV=kF*MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )
128             gV(i,j,kLev,bi,bj)=gV(i,j,kLev,bi,bj)
129         &                      -kV*vVel(i,j,kLev,bi,bj)
130            ENDIF
131           ENDDO
132          ENDDO
133    
134          RETURN
135          END
136    
137    CStartOfInterface
138          SUBROUTINE EXTERNAL_FORCING_T(
139         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
140         I           maskC,
141         I           myCurrentTime,myThid)
142    C     /==========================================================\
143    C     | S/R EXTERNAL_FORCING_T                                   |
144    C     | o Contains problem specific forcing for temperature.     |
145    C     |==========================================================|
146    C     | Adds terms to gT for forcing by external sources         |
147    C     | e.g. heat flux, climatalogical relaxation..............  |
148    C     \==========================================================/
149          IMPLICIT NONE
150    
151    C     == Global data ==
152    #include "SIZE.h"
153    #include "EEPARAMS.h"
154    #include "PARAMS.h"
155    #include "GRID.h"
156    #include "DYNVARS.h"
157    #include "FFIELDS.h"
158    
159    #ifdef USE_FRANCO_PHYSICS
160    #include "atparam0.h"
161    #include "atparam1.h"
162          INTEGER NGP
163          INTEGER NLON
164          INTEGER NLAT
165          INTEGER NLEV
166          PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
167    #include "com_physvar.h"
168    #define _KDKA( KD ) Nr-KD+1
169    #endif
170    
171    C     == Routine arguments ==
172    C     iMin - Working range of tile for applying forcing.
173    C     iMax
174    C     jMin
175    C     jMax
176    C     kLev
177          _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
178          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
179          _RL myCurrentTime
180          INTEGER myThid
181    CEndOfInterface
182    
183    C     == Local variables ==
184    C     Loop counters
185          INTEGER I, J
186          _RL thetaLim,kT,ka,ks,term1,term2,thetaEq,termP,rSurf
187    
188    C--   Forcing term(s)
189          rSurf=1.E5
190          ka=1./(40.*86400.)
191          ks=1./(4. *86400.)
192          DO J=jMin,jMax
193           term1=60.*(sin(yC(1,J,bi,bj)*deg2rad)**2)
194    C      termP=0.5*( rF(kLev) + min( rF(kLev+1) , H(I,J,bi,bj) ) )
195           termP=0.5*( rF(kLev) + rF(kLev+1) )
196    C      termP=rC(kLev)
197           term2=10.*log(termP/rSurf)
198         &          *(cos(yC(1,J,bi,bj)*deg2rad)**2)
199           thetaLim = 200. / ((termP/rSurf)**(2./7.))
200    C      thetaLim = 170. / ((termP/rSurf)**(2./7.))
201           thetaEq=315.-term1-term2
202           thetaEq=MAX(thetaLim,thetaEq)
203           DO I=iMin,iMax
204            kT=ka+(ks-ka)
205         &    *MAX(0., (termP*recip_H(I,J,bi,bj)-0.7)/(1.-0.7) )
206         &    *COS((yC(1,J,bi,bj)*deg2rad))**4
207             gT(i,j,kLev,bi,bj)=gT(i,j,kLev,bi,bj)
208         &        - kT*( theta(I,J,kLev,bi,bj)-thetaEq )
209         &            *maskC(i,j)
210           ENDDO
211          ENDDO
212    
213          RETURN
214          END
215    
216    CStartOfInterface
217          SUBROUTINE EXTERNAL_FORCING_S(
218         I           iMin, iMax, jMin, jMax,bi,bj,kLev,
219         I           maskC,
220         I           myCurrentTime,myThid)
221    C     /==========================================================\
222    C     | S/R EXTERNAL_FORCING_S                                   |
223    C     | o Contains problem specific forcing for merid velocity.  |
224    C     |==========================================================|
225    C     | Adds terms to gS for forcing by external sources         |
226    C     | e.g. fresh-water flux, climatalogical relaxation.......  |
227    C     \==========================================================/
228          IMPLICIT NONE
229    
230    C     == Global data ==
231    #include "SIZE.h"
232    #include "EEPARAMS.h"
233    #include "PARAMS.h"
234    #include "GRID.h"
235    #include "DYNVARS.h"
236    #include "FFIELDS.h"
237    
238    #ifdef USE_FRANCO_PHYSICS
239    #include "atparam0.h"
240    #include "atparam1.h"
241          INTEGER NGP
242          INTEGER NLON
243          INTEGER NLAT
244          INTEGER NLEV
245          PARAMETER ( NLON=IX, NLAT=IL, NLEV=KX, NGP=NLON*NLAT )
246    #include "com_physvar.h"
247    #define _KDKA( KD ) Nr-KD+1
248    #endif
249    
250    C     == Routine arguments ==
251    C     iMin - Working range of tile for applying forcing.
252    C     iMax
253    C     jMin
254    C     jMax
255    C     kLev
256          _RS maskC (1-OLx:sNx+OLx,1-OLy:sNy+OLy)
257          INTEGER iMin, iMax, jMin, jMax, kLev, bi, bj
258          _RL myCurrentTime
259          INTEGER myThid
260    CEndOfInterface
261    
262    C     == Local variables ==
263    C     Loop counters
264    
265    C--   Forcing term
266    
267          RETURN
268          END
Legend:
Removed from v.1.1  
changed lines
  Added in v.1.2
  ViewVC Help
Powered by ViewVC 1.1.22