pkg/aim_v23/phy_driver.F

d676f916b2 Jean*0001 #include "AIM_OPTIONS.h"
                0002
2a80e4d00e Jean*0003 CBOP
                0004 C     !ROUTINE: PHY_DRIVER
                0005 C     !INTERFACE:
26eee352b3 Jean*0006       SUBROUTINE PHY_DRIVER( tYear, usePkgDiag,
                0007      I                       bi, bj, myTime, myIter, myThid )
d676f916b2 Jean*0008
2a80e4d00e Jean*0009 C     !DESCRIPTION: \bv
d676f916b2 Jean*0010 C------------------------
                0011 C--   SUBROUTINE PHYDRIVER (tYear, myTime, bi, bj, myThid )
                0012 C--   Purpose: stand-alone driver for physical parametrization routines
                0013 C--   Input  :  TYEAR  : fraction of year (0 = 1jan.00, 1 = 31dec.24)
                0014 C--             grid-point model fields in common block: PHYGR1
                0015 C--             forcing fields in common blocks : LSMASK, FORFIX, FORCIN
                0016 C--   Output :  Diagnosed upper-air variables in common block: PHYGR2
                0017 C--             Diagnosed surface variables in common block: PHYGR3
                0018 C--             Physical param. tendencies in common block: PHYTEN
                0019 C--             Surface and upper boundary fluxes in common block: FLUXES
                0020 C-------
2a80e4d00e Jean*0021 C     Note: tendencies are not /dpFac here but later in AIM_AIM2DYN
d676f916b2 Jean*0022 C-------
2a80e4d00e Jean*0023 C from SPEDDY code: (part of original code left with c_FM)
                0024 C * S/R PHYPAR : except interp. dynamical Var. from Spectral of grid point
                0025 C                here dynamical var. are loaded within S/R AIM_DYN2AIM.
                0026 C * S/R FORDATE: only the CALL SOL_OZ (done once / day in SPEEDY)
                0027 C------------------------
                0028 C     \ev
d676f916b2 Jean*0029
2a80e4d00e Jean*0030 C     !USES:
d676f916b2 Jean*0031       IMPLICIT NONE
                0032
2a80e4d00e Jean*0033 C     == Global variables ===
d676f916b2 Jean*0034
                0035 C-- size for MITgcm & Physics package :
26eee352b3 Jean*0036 #include "AIM_SIZE.h"
d676f916b2 Jean*0037 #include "EEPARAMS.h"
b3097ed02d Jean*0038
                0039 C-- Physics package
                0040 #include "AIM_PARAMS.h"
d676f916b2 Jean*0041 #include "AIM_GRID.h"
0d5086b5bf Jean*0042 #include "AIM_CO2.h"
d676f916b2 Jean*0043
                0044 C     Constants + functions of sigma and latitude
                0045 #include "com_physcon.h"
                0046
                0047 C     Model variables, tendencies and fluxes on gaussian grid
                0048 #include "com_physvar.h"
                0049
                0050 C     Surface forcing fields (time-inv. or functions of seasonal cycle)
                0051 #include "com_forcing.h"
                0052
                0053 C     Constants for forcing fields:
                0054 #include "com_forcon.h"
                0055
2a80e4d00e Jean*0056 C     Radiation scheme variables
d676f916b2 Jean*0057 #include "com_radvar.h"
                0058
b3097ed02d Jean*0059 C     Radiation constants
                0060 #include "com_radcon.h"
                0061
d676f916b2 Jean*0062 C     Logical flags
                0063 c_FM  include "com_lflags.h"
                0064
2a80e4d00e Jean*0065 C     !INPUT/OUTPUT PARAMETERS:
                0066 C     == Routine arguments ==
                0067 C     tYear      :: Fraction into year
                0068 C     usePkgDiag :: logical flag, true if using Diagnostics PKG
                0069 C     bi, bj     :: Tile index
                0070 C     myTime     :: Current time of simulation ( s )
                0071 C     myIter     :: Current iteration number in simulation
                0072 C     myThid     :: Number of this instance of the routine
                0073       _RL     tYear
26eee352b3 Jean*0074       LOGICAL usePkgDiag
                0075       INTEGER bi,bj
