/[MITgcm]/MITgcm/pkg/aim_v23/phy_driver.F
ViewVC logotype

Contents of /MITgcm/pkg/aim_v23/phy_driver.F

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


Revision 1.7 - (show annotations) (download)
Thu Jan 26 00:18:54 2006 UTC (18 years, 3 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint58b_post, checkpoint59, checkpoint58f_post, checkpoint58d_post, checkpoint58a_post, checkpoint62a, checkpoint58y_post, checkpoint58t_post, checkpoint58m_post, checkpoint60, checkpoint61, checkpoint62, checkpoint58w_post, checkpoint58o_post, checkpoint58p_post, checkpoint58q_post, checkpoint58e_post, checkpoint58r_post, checkpoint58n_post, checkpoint59q, checkpoint59p, checkpoint59r, checkpoint59e, checkpoint59d, checkpoint59g, checkpoint59f, checkpoint59a, checkpoint59c, checkpoint59b, checkpoint59m, checkpoint59l, checkpoint59o, checkpoint59n, checkpoint59i, checkpoint59h, checkpoint59k, checkpoint59j, checkpoint58k_post, checkpoint58v_post, checkpoint58l_post, checkpoint61f, checkpoint58g_post, checkpoint58x_post, checkpoint61n, checkpoint58h_post, checkpoint58j_post, checkpoint61q, checkpoint61z, checkpoint61e, checkpoint58i_post, checkpoint58c_post, checkpoint58u_post, checkpoint58s_post, checkpoint61g, checkpoint61d, checkpoint61b, checkpoint61c, checkpoint61a, checkpoint61o, checkpoint61l, checkpoint61m, checkpoint61j, checkpoint61k, checkpoint61h, checkpoint61i, checkpoint61v, checkpoint61w, checkpoint61t, checkpoint61u, checkpoint61r, checkpoint61s, checkpoint61p, checkpoint61x, checkpoint61y
Changes since 1.6: +16 -5 lines
add diagnostic for Donward LW radiation at the ground.

1 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/phy_driver.F,v 1.6 2004/06/24 23:43:11 jmc Exp $
2 C $Name: $
3
4 #include "AIM_OPTIONS.h"
5
6 SUBROUTINE PHY_DRIVER( tYear, usePkgDiag,
7 I bi, bj, myTime, myIter, myThid )
8
9 C------------------------
10 C from SPEDDY code: (part of original code left with c_FM)
11 C * S/R PHYPAR : except interp. dynamical Var. from Spectral of grid point
12 C here dynamical var. are loaded within S/R AIM_DYN2AIM.
13 C * S/R FORDATE: only the CALL SOL_OZ (done once / day in SPEEDY)
14 C------------------------
15 C-- SUBROUTINE PHYDRIVER (tYear, myTime, bi, bj, myThid )
16 C-- Purpose: stand-alone driver for physical parametrization routines
17 C-- Input : TYEAR : fraction of year (0 = 1jan.00, 1 = 31dec.24)
18 C-- grid-point model fields in common block: PHYGR1
19 C-- forcing fields in common blocks : LSMASK, FORFIX, FORCIN
20 C-- Output : Diagnosed upper-air variables in common block: PHYGR2
21 C-- Diagnosed surface variables in common block: PHYGR3
22 C-- Physical param. tendencies in common block: PHYTEN
23 C-- Surface and upper boundary fluxes in common block: FLUXES
24 C-------
25 C Note: tendencies are not /dpFac here but later in AIM_AIM2DYN
26 C-------
27
28 IMPLICIT NONE
29
30 C Resolution parameters
31
32 C-- size for MITgcm & Physics package :
33 #include "AIM_SIZE.h"
34 #include "EEPARAMS.h"
35
36 C-- Physics package
37 #include "AIM_PARAMS.h"
38 #include "AIM_GRID.h"
39
40 C Constants + functions of sigma and latitude
41 #include "com_physcon.h"
42
43 C Model variables, tendencies and fluxes on gaussian grid
44 #include "com_physvar.h"
45
46 C Surface forcing fields (time-inv. or functions of seasonal cycle)
47 #include "com_forcing.h"
48
49 C Constants for forcing fields:
50 #include "com_forcon.h"
51
52 C Radiation scheme variables
53 #include "com_radvar.h"
54
55 C Radiation constants
56 #include "com_radcon.h"
57
58 C Logical flags
59 c_FM include "com_lflags.h"
60
61 C-- Routine arguments:
62 _RL tYear
63 LOGICAL usePkgDiag
64 INTEGER bi,bj
65 _RL myTime
66 INTEGER myIter, myThid
67
68 #ifdef ALLOW_AIM
69
70 C-- Local variables:
71 C kGrd :: Ground level index (2-dim)
72 C dpFac :: cell delta_P fraction (3-dim)
73 C dTskin :: temp. correction for daily-cycle heating [K]
74 C T1s :: near-surface air temperature (from Pot.Temp)
75 C DENVV :: surface flux (sens,lat.) coeff. (=Rho*|V|) [kg/m2/s]
76 C Shf0 :: sensible heat flux over freezing surf.
77 C dShf :: sensible heat flux derivative relative to surf. temp
78 C Evp0 :: evaporation computed over freezing surface (Ts=0.oC)
79 C dEvp :: evaporation derivative relative to surf. temp
80 C Slr0 :: upward long wave radiation over freezing surf.
81 C dSlr :: upward long wave rad. derivative relative to surf. temp
82 C sFlx :: net surface flux (+=down) function of surf. temp Ts:
83 C 0: Flux(Ts=0.oC) ; 1: Flux(Ts^n) ; 2: d.Flux/d.Ts(Ts^n)
84 LOGICAL LRADSW
85 INTEGER ICLTOP(NGP)
86 INTEGER kGround(NGP)
87 _RL dpFac(NGP,NLEV)
88 c_FM REAL RPS(NGP), ST4S(NGP)
89 _RL ST4S(NGP)
90 _RL PSG_1(NGP), RPS_1
91 _RL dTskin(NGP), T1s(NGP), DENVV(NGP)
92 _RL Shf0(NGP), dShf(NGP), Evp0(NGP), dEvp(NGP)
93 _RL Slr0(NGP), dSlr(NGP), sFlx(NGP,0:2)
94
95 INTEGER J, K
96
97 #ifdef ALLOW_CLR_SKY_DIAG
98 _RL dummyR(NGP)
99 INTEGER dummyI(NGP)
100 #endif
101 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
102
103 C-- 1. Compute grid-point fields
104
105 C- 1.1 Convert model spectral variables to grid-point variables
106
107 CALL AIM_DYN2AIM(
108 O TG1, QG1, SE, VsurfSq, PSG, dpFac, kGround,
109 I bi, bj, myTime, myIter, myThid )
110
111 C- 1.2 Compute thermodynamic variables
112
113 C- 1.2.a Surface pressure (ps), 1/ps and surface temperature
114 RPS_1 = 1. _d 0
115 DO J=1,NGP
116 PSG_1(J)=1. _d 0
117 c_FM PSG(J)=EXP(PSLG1(J))
118 c_FM RPS(J)=1./PSG(J)
119 ENDDO
120
121 C 1.2.b Dry static energy
122 C <= replaced by Pot.Temp in aim_dyn2aim
123 c DO K=1,NLEV
124 c DO J=1,NGP
125 c_FM SE(J,K)=CP*TG1(J,K)+PHIG1(J,K)
126 c ENDDO
127 c ENDDO
128
129 C 1.2.c Relative humidity and saturation spec. humidity
130
131 DO K=1,NLEV
132 c_FM CALL SHTORH (1,NGP,TG1(1,K),PSG,SIG(K),QG1(1,K),
133 c_FM & RH(1,K),QSAT(1,K))
134 CALL SHTORH (1,NGP,TG1(1,K),PSG_1,SIG(K),QG1(1,K),
135 O RH(1,K,myThid),QSAT(1,K),
136 I myThid)
137 ENDDO
138
139 C-- 2. Precipitation
140
141 C 2.1 Deep convection
142
143 c_FM CALL CONVMF (PSG,SE,QG1,QSAT,
144 c_FM & ICLTOP,CBMF,PRECNV,TT_CNV,QT_CNV)
145 CALL CONVMF (PSG,dpFac,SE,QG1,QSAT,
146 O ICLTOP,CBMF(1,myThid),PRECNV(1,myThid),
147 O TT_CNV(1,1,myThid),QT_CNV(1,1,myThid),
148 I kGround,bi,bj,myThid)
149
150 DO K=2,NLEV
151 DO J=1,NGP
152 TT_CNV(J,K,myThid)=TT_CNV(J,K,myThid)*RPS_1*GRDSCP(K)
153 QT_CNV(J,K,myThid)=QT_CNV(J,K,myThid)*RPS_1*GRDSIG(K)
154 ENDDO
155 ENDDO
156
157 C 2.2 Large-scale condensation
158
159 c_FM CALL LSCOND (PSG,QG1,QSAT,
160 c_FM & PRECLS,TT_LSC,QT_LSC)
161 CALL LSCOND (PSG,dpFac,QG1,QSAT,
162 O PRECLS(1,myThid),TT_LSC(1,1,myThid),
163 O QT_LSC(1,1,myThid),
164 I kGround,bi,bj,myThid)
165
166 IF ( aim_energPrecip ) THEN
167 C 2.3 Snow Precipitation (update TT_CNV & TT_LSC)
168 CALL SNOW_PRECIP (
169 I PSG, dpFac, SE, ICLTOP,
170 I PRECNV(1,myThid), QT_CNV(1,1,myThid),
171 I PRECLS(1,myThid), QT_LSC(1,1,myThid),
172 U TT_CNV(1,1,myThid), TT_LSC(1,1,myThid),
173 O EnPrec(1,myThid),
174 I kGround,bi,bj,myThid)
175 ELSE
176 DO J=1,NGP
177 EnPrec(J,myThid) = 0. _d 0
178 ENDDO
179 ENDIF
180
181 C-- 3. Radiation (shortwave and longwave) and surface fluxes
182
183 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
184 C --> from FORDATE (in SPEEDY) :
185
186 C 3.0 Compute Incomming shortwave rad. (from FORDATE in SPEEDY)
187
188 c_FM CALL SOL_OZ (SOLC,TYEAR)
189 CALL SOL_OZ (SOLC,tYear, snLat(1,myThid), csLat(1,myThid),
190 O FSOL, OZONE, OZUPP, ZENIT, STRATZ,
191 I bi,bj,myThid)
192
193 C <-- from FORDATE (in SPEEDY).
194 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
195
196 C 3.1 Compute shortwave tendencies and initialize lw transmissivity
197
198 C The sw radiation may be called at selected time steps
199 LRADSW = .TRUE.
200
201 IF (LRADSW) THEN
202
203 c_FM CALL RADSW (PSG,QG1,RH,ALB1,
204 c_FM & ICLTOP,CLOUDC,TSR,SSR,TT_RSW)
205 ICLTOP(1) = 1
206 CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
207 I FSOL, OZONE, OZUPP, ZENIT, STRATZ,
208 O TAU2, STRATC,
209 O ICLTOP,CLOUDC(1,myThid),
210 O TSR(1,myThid),SSR(1,0,myThid),TT_RSW(1,1,myThid),
211 I kGround,bi,bj,myThid)
212
213 DO J=1,NGP
214 CLTOP(J,myThid)=SIGH(ICLTOP(J)-1)*PSG_1(J)
215 ENDDO
216
217 DO K=1,NLEV
218 DO J=1,NGP
219 TT_RSW(J,K,myThid)=TT_RSW(J,K,myThid)*RPS_1*GRDSCP(K)
220 ENDDO
221 ENDDO
222
223 ENDIF
224
225 C 3.2 Compute downward longwave fluxes
226
227 c_FM CALL RADLW (-1,TG1,TS,ST4S,
228 c_FM & OLR,SLR,TT_RLW)
229 CALL RADLW (-1,TG1,TS(1,myThid),ST4S,
230 & OZUPP, STRATC, TAU2, FLUX, ST4A,
231 O OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
232 I kGround,bi,bj,myThid)
233
234 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
235 C 3.3. Compute surface fluxes and land skin temperature
236
237 c_FM CALL SUFLUX (PSG,UG1,VG1,TG1,QG1,RH,PHIG1,
238 c_FM & PHIS0,FMASK1,STL1,SST1,SOILW1,SSR,SLR,
239 c_FM & USTR,VSTR,SHF,EVAP,ST4S,
240 c_FM & TS,TSKIN,U0,V0,T0,Q0)
241 CALL SUFLUX_PREP(
242 I PSG, TG1, QG1, RH(1,1,myThid), SE, VsurfSq,
243 I WVSurf(1,myThid),csLat(1,myThid),fOrogr(1,myThid),
244 I FMASK1(1,1,myThid),STL1(1,myThid),SST1(1,myThid),
245 I sti1(1,myThid), SSR(1,0,myThid),
246 O SPEED0(1,myThid),DRAG(1,0,myThid),DENVV,
247 O dTskin,T1s,T0(1,myThid),Q0(1,myThid),
248 I kGround,bi,bj,myThid)
249
250 CALL SUFLUX_LAND (
251 I PSG, FMASK1(1,1,myThid), EMISFC,
252 I STL1(1,myThid), dTskin,
253 I SOILW1(1,myThid), SSR(1,1,myThid), SLR(1,0,myThid),
254 I T1s, T0(1,myThid), Q0(1,myThid), DENVV,
255 O SHF(1,1,myThid), EVAP(1,1,myThid), SLR(1,1,myThid),
256 O Shf0, dShf, Evp0, dEvp, Slr0, dSlr, sFlx,
257 O TS(1,myThid), TSKIN(1,myThid),
258 I bi,bj,myThid)
259 #ifdef ALLOW_LAND
260 CALL AIM_LAND_IMPL(
261 I FMASK1(1,1,myThid), dTskin,
262 I Shf0, dShf, Evp0, dEvp, Slr0, dSlr,
263 U sFlx, STL1(1,myThid),
264 U SHF(1,1,myThid), EVAP(1,1,myThid), SLR(1,1,myThid),
265 O dTsurf(1,1,myThid),
266 I bi, bj, myTime, myIter, myThid)
267 #endif /* ALLOW_LAND */
268
269 CALL SUFLUX_OCEAN(
270 I PSG, FMASK1(1,2,myThid),
271 I SST1(1,myThid),
272 I SSR(1,2,myThid), SLR(1,0,myThid),
273 O T1s, T0(1,myThid), Q0(1,myThid), DENVV,
274 O SHF(1,2,myThid), EVAP(1,2,myThid), SLR(1,2,myThid),
275 I bi,bj,myThid)
276
277 IF ( aim_splitSIOsFx ) THEN
278 CALL SUFLUX_SICE (
279 I PSG, FMASK1(1,3,myThid), EMISFC,
280 I STI1(1,myThid), dTskin,
281 I SSR(1,3,myThid), SLR(1,0,myThid),
282 I T1s, T0(1,myThid), Q0(1,myThid), DENVV,
283 O SHF(1,3,myThid), EVAP(1,3,myThid), SLR(1,3,myThid),
284 O Shf0, dShf, Evp0, dEvp, Slr0, dSlr, sFlx,
285 O TS(1,myThid), TSKIN(1,myThid),
286 I bi,bj,myThid)
287 #ifdef ALLOW_THSICE
288 CALL AIM_SICE_IMPL(
289 I FMASK1(1,3,myThid), SSR(1,3,myThid), sFlx,
290 I Shf0, dShf, Evp0, dEvp, Slr0, dSlr,
291 U STI1(1,myThid),
292 U SHF(1,3,myThid), EVAP(1,3,myThid), SLR(1,3,myThid),
293 O dTsurf(1,3,myThid),
294 I bi, bj, myTime, myIter, myThid)
295 #endif /* ALLOW_THSICE */
296 ELSE
297 DO J=1,NGP
298 SHF (J,3,myThid) = 0. _d 0
299 EVAP(J,3,myThid) = 0. _d 0
300 SLR (J,3,myThid) = 0. _d 0
301 ENDDO
302 ENDIF
303
304 CALL SUFLUX_POST(
305 I FMASK1(1,1,myThid), EMISFC,
306 I STL1(1,myThid), SST1(1,myThid), sti1(1,myThid),
307 I dTskin, SLR(1,0,myThid),
308 I T0(1,myThid), Q0(1,myThid), DENVV,
309 U DRAG(1,0,myThid), SHF(1,0,myThid),
310 U EVAP(1,0,myThid), SLR(1,1,myThid),
311 O ST4S, TS(1,myThid), TSKIN(1,myThid),
312 I bi,bj,myThid)
313
314 #ifdef ALLOW_DIAGNOSTICS
315 IF ( usePkgDiag ) THEN
316 CALL DIAGNOSTICS_FILL( SLR(1,0,myThid),
317 & 'DWNLWG ', 1, 1 , 3,bi,bj, myThid )
318 ENDIF
319 #endif
320 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
321
322 C 3.4 Compute upward longwave fluxes, convert them to tendencies
323 C and add shortwave tendencies
324
325 c_FM CALL RADLW (1,TG1,TS,ST4S,
326 c_FM & OLR,SLR,TT_RLW)
327 CALL RADLW (1,TG1,TS(1,myThid),ST4S,
328 & OZUPP, STRATC, TAU2, FLUX, ST4A,
329 O OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
330 I kGround,bi,bj,myThid)
331
332 DO K=1,NLEV
333 DO J=1,NGP
334 TT_RLW(J,K,myThid)=TT_RLW(J,K,myThid)*RPS_1*GRDSCP(K)
335 c_FM TTEND (J,K)=TTEND(J,K)+TT_RSW(J,K)+TT_RLW(J,K)
336 ENDDO
337 ENDDO
338
339 #ifdef ALLOW_CLR_SKY_DIAG
340 C 3.5 Compute clear-sky radiation (for diagnostics only)
341 IF ( aim_clrSkyDiag ) THEN
342
343 C 3.5.1 Compute shortwave tendencies
344 dummyI(1) = -1
345 CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
346 I FSOL, OZONE, OZUPP, ZENIT, STRATZ,
347 O TAU2, STRATC,
348 O dummyI, dummyR,
349 O TSWclr(1,myThid), SSWclr(1,myThid), TT_SWclr(1,1,myThid),
350 I kGround,bi,bj,myThid)
351
352 C 3.5.2 Compute downward longwave fluxes
353
354 CALL RADLW (-1,TG1,TS(1,myThid),ST4S,
355 & OZUPP, STRATC, TAU2, FLUX, ST4A,
356 O OLWclr(1,myThid), SLWclr(1,myThid), TT_LWclr(1,1,myThid),
357 I kGround,bi,bj,myThid)
358
359 C 3.5.3 Compute upward longwave fluxes, convert them to tendencies
360
361 CALL RADLW (1,TG1,TS(1,myThid),ST4S,
362 & OZUPP, STRATC, TAU2, FLUX, ST4A,
363 O OLWclr(1,myThid), SLWclr(1,myThid), TT_LWclr(1,1,myThid),
364 I kGround,bi,bj,myThid)
365
366 DO K=1,NLEV
367 DO J=1,NGP
368 TT_SWclr(J,K,myThid)=TT_SWclr(J,K,myThid)*RPS_1*GRDSCP(K)
369 TT_LWclr(J,K,myThid)=TT_LWclr(J,K,myThid)*RPS_1*GRDSCP(K)
370 ENDDO
371 ENDDO
372
373 ENDIF
374 #endif /* ALLOW_CLR_SKY_DIAG */
375
376 C-- 4. PBL interactions with lower troposphere
377
378 C 4.1 Vertical diffusion and shallow convection
379
380 c_FM CALL VDIFSC (UG1,VG1,SE,RH,QG1,QSAT,PHIG1,
381 c_FM & UT_PBL,VT_PBL,TT_PBL,QT_PBL)
382 CALL VDIFSC (dpFac, SE, RH(1,1,myThid), QG1, QSAT,
383 O TT_PBL(1,1,myThid),QT_PBL(1,1,myThid),
384 I kGround,bi,bj,myThid)
385
386 C 4.2 Add tendencies due to surface fluxes
387
388 DO J=1,NGP
389 c_FM UT_PBL(J,NLEV)=UT_PBL(J,NLEV)+USTR(J,3)*RPS(J)*GRDSIG(NLEV)
390 c_FM VT_PBL(J,NLEV)=VT_PBL(J,NLEV)+VSTR(J,3)*RPS(J)*GRDSIG(NLEV)
391 c_FM TT_PBL(J,NLEV)=TT_PBL(J,NLEV)+ SHF(J,3)*RPS(J)*GRDSCP(NLEV)
392 c_FM QT_PBL(J,NLEV)=QT_PBL(J,NLEV)+EVAP(J,3)*RPS(J)*GRDSIG(NLEV)
393 K = kGround(J)
394 IF ( K.GT.0 ) THEN
395 TT_PBL(J,K,myThid) = TT_PBL(J,K,myThid)
396 & + SHF(J,0,myThid) *RPS_1*GRDSCP(K)
397 QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)
398 & + EVAP(J,0,myThid)*RPS_1*GRDSIG(K)
399 ENDIF
400 ENDDO
401
402 c_FM DO K=1,NLEV
403 c_FM DO J=1,NGP
404 c_FM UTEND(J,K)=UTEND(J,K)+UT_PBL(J,K)
405 c_FM VTEND(J,K)=VTEND(J,K)+VT_PBL(J,K)
406 c_FM TTEND(J,K)=TTEND(J,K)+TT_PBL(J,K)
407 c_FM QTEND(J,K)=QTEND(J,K)+QT_PBL(J,K)
408 c_FM ENDDO
409 c_FM ENDDO
410
411 #endif /* ALLOW_AIM */
412
413 RETURN
414 END

  ViewVC Help
Powered by ViewVC 1.1.22