/[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.3 by jmc, Thu Mar 11 14:33:19 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     Radiation constants
55    #include "com_radcon.h"
56    
57  c #include "com_sflcon.h"  c #include "com_sflcon.h"
58    
59  C     Logical flags  C     Logical flags
# Line 60  C-- Routine arguments: Line 66  C-- Routine arguments:
66  #ifdef ALLOW_AIM  #ifdef ALLOW_AIM
67    
68  C-- Local variables:  C-- Local variables:
69  C    kGrd   = Ground level index              (2-dim)    C    kGrd   :: Ground level index              (2-dim)  
70  C    dpFac  = cell delta_P fraction           (3-dim)  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        LOGICAL LRADSW        LOGICAL LRADSW
80        INTEGER ICLTOP(NGP)        INTEGER ICLTOP(NGP)
81        INTEGER kGround(NGP)        INTEGER kGround(NGP)
# Line 69  C    dpFac  = cell delta_P fraction Line 83  C    dpFac  = cell delta_P fraction
83  c_FM  REAL    RPS(NGP), ST4S(NGP)  c_FM  REAL    RPS(NGP), ST4S(NGP)
84        _RL ST4S(NGP)        _RL ST4S(NGP)
85        _RL PSG_1(NGP), RPS_1        _RL PSG_1(NGP), RPS_1
86          _RL dTskin(NGP), CDENVV(NGP,3)
87          _RL Evp0(NGP), dEvp(NGP), Slr0(NGP), dSlr(NGP), sFlx(NGP,0:2)
88    
89        INTEGER J, K        INTEGER J, K
90    
# Line 137  c_FM &             PRECLS,TT_LSC,QT_LSC) Line 153  c_FM &             PRECLS,TT_LSC,QT_LSC)
153       O             QT_LSC(1,1,myThid),       O             QT_LSC(1,1,myThid),
154       I             kGround,bi,bj,myThid)       I             kGround,bi,bj,myThid)
155    
156          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  C--   3. Radiation (shortwave and longwave) and surface fluxes  C--   3. Radiation (shortwave and longwave) and surface fluxes
172    
173  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 192  C     The sw radiation may be called at
192    
193  c_FM    CALL RADSW (PSG,QG1,RH,ALB1,  c_FM    CALL RADSW (PSG,QG1,RH,ALB1,
194  c_FM &              ICLTOP,CLOUDC,TSR,SSR,TT_RSW)  c_FM &              ICLTOP,CLOUDC,TSR,SSR,TT_RSW)
195         CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,myThid),         CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
196       I             FSOL, OZONE, OZUPP, ZENIT, STRATZ,       I             FSOL, OZONE, OZUPP, ZENIT, STRATZ,
197       O             TAU2, STRATC,       O             TAU2, STRATC,
198       O             ICLTOP,CLOUDC(1,myThid),       O             ICLTOP,CLOUDC(1,myThid),
199       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),
200       I             kGround,bi,bj,myThid)       I             kGround,bi,bj,myThid)
201    
202          DO J=1,NGP          DO J=1,NGP
# Line 186  c_FM  CALL RADLW (-1,TG1,TS,ST4S, Line 217  c_FM  CALL RADLW (-1,TG1,TS,ST4S,
217  c_FM &            OLR,SLR,TT_RLW)  c_FM &            OLR,SLR,TT_RLW)
218        CALL RADLW (-1,TG1,TS(1,myThid),ST4S,        CALL RADLW (-1,TG1,TS(1,myThid),ST4S,
219       &            OZUPP, STRATC, TAU2, FLUX, ST4A,       &            OZUPP, STRATC, TAU2, FLUX, ST4A,
220       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),
221       I            kGround,bi,bj,myThid)       I            kGround,bi,bj,myThid)
222    
223    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
224  C     3.3. Compute surface fluxes and land skin temperature  C     3.3. Compute surface fluxes and land skin temperature
225    
226  c_FM  CALL SUFLUX (PSG,UG1,VG1,TG1,QG1,RH,PHIG1,  c_FM  CALL SUFLUX (PSG,UG1,VG1,TG1,QG1,RH,PHIG1,
227  c_FM &             PHIS0,FMASK1,STL1,SST1,SOILW1,SSR,SLR,  c_FM &             PHIS0,FMASK1,STL1,SST1,SOILW1,SSR,SLR,
228  c_FM &             USTR,VSTR,SHF,EVAP,ST4S,  c_FM &             USTR,VSTR,SHF,EVAP,ST4S,
229  c_FM &             TS,TSKIN,U0,V0,T0,Q0)  c_FM &             TS,TSKIN,U0,V0,T0,Q0)
230        CALL SUFLUX (PSG, TG1, QG1, RH(1,1,myThid), SE, VsurfSq,        CALL SUFLUX_PREP(
231         I             PSG, TG1, QG1, RH(1,1,myThid), SE, VsurfSq,
232       I             WVSurf(1,myThid),csLat(1,myThid),fOrogr(1,myThid),       I             WVSurf(1,myThid),csLat(1,myThid),fOrogr(1,myThid),
233       I             FMASK1(1,myThid),STL1(1,myThid),SST1(1,myThid),       I             FMASK1(1,1,myThid),STL1(1,myThid),SST1(1,myThid),
234       I             SOILW1(1,myThid), SSR(1,myThid),SLR(1,myThid),       I             sti1(1,myThid), SSR(1,0,myThid),
235       O             SPEED0(1,myThid),DRAG(1,1,myThid),       O             SPEED0(1,myThid),DRAG(1,0,myThid),CDENVV,
236       O             SHF(1,1,myThid), EVAP(1,1,myThid),       O             dTskin,T0(1,myThid),Q0(1,myThid),
      O             ST4S,TS(1,myThid),TSKIN(1,myThid),  
      O             T0(1,myThid),Q0(1,myThid),  
237       I             kGround,bi,bj,myThid)       I             kGround,bi,bj,myThid)
238    
239          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          ELSE
278            DO J=1,NGP
279              EVAP(J,3,myThid) = 0. _d 0
280              SLR (J,3,myThid) = 0. _d 0
281            ENDDO
282          ENDIF
283    
284          CALL SUFLUX_POST(
285         I             FMASK1(1,1,myThid), EMISFC,
286         I             STL1(1,myThid), SST1(1,myThid), sti1(1,myThid),
287         I             dTskin, SLR(1,0,myThid),
288         I             T0(1,myThid), Q0(1,myThid), CDENVV,
289         U             DRAG(1,0,myThid), SHF(1,0,myThid),
290         U             EVAP(1,0,myThid), SLR(1,1,myThid),
291         O             ST4S, TS(1,myThid), TSKIN(1,myThid),
292         I             bi,bj,myThid)
293    C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
294    
295  C     3.4 Compute upward longwave fluxes, convert them to tendencies  C     3.4 Compute upward longwave fluxes, convert them to tendencies
296  C         and add shortwave tendencies  C         and add shortwave tendencies
297    
# Line 212  c_FM  CALL RADLW (1,TG1,TS,ST4S, Line 299  c_FM  CALL RADLW (1,TG1,TS,ST4S,
299  c_FM &            OLR,SLR,TT_RLW)  c_FM &            OLR,SLR,TT_RLW)
300        CALL RADLW (1,TG1,TS(1,myThid),ST4S,        CALL RADLW (1,TG1,TS(1,myThid),ST4S,
301       &            OZUPP, STRATC, TAU2, FLUX, ST4A,       &            OZUPP, STRATC, TAU2, FLUX, ST4A,
302       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),
303       I            kGround,bi,bj,myThid)       I            kGround,bi,bj,myThid)
304    
305        DO K=1,NLEV        DO K=1,NLEV
# Line 242  c_FM   QT_PBL(J,NLEV)=QT_PBL(J,NLEV)+EVA Line 329  c_FM   QT_PBL(J,NLEV)=QT_PBL(J,NLEV)+EVA
329         K = kGround(J)         K = kGround(J)
330         IF ( K.GT.0 ) THEN         IF ( K.GT.0 ) THEN
331          TT_PBL(J,K,myThid) = TT_PBL(J,K,myThid)          TT_PBL(J,K,myThid) = TT_PBL(J,K,myThid)
332       &                     + SHF(J,3,myThid) *RPS_1*GRDSCP(K)       &                     + SHF(J,0,myThid) *RPS_1*GRDSCP(K)
333          QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)          QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)
334       &                     + EVAP(J,3,myThid)*RPS_1*GRDSIG(K)       &                     + EVAP(J,0,myThid)*RPS_1*GRDSIG(K)
335         ENDIF         ENDIF
336        ENDDO        ENDDO
337    
Legend:
Removed from v.1.2  
changed lines
  Added in v.1.3
  ViewVC Help
Powered by ViewVC 1.1.22