2a80e4d00e Jean*0076       _RL     myTime
26eee352b3 Jean*0077       INTEGER myIter, myThid
2a80e4d00e Jean*0078 CEOP
d676f916b2 Jean*0079
                0080 #ifdef ALLOW_AIM
2a80e4d00e Jean*0081 C     !FUNCTIONS:
                0082 C     !LOCAL VARIABLES:
                0083 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0084 C--   Local Variables originally (Speedy) in common bloc (com_physvar.h):
                0085 C      TG1     :: absolute temperature
                0086 C      QG1     :: specific humidity (g/kg)
                0087 C      VsurfSq :: Square of surface wind speed (grid position = as T,Q)
                0088 C      SE      :: dry static energy <- replaced by Pot.Temp.
                0089 C      QSAT    :: saturation specific humidity (g/kg)
                0090 C      PSG     :: surface pressure (normalized)
                0091       _RL TG1    (NGP,NLEV)
                0092       _RL QG1    (NGP,NLEV)
                0093       _RL VsurfSq(NGP)
                0094       _RL SE   (NGP,NLEV)
                0095       _RL QSAT (NGP,NLEV)
                0096       _RL PSG   (NGP)
                0097 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d676f916b2 Jean*0098 C-- Local variables:
0d5086b5bf Jean*0099 C    absLW_CO2 :: LW absorbtion in CO2 band (uniform value)
                0100 C    kGround   :: Ground level index              (2-dim)
b3097ed02d Jean*0101 C    dpFac  :: cell delta_P fraction           (3-dim)
                0102 C    dTskin :: temp. correction for daily-cycle heating [K]
e749d70ece Jean*0103 C    T1s    :: near-surface air temperature (from Pot.Temp)
                0104 C    DENVV  :: surface flux (sens,lat.) coeff. (=Rho*|V|) [kg/m2/s]
                0105 C    Shf0   :: sensible heat flux over freezing surf.
                0106 C    dShf   :: sensible heat flux derivative relative to surf. temp
b3097ed02d Jean*0107 C    Evp0   :: evaporation computed over freezing surface (Ts=0.oC)
2a80e4d00e Jean*0108 C    dEvp   :: evaporation derivative relative to surf. temp
b3097ed02d Jean*0109 C    Slr0   :: upward long wave radiation over freezing surf.
                0110 C    dSlr   :: upward long wave rad. derivative relative to surf. temp
                0111 C    sFlx   :: net surface flux (+=down) function of surf. temp Ts:
                0112 C              0: Flux(Ts=0.oC) ; 1: Flux(Ts^n) ; 2: d.Flux/d.Ts(Ts^n)
d676f916b2 Jean*0113       LOGICAL LRADSW
                0114       INTEGER ICLTOP(NGP)
                0115       INTEGER kGround(NGP)
0d5086b5bf Jean*0116       _RL absLW_CO2
d676f916b2 Jean*0117       _RL dpFac(NGP,NLEV)
                0118 c_FM  REAL    RPS(NGP), ST4S(NGP)
                0119       _RL ST4S(NGP)
                0120       _RL PSG_1(NGP), RPS_1
e749d70ece Jean*0121       _RL dTskin(NGP), T1s(NGP), DENVV(NGP)
                0122       _RL Shf0(NGP), dShf(NGP), Evp0(NGP), dEvp(NGP)
                0123       _RL Slr0(NGP), dSlr(NGP), sFlx(NGP,0:2)
7f98c35e47 Davi*0124       _RL UPSWG(NGP)
d676f916b2 Jean*0125
                0126       INTEGER J, K
                0127
e749d70ece Jean*0128 #ifdef ALLOW_CLR_SKY_DIAG
                0129       _RL dummyR(NGP)
                0130       INTEGER dummyI(NGP)
                0131 #endif
d676f916b2 Jean*0132 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0133
                0134 C--   1. Compute grid-point fields
                0135
                0136 C-    1.1 Convert model spectral variables to grid-point variables
                0137
                0138       CALL AIM_DYN2AIM(
                0139      O                 TG1, QG1, SE, VsurfSq, PSG, dpFac, kGround,
                0140      I                 bi, bj, myTime, myIter, myThid )
                0141
                0142 C-    1.2 Compute thermodynamic variables
                0143
                0144 C-    1.2.a Surface pressure (ps), 1/ps and surface temperature
                0145       RPS_1 = 1. _d 0
                0146       DO J=1,NGP
                0147        PSG_1(J)=1. _d 0
                0148 c_FM   PSG(J)=EXP(PSLG1(J))
                0149 c_FM   RPS(J)=1./PSG(J)
                0150       ENDDO
                0151
                0152 C     1.2.b Dry static energy
                0153 C      <= replaced by Pot.Temp in aim_dyn2aim
                0154 c     DO K=1,NLEV
                0155 c      DO J=1,NGP
