/[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.6 - (show annotations) (download)
Thu Jun 24 23:43:11 2004 UTC (19 years, 10 months ago) by jmc
Branch: MAIN
CVS Tags: checkpoint57m_post, checkpoint57g_pre, checkpoint57s_post, checkpoint57b_post, checkpoint57g_post, checkpoint56b_post, checkpoint57y_post, checkpoint54d_post, checkpoint54e_post, checkpoint57r_post, checkpoint57d_post, checkpoint57i_post, checkpoint58, checkpoint55, checkpoint54, checkpoint57, checkpoint56, checkpoint57n_post, checkpoint57z_post, checkpoint54f_post, checkpoint55i_post, checkpoint57l_post, checkpoint57t_post, checkpoint55c_post, checkpoint57v_post, checkpoint57f_post, checkpoint57a_post, checkpoint57h_pre, checkpoint54b_post, checkpoint57h_post, checkpoint57y_pre, checkpoint55g_post, checkpoint57c_post, checkpoint55d_post, checkpoint54a_pre, checkpoint55d_pre, checkpoint57c_pre, checkpoint55j_post, checkpoint54a_post, checkpoint55h_post, checkpoint57e_post, checkpoint55b_post, checkpoint55f_post, checkpoint53g_post, checkpoint57p_post, checkpint57u_post, checkpoint57q_post, eckpoint57e_pre, checkpoint56a_post, checkpoint53f_post, checkpoint57h_done, checkpoint57j_post, checkpoint57f_pre, checkpoint56c_post, checkpoint57a_pre, checkpoint55a_post, checkpoint57o_post, checkpoint57k_post, checkpoint57w_post, checkpoint57x_post, checkpoint55e_post, checkpoint54c_post
Changes since 1.5: +67 -19 lines
- include stability function into surf.Flux derivative relative to Ts
- calculate clear-sky radiation & surface temp. change
- update diagnostics (snap-shot, timeave & diagnostics)

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

  ViewVC Help
Powered by ViewVC 1.1.22