pkg/aim_v23/phy_vdifsc.F

d676f916b2 Jean*0001 #include "AIM_OPTIONS.h"
                0002
                0003       SUBROUTINE VDIFSC (dpFac,SE,RH,QA,QSAT,
                0004      O                   TTENVD,QTENVD,
                0005      I                   kGrd,bi,bj,myThid)
                0006 C--
                0007 C--   SUBROUTINE VDIFSC (UA,VA,SE,RH,QA,QSAT,PHI,
                0008 C--  &                   UTENVD,VTENVD,TTENVD,QTENVD)
                0009 C--
                0010 C--   Purpose: Compute tendencies of momentum, energy and moisture
                0011 C--            due to vertical diffusion and shallow convection
                0012 C--   Input:   UA     = u-wind                           (3-dim)
                0013 C--            VA     = v-wind                           (3-dim)
                0014 C              dpFac  = cell delta_P fraction            (3-dim)
                0015 C--            SE     = dry static energy                (3-dim)
                0016 C--            RH     = relative humidity [0-1]          (3-dim)
                0017 C--            QA     = specific humidity [g/kg]         (3-dim)
                0018 C--            QSAT   = saturation sp. humidity [g/kg]   (3-dim)
                0019 C--            PHI    = geopotential                     (3-dim)
                0020 C--   Output:  UTENVD = u-wind tendency                  (3-dim)
                0021 C--            VTENVD = v-wind tendency                  (3-dim)
                0022 C--            TTENVD = temperature tendency             (3-dim)
                0023 C--            QTENVD = sp. humidity tendency [g/(kg s)] (3-dim)
                0024 C    Input:    kGrd   = Ground level index               (2-dim)
                0025 C              bi,bj  = tile index
                0026 C           myThid    = Thread number for this instance of the routine
                0027 C-------
                0028 C  Note: a) dry static energy (SE,input) has been replaced by Pot.Temp.
                0029 C        b) UA,VA & U,V_TENVD not used => removed
                0030 C-------
                0031 C In contrast to other Physics S/R, VDIFSC return a real tendency (dQ/dt,dT/dt)
                0032 C  nevertheless /dpFac is not applied here but later in AIM_AIM2DYN
                0033 C-------
                0034
                0035       IMPLICIT NONE
                0036
                0037 C     Resolution parameters
                0038
                0039 C-- size for MITgcm & Physics package :
                0040 #include "AIM_SIZE.h"
                0041
                0042 #include "EEPARAMS.h"
                0043
                0044 C     Physical constants + functions of sigma and latitude
                0045 #include "com_physcon.h"
                0046
                0047 C     Vertical diffusion constants
                0048 #include "com_vdicon.h"
                0049
                0050 C-- Routine arguments:
                0051 c     _RL  UA(NGP,NLEV), VA(NGP,NLEV)
                0052       _RL  dpFac(NGP,NLEV)
                0053       _RL  SE(NGP,NLEV), RH(NGP,NLEV), QA(NGP,NLEV), QSAT(NGP,NLEV)
                0054 c     _RL  PHI(NGP,NLEV)
                0055
                0056 c     _RL  UTENVD(NGP,NLEV), VTENVD(NGP,NLEV)
                0057       _RL  TTENVD(NGP,NLEV), QTENVD(NGP,NLEV)
                0058
                0059       INTEGER  kGrd(NGP)
                0060       INTEGER  bi,bj,myThid
                0061
                0062 #ifdef ALLOW_AIM
                0063
                0064 C-- Local variables:
                0065       INTEGER J, K, Ktmp, NL1
                0066       _RL  RSIG(NLEV)
                0067       _RL  dSEdp(NGP,NLEV-1), DeltaPI(NLEV-1), factP
                0068
                0069 C- jmc: declare all local variables:
                0070       _RL  CVDI(NGP), FSHCQ
                0071       _RL  DRH0, DRH, DMSE, FLUXSE, FLUXQ
                0072 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0073
                0074 C--   1. Initalization
                0075
                0076 C     N.B. In this routine, fluxes of dry static energy and humidity
                0077 C          are scaled in such a way that:
                0078 C          d_T/dt = d_F'(SE)/d_sigma,  d_Q/dt = d_F'(Q)/d_sigma
                0079
                0080 c_FM  NL1  = NLEV-1
                0081 c_FM  CSHC = DSIG(NLEV)/3600.
                0082 c_FM  CVDI = (SIGH(NL1)-SIGH(1))/((NL1-1)*3600.)
                0083
                0084 c_FM  FSHCQ  = CSHC/TRSHC
                0085 c_FM  FSHCSE = CSHC/(TRSHC*CP)
                0086
                0087 c_FM  FVDIQ  = CVDI/TRVDI
                0088 c_FM  FVDISE = CVDI/(TRVDS*CP)
                0089
                0090       DO J=1,NGP
                0091         NL1 = kGrd(J)-1
                0092         CVDI(J) = 0.
                0093         IF (NL1.GE.2) THEN
                0094           CVDI(J) = (SIGH(NL1)-SIGH(1))/((NL1-1)*3600. _d 0)
                0095         ENDIF
                0096       ENDDO
                0097
                0098       DO K=1,NLEV
                0099         RSIG(K)=1./DSIG(K)
                0100       ENDDO
                0101
                0102       DO K=1,NLEV
                0103         DO J=1,NGP
                0104 c         UTENVD(J,K) = 0.
                0105 c         VTENVD(J,K) = 0.
                0106           TTENVD(J,K) = 0.
                0107           QTENVD(J,K) = 0.
                0108         ENDDO
                0109       ENDDO
                0110
                0111 C ---------------------------------------------
                0112 C    Write Conditional stability based on Pot.Temp :
                0113 C    dSEdp(K) = Delta[Static-Energy] between 2 Plevels(k,k+1)
                0114 C    and corresponds to SE(K+1)-SE(K) in the original code
                0115 C -------
                0116       DO K=1,NLEV-1
                0117        factP = CP*SIGH(K)**(RD/CP)
                0118        DO J=1,NGP
                0119          dSEdp(J,K)=(SE(J,K+1)-SE(J,K))*factP
                0120        ENDDO
                0121        DeltaPI(K) = SIG(K+1)**(RD/CP) - SIG(K)**(RD/CP)
                0122       ENDDO
                0123
                0124 C--   2. Shallow convection
                0125
                0126       DO J=1,NGP
                0127         Ktmp = kGrd(J)
                0128         NL1 = Ktmp - 1
                0129        IF (Ktmp.GE.2) THEN
                0130
                0131         DRH0=RHGRAD*(SIG(Ktmp)-SIG(NL1))
                0132         FSHCQ = DSIG(Ktmp)*dpFac(J,Ktmp)/(TRSHC*3600. _d 0)
                0133
                0134 c_FM    DMSE = (SE(J,NLEV)-SE(J,NL1))+ALHC*(QA(J,NLEV)-QSAT(J,NL1))
                0135         DMSE = dSEdp(J,NL1)         + ALHC*(QA(J,Ktmp)-QSAT(J,NL1))
                0136         DRH  = RH(J,Ktmp)-RH(J,NL1)
                0137
                0138         IF (DMSE.GE.0.0) THEN
                0139
                0140 c_FM      FLUXSE         = FSHCSE*DMSE
                0141           FLUXSE         = FSHCQ *DMSE/CP
                0142           TTENVD(J,NL1)  = FLUXSE*RSIG(NL1)
                0143           TTENVD(J,Ktmp) =-FLUXSE*RSIG(Ktmp)
                0144
                0145           IF (DRH.GE.0.0) THEN
                0146             FLUXQ          = FSHCQ*QSAT(J,Ktmp)*DRH
                0147             QTENVD(J,NL1)  = FLUXQ*RSIG(NL1)
                0148             QTENVD(J,Ktmp) =-FLUXQ*RSIG(Ktmp)
                0149           ENDIF
                0150
                0151         ELSE IF (DRH.GE.DRH0) THEN
                0152
                0153 c_FM      FLUXQ          = FVDIQ*QSAT(J,NL1)*DRH
                0154           FLUXQ          = QSAT(J,NL1)*DRH*CVDI(J)/TRVDI
                0155           QTENVD(J,NL1)  = FLUXQ*RSIG(NL1)
                0156           QTENVD(J,Ktmp) =-FLUXQ*RSIG(Ktmp)
                0157
                0158         ENDIF
                0159
                0160        ENDIF
                0161       ENDDO
                0162
                0163 C--   3. Vertical diffusion of moisture above the PBL
                0164
                0165       DO J=1,NGP
                0166
                0167         DO K=3,kGrd(J)-2
                0168
                0169           DRH0=RHGRAD*(SIG(K+1)-SIG(K))
                0170
                0171           DRH=RH(J,K+1)-RH(J,K)
                0172
                0173           IF (DRH.GE.DRH0) THEN
                0174 c_FM        FLUXQ        = FVDIQ*QSAT(J,K)*DRH
                0175             FLUXQ        = QSAT(J,K)*DRH*CVDI(J)/TRVDI
                0176             QTENVD(J,K)  = QTENVD(J,K)  +FLUXQ*RSIG(K)
                0177             QTENVD(J,K+1)= QTENVD(J,K+1)-FLUXQ*RSIG(K+1)
                0178           ENDIF
                0179
                0180         ENDDO
                0181
                0182       ENDDO
                0183
                0184 C--   4. Damping of super-adiabatic lapse rate
                0185
                0186       DO J=1,NGP
                0187        DO K=1,kGrd(J)-1
                0188
                0189 c_FM     SE0 = SE(J,K+1)+SEGRAD*(PHI(J,K)-PHI(J,K+1))
                0190          DMSE = dSEdp(J,K)
                0191      &        +SEGRAD*CP*DeltaPI(K)*(SE(J,K+1)+SE(J,K))*0.5 _d 0
                0192
                0193 c_FM     IF (SE(J,K).LT.SE0) THEN
                0194 c_FM       FLUXSE        = FVDISE*(SE0-SE(J,K))
                0195          IF (DMSE.GT.0.) THEN
                0196            FLUXSE        = DMSE*CVDI(J)/(TRVDS*CP)
                0197            TTENVD(J,K  ) = TTENVD(J,K  )+FLUXSE*RSIG(K)
                0198            TTENVD(J,K+1) = TTENVD(J,K+1)-FLUXSE*RSIG(K+1)
                0199          ENDIF
                0200
                0201        ENDDO
                0202       ENDDO
                0203 C--
                0204 C---+----1----+----2----+----3----+----4----+----5----+----6----+----7-|--+----|
                0205 #endif /* ALLOW_AIM */
                0206
                0207       RETURN
                0208       END