2a80e4d00e Jean*0156 c_FM    SE(J,K)=CP*TG1(J,K)+PHIG1(J,K)
d676f916b2 Jean*0157 c      ENDDO
                0158 c     ENDDO
                0159
                0160 C     1.2.c Relative humidity and saturation spec. humidity
                0161
                0162       DO K=1,NLEV
                0163 c_FM   CALL SHTORH (1,NGP,TG1(1,K),PSG,SIG(K),QG1(1,K),
                0164 c_FM &              RH(1,K),QSAT(1,K))
                0165        CALL SHTORH (1,NGP,TG1(1,K),PSG_1,SIG(K),QG1(1,K),
                0166      O              RH(1,K,myThid),QSAT(1,K),
                0167      I              myThid)
                0168       ENDDO
                0169
                0170 C--   2. Precipitation
                0171
                0172 C     2.1 Deep convection
                0173
                0174 c_FM  CALL CONVMF (PSG,SE,QG1,QSAT,
                0175 c_FM &             ICLTOP,CBMF,PRECNV,TT_CNV,QT_CNV)
                0176       CALL CONVMF (PSG,dpFac,SE,QG1,QSAT,
                0177      O             ICLTOP,CBMF(1,myThid),PRECNV(1,myThid),
                0178      O             TT_CNV(1,1,myThid),QT_CNV(1,1,myThid),
                0179      I             kGround,bi,bj,myThid)
                0180
                0181       DO K=2,NLEV
                0182        DO J=1,NGP
                0183         TT_CNV(J,K,myThid)=TT_CNV(J,K,myThid)*RPS_1*GRDSCP(K)
                0184         QT_CNV(J,K,myThid)=QT_CNV(J,K,myThid)*RPS_1*GRDSIG(K)
                0185        ENDDO
                0186       ENDDO
                0187
                0188 C     2.2 Large-scale condensation
                0189
                0190 c_FM  CALL LSCOND (PSG,QG1,QSAT,
                0191 c_FM &             PRECLS,TT_LSC,QT_LSC)
                0192       CALL LSCOND (PSG,dpFac,QG1,QSAT,
                0193      O             PRECLS(1,myThid),TT_LSC(1,1,myThid),
                0194      O             QT_LSC(1,1,myThid),
                0195      I             kGround,bi,bj,myThid)
                0196
b3097ed02d Jean*0197       IF ( aim_energPrecip ) THEN
                0198 C     2.3 Snow Precipitation (update TT_CNV & TT_LSC)
2a80e4d00e Jean*0199         CALL SNOW_PRECIP (
b3097ed02d Jean*0200      I             PSG, dpFac, SE, ICLTOP,
                0201      I             PRECNV(1,myThid), QT_CNV(1,1,myThid),
                0202      I             PRECLS(1,myThid), QT_LSC(1,1,myThid),
                0203      U             TT_CNV(1,1,myThid), TT_LSC(1,1,myThid),
                0204      O             EnPrec(1,myThid),
                0205      I             kGround,bi,bj,myThid)
                0206       ELSE
                0207         DO J=1,NGP
                0208           EnPrec(J,myThid) = 0. _d 0
                0209         ENDDO
                0210       ENDIF
                0211
d676f916b2 Jean*0212 C--   3. Radiation (shortwave and longwave) and surface fluxes
                0213
                0214 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0215 C --> from FORDATE (in SPEEDY) :
                0216
                0217 C     3.0 Compute Incomming shortwave rad. (from FORDATE in SPEEDY)
                0218
                0219 c_FM  CALL SOL_OZ (SOLC,TYEAR)
                0220       CALL SOL_OZ (SOLC,tYear, snLat(1,myThid), csLat(1,myThid),
                0221      O             FSOL, OZONE, OZUPP, ZENIT, STRATZ,
                0222      I             bi,bj,myThid)
                0223
                0224 C <-- from FORDATE (in SPEEDY).
                0225 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0226
                0227 C     3.1 Compute shortwave tendencies and initialize lw transmissivity
                0228
