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

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

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


Revision 1.6 - (hide 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 jmc 1.6 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/phy_driver.F,v 1.5 2004/05/21 17:43:04 jmc Exp $
2 jmc 1.1 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 jmc 1.3
35     C-- Physics package
36     #include "AIM_PARAMS.h"
37 jmc 1.1 #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 jmc 1.3 C Radiation constants
55     #include "com_radcon.h"
56    
57 jmc 1.1 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 jmc 1.3 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 jmc 1.6 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 jmc 1.3 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 jmc 1.1 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 jmc 1.6 _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 jmc 1.1
91     INTEGER J, K
92    
93 jmc 1.6 #ifdef ALLOW_CLR_SKY_DIAG
94     _RL dummyR(NGP)
95     INTEGER dummyI(NGP)
96     #endif
97 jmc 1.1 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 jmc 1.3 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 jmc 1.1 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 jmc 1.6 ICLTOP(1) = 1
202 jmc 1.3 CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
203 jmc 1.1 I FSOL, OZONE, OZUPP, ZENIT, STRATZ,
204     O TAU2, STRATC,
205     O ICLTOP,CLOUDC(1,myThid),
206 jmc 1.3 O TSR(1,myThid),SSR(1,0,myThid),TT_RSW(1,1,myThid),
207 jmc 1.1 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 jmc 1.3 O OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
228 jmc 1.1 I kGround,bi,bj,myThid)
229    
230 jmc 1.3 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
231 jmc 1.1 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 jmc 1.3 CALL SUFLUX_PREP(
238     I PSG, TG1, QG1, RH(1,1,myThid), SE, VsurfSq,
239 jmc 1.1 I WVSurf(1,myThid),csLat(1,myThid),fOrogr(1,myThid),
240 jmc 1.3 I FMASK1(1,1,myThid),STL1(1,myThid),SST1(1,myThid),
241     I sti1(1,myThid), SSR(1,0,myThid),
242 jmc 1.6 O SPEED0(1,myThid),DRAG(1,0,myThid),DENVV,
243     O dTskin,T1s,T0(1,myThid),Q0(1,myThid),
244 jmc 1.1 I kGround,bi,bj,myThid)
245    
246 jmc 1.3 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 jmc 1.6 I T1s, T0(1,myThid), Q0(1,myThid), DENVV,
251 jmc 1.3 O SHF(1,1,myThid), EVAP(1,1,myThid), SLR(1,1,myThid),
252 jmc 1.6 O Shf0, dShf, Evp0, dEvp, Slr0, dSlr, sFlx,
253 jmc 1.3 O TS(1,myThid), TSKIN(1,myThid),
254     I bi,bj,myThid)
255     #ifdef ALLOW_LAND
256     CALL AIM_LAND_IMPL(
257 jmc 1.5 I FMASK1(1,1,myThid), dTskin,
258 jmc 1.6 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 jmc 1.3 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 jmc 1.6 O T1s, T0(1,myThid), Q0(1,myThid), DENVV,
270 jmc 1.3 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 jmc 1.6 I T1s, T0(1,myThid), Q0(1,myThid), DENVV,
279 jmc 1.3 O SHF(1,3,myThid), EVAP(1,3,myThid), SLR(1,3,myThid),
280 jmc 1.6 O Shf0, dShf, Evp0, dEvp, Slr0, dSlr, sFlx,
281 jmc 1.3 O TS(1,myThid), TSKIN(1,myThid),
282     I bi,bj,myThid)
283 jmc 1.4 #ifdef ALLOW_THSICE
284     CALL AIM_SICE_IMPL(
285     I FMASK1(1,3,myThid), SSR(1,3,myThid), sFlx,
286 jmc 1.6 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 jmc 1.4 I bi, bj, myTime, myIter, myThid)
291     #endif /* ALLOW_THSICE */
292 jmc 1.3 ELSE
293     DO J=1,NGP
294 jmc 1.6 SHF (J,3,myThid) = 0. _d 0
295 jmc 1.3 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 jmc 1.6 I T0(1,myThid), Q0(1,myThid), DENVV,
305 jmc 1.3 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 jmc 1.1 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 jmc 1.3 O OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
319 jmc 1.1 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 jmc 1.6 #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 jmc 1.1 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 jmc 1.3 & + SHF(J,0,myThid) *RPS_1*GRDSCP(K)
386 jmc 1.1 QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)
387 jmc 1.3 & + EVAP(J,0,myThid)*RPS_1*GRDSIG(K)
388 jmc 1.1 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