/[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.4 - (hide annotations) (download)
Thu Apr 8 00:14:09 2004 UTC (20 years, 1 month ago) by jmc
Branch: MAIN
CVS Tags: checkpoint53, checkpoint52m_post, checkpoint53a_post, checkpoint52n_post, checkpoint53b_pre, checkpoint53b_post
Changes since 1.3: +8 -1 lines
allow to use ThSIce (with salb ocean) with AIM:
 - compute ice and surface temp. implicitly (aim_sice_impl alled from phy_driver)
 - call thermodynamic sea-ice model at the end of aim_do_physics.F

1 jmc 1.4 C $Header: /u/gcmpack/MITgcm/pkg/aim_v23/phy_driver.F,v 1.3 2004/03/11 14:33:19 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 #include "com_sflcon.h"
58    
59     C Logical flags
60     c_FM include "com_lflags.h"
61    
62     C-- Routine arguments:
63     _RL tYear, myTime
64     INTEGER myIter, bi,bj, myThid
65    
66     #ifdef ALLOW_AIM
67    
68     C-- Local variables:
69 jmc 1.3 C kGrd :: Ground level index (2-dim)
70     C dpFac :: cell delta_P fraction (3-dim)
71     C dTskin :: temp. correction for daily-cycle heating [K]
72     C CDENVV :: sensible heat flux coefficient (1:land, 2:sea, 3:sea-ice)
73     C Evp0 :: evaporation computed over freezing surface (Ts=0.oC)
74     C dEvp :: evaporation derivative relative to surf. temp
75     C Slr0 :: upward long wave radiation over freezing surf.
76     C dSlr :: upward long wave rad. derivative relative to surf. temp
77     C sFlx :: net surface flux (+=down) function of surf. temp Ts:
78     C 0: Flux(Ts=0.oC) ; 1: Flux(Ts^n) ; 2: d.Flux/d.Ts(Ts^n)
79 jmc 1.1 LOGICAL LRADSW
80     INTEGER ICLTOP(NGP)
81     INTEGER kGround(NGP)
82     _RL dpFac(NGP,NLEV)
83     c_FM REAL RPS(NGP), ST4S(NGP)
84     _RL ST4S(NGP)
85     _RL PSG_1(NGP), RPS_1
86 jmc 1.3 _RL dTskin(NGP), CDENVV(NGP,3)
87     _RL Evp0(NGP), dEvp(NGP), Slr0(NGP), dSlr(NGP), sFlx(NGP,0:2)
88 jmc 1.1
89     INTEGER J, K
90    
91     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
92    
93     C-- 1. Compute grid-point fields
94    
95     C- 1.1 Convert model spectral variables to grid-point variables
96    
97     CALL AIM_DYN2AIM(
98     O TG1, QG1, SE, VsurfSq, PSG, dpFac, kGround,
99     I bi, bj, myTime, myIter, myThid )
100    
101     C- 1.2 Compute thermodynamic variables
102    
103     C- 1.2.a Surface pressure (ps), 1/ps and surface temperature
104     RPS_1 = 1. _d 0
105     DO J=1,NGP
106     PSG_1(J)=1. _d 0
107     c_FM PSG(J)=EXP(PSLG1(J))
108     c_FM RPS(J)=1./PSG(J)
109     ENDDO
110    
111     C 1.2.b Dry static energy
112     C <= replaced by Pot.Temp in aim_dyn2aim
113     c DO K=1,NLEV
114     c DO J=1,NGP
115     c_FM SE(J,K)=CP*TG1(J,K)+PHIG1(J,K)
116     c ENDDO
117     c ENDDO
118    
119     C 1.2.c Relative humidity and saturation spec. humidity
120    
121     DO K=1,NLEV
122     c_FM CALL SHTORH (1,NGP,TG1(1,K),PSG,SIG(K),QG1(1,K),
123     c_FM & RH(1,K),QSAT(1,K))
124     CALL SHTORH (1,NGP,TG1(1,K),PSG_1,SIG(K),QG1(1,K),
125     O RH(1,K,myThid),QSAT(1,K),
126     I myThid)
127     ENDDO
128    
129     C-- 2. Precipitation
130    
131     C 2.1 Deep convection
132    
133     c_FM CALL CONVMF (PSG,SE,QG1,QSAT,
134     c_FM & ICLTOP,CBMF,PRECNV,TT_CNV,QT_CNV)
135     CALL CONVMF (PSG,dpFac,SE,QG1,QSAT,
136     O ICLTOP,CBMF(1,myThid),PRECNV(1,myThid),
137     O TT_CNV(1,1,myThid),QT_CNV(1,1,myThid),
138     I kGround,bi,bj,myThid)
139    
140     DO K=2,NLEV
141     DO J=1,NGP
142     TT_CNV(J,K,myThid)=TT_CNV(J,K,myThid)*RPS_1*GRDSCP(K)
143     QT_CNV(J,K,myThid)=QT_CNV(J,K,myThid)*RPS_1*GRDSIG(K)
144     ENDDO
145     ENDDO
146    
147     C 2.2 Large-scale condensation
148    
149     c_FM CALL LSCOND (PSG,QG1,QSAT,
150     c_FM & PRECLS,TT_LSC,QT_LSC)
151     CALL LSCOND (PSG,dpFac,QG1,QSAT,
152     O PRECLS(1,myThid),TT_LSC(1,1,myThid),
153     O QT_LSC(1,1,myThid),
154     I kGround,bi,bj,myThid)
155    
156 jmc 1.3 IF ( aim_energPrecip ) THEN
157     C 2.3 Snow Precipitation (update TT_CNV & TT_LSC)
158     CALL SNOW_PRECIP (
159     I PSG, dpFac, SE, ICLTOP,
160     I PRECNV(1,myThid), QT_CNV(1,1,myThid),
161     I PRECLS(1,myThid), QT_LSC(1,1,myThid),
162     U TT_CNV(1,1,myThid), TT_LSC(1,1,myThid),
163     O EnPrec(1,myThid),
164     I kGround,bi,bj,myThid)
165     ELSE
166     DO J=1,NGP
167     EnPrec(J,myThid) = 0. _d 0
168     ENDDO
169     ENDIF
170    
171 jmc 1.1 C-- 3. Radiation (shortwave and longwave) and surface fluxes
172    
173     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
174     C --> from FORDATE (in SPEEDY) :
175    
176     C 3.0 Compute Incomming shortwave rad. (from FORDATE in SPEEDY)
177    
178     c_FM CALL SOL_OZ (SOLC,TYEAR)
179     CALL SOL_OZ (SOLC,tYear, snLat(1,myThid), csLat(1,myThid),
180     O FSOL, OZONE, OZUPP, ZENIT, STRATZ,
181     I bi,bj,myThid)
182    
183     C <-- from FORDATE (in SPEEDY).
184     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
185    
186     C 3.1 Compute shortwave tendencies and initialize lw transmissivity
187    
188     C The sw radiation may be called at selected time steps
189     LRADSW = .TRUE.
190    
191     IF (LRADSW) THEN
192    
193     c_FM CALL RADSW (PSG,QG1,RH,ALB1,
194     c_FM & ICLTOP,CLOUDC,TSR,SSR,TT_RSW)
195 jmc 1.3 CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
196 jmc 1.1 I FSOL, OZONE, OZUPP, ZENIT, STRATZ,
197     O TAU2, STRATC,
198     O ICLTOP,CLOUDC(1,myThid),
199 jmc 1.3 O TSR(1,myThid),SSR(1,0,myThid),TT_RSW(1,1,myThid),
200 jmc 1.1 I kGround,bi,bj,myThid)
201    
202     DO J=1,NGP
203     CLTOP(J,myThid)=SIGH(ICLTOP(J)-1)*PSG_1(J)
204     ENDDO
205    
206     DO K=1,NLEV
207     DO J=1,NGP
208     TT_RSW(J,K,myThid)=TT_RSW(J,K,myThid)*RPS_1*GRDSCP(K)
209     ENDDO
210     ENDDO
211    
212     ENDIF
213    
214     C 3.2 Compute downward longwave fluxes
215    
216     c_FM CALL RADLW (-1,TG1,TS,ST4S,
217     c_FM & OLR,SLR,TT_RLW)
218     CALL RADLW (-1,TG1,TS(1,myThid),ST4S,
219     & OZUPP, STRATC, TAU2, FLUX, ST4A,
220 jmc 1.3 O OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
221 jmc 1.1 I kGround,bi,bj,myThid)
222    
223 jmc 1.3 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
224 jmc 1.1 C 3.3. Compute surface fluxes and land skin temperature
225    
226     c_FM CALL SUFLUX (PSG,UG1,VG1,TG1,QG1,RH,PHIG1,
227     c_FM & PHIS0,FMASK1,STL1,SST1,SOILW1,SSR,SLR,
228     c_FM & USTR,VSTR,SHF,EVAP,ST4S,
229     c_FM & TS,TSKIN,U0,V0,T0,Q0)
230 jmc 1.3 CALL SUFLUX_PREP(
231     I PSG, TG1, QG1, RH(1,1,myThid), SE, VsurfSq,
232 jmc 1.1 I WVSurf(1,myThid),csLat(1,myThid),fOrogr(1,myThid),
233 jmc 1.3 I FMASK1(1,1,myThid),STL1(1,myThid),SST1(1,myThid),
234     I sti1(1,myThid), SSR(1,0,myThid),
235     O SPEED0(1,myThid),DRAG(1,0,myThid),CDENVV,
236     O dTskin,T0(1,myThid),Q0(1,myThid),
237 jmc 1.1 I kGround,bi,bj,myThid)
238    
239 jmc 1.3 CALL SUFLUX_LAND (
240     I PSG, FMASK1(1,1,myThid), EMISFC,
241     I STL1(1,myThid), dTskin,
242     I SOILW1(1,myThid), SSR(1,1,myThid), SLR(1,0,myThid),
243     I T0(1,myThid), Q0(1,myThid), EnPrec(1,myThid),
244     I CDENVV(1,1),
245     O SHF(1,1,myThid), EVAP(1,1,myThid), SLR(1,1,myThid),
246     O Evp0, dEvp, Slr0, dSlr, sFlx,
247     O TS(1,myThid), TSKIN(1,myThid),
248     I bi,bj,myThid)
249     #ifdef ALLOW_LAND
250     CALL AIM_LAND_IMPL(
251     I FMASK1(1,1,myThid), dTskin, sFlx,
252     I Evp0, dEvp, Slr0, dSlr,
253     U STL1(1,myThid), EVAP(1,1,myThid), SLR(1,1,myThid),
254     c O TS(1,myThid), TSKIN(1,myThid),
255     I bi, bj, myTime, myIter, myThid)
256     #endif /* ALLOW_LAND */
257    
258     CALL SUFLUX_OCEAN(
259     I PSG, FMASK1(1,2,myThid),
260     I SST1(1,myThid),
261     I SSR(1,2,myThid), SLR(1,0,myThid),
262     O T0(1,myThid), Q0(1,myThid), CDENVV(1,2),
263     O SHF(1,2,myThid), EVAP(1,2,myThid), SLR(1,2,myThid),
264     I bi,bj,myThid)
265    
266     IF ( aim_splitSIOsFx ) THEN
267     CALL SUFLUX_SICE (
268     I PSG, FMASK1(1,3,myThid), EMISFC,
269     I STI1(1,myThid), dTskin,
270     I SSR(1,3,myThid), SLR(1,0,myThid),
271     I T0(1,myThid), Q0(1,myThid), EnPrec(1,myThid),
272     I CDENVV(1,3),
273     O SHF(1,3,myThid), EVAP(1,3,myThid), SLR(1,3,myThid),
274     O Evp0, dEvp, Slr0, dSlr, sFlx,
275     O TS(1,myThid), TSKIN(1,myThid),
276     I bi,bj,myThid)
277 jmc 1.4 #ifdef ALLOW_THSICE
278     CALL AIM_SICE_IMPL(
279     I FMASK1(1,3,myThid), SSR(1,3,myThid), sFlx,
280     I Evp0, dEvp, Slr0, dSlr,
281     U STI1(1,myThid), EVAP(1,3,myThid), SLR(1,3,myThid),
282     I bi, bj, myTime, myIter, myThid)
283     #endif /* ALLOW_THSICE */
284 jmc 1.3 ELSE
285     DO J=1,NGP
286     EVAP(J,3,myThid) = 0. _d 0
287     SLR (J,3,myThid) = 0. _d 0
288     ENDDO
289     ENDIF
290    
291     CALL SUFLUX_POST(
292     I FMASK1(1,1,myThid), EMISFC,
293     I STL1(1,myThid), SST1(1,myThid), sti1(1,myThid),
294     I dTskin, SLR(1,0,myThid),
295     I T0(1,myThid), Q0(1,myThid), CDENVV,
296     U DRAG(1,0,myThid), SHF(1,0,myThid),
297     U EVAP(1,0,myThid), SLR(1,1,myThid),
298     O ST4S, TS(1,myThid), TSKIN(1,myThid),
299     I bi,bj,myThid)
300     C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
301    
302 jmc 1.1 C 3.4 Compute upward longwave fluxes, convert them to tendencies
303     C and add shortwave tendencies
304    
305     c_FM CALL RADLW (1,TG1,TS,ST4S,
306     c_FM & OLR,SLR,TT_RLW)
307     CALL RADLW (1,TG1,TS(1,myThid),ST4S,
308     & OZUPP, STRATC, TAU2, FLUX, ST4A,
309 jmc 1.3 O OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
310 jmc 1.1 I kGround,bi,bj,myThid)
311    
312     DO K=1,NLEV
313     DO J=1,NGP
314     TT_RLW(J,K,myThid)=TT_RLW(J,K,myThid)*RPS_1*GRDSCP(K)
315     c_FM TTEND (J,K)=TTEND(J,K)+TT_RSW(J,K)+TT_RLW(J,K)
316     ENDDO
317     ENDDO
318    
319     C-- 4. PBL interactions with lower troposphere
320    
321     C 4.1 Vertical diffusion and shallow convection
322    
323     c_FM CALL VDIFSC (UG1,VG1,SE,RH,QG1,QSAT,PHIG1,
324     c_FM & UT_PBL,VT_PBL,TT_PBL,QT_PBL)
325     CALL VDIFSC (dpFac, SE, RH(1,1,myThid), QG1, QSAT,
326     O TT_PBL(1,1,myThid),QT_PBL(1,1,myThid),
327     I kGround,bi,bj,myThid)
328    
329     C 4.2 Add tendencies due to surface fluxes
330    
331     DO J=1,NGP
332     c_FM UT_PBL(J,NLEV)=UT_PBL(J,NLEV)+USTR(J,3)*RPS(J)*GRDSIG(NLEV)
333     c_FM VT_PBL(J,NLEV)=VT_PBL(J,NLEV)+VSTR(J,3)*RPS(J)*GRDSIG(NLEV)
334     c_FM TT_PBL(J,NLEV)=TT_PBL(J,NLEV)+ SHF(J,3)*RPS(J)*GRDSCP(NLEV)
335     c_FM QT_PBL(J,NLEV)=QT_PBL(J,NLEV)+EVAP(J,3)*RPS(J)*GRDSIG(NLEV)
336     K = kGround(J)
337     IF ( K.GT.0 ) THEN
338     TT_PBL(J,K,myThid) = TT_PBL(J,K,myThid)
339 jmc 1.3 & + SHF(J,0,myThid) *RPS_1*GRDSCP(K)
340 jmc 1.1 QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)
341 jmc 1.3 & + EVAP(J,0,myThid)*RPS_1*GRDSIG(K)
342 jmc 1.1 ENDIF
343     ENDDO
344    
345     c_FM DO K=1,NLEV
346     c_FM DO J=1,NGP
347     c_FM UTEND(J,K)=UTEND(J,K)+UT_PBL(J,K)
348     c_FM VTEND(J,K)=VTEND(J,K)+VT_PBL(J,K)
349     c_FM TTEND(J,K)=TTEND(J,K)+TT_PBL(J,K)
350     c_FM QTEND(J,K)=QTEND(J,K)+QT_PBL(J,K)
351     c_FM ENDDO
352     c_FM ENDDO
353    
354     #endif /* ALLOW_AIM */
355    
356     RETURN
357     END

  ViewVC Help
Powered by ViewVC 1.1.22