0d5086b5bf Jean*0229 C     Set LW absorption in CO2 band
                0230       IF ( aim_select_pCO2.EQ.1 .OR. aim_select_pCO2.EQ.3 ) THEN
                0231         absLW_CO2 = ABLCO2
                0232      &            + aim_abs_pCO2*LOG( aim_pCO2/aim_ref_pCO2 )
                0233       ELSE
                0234         absLW_CO2 = ABLCO2
                0235       ENDIF
                0236
d676f916b2 Jean*0237 C     The sw radiation may be called at selected time steps
                0238       LRADSW = .TRUE.
2a80e4d00e Jean*0239
d676f916b2 Jean*0240       IF (LRADSW) THEN
2a80e4d00e Jean*0241
d676f916b2 Jean*0242 c_FM    CALL RADSW (PSG,QG1,RH,ALB1,
                0243 c_FM &              ICLTOP,CLOUDC,TSR,SSR,TT_RSW)
e749d70ece Jean*0244        ICLTOP(1) = 1
b3097ed02d Jean*0245        CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
d676f916b2 Jean*0246      I             FSOL, OZONE, OZUPP, ZENIT, STRATZ,
                0247      O             TAU2, STRATC,
                0248      O             ICLTOP,CLOUDC(1,myThid),
7f98c35e47 Davi*0249      O             TSR(1,myThid),SSR(1,0,myThid),
                0250      O             UPSWG,TT_RSW(1,1,myThid),
0d5086b5bf Jean*0251      I             absLW_CO2, kGround, bi, bj, myThid )
2a80e4d00e Jean*0252
d676f916b2 Jean*0253         DO J=1,NGP
                0254           CLTOP(J,myThid)=SIGH(ICLTOP(J)-1)*PSG_1(J)
                0255         ENDDO
2a80e4d00e Jean*0256
d676f916b2 Jean*0257         DO K=1,NLEV
                0258          DO J=1,NGP
                0259           TT_RSW(J,K,myThid)=TT_RSW(J,K,myThid)*RPS_1*GRDSCP(K)
                0260          ENDDO
                0261         ENDDO
2a80e4d00e Jean*0262
7f98c35e47 Davi*0263 #ifdef ALLOW_DIAGNOSTICS
                0264       IF ( usePkgDiag ) THEN
                0265         CALL DIAGNOSTICS_FILL( UPSWG,
                0266      &                        'UPSWG   ', 1, 1 , 3,bi,bj, myThid )
                0267       ENDIF
                0268 #endif
                0269
d676f916b2 Jean*0270       ENDIF
                0271
                0272 C     3.2 Compute downward longwave fluxes
2a80e4d00e Jean*0273
d676f916b2 Jean*0274 c_FM  CALL RADLW (-1,TG1,TS,ST4S,
                0275 c_FM &            OLR,SLR,TT_RLW)
                0276       CALL RADLW (-1,TG1,TS(1,myThid),ST4S,
                0277      &            OZUPP, STRATC, TAU2, FLUX, ST4A,
b3097ed02d Jean*0278      O            OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
d676f916b2 Jean*0279      I            kGround,bi,bj,myThid)
                0280
b3097ed02d Jean*0281 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
d676f916b2 Jean*0282 C     3.3. Compute surface fluxes and land skin temperature
2a80e4d00e Jean*0283
d676f916b2 Jean*0284 c_FM  CALL SUFLUX (PSG,UG1,VG1,TG1,QG1,RH,PHIG1,
                0285 c_FM &             PHIS0,FMASK1,STL1,SST1,SOILW1,SSR,SLR,
                0286 c_FM &             USTR,VSTR,SHF,EVAP,ST4S,
2a80e4d00e Jean*0287 c_FM &             TS,TSKIN,U0,V0,T0,Q0)
b3097ed02d Jean*0288       CALL SUFLUX_PREP(
                0289      I             PSG, TG1, QG1, RH(1,1,myThid), SE, VsurfSq,
d676f916b2 Jean*0290      I             WVSurf(1,myThid),csLat(1,myThid),fOrogr(1,myThid),
b3097ed02d Jean*0291      I             FMASK1(1,1,myThid),STL1(1,myThid),SST1(1,myThid),
                0292      I             sti1(1,myThid), SSR(1,0,myThid),
e749d70ece Jean*0293      O             SPEED0(1,myThid),DRAG(1,0,myThid),DENVV,
                0294      O             dTskin,T1s,T0(1,myThid),Q0(1,myThid),
d676f916b2 Jean*0295      I             kGround,bi,bj,myThid)
                0296
