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

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

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

revision 1.2 by jmc, Thu May 22 03:00:49 2003 UTC revision 1.6 by jmc, Thu Jun 24 23:43:11 2004 UTC
# Line 31  C     Resolution parameters Line 31  C     Resolution parameters
31  C-- size for MITgcm & Physics package :  C-- size for MITgcm & Physics package :
32  #include "AIM_SIZE.h"  #include "AIM_SIZE.h"
33  #include "EEPARAMS.h"  #include "EEPARAMS.h"
34    
35    C-- Physics package
36    #include "AIM_PARAMS.h"
37  #include "AIM_GRID.h"  #include "AIM_GRID.h"
38    
39  C     Constants + functions of sigma and latitude  C     Constants + functions of sigma and latitude
# Line 48  C     Constants for forcing fields: Line 51  C     Constants for forcing fields:
51  C     Radiation scheme variables  C     Radiation scheme variables
52  #include "com_radvar.h"  #include "com_radvar.h"
53    
54  c #include "com_sflcon.h"  C     Radiation constants
55    #include "com_radcon.h"
56    
57  C     Logical flags  C     Logical flags
58  c_FM  include "com_lflags.h"  c_FM  include "com_lflags.h"
# Line 60  C-- Routine arguments: Line 64  C-- Routine arguments:
64  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
65    
66  C-- Local variables:  C-- Local variables:
67  C    kGrd   = Ground level index              (2-dim)    C    kGrd   :: Ground level index              (2-dim)  
68  C    dpFac  = cell delta_P fraction           (3-dim)  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        LOGICAL LRADSW
81        INTEGER ICLTOP(NGP)        INTEGER ICLTOP(NGP)
82        INTEGER kGround(NGP)        INTEGER kGround(NGP)
# Line 69  C    dpFac  = cell delta_P fraction Line 84  C    dpFac  = cell delta_P fraction
84  c_FM  REAL    RPS(NGP), ST4S(NGP)  c_FM  REAL    RPS(NGP), ST4S(NGP)
85        _RL ST4S(NGP)        _RL ST4S(NGP)
86        _RL PSG_1(NGP), RPS_1        _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        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-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
98    
99  C--   1. Compute grid-point fields  C--   1. Compute grid-point fields
# Line 137  c_FM &             PRECLS,TT_LSC,QT_LSC) Line 159  c_FM &             PRECLS,TT_LSC,QT_LSC)
159       O             QT_LSC(1,1,myThid),       O             QT_LSC(1,1,myThid),
160       I             kGround,bi,bj,myThid)       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  C--   3. Radiation (shortwave and longwave) and surface fluxes
178    
179  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|  C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
# Line 161  C     The sw radiation may be called at Line 198  C     The sw radiation may be called at
198    
199  c_FM    CALL RADSW (PSG,QG1,RH,ALB1,  c_FM    CALL RADSW (PSG,QG1,RH,ALB1,
200  c_FM &              ICLTOP,CLOUDC,TSR,SSR,TT_RSW)  c_FM &              ICLTOP,CLOUDC,TSR,SSR,TT_RSW)
201         CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,myThid),         ICLTOP(1) = 1
202           CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
203       I             FSOL, OZONE, OZUPP, ZENIT, STRATZ,       I             FSOL, OZONE, OZUPP, ZENIT, STRATZ,
204       O             TAU2, STRATC,       O             TAU2, STRATC,
205       O             ICLTOP,CLOUDC(1,myThid),       O             ICLTOP,CLOUDC(1,myThid),
206       O             TSR(1,myThid),SSR(1,myThid),TT_RSW(1,1,myThid),       O             TSR(1,myThid),SSR(1,0,myThid),TT_RSW(1,1,myThid),
207       I             kGround,bi,bj,myThid)       I             kGround,bi,bj,myThid)
208    
209          DO J=1,NGP          DO J=1,NGP
# Line 186  c_FM  CALL RADLW (-1,TG1,TS,ST4S, Line 224  c_FM  CALL RADLW (-1,TG1,TS,ST4S,
224  c_FM &            OLR,SLR,TT_RLW)  c_FM &            OLR,SLR,TT_RLW)
225        CALL RADLW (-1,TG1,TS(1,myThid),ST4S,        CALL RADLW (-1,TG1,TS(1,myThid),ST4S,
226       &            OZUPP, STRATC, TAU2, FLUX, ST4A,       &            OZUPP, STRATC, TAU2, FLUX, ST4A,
227       O            OLR(1,myThid),SLR(1,myThid),TT_RLW(1,1,myThid),       O            OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
228       I            kGround,bi,bj,myThid)       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  C     3.3. Compute surface fluxes and land skin temperature
232    
233  c_FM  CALL SUFLUX (PSG,UG1,VG1,TG1,QG1,RH,PHIG1,  c_FM  CALL SUFLUX (PSG,UG1,VG1,TG1,QG1,RH,PHIG1,
234  c_FM &             PHIS0,FMASK1,STL1,SST1,SOILW1,SSR,SLR,  c_FM &             PHIS0,FMASK1,STL1,SST1,SOILW1,SSR,SLR,
235  c_FM &             USTR,VSTR,SHF,EVAP,ST4S,  c_FM &             USTR,VSTR,SHF,EVAP,ST4S,
236  c_FM &             TS,TSKIN,U0,V0,T0,Q0)  c_FM &             TS,TSKIN,U0,V0,T0,Q0)
237        CALL SUFLUX (PSG, TG1, QG1, RH(1,1,myThid), SE, VsurfSq,        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),       I             WVSurf(1,myThid),csLat(1,myThid),fOrogr(1,myThid),
240       I             FMASK1(1,myThid),STL1(1,myThid),SST1(1,myThid),       I             FMASK1(1,1,myThid),STL1(1,myThid),SST1(1,myThid),
241       I             SOILW1(1,myThid), SSR(1,myThid),SLR(1,myThid),       I             sti1(1,myThid), SSR(1,0,myThid),
242       O             SPEED0(1,myThid),DRAG(1,1,myThid),       O             SPEED0(1,myThid),DRAG(1,0,myThid),DENVV,
243       O             SHF(1,1,myThid), EVAP(1,1,myThid),       O             dTskin,T1s,T0(1,myThid),Q0(1,myThid),
      O             ST4S,TS(1,myThid),TSKIN(1,myThid),  
      O             T0(1,myThid),Q0(1,myThid),  
244       I             kGround,bi,bj,myThid)       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  C     3.4 Compute upward longwave fluxes, convert them to tendencies
312  C         and add shortwave tendencies  C         and add shortwave tendencies
313    
# Line 212  c_FM  CALL RADLW (1,TG1,TS,ST4S, Line 315  c_FM  CALL RADLW (1,TG1,TS,ST4S,
315  c_FM &            OLR,SLR,TT_RLW)  c_FM &            OLR,SLR,TT_RLW)
316        CALL RADLW (1,TG1,TS(1,myThid),ST4S,        CALL RADLW (1,TG1,TS(1,myThid),ST4S,
317       &            OZUPP, STRATC, TAU2, FLUX, ST4A,       &            OZUPP, STRATC, TAU2, FLUX, ST4A,
318       O            OLR(1,myThid),SLR(1,myThid),TT_RLW(1,1,myThid),       O            OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
319       I            kGround,bi,bj,myThid)       I            kGround,bi,bj,myThid)
320    
321        DO K=1,NLEV        DO K=1,NLEV
# Line 222  c_FM    TTEND (J,K)=TTEND(J,K)+TT_RSW(J, Line 325  c_FM    TTEND (J,K)=TTEND(J,K)+TT_RSW(J,
325         ENDDO         ENDDO
326        ENDDO        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  C--   4. PBL interactions with lower troposphere
366    
367  C     4.1 Vertical diffusion and shallow convection  C     4.1 Vertical diffusion and shallow convection
# Line 242  c_FM   QT_PBL(J,NLEV)=QT_PBL(J,NLEV)+EVA Line 382  c_FM   QT_PBL(J,NLEV)=QT_PBL(J,NLEV)+EVA
382         K = kGround(J)         K = kGround(J)
383         IF ( K.GT.0 ) THEN         IF ( K.GT.0 ) THEN
384          TT_PBL(J,K,myThid) = TT_PBL(J,K,myThid)          TT_PBL(J,K,myThid) = TT_PBL(J,K,myThid)
385       &                     + SHF(J,3,myThid) *RPS_1*GRDSCP(K)       &                     + SHF(J,0,myThid) *RPS_1*GRDSCP(K)
386          QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)          QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)
387       &                     + EVAP(J,3,myThid)*RPS_1*GRDSIG(K)       &                     + EVAP(J,0,myThid)*RPS_1*GRDSIG(K)
388         ENDIF         ENDIF
389        ENDDO        ENDDO
390    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.6
  ViewVC Help
Powered by ViewVC 1.1.22