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

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

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


Revision 1.1.2.1 - (show annotations) (download)
Tue Jan 23 16:23:06 2001 UTC (20 years, 9 months ago) by adcroft
Branch: branch-atmos-merge
CVS Tags: branch-atmos-merge-shapiro, branch-atmos-merge-freeze, branch-atmos-merge-zonalfilt
Changes since 1.1: +268 -0 lines
Added new experiment: hs94.1x64x5

1 C $Header: /u/gcmpack/models/MITgcmUV-atmos-exact/verification/hs94.five-layer/code/external_forcing.F,v 1.2 2000/07/03 02:35:01 cnh Exp $
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

  ViewVC Help
Powered by ViewVC 1.1.22