b3097ed02d Jean*0297       CALL SUFLUX_LAND (
                0298      I             PSG, FMASK1(1,1,myThid), EMISFC,
                0299      I             STL1(1,myThid), dTskin,
                0300      I             SOILW1(1,myThid), SSR(1,1,myThid), SLR(1,0,myThid),
e749d70ece Jean*0301      I             T1s, T0(1,myThid), Q0(1,myThid), DENVV,
b3097ed02d Jean*0302      O             SHF(1,1,myThid), EVAP(1,1,myThid), SLR(1,1,myThid),
e749d70ece Jean*0303      O             Shf0, dShf, Evp0, dEvp, Slr0, dSlr, sFlx,
b3097ed02d Jean*0304      O             TS(1,myThid), TSKIN(1,myThid),
                0305      I             bi,bj,myThid)
2a80e4d00e Jean*0306 #ifdef ALLOW_LAND
b3097ed02d Jean*0307       CALL AIM_LAND_IMPL(
1b19160514 Jean*0308      I             FMASK1(1,1,myThid), dTskin,
e749d70ece Jean*0309      I             Shf0, dShf, Evp0, dEvp, Slr0, dSlr,
                0310      U             sFlx, STL1(1,myThid),
                0311      U             SHF(1,1,myThid), EVAP(1,1,myThid), SLR(1,1,myThid),
                0312      O             dTsurf(1,1,myThid),
b3097ed02d Jean*0313      I             bi, bj, myTime, myIter, myThid)
                0314 #endif /* ALLOW_LAND */
                0315
                0316       CALL SUFLUX_OCEAN(
                0317      I             PSG, FMASK1(1,2,myThid),
                0318      I             SST1(1,myThid),
                0319      I             SSR(1,2,myThid), SLR(1,0,myThid),
e749d70ece Jean*0320      O             T1s, T0(1,myThid), Q0(1,myThid), DENVV,
b3097ed02d Jean*0321      O             SHF(1,2,myThid), EVAP(1,2,myThid), SLR(1,2,myThid),
                0322      I             bi,bj,myThid)
                0323
                0324       IF ( aim_splitSIOsFx ) THEN
                0325         CALL SUFLUX_SICE (
                0326      I             PSG, FMASK1(1,3,myThid), EMISFC,
                0327      I             STI1(1,myThid), dTskin,
                0328      I             SSR(1,3,myThid), SLR(1,0,myThid),
e749d70ece Jean*0329      I             T1s, T0(1,myThid), Q0(1,myThid), DENVV,
b3097ed02d Jean*0330      O             SHF(1,3,myThid), EVAP(1,3,myThid), SLR(1,3,myThid),
e749d70ece Jean*0331      O             Shf0, dShf, Evp0, dEvp, Slr0, dSlr, sFlx,
b3097ed02d Jean*0332      O             TS(1,myThid), TSKIN(1,myThid),
                0333      I             bi,bj,myThid)
2a80e4d00e Jean*0334 #ifdef ALLOW_THSICE
cdcb187d4c Jean*0335         CALL AIM_SICE_IMPL(
                0336      I             FMASK1(1,3,myThid), SSR(1,3,myThid), sFlx,
e749d70ece Jean*0337      I             Shf0, dShf, Evp0, dEvp, Slr0, dSlr,
                0338      U             STI1(1,myThid),
                0339      U             SHF(1,3,myThid), EVAP(1,3,myThid), SLR(1,3,myThid),
                0340      O             dTsurf(1,3,myThid),
cdcb187d4c Jean*0341      I             bi, bj, myTime, myIter, myThid)
                0342 #endif /* ALLOW_THSICE */
b3097ed02d Jean*0343       ELSE
                0344         DO J=1,NGP
e749d70ece Jean*0345           SHF (J,3,myThid) = 0. _d 0
b3097ed02d Jean*0346           EVAP(J,3,myThid) = 0. _d 0
                0347           SLR (J,3,myThid) = 0. _d 0
                0348         ENDDO
                0349       ENDIF
                0350
                0351       CALL SUFLUX_POST(
2a80e4d00e Jean*0352      I             FMASK1(1,1,myThid), EMISFC,
                0353      I             STL1(1,myThid), SST1(1,myThid), sti1(1,myThid),
b3097ed02d Jean*0354      I             dTskin, SLR(1,0,myThid),
e749d70ece Jean*0355      I             T0(1,myThid), Q0(1,myThid), DENVV,
2a80e4d00e Jean*0356      U             DRAG(1,0,myThid), SHF(1,0,myThid),
b3097ed02d Jean*0357      U             EVAP(1,0,myThid), SLR(1,1,myThid),
                0358      O             ST4S, TS(1,myThid), TSKIN(1,myThid),
                0359      I             bi,bj,myThid)
26eee352b3 Jean*0360
                0361 #ifdef ALLOW_DIAGNOSTICS
                0362       IF ( usePkgDiag ) THEN
                0363         CALL DIAGNOSTICS_FILL( SLR(1,0,myThid),
                0364      &                        'DWNLWG  ', 1, 1 , 3,bi,bj, myThid )
                0365       ENDIF
                0366 #endif
b3097ed02d Jean*0367 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0368
d676f916b2 Jean*0369 C     3.4 Compute upward longwave fluxes, convert them to tendencies
                0370 C         and add shortwave tendencies
                0371
                0372 c_FM  CALL RADLW (1,TG1,TS,ST4S,
                0373 c_FM &            OLR,SLR,TT_RLW)
                0374       CALL RADLW (1,TG1,TS(1,myThid),ST4S,
                0375      &            OZUPP, STRATC, TAU2, FLUX, ST4A,
b3097ed02d Jean*0376      O            OLR(1,myThid),SLR(1,0,myThid),TT_RLW(1,1,myThid),
d676f916b2 Jean*0377      I            kGround,bi,bj,myThid)
2a80e4d00e Jean*0378
d676f916b2 Jean*0379       DO K=1,NLEV
                0380        DO J=1,NGP
                0381         TT_RLW(J,K,myThid)=TT_RLW(J,K,myThid)*RPS_1*GRDSCP(K)
                0382 c_FM    TTEND (J,K)=TTEND(J,K)+TT_RSW(J,K)+TT_RLW(J,K)
                0383        ENDDO
2a80e4d00e Jean*0384       ENDDO
d676f916b2 Jean*0385
e749d70ece Jean*0386 #ifdef ALLOW_CLR_SKY_DIAG
                0387 C     3.5 Compute clear-sky radiation (for diagnostics only)
                0388       IF ( aim_clrSkyDiag ) THEN
2a80e4d00e Jean*0389
e749d70ece Jean*0390 C      3.5.1 Compute shortwave tendencies
                0391        dummyI(1) = -1
                0392        CALL RADSW (PSG,dpFac,QG1,RH(1,1,myThid),ALB1(1,0,myThid),
                0393      I             FSOL, OZONE, OZUPP, ZENIT, STRATZ,
                0394      O             TAU2, STRATC,
                0395      O             dummyI, dummyR,
7f98c35e47 Davi*0396      O  TSWclr(1,myThid), SSWclr(1,myThid), UPSWG, TT_SWclr(1,1,myThid),
0d5086b5bf Jean*0397      I             absLW_CO2, kGround, bi, bj, myThid )
2a80e4d00e Jean*0398
7f98c35e47 Davi*0399 #ifdef ALLOW_DIAGNOSTICS
                0400       IF ( usePkgDiag ) THEN
                0401         CALL DIAGNOSTICS_FILL( UPSWG,
                0402      &                        'UPSWGclr', 1, 1 , 3,bi,bj, myThid )
                0403       ENDIF
                0404 #endif
                0405
e749d70ece Jean*0406 C      3.5.2 Compute downward longwave fluxes
2a80e4d00e Jean*0407
e749d70ece Jean*0408        CALL RADLW (-1,TG1,TS(1,myThid),ST4S,
                0409      &             OZUPP, STRATC, TAU2, FLUX, ST4A,
                0410      O      OLWclr(1,myThid), SLWclr(1,myThid), TT_LWclr(1,1,myThid),
                0411      I             kGround,bi,bj,myThid)
                0412
                0413 C      3.5.3 Compute upward longwave fluxes, convert them to tendencies
                0414
                0415        CALL RADLW (1,TG1,TS(1,myThid),ST4S,
                0416      &            OZUPP, STRATC, TAU2, FLUX, ST4A,
                0417      O      OLWclr(1,myThid), SLWclr(1,myThid), TT_LWclr(1,1,myThid),
                0418      I            kGround,bi,bj,myThid)
2a80e4d00e Jean*0419
e749d70ece Jean*0420        DO K=1,NLEV
                0421         DO J=1,NGP
                0422           TT_SWclr(J,K,myThid)=TT_SWclr(J,K,myThid)*RPS_1*GRDSCP(K)
                0423           TT_LWclr(J,K,myThid)=TT_LWclr(J,K,myThid)*RPS_1*GRDSCP(K)
                0424         ENDDO
2a80e4d00e Jean*0425        ENDDO
e749d70ece Jean*0426
                0427       ENDIF
                0428 #endif /* ALLOW_CLR_SKY_DIAG */
                0429
d676f916b2 Jean*0430 C--   4. PBL interactions with lower troposphere
                0431
                0432 C     4.1 Vertical diffusion and shallow convection
2a80e4d00e Jean*0433
d676f916b2 Jean*0434 c_FM  CALL VDIFSC (UG1,VG1,SE,RH,QG1,QSAT,PHIG1,
                0435 c_FM &             UT_PBL,VT_PBL,TT_PBL,QT_PBL)
                0436       CALL VDIFSC (dpFac, SE, RH(1,1,myThid), QG1, QSAT,
                0437      O             TT_PBL(1,1,myThid),QT_PBL(1,1,myThid),
                0438      I             kGround,bi,bj,myThid)
2a80e4d00e Jean*0439
d676f916b2 Jean*0440 C     4.2 Add tendencies due to surface fluxes
2a80e4d00e Jean*0441
d676f916b2 Jean*0442       DO J=1,NGP
                0443 c_FM   UT_PBL(J,NLEV)=UT_PBL(J,NLEV)+USTR(J,3)*RPS(J)*GRDSIG(NLEV)
                0444 c_FM   VT_PBL(J,NLEV)=VT_PBL(J,NLEV)+VSTR(J,3)*RPS(J)*GRDSIG(NLEV)
                0445 c_FM   TT_PBL(J,NLEV)=TT_PBL(J,NLEV)+ SHF(J,3)*RPS(J)*GRDSCP(NLEV)
                0446 c_FM   QT_PBL(J,NLEV)=QT_PBL(J,NLEV)+EVAP(J,3)*RPS(J)*GRDSIG(NLEV)
                0447        K = kGround(J)
                0448        IF ( K.GT.0 ) THEN
                0449         TT_PBL(J,K,myThid) = TT_PBL(J,K,myThid)
b3097ed02d Jean*0450      &                     + SHF(J,0,myThid) *RPS_1*GRDSCP(K)
d676f916b2 Jean*0451         QT_PBL(J,K,myThid) = QT_PBL(J,K,myThid)
b3097ed02d Jean*0452      &                     + EVAP(J,0,myThid)*RPS_1*GRDSIG(K)
d676f916b2 Jean*0453        ENDIF
                0454       ENDDO
2a80e4d00e Jean*0455
d676f916b2 Jean*0456 c_FM  DO K=1,NLEV
                0457 c_FM   DO J=1,NGP
                0458 c_FM    UTEND(J,K)=UTEND(J,K)+UT_PBL(J,K)
                0459 c_FM    VTEND(J,K)=VTEND(J,K)+VT_PBL(J,K)
                0460 c_FM    TTEND(J,K)=TTEND(J,K)+TT_PBL(J,K)
                0461 c_FM    QTEND(J,K)=QTEND(J,K)+QT_PBL(J,K)
                0462 c_FM   ENDDO
2a80e4d00e Jean*0463 c_FM  ENDDO
d676f916b2 Jean*0464
2a80e4d00e Jean*0465 #endif /* ALLOW_AIM */
d676f916b2 Jean*0466
                0467       RETURN
                0468       END