!-------------------------------------- LICENCE BEGIN ------------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
!-------------------------------------------------------------------------------
!
! ######################
SUBROUTINE INI_CONVPAR 1,1
! ######################
!
!!**** *INI_CONVPAR * - routine to initialize the constants modules
!!
!! PURPOSE
!! -------
! The purpose of this routine is to initialize the constants
! stored in modules MODD_CONVPAR, MODD_CONVPAREXT.
!
!
!!** METHOD
!! ------
!! The deep convection constants are set to their numerical values
!!
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CONVPAR : contains deep convection constants
!!
!! REFERENCE
!! ---------
!! Book2 of the documentation (module MODD_CONVPAR, routine INI_CONVPAR)
!!
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 26/03/96
!! Last modified 15/04/98 adapted for ARPEGE
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONVPAR
!
IMPLICIT NONE
!
!-------------------------------------------------------------------------------
!
!* 1. Set the thermodynamical and numerical constants for
! the deep convection parameterization
! ---------------------------------------------------
!
!
XA25 = 625.E6 ! 25 km x 25 km reference grid area
!
XCRAD = 1500. ! cloud radius !jiao xcrad updated
XCDEPTH = 3.E3 ! minimum necessary cloud depth !jiao xcdepth updated
XENTR = 0.03 ! entrainment constant (m/Pa) = 0.2 (m)
!
XZLCL = 3.5E3 ! maximum allowed allowed height
! difference between the surface and the LCL
XZPBL = 60.E2 ! minimum mixed layer depth to sustain convection
XWTRIG = 6.00 ! constant in vertical velocity trigger
XWTRIG = 4.64 ! constant in vertical velocity trigger !jiao this is the value in the paper
!
!
XNHGAM = 1.3333 ! accounts for non-hydrost. pressure
! in buoyancy term of w equation
! = 2 / (1+gamma)
XTFRZ1 = 268.16 ! begin of freezing interval
XTFRZ2 = 248.16 ! end of freezing interval
!
XRHDBC = 0.9 ! relative humidity below cloud in downdraft
XRCONV = 0.015 ! constant in precipitation conversion
XSTABT = 0.75 ! factor to assure stability in fractional time
! integration, routine CONVECT_CLOSURE
XSTABC = 0.95 ! factor to assure stability in CAPE adjustment,
! routine CONVECT_CLOSURE
XUSRDPTH = 165.E2 ! pressure thickness used to compute updraft
! moisture supply rate for downdraft
XMELDPTH = 200.E2 ! layer (Pa) through which precipitation melt is
! allowed below downdraft
XUVDP = 0.7 ! constant for pressure perturb in momentum transport
!
!
!* 2. Set the fundamental thermodynamical constants
! these have the same values (not names) as in ARPEGE IFS
! -------------------------------------------------------
! (now initialized by a call to INI_CSTS in BKFCALL, BD)
!
! XP00 = 1.E5 ! reference pressure
! XPI = 3.141592654 ! Pi
! XG = 9.80665 ! gravity constant
! XMD = 28.9644E-3 ! molecular weight of dry air
! XMV = 18.0153E-3 ! molecular weight of water vapor
! XRD = 287.05967 ! gaz constant for dry air
! XRV = 461.524993 ! gaz constant for water vapor
! XCPD = 1004.708845 ! specific heat of dry air
! XCPV = 1846.1 ! specific heat of water vapor
! XRHOLW = 1000. ! density of liquid water
! XCL = 4218. ! specific heat of liquid water
! XCI = 2106. ! specific heat of ice
! XTT = 273.16 ! triple point temperature
! XLVTT = 2.5008E6 ! latent heat of vaporisation at XTT
! XLSTT = 2.8345E6 ! latent heat of sublimation at XTT
! XLMTT = 0.3337E6 ! latent heat of melting at XTT
! XESTT = 611.14 ! saturation pressure at XTT
! XALPW = 60.22416 ! constants in saturation pressure over liquid water
! XBETAW = 6822.459384
! XGAMW = 5.13948
! XALPI = 32.62116 ! constants in saturation pressure over ice
! XBETAI = 6295.421
! XGAMI = 0.56313
!
!
END SUBROUTINE INI_CONVPAR
!
!------------------------------------------------------------------------------
!
!
! ###################################################################
SUBROUTINE DEEP_CONVECTION( KLON , KLEV , PDTCONV, & 1,11
KIDIA , KFDIA , KBDIA , KTDIA , &
KICE , OREFRESH, ODOWN , OSETTADJ, PTIMEC , &
KCOUNT , INDEXCV , PDXDY , &
PPABST , PZZ , PTT , &
PRVT , PRCT , PRIT , &
PUT , PVT , PWT , &
PTTEN , PRVTEN , OUVCONV, PUTEN , &
PVTEN , PRTTEN , PPCTEN , &
PAREA , PCLOUD , PEFFOUT, PWMAX , &
PPRLFLX , PPRSFLX , PPRTTEN, &
PURCOUT , PURIOUT , PURCINT, PURIINT , &
PCAPE , PCLTOP , PCLBAS , &
PUMF , PDMF , &
OCH1CONV, KCH1 , PCH1 , PCH1TEN )
! ###################################################################
!
!!**** Monitor routine to compute all convective tendencies by calls
!! of several subroutines.
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine the convective
!! tendencies. The routine first prepares all necessary grid-scale
!! variables. The final convective tendencies are then computed by
!! calls of different subroutines.
!!
!!
!!** METHOD
!! ------
!! We start by selecting convective columns in the model domain through
!! the call of routine TRIGGER_FUNCT. Then, we allocate memory for the
!! convection updraft and downdraft variables and gather the grid scale
!! variables in convective arrays.
!! The updraft and downdraft computations are done level by level starting
!! at the bottom and top of the domain, respectively.
!! All computations are done on MNH thermodynamic levels. The depth
!! of the current model layer k is defined by DP(k)=P(k-1)-P(k)
!!
!!
!!
!! EXTERNAL
!! --------
!! CONVECT_TRIGGER_FUNCT
!! CONVECT_SATMIXRATIO
!! CONVECT_UPDRAFT
!! CONVECT_CONDENS
!! CONVECT_MIXING_FUNCT
!! CONVECT_TSTEP_PREF
!! CONVECT_DOWNDRAFT
!! CONVECT_PRECIP_ADJUST
!! CONVECT_CLOSURE
!! CONVECT_CLOSURE_THRVLCL
!! CONVECT_CLOSURE_ADJUST
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XG ! gravity constant
!! XPI ! number Pi
!! XP00 ! reference pressure
!! XRD, XRV ! gaz constants for dry air and water vapor
!! XCPD, XCPV ! specific heat for dry air and water vapor
!! XRHOLW ! density of liquid water
!! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
!! XTT ! triple point temperature
!! XLVTT, XLSTT ! vaporization, sublimation heat constant
!! XCL, XCI ! specific heat for liquid water and ice
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! Module MODD_CONVPAR
!! XA25 ! reference grid area
!! XCRAD ! cloud radius
!!
!!
!! REFERENCE
!! ---------
!!
!! Bechtold et al., 2001, Quart. J. Roy. Meteor. Soc. :
!! A mass flux convection scheme for regional and global models.
!! Kain and Fritsch, 1990, J. Atmos. Sci., Vol. 47, 2784-2801.
!! Kain and Fritsch, 1993, Meteor. Monographs, Vol. 24, 165-170.
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 26/03/96
!! Peter Bechtold 04/10/97 replace theta_il by enthalpy
!! " 10/12/98 changes for ARPEGE
!! Dominique Paquin UQAM suivi des corrections de debordements
!
! " OURANOS Avril 2003
! CONVECT_CLOSURE correction pcp < 0
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAREXT
USE MODD_CONVPAR
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
INTEGER, INTENT(IN) :: KIDIA ! value of the first point in x
INTEGER, INTENT(IN) :: KFDIA ! value of the last point in x
INTEGER, INTENT(IN) :: KBDIA ! vertical computations start at
! ! KBDIA that is at least 1
INTEGER, INTENT(IN) :: KTDIA ! vertical computations can be
! limited to KLEV + 1 - KTDIA
! default=1
REAL, INTENT(IN) :: PDTCONV ! Interval of time between two
! calls of the deep convection scheme
INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
! 0 = no ice )
LOGICAL, INTENT(IN) :: OREFRESH ! refresh or not tendencies
! at every call
LOGICAL, INTENT(IN) :: ODOWN ! take or not convective
! downdrafts into account
LOGICAL, INTENT(IN) :: OSETTADJ ! logical to set convective
! adjustment time by user
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT ! grid scale temperature at t
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT ! grid scale water vapor "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT ! grid scale r_c "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT ! grid scale r_i "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUT ! grid scale horiz. wind u "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PVT ! grid scale horiz. wind v "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT ! grid scale vertical velocity (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST ! grid scale pressure at t (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ ! height of model layer (m)
REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! horizontal grid area (m^2)
REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC ! value of convective adjustment
! time if OSETTADJ=.TRUE.
REAL, DIMENSION(KLON), INTENT(INOUT):: KCOUNT ! convective counter (FLAGCONV IN KF)
! (recompute tendency when OREFRESH=.TRUE.)
! (or keep it when OREFRESH=.FALSE.)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN ! convective temperature tendency (K/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
REAL, DIMENSION(KLON,KLEV) :: PRCTEN ! convective r_c tendency (1/s)
REAL, DIMENSION(KLON,KLEV) :: PRITEN ! convective r_i tendency (1/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRTTEN ! convective cloud liquid/ice tendency (1/s)
! PRTTEN=PRCTEN+PRITEN (DQCDT IN KF)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPCTEN ! convective rain liquid/ice tendency (1/s)
! PPCTEN=ZURR+ZURC (DQRDT IN KF)
LOGICAL, INTENT(IN) :: OUVCONV ! include wind transport (Cu friction)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUTEN ! convective u-momentum tendency (m/s^2) (DUDT IN KF)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PVTEN ! convective v-momentum tendency (m/s^2) (DVDT IN KF)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PURCOUT ! normalized mixing ratio of updraft cloud water (kg/kg)
! RLIQOUT IN KF
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PURIOUT ! normalized mixing ratio of updraft cloud ice (kg/kg)
! RICEOUT IN KF
REAL, DIMENSION(KLON) , INTENT(INOUT):: PURCINT ! integrated (purcout) updraft cloud water (kg/m2)
REAL, DIMENSION(KLON) , INTENT(INOUT):: PURIINT ! integrated (puriout) updraft cloud ice (kg/m2)
!
REAL, DIMENSION(KLON) :: PPRLTEN ! liquid surf. precipitation tendency (m/s)
REAL, DIMENSION(KLON) :: PPRSTEN ! solid surf. precipitation tendency (m/s)
REAL, DIMENSION(KLON), INTENT(INOUT):: PPRTTEN ! total liquid+solid surf. precipitation tendency (m/s)
! at surface (ZCRR IN KF)
INTEGER, DIMENSION(KLON), INTENT(INOUT):: INDEXCV ! convection index (deep=2, shallow=1,none=0)
INTEGER, DIMENSION(KLON) :: KCLTOP ! cloud top level
INTEGER, DIMENSION(KLON) :: KCLBAS ! cloud base level
! they are given a value of 0 if no convection
REAL, DIMENSION(KLON), INTENT(INOUT):: PCLTOP ! cloud top height (m)
REAL, DIMENSION(KLON), INTENT(INOUT):: PCLBAS ! cloud base height (m)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRLFLX ! liquid precip flux (m/s) !jiao unit changed into kg/m2 s
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRSFLX ! solid precip flux (m/s) !jiao unit changed into kg/m2 s
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s m2)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s m2)
! unit changed back to kg/s, in consistent with KF output !jiao
REAL, DIMENSION(KLON), INTENT(INOUT):: PCAPE ! total CAPE (J/kg) in updraft
! in original scheme, this was the maximum CAPE
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PAREA ! cloud coverage (updraft) area (m^2)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PCLOUD ! cloud fractional coverage area
! (fraction between 0 and 1 = areaup/dxdy)
REAL, DIMENSION(KLON ), INTENT(INOUT):: PEFFOUT ! precipitation efficiency = ZPREF
REAL, DIMENSION(KLON ), INTENT(INOUT):: PWMAX ! maximum velocity in the convective updrafts (m/s)
!
LOGICAL, INTENT(IN) :: OCH1CONV ! include tracer transport
INTEGER, INTENT(IN) :: KCH1 ! number of species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1 ! grid scale chemical species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN ! species conv. tendency (1/s)
!
!
!* 0.2 Declarations of local fixed memory variables :
!
INTEGER :: ITEST, ICONV, ICONV1 ! number of convective columns
INTEGER :: IIB, IIE ! horizontal loop bounds
INTEGER :: IKB, IKE ! vertical loop bounds
INTEGER :: IKS ! vertical dimension
INTEGER :: JI, JL ! horizontal loop index
INTEGER :: JN ! number of tracers
INTEGER :: JK, JKP, JKM ! vertical loop index
INTEGER :: IFTSTEPS ! only used for chemical tracers
REAL :: ZEPS, ZEPSA, ZEPSB ! R_d / R_v, R_v / R_d, XCPV / XCPD - ZEPSA
REAL :: ZCPORD, ZRDOCP ! C_p/R_d, R_d/C_p
!
LOGICAL, DIMENSION(KLON, KLEV) :: GTRIG3 ! 3D logical mask for convection
LOGICAL, DIMENSION(KLON ) :: GTRIG ! 2D logical mask for trigger test
REAL , DIMENSION(KLON, KLEV) :: ZTHT, ZSTHV, ZSTHES ! grid scale theta, theta_v, theta_es
REAL , DIMENSION(KLON ) :: ZTIME ! convective time period
REAL , DIMENSION(KLON ) :: ZWORK2, ZWORK2B ! work array
REAL :: ZW1 ! work scalar
!
!
!* 0.2 Declarations of local allocatable variables :
!
INTEGER, DIMENSION(:), ALLOCATABLE :: IDPL ! index for parcel departure level
INTEGER, DIMENSION(:), ALLOCATABLE :: IPBL ! index for source layer top
INTEGER, DIMENSION(:), ALLOCATABLE :: ILCL ! index for lifting condensation level
INTEGER, DIMENSION(:), ALLOCATABLE :: IETL ! index for zero buoyancy level
INTEGER, DIMENSION(:), ALLOCATABLE :: ICTL ! index for cloud top level
INTEGER, DIMENSION(:), ALLOCATABLE :: ILFS ! index for level of free sink
INTEGER, DIMENSION(:), ALLOCATABLE :: IDBL ! index for downdraft base level
INTEGER, DIMENSION(:), ALLOCATABLE :: IML ! melting level
!
INTEGER, DIMENSION(:), ALLOCATABLE :: ISDPL ! index for parcel departure level
INTEGER, DIMENSION(:), ALLOCATABLE :: ISPBL ! index for source layer top
INTEGER, DIMENSION(:), ALLOCATABLE :: ISLCL ! index for lifting condensation level
REAL , DIMENSION(:), ALLOCATABLE :: ZSTHLCL ! updraft theta at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZSTLCL ! updraft temp. at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZSRVLCL ! updraft rv at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZSWLCL ! updraft w at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZSZLCL ! LCL height
REAL , DIMENSION(:), ALLOCATABLE :: ZSTHVELCL! envir. theta_v at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZSDXDY ! grid area (m^2)
REAL , DIMENSION(:), ALLOCATABLE :: ZSCRAD ! cloud radius (m) !jiao xcrad
REAL , DIMENSION(:), ALLOCATABLE :: ZSCDEP ! cloud depth (m) !jiao xcdepth
!
! grid scale variables
REAL , DIMENSION(:,:), ALLOCATABLE :: ZZ ! height of model layer (m)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZPRES ! grid scale pressure
REAL , DIMENSION(:,:), ALLOCATABLE :: ZDPRES ! pressure difference between
! bottom and top of layer (Pa)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZU ! grid scale horiz. u component on theta grid
REAL , DIMENSION(:,:), ALLOCATABLE :: ZV ! grid scale horiz. v component on theta grid
REAL , DIMENSION(:,:), ALLOCATABLE :: ZW ! grid scale vertical velocity on theta grid
REAL , DIMENSION(:,:), ALLOCATABLE :: ZTT ! temperature
REAL , DIMENSION(:,:), ALLOCATABLE :: ZTH ! grid scale theta
REAL , DIMENSION(:,:), ALLOCATABLE :: ZTHV ! grid scale theta_v
REAL , DIMENSION(:,:), ALLOCATABLE :: ZTHL ! grid scale enthalpy (J/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZTHES, ZTHEST ! grid scale saturated theta_e
REAL , DIMENSION(:,:), ALLOCATABLE :: ZRW ! grid scale total water (kg/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZRV ! grid scale water vapor (kg/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZRC ! grid scale cloud water (kg/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZRI ! grid scale cloud ice (kg/kg)
REAL , DIMENSION(:), ALLOCATABLE :: ZDXDY ! grid area (m^2)
REAL , DIMENSION(:), ALLOCATABLE :: ZCRAD ! cloud radius (m) !jiao xcrad
REAL , DIMENSION(:), ALLOCATABLE :: ZCDEP ! cloud depth (m) !jiao xcdepth
!
! updraft variables
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUMF ! updraft mass flux (kg/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUER ! updraft entrainment (kg/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUDR ! updraft detrainment (kg/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUPR ! updraft precipitation in
! flux units (kg water / s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUTHL ! updraft enthalpy (J/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUTHV ! updraft theta_v (K)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZURW ! updraft total water (kg/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZURC ! updraft cloud water (kg/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZURI ! updraft cloud ice (kg/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZURR ! liquid precipit. (kg/kg)
! produced in model layer
REAL , DIMENSION(:,:), ALLOCATABLE :: ZURS ! solid precipit. (kg/kg)
! produced in model layer
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUWW ! vertical velocity in updraft (m/s)
REAL , DIMENSION(:), ALLOCATABLE :: ZUTPR ! total updraft precipitation (kg/s)
REAL , DIMENSION(:), ALLOCATABLE :: ZMFLCL ! cloud base unit mass flux(kg/s)
REAL , DIMENSION(:), ALLOCATABLE :: ZCAPE ! available potent. energy
REAL , DIMENSION(:), ALLOCATABLE :: ZTHLCL ! updraft theta at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZTLCL ! updraft temp. at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZRVLCL ! updraft rv at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZWLCL ! updraft w at LCL
REAL , DIMENSION(:), ALLOCATABLE :: ZZLCL ! LCL height
REAL , DIMENSION(:), ALLOCATABLE :: ZTHVELCL ! envir. theta_v at LCL
!
! downdraft variables
REAL , DIMENSION(:,:), ALLOCATABLE :: ZDMF ! downdraft mass flux (kg/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZDER ! downdraft entrainment (kg/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZDDR ! downdraft detrainment (kg/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZDTHL ! downdraft enthalpy (J/kg)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZDRW ! downdraft total water (kg/kg)
REAL , DIMENSION(:), ALLOCATABLE :: ZMIXF ! mixed fraction at LFS
REAL , DIMENSION(:), ALLOCATABLE :: ZTPR ! total surf precipitation (kg/s)
REAL , DIMENSION(:), ALLOCATABLE :: ZSPR ! solid surf precipitation (kg/s)
REAL , DIMENSION(:), ALLOCATABLE :: ZDTEVR ! donwndraft evapor. (kg/s)
REAL , DIMENSION(:), ALLOCATABLE :: ZPREF ! precipitation efficiency
REAL , DIMENSION(:,:), ALLOCATABLE :: ZDTEVRF ! donwndraft evapor. (kg/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZPRLFLX ! liquid precip flux
REAL , DIMENSION(:,:), ALLOCATABLE :: ZPRSFLX ! solid precip flux
!
! closure variables
REAL , DIMENSION(:,:), ALLOCATABLE :: ZLMASS ! mass of model layer (kg)
REAL , DIMENSION(:), ALLOCATABLE :: ZTIMEA ! advective time period
REAL , DIMENSION(:), ALLOCATABLE :: ZTIMEC, ZTIMED! time during which convection is
! active at grid point (as ZTIME)
!
REAL , DIMENSION(:,:), ALLOCATABLE :: ZTHC ! conv. adj. grid scale theta
REAL , DIMENSION(:,:), ALLOCATABLE :: ZRVC ! conv. adj. grid scale r_w
REAL , DIMENSION(:,:), ALLOCATABLE :: ZRCC ! conv. adj. grid scale r_c
REAL , DIMENSION(:,:), ALLOCATABLE :: ZRIC ! conv. adj. grid scale r_i
REAL , DIMENSION(:,:), ALLOCATABLE :: ZWSUB ! envir. compensating subsidence (Pa/s)
!
LOGICAL, DIMENSION(:), ALLOCATABLE :: GTRIG1 ! logical mask for convection
LOGICAL, DIMENSION(:), ALLOCATABLE :: GWORK ! logical work array
INTEGER, DIMENSION(:), ALLOCATABLE :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX ! hor.index
REAL , DIMENSION(:), ALLOCATABLE :: ZCPH ! specific heat C_ph
REAL , DIMENSION(:), ALLOCATABLE :: ZLV, ZLS ! latent heat of vaporis., sublim.
REAL :: ZES ! saturation vapor mixng ratio
! for U, V transport:
REAL , DIMENSION(:,:), ALLOCATABLE :: ZUC ! horizontal wind u (m/s)
REAL , DIMENSION(:,:), ALLOCATABLE :: ZVC ! horizontal wind v (m/s)
! Chemical Tracers:
REAL , DIMENSION(:,:,:), ALLOCATABLE:: ZCH1 ! grid scale chemical specy (kg/kg)
REAL , DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C ! conv. adjust. chemical specy 1
REAL , DIMENSION(:,:), ALLOCATABLE:: ZWORK3 ! work arrays
LOGICAL, DIMENSION(:,:,:), ALLOCATABLE:: GTRIG4 ! logical mask
!
!-------------------------------------------------------------------------------
!
!* 0.3 Compute loop bounds
! -------------------
!
IIB = KIDIA
IIE = KFDIA
JCVEXB = MAX( 0, KBDIA - 1 )
IKB = 1 + JCVEXB
IKS = KLEV
JCVEXT = MAX( 0, KTDIA - 1 )
IKE = IKS - JCVEXT
!
!
!* 0.5 Update convective counter ( where KCOUNT > 0
! convection is still active ).
! ---------------------------------------------
!
KCOUNT(IIB:IIE) = KCOUNT(IIB:IIE) - 1.
!
IF ( OREFRESH ) THEN
KCOUNT(IIB:IIE) = 0. ! refresh or not at every call
END IF
!
GTRIG(:) = KCOUNT(:) <= 0.
ITEST = COUNT( GTRIG(:) )
IF ( ITEST == 0 ) RETURN ! if convection is already active at every grid point
! exit DEEP_CONVECTION
!
!
!* 0.7 Reset convective tendencies to zero if convective
! counter becomes negative
! -------------------------------------------------
!
GTRIG3(:,:) = SPREAD( GTRIG(:), DIM=2, NCOPIES=IKS )
WHERE ( GTRIG3(:,:) )
PTTEN (:,:) = 0.
PRVTEN (:,:) = 0.
PRCTEN (:,:) = 0.
PRITEN (:,:) = 0.
PRTTEN (:,:) = 0.
PPCTEN (:,:) = 0.
PPRLFLX (:,:) = 0.
PPRSFLX (:,:) = 0.
PUTEN (:,:) = 0.
PVTEN (:,:) = 0.
PUMF (:,:) = 0.
PDMF (:,:) = 0.
PURCOUT (:,:) = 0.
PURIOUT (:,:) = 0.
PAREA (:,:) = 0.
PCLOUD (:,:) = 0.
END WHERE
WHERE ( GTRIG(:) )
PPRLTEN (:) = 0.
PPRSTEN (:) = 0.
PPRTTEN (:) = 0.
PURCINT (:) = 0.
PURIINT (:) = 0.
PEFFOUT (:) = 0.
PWMAX (:) = 0.
INDEXCV (:) = 0
KCLTOP (:) = 0
KCLBAS (:) = 0
PCLTOP (:) = 0.
PCLBAS (:) = 0.
PCAPE (:) = 0.
END WHERE
IF ( OCH1CONV ) THEN
ALLOCATE( GTRIG4(KLON,KLEV,KCH1) )
GTRIG4(:,:,:) = SPREAD( GTRIG3(:,:), DIM=3, NCOPIES=KCH1 )
WHERE( GTRIG4(:,:,:) ) PCH1TEN(:,:,:) = 0.
DEALLOCATE( GTRIG4 )
END IF
!
!
!* 1. Initialize local variables
! ----------------------------
!
ZEPS = XRD / XRV
ZEPSA = XRV / XRD
ZEPSB = XCPV / XCPD - ZEPSA
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
!
!
!* 1.1 Set up grid scale theta, theta_v, theta_es
! ------------------------------------------
!
ZTHT(:,:) = 300.
ZSTHV(:,:)= 300.
ZSTHES(:,:) = 400.
DO JK = IKB, IKE
DO JI = IIB, IIE
IF ( PPABST(JI,JK) > 40.E2 ) THEN
ZTHT(JI,JK) = PTT(JI,JK) * ( XP00 / PPABST(JI,JK) ) ** ZRDOCP
ZSTHV(JI,JK) = ZTHT(JI,JK) * ( 1. + ZEPSA * PRVT(JI,JK) ) / &
( 1. + PRVT(JI,JK) + PRCT(JI,JK) + PRIT(JI,JK) )
!
! use conservative Bolton (1980) formula for theta_e
! it is used to compute CAPE for undilute parcel ascent
! For economical reasons we do not use routine CONVECT_SATMIXRATIO here
!
ZES = EXP( XALPW - XBETAW / PTT(JI,JK) - XGAMW * LOG( PTT(JI,JK) ) )
ZES = MIN( 1., ZEPS * ZES / ( PPABST(JI,JK) - ZES ) )
ZSTHES(JI,JK) = PTT(JI,JK) * ( ZTHT(JI,JK) / PTT(JI,JK) ) ** &
( 1. - 0.28 * ZES ) * EXP( ( 3374.6525 / PTT(JI,JK) - 2.5403 ) &
* ZES * ( 1. + 0.81 * ZES ) )
END IF
END DO
END DO
!
!
!
!* 2. Test for convective columns and determine properties at the LCL
! --------------------------------------------------------------
!
!* 2.1 Allocate arrays depending on number of model columns that need
! to be tested for convection (i.e. where no convection is present
! at the moment.
! --------------------------------------------------------------
!
ALLOCATE( ZPRES (ITEST,IKS) )
ALLOCATE( ZZ (ITEST,IKS) )
ALLOCATE( ZW (ITEST,IKS) )
ALLOCATE( ZTH (ITEST,IKS) )
ALLOCATE( ZTHV (ITEST,IKS) )
ALLOCATE( ZTHEST (ITEST,IKS) )
ALLOCATE( ZRV (ITEST,IKS) )
ALLOCATE( ZSTHLCL (ITEST) )
ALLOCATE( ZSTLCL (ITEST) )
ALLOCATE( ZSRVLCL (ITEST) )
ALLOCATE( ZSWLCL (ITEST) )
ALLOCATE( ZSZLCL (ITEST) )
ALLOCATE( ZSTHVELCL(ITEST) )
ALLOCATE( ISDPL (ITEST) )
ALLOCATE( ISPBL (ITEST) )
ALLOCATE( ISLCL (ITEST) )
ALLOCATE( ZSDXDY (ITEST) )
ALLOCATE( ZSCRAD (ITEST) ) !jiao xcrad
ALLOCATE( ZSCDEP (ITEST) ) !jiao xcdepth
ALLOCATE( GTRIG1 (ITEST) )
ALLOCATE( ZCAPE (ITEST) )
ALLOCATE( IINDEX (KLON) )
ALLOCATE( IJSINDEX (ITEST) )
DO JI = 1, KLON
IINDEX(JI) = JI
END DO
IJSINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
!
DO JK = IKB, IKE
DO JI = 1, ITEST
JL = IJSINDEX(JI)
ZPRES (JI,JK) = PPABST(JL,JK)
ZZ (JI,JK) = PZZ (JL,JK)
ZTH (JI,JK) = ZTHT (JL,JK)
ZTHV (JI,JK) = ZSTHV (JL,JK)
ZTHEST(JI,JK) = ZSTHES(JL,JK)
ZRV (JI,JK) = MAX( 0., PRVT(JL,JK) )
ZW (JI,JK) = PWT (JL,JK)
END DO
END DO
DO JI = 1, ITEST
JL = IJSINDEX(JI)
ZSDXDY(JI) = PDXDY(JL)
END DO
!
!* 2.2 Compute environm. enthalpy and total water = r_v + r_i + r_c
! and envir. saturation theta_e
! ------------------------------------------------------------
!
!
!* 2.3 Test for convective columns and determine properties at the LCL
! --------------------------------------------------------------
!
ISLCL(:) = MAX( IKB, 2 ) ! initialize DPL PBL and LCL
ISDPL(:) = IKB
ISPBL(:) = IKB
!
!
CALL CONVECT_TRIGGER_FUNCT( ITEST, KLEV, &
ZPRES, ZTH, ZTHV, ZTHEST, &
ZRV, ZW, ZZ, ZSDXDY, &
ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, &
ZSTHVELCL, ISLCL, ISDPL, ISPBL, GTRIG1, &
ZCAPE, ZSCRAD, ZSCDEP ) !jiao xcrad and xcdepth
!
DEALLOCATE( ZPRES )
DEALLOCATE( ZZ )
DEALLOCATE( ZTH )
DEALLOCATE( ZTHV )
DEALLOCATE( ZTHEST )
DEALLOCATE( ZRV )
DEALLOCATE( ZW )
DEALLOCATE( ZCAPE )
!
!
!* 3. After the call of TRIGGER_FUNCT we allocate all the dynamic
! arrays used in the convection scheme using the mask GTRIG, i.e.
! we do calculus only in convective columns. This corresponds to
! a GATHER operation.
! --------------------------------------------------------------
!
ICONV = COUNT( GTRIG1(:) )
IF ( ICONV == 0 ) THEN
DEALLOCATE( ZSTHLCL )
DEALLOCATE( ZSTLCL )
DEALLOCATE( ZSRVLCL )
DEALLOCATE( ZSWLCL )
DEALLOCATE( ZSZLCL )
DEALLOCATE( ZSTHVELCL )
DEALLOCATE( ZSDXDY )
DEALLOCATE( ZSCRAD ) !jiao xcrad
DEALLOCATE( ZSCDEP ) !jiao xcdepth
DEALLOCATE( ISLCL )
DEALLOCATE( ISDPL )
DEALLOCATE( ISPBL )
DEALLOCATE( GTRIG1 )
DEALLOCATE( IINDEX )
DEALLOCATE( IJSINDEX )
RETURN ! no convective column has been found, exit DEEP_CONVECTION
ENDIF
!
! vertical index variables
!
ALLOCATE( IDPL(ICONV) )
ALLOCATE( IPBL(ICONV) )
ALLOCATE( ILCL(ICONV) )
ALLOCATE( ICTL(ICONV) )
ALLOCATE( IETL(ICONV) )
!
! grid scale variables
!
ALLOCATE( ZZ (ICONV,IKS) )
ALLOCATE( ZPRES (ICONV,IKS) )
ALLOCATE( ZDPRES(ICONV,IKS) )
ALLOCATE( ZU (ICONV,IKS) )
ALLOCATE( ZV (ICONV,IKS) )
ALLOCATE( ZTT (ICONV,IKS) )
ALLOCATE( ZTH (ICONV,IKS) )
ALLOCATE( ZTHV (ICONV,IKS) )
ALLOCATE( ZTHL (ICONV,IKS) )
ALLOCATE( ZTHES (ICONV,IKS) )
ALLOCATE( ZRV (ICONV,IKS) )
ALLOCATE( ZRC (ICONV,IKS) )
ALLOCATE( ZRI (ICONV,IKS) )
ALLOCATE( ZRW (ICONV,IKS) )
ALLOCATE( ZDXDY (ICONV) )
ALLOCATE( ZCRAD (ICONV) ) !jiao xcrad
ALLOCATE( ZCDEP (ICONV) ) !jiao xcdepth
!
! updraft variables
!
ALLOCATE( ZUMF (ICONV,IKS) )
ALLOCATE( ZUER (ICONV,IKS) )
ALLOCATE( ZUDR (ICONV,IKS) )
ALLOCATE( ZUPR (ICONV,IKS) )
ALLOCATE( ZUTHL (ICONV,IKS) )
ALLOCATE( ZUTHV (ICONV,IKS) )
ALLOCATE( ZURW (ICONV,IKS) )
ALLOCATE( ZURC (ICONV,IKS) )
ALLOCATE( ZURI (ICONV,IKS) )
ALLOCATE( ZURR (ICONV,IKS) )
ALLOCATE( ZURS (ICONV,IKS) )
ALLOCATE( ZUWW (ICONV,IKS) )
ALLOCATE( ZUTPR (ICONV) )
ALLOCATE( ZTHLCL (ICONV) )
ALLOCATE( ZTLCL (ICONV) )
ALLOCATE( ZRVLCL (ICONV) )
ALLOCATE( ZWLCL (ICONV) )
ALLOCATE( ZMFLCL (ICONV) )
ALLOCATE( ZZLCL (ICONV) )
ALLOCATE( ZTHVELCL(ICONV) )
ALLOCATE( ZCAPE (ICONV) )
!
! work variables
!
ALLOCATE( IJINDEX (ICONV) )
ALLOCATE( IJPINDEX(ICONV) )
ALLOCATE( ZCPH (ICONV) )
ALLOCATE( ZLV (ICONV) )
ALLOCATE( ZLS (ICONV) )
!
!
!* 3.1 Gather grid scale and updraft base variables in
! arrays using mask GTRIG
! ---------------------------------------------------
!
GTRIG(:) = UNPACK( GTRIG1(:), MASK=GTRIG(:), FIELD=.FALSE. )
IJINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
!
DO JK = IKB, IKE
DO JI = 1, ICONV
JL = IJINDEX(JI)
ZZ (JI,JK) = PZZ (JL,JK)
ZPRES(JI,JK) = PPABST (JL,JK)
ZTT (JI,JK) = PTT (JL,JK)
ZTH (JI,JK) = ZTHT (JL,JK)
ZTHES(JI,JK) = ZSTHES (JL,JK)
ZRV (JI,JK) = MAX(PRVT(JL,JK), 0.0 )
ZRC (JI,JK) = MAX(PRCT(JL,JK), 0.0)
ZRI (JI,JK) = MAX(PRIT(JL,JK), 0.0)
ZTHV (JI,JK) = ZSTHV (JL,JK)
ZU (JI,JK) = PUT (JL,JK)
ZV (JI,JK) = PVT (JL,JK)
END DO
END DO
IF ( OSETTADJ ) THEN
ALLOCATE( ZTIMED(ICONV) )
DO JI = 1, ICONV
JL = IJINDEX(JI)
ZTIMED(JI) = PTIMEC(JL)
END DO
END IF
!
DO JI = 1, ITEST
IJSINDEX(JI) = JI
END DO
IJPINDEX(:) = PACK( IJSINDEX(:), MASK=GTRIG1(:) )
DO JI = 1, ICONV
JL = IJPINDEX(JI)
IDPL (JI) = ISDPL (JL)
IPBL (JI) = ISPBL (JL)
ILCL (JI) = ISLCL (JL)
ZTHLCL (JI) = ZSTHLCL (JL)
ZTLCL (JI) = ZSTLCL (JL)
ZRVLCL (JI) = ZSRVLCL (JL)
ZWLCL (JI) = ZSWLCL (JL)
ZZLCL (JI) = ZSZLCL (JL)
ZTHVELCL(JI) = ZSTHVELCL(JL)
ZDXDY (JI) = ZSDXDY (JL)
ZCRAD (JI) = ZSCRAD (JL) !jiao xcrad
ZCDEP (JI) = ZSCDEP (JL) !jiao xcdepth
END DO
ALLOCATE( GWORK(ICONV) )
GWORK(:) = PACK( GTRIG1(:), MASK=GTRIG1(:) )
DEALLOCATE( GTRIG1 )
ALLOCATE( GTRIG1(ICONV) )
GTRIG1(:) = GWORK(:)
!
DEALLOCATE( GWORK )
DEALLOCATE( IJPINDEX )
DEALLOCATE( ISDPL )
DEALLOCATE( ISPBL )
DEALLOCATE( ISLCL )
DEALLOCATE( ZSTHLCL )
DEALLOCATE( ZSTLCL )
DEALLOCATE( ZSRVLCL )
DEALLOCATE( ZSWLCL )
DEALLOCATE( ZSZLCL )
DEALLOCATE( ZSTHVELCL)
DEALLOCATE( ZSDXDY )
DEALLOCATE( ZSCRAD ) !jiao xcrad
DEALLOCATE( ZSCDEP ) !jiao xcdepth
!
!
!* 3.2 Compute pressure difference
! ---------------------------------------------------
!
ZDPRES(:,IKB) = 0.
DO JK = IKB + 1, IKE
ZDPRES(:,JK) = ZPRES(:,JK-1) - ZPRES(:,JK)
END DO
!
!* 3.3 Compute environm. enthalpy and total water = r_v + r_i + r_c
! ----------------------------------------------------------
!
DO JK = IKB, IKE, 1
ZRW(:,JK) = ZRV(:,JK) + ZRC(:,JK) + ZRI(:,JK)
ZCPH(:) = XCPD + XCPV * ZRW(:,JK)
ZLV(:) = XLVTT + ( XCPV - XCL ) * ( ZTT(:,JK) - XTT ) ! compute L_v
ZLS(:) = XLSTT + ( XCPV - XCI ) * ( ZTT(:,JK) - XTT ) ! compute L_i
ZTHL(:,JK) = ZCPH(:) * ZTT(:,JK) + ( 1. + ZRW(:,JK) ) * XG * ZZ(:,JK) &
- ZLV(:) * ZRC(:,JK) - ZLS(:) * ZRI(:,JK)
END DO
!
!
!* 4. Compute updraft properties
! ----------------------------
!
!* 4.1 Set mass flux at LCL ( here a unit mass flux with w = 1 m/s )
! -------------------------------------------------------------
!
DO JI = 1, ICONV
JK = ILCL(JI) - 1
ZMFLCL(JI) = ZPRES(JI,JK) / ( XRD * ZTT(JI,JK) * &
( 1. + ZEPS * ZRVLCL(JI) ) ) * XPI * ZCRAD(JI) * ZCRAD(JI)
END DO
!
DEALLOCATE( ZCPH )
DEALLOCATE( ZLV )
DEALLOCATE( ZLS )
!
!
CALL CONVECT_UPDRAFT( ICONV, KLEV, &
KICE, ZPRES, ZDPRES, ZZ, ZTHL, ZTHV, ZTHES, ZRW, &
ZTHLCL, ZTLCL, ZRVLCL, ZWLCL, ZZLCL, ZTHVELCL, &
ZMFLCL, GTRIG1, ILCL, IDPL, IPBL, &
ZUMF, ZUER, ZUDR, ZUTHL, ZUTHV, ZURW, &
ZURC, ZURI, ZURR, ZURS, ZUPR, &
ZUTPR, ZCAPE, ICTL, IETL, ZCRAD, ZCDEP, ZUWW)
!jiao xcrad and xcdepth
!
!
!
!* 4.2 In routine UPDRAFT GTRIG1 has been set to false when cloud
! thickness is smaller than 3 km
! -----------------------------------------------------------
!
!
ICONV1 = COUNT(GTRIG1)
!
IF ( ICONV1 > 0 ) THEN
!
!* 4.3 Allocate memory for downdraft variables
! ---------------------------------------
!
! downdraft variables
!
ALLOCATE( ILFS (ICONV) )
ALLOCATE( IDBL (ICONV) )
ALLOCATE( IML (ICONV) )
ALLOCATE( ZDMF (ICONV,IKS) )
ALLOCATE( ZDER (ICONV,IKS) )
ALLOCATE( ZDDR (ICONV,IKS) )
ALLOCATE( ZDTHL (ICONV,IKS) )
ALLOCATE( ZDRW (ICONV,IKS) )
ALLOCATE( ZLMASS(ICONV,IKS) )
DO JK = IKB, IKE
ZLMASS(:,JK) = ZDXDY(:) * ZDPRES(:,JK) / XG ! mass of model layer
END DO
ZLMASS(:,IKB) = ZLMASS(:,IKB+1)
ALLOCATE( ZMIXF (ICONV) )
ALLOCATE( ZTPR (ICONV) )
ALLOCATE( ZSPR (ICONV) )
ALLOCATE( ZDTEVR (ICONV) )
ALLOCATE( ZPREF (ICONV) )
ALLOCATE( ZDTEVRF(ICONV,IKS) )
ALLOCATE( ZPRLFLX(ICONV,IKS) )
ALLOCATE( ZPRSFLX(ICONV,IKS) )
!
! closure variables
!
ALLOCATE( ZTIMEA(ICONV) )
ALLOCATE( ZTIMEC(ICONV) )
ALLOCATE( ZTHC (ICONV,IKS) )
ALLOCATE( ZRVC (ICONV,IKS) )
ALLOCATE( ZRCC (ICONV,IKS) )
ALLOCATE( ZRIC (ICONV,IKS) )
ALLOCATE( ZWSUB (ICONV,IKS) )
!
!
!* 5. Compute downdraft properties
! ----------------------------
!
!* 5.1 Compute advective time period and precipitation
! efficiency as a function of mean ambient wind (shear)
! --------------------------------------------------------
!
CALL CONVECT_TSTEP_PREF( ICONV, KLEV, &
ZU, ZV, ZPRES, ZZ, ZDXDY, ILCL, ICTL, &
ZTIMEA, ZPREF )
!
! exclude convective downdrafts if desired
IF ( .NOT. ODOWN ) ZPREF(:) = 1.
!
! Compute the period during which convection is active
ZTIMEC(:) = MAX( 1800., MIN( 3600., ZTIMEA(:) ) )
ZTIMEC(:) = REAL( INT( ZTIMEC(:) / PDTCONV ) ) * PDTCONV
ZTIMEC(:) = MAX( PDTCONV, ZTIMEC(:) ) ! necessary if PDTCONV > 1800
IF ( OSETTADJ ) THEN
ZTIMEC(:) = MAX( PDTCONV, ZTIMED(:) )
END IF
!
!
!* 5.2 Compute melting level
! ----------------------
!
IML(:) = IKB
DO JK = IKE, IKB, -1
WHERE( ZTT(:,JK) <= XTT ) IML(:) = JK
END DO
!
CALL CONVECT_DOWNDRAFT( ICONV, KLEV, &
KICE, ZPRES, ZDPRES, ZZ, ZTH, ZTHES, &
ZRW, ZRC, ZRI, &
ZPREF, ILCL, ICTL, IETL, &
ZUTHL, ZURW, ZURC, ZURI, &
ZDMF, ZDER, ZDDR, ZDTHL, ZDRW, &
ZMIXF, ZDTEVR, ILFS, IDBL, IML, &
ZDTEVRF,ZCRAD ) !jiao xcrad
!
!
!* 6. Adjust up and downdraft mass flux to be consistent
! with precipitation efficiency relation.
! ---------------------------------------------------
!
CALL CONVECT_PRECIP_ADJUST( ICONV, KLEV, &
ZPRES,ZUMF, ZUER, ZUDR, ZUPR, ZUTPR, ZURW,&
ZDMF, ZDER, ZDDR, ZDTHL, ZDRW, &
ZPREF, ZTPR, ZMIXF, ZDTEVR, &
ILFS, IDBL, ILCL, ICTL, IETL, &
ZDTEVRF )
!
!
!* 7. Determine adjusted environmental values assuming
! that all available buoyant energy must be removed
! within an advective time step ZTIMEC.
! ---------------------------------------------------
!
CALL CONVECT_CLOSURE( ICONV, KLEV, &
ZPRES, ZDPRES, ZZ, ZDXDY, ZLMASS, &
ZTHL, ZTH, ZRW, ZRC, ZRI, GTRIG1, &
ZTHC, ZRVC, ZRCC, ZRIC, ZWSUB, &
ILCL, IDPL, IPBL, ILFS, ICTL, IML, &
ZUMF, ZUER, ZUDR, ZUTHL, ZURW, &
ZURC, ZURI, ZUPR, &
ZDMF, ZDER, ZDDR, ZDTHL, ZDRW, &
ZTPR, ZSPR, ZDTEVR, &
ZCAPE, ZTIMEC, &
IFTSTEPS, &
ZDTEVRF, ZPRLFLX, ZPRSFLX )
!
!* 8. Determine the final grid-scale (environmental) convective
! tendencies and set convective counter
! --------------------------------------------------------
!
!
!* 8.1 Grid scale tendencies
! ---------------------
!
! in order to save memory, the tendencies are temporarily stored
! in the tables for the adjusted grid-scale values
!
DO JK = IKB, IKE
ZTHC(:,JK) = ( ZTHC(:,JK) - ZTH(:,JK) ) / ZTIMEC(:) &
* ( ZPRES(:,JK) / XP00 ) ** ZRDOCP ! change theta in temperature
ZRVC(:,JK) = ( ZRVC(:,JK) - ZRW(:,JK) + ZRC(:,JK) + ZRI(:,JK) ) &
/ ZTIMEC(:)
ZRCC(:,JK) = ( ZRCC(:,JK) - ZRC(:,JK) ) / ZTIMEC(:)
ZRIC(:,JK) = ( ZRIC(:,JK) - ZRI(:,JK) ) / ZTIMEC(:)
!
ZPRLFLX(:,JK) = ZPRLFLX(:,JK) / ( XRHOLW * ZDXDY(:) )
ZPRSFLX(:,JK) = ZPRSFLX(:,JK) / ( XRHOLW * ZDXDY(:) )
!
END DO
!
ZPRLFLX(:,IKB) = ZPRLFLX(:,IKB+1)
ZPRSFLX(:,IKB) = ZPRSFLX(:,IKB+1)
!
!
!* 8.2 Apply conservation correction
! -----------------------------
!
! Compute vertical integrals
!
JKM = MAXVAL( ICTL(:) )
ZWORK2(:) = 0.
ZWORK2B(:) = 0.
DO JK = JKM, IKB+1, -1
JKP = JK + 1
DO JI = 1, ICONV
ZWORK2(JI) = ZWORK2(JI) + ( ZRVC(JI,JK) + ZRCC(JI,JK) + ZRIC(JI,JK) ) * & ! moisture
(ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
! ZWORK2B(JI) = ZWORK2B(JI) + ( & ! energy
! ( XCPD + XCPV * ZRW(JI,JK) )* ZTHC(JI,JK) - &
! ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRCC(JI,JK) - &
! ( XLSTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRIC(JI,JK) ) * &
! (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
END DO
END DO
!
! Budget error (compare integral to surface precip.)
!
DO JI = 1, ICONV
IF ( ZTPR(JI) > 0.) THEN
JKP = ICTL(JI) + 1
ZWORK2(JI) = ( ZTPR(JI) / ZDXDY(JI) + ZWORK2(JI) ) * XG / &
( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
! ZWORK2B(JI) = ( ZTPR(JI) / ZDXDY(JI) * &
! ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,IKB) - XTT ) ) - ZWORK2B(JI) ) &
! * XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
END IF
END DO
!
! Apply uniform correction
!
DO JK = JKM, IKB+1, -1
DO JI = 1, ICONV
IF ( ZTPR(JI) > 0. .AND. JK <= ICTL(JI) ) THEN
ZRVC(JI,JK) = ZRVC(JI,JK) - ZWORK2(JI) ! moisture
! ZTHC(JI,JK) = ZTHC(JI,JK) + ZWORK2B(JI) / ( XCPD + XCPV * ZRW(JI,JK) )! energy
END IF
END DO
END DO
!
!
!
! execute a "scatter"= pack command to store the tendencies in
! the final 2D tables
!
DO JK = IKB, IKE
DO JI = 1, ICONV
JL = IJINDEX(JI)
PTTEN (JL,JK) = ZTHC (JI,JK)
PRVTEN (JL,JK) = ZRVC (JI,JK)
PRCTEN (JL,JK) = ZRCC (JI,JK)
PRITEN (JL,JK) = ZRIC (JI,JK)
PRTTEN (JL,JK) = ZRCC (JI,JK) + ZRIC (JI,JK)
!
!jiao>>> --------------------------------
! Units changed to (kg/m2 s) by multiplying XRHOLW
! PPRLFLX(JL,JK) = ZPRLFLX(JI,JK) !orig, unit in m/s
! PPRSFLX(JL,JK) = ZPRSFLX(JI,JK) !orig, unit in m/s
PPRLFLX(JL,JK) = ZPRLFLX(JI,JK) * XRHOLW
PPRSFLX(JL,JK) = ZPRSFLX(JI,JK) * XRHOLW
!jiao<<< --------------------------------
END DO
END DO
!
!
!
!
!* 8.3 Convective rainfall tendency, cape and precipitation efficiency
! ---------------------------------------------------------
!
! liquid and solid surface rainfall tendency in m/s
ZTPR(:) = ZTPR(:) / ( XRHOLW * ZDXDY(:) ) ! total surf precip
ZSPR(:) = ZSPR(:) / ( XRHOLW * ZDXDY(:) ) ! solid surf precip
ZTPR(:) = ZTPR(:) - ZSPR(:) ! compute liquid part
!
DO JI = 1, ICONV
JL = IJINDEX(JI)
PPRLTEN(JL) = ZTPR (JI)
PPRSTEN(JL) = ZSPR (JI)
PPRTTEN(JL) = ZTPR (JI) + ZSPR(JI)
!jiao>>> precipitation efficiency for output
PEFFOUT(JL) = ZPREF(JI)
PCAPE (JL) = ZCAPE(JI)
END DO
!
!
! Cloud base and top levels
! -------------------------
!
ILCL(:) = MIN( ILCL(:), ICTL(:) )
DO JI = 1, ICONV
JL = IJINDEX(JI)
KCLTOP (JL) = ICTL(JI)
KCLBAS (JL) = ILCL(JI)
PCLTOP (JL) = PZZ( JI, ICTL(JI) )
PCLBAS (JL) = PZZ( JI, ILCL(JI) )
INDEXCV(JL) = 2
END DO
!
!
!* 8.4 Set convective counter
! ----------------------
!
! compute convective counter for just activated convective
! grid points
! If the advective time period is less than specified
! minimum for convective period, allow feedback to occur only
! during advective time
!
ZTIME(:) = 1.
ZWORK2(:) = 0.
DO JI = 1, ICONV
JL = IJINDEX(JI)
ZTIME(JL) = ZTIMEC(JI)
ZWORK2(JL) = ZTIMEA(JI)
ZWORK2(JL) = MIN( ZWORK2(JL), ZTIME(JL) )
ZWORK2(JL) = MAX( ZWORK2(JL), PDTCONV )
IF ( GTRIG(JL) ) KCOUNT(JL) = ZWORK2(JL) / PDTCONV
IF ( GTRIG(JL) .AND. PPRLTEN(JL)<1.E-14 ) KCOUNT(JL) = 0.
END DO
!
!
!
!* 8.7 Compute convective tendencies for Tracers
! ------------------------------------------
!
IF ( OCH1CONV ) THEN
!
ALLOCATE( ZCH1 (ICONV,IKS,KCH1) )
ALLOCATE( ZCH1C (ICONV,IKS,KCH1) )
ALLOCATE( ZWORK3(ICONV,KCH1) )
!
DO JK = IKB, IKE
DO JI = 1, ICONV
JL = IJINDEX(JI)
ZCH1(JI,JK,:) = PCH1(JL,JK,:)
END DO
END DO
!
CALL CONVECT_CHEM_TRANSPORT( ICONV, KLEV, KCH1, ZCH1, ZCH1C, &
IDPL, IPBL, ILCL, ICTL, ILFS, IDBL, &
ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR, &
ZTIMEC, ZDXDY, ZMIXF, ZLMASS, ZWSUB, &
IFTSTEPS )
!
DO JK = IKB, IKE
DO JN = 1, KCH1
ZCH1C(:,JK,JN) = ( ZCH1C(:,JK,JN)- ZCH1(:,JK,JN) ) / ZTIMEC(:)
END DO
END DO
!
!* 8.8 Apply conservation correction
! -----------------------------
!
! Compute vertical integrals
!
JKM = MAXVAL( ICTL(:) )
ZWORK3(:,:) = 0.
DO JK = JKM, IKB+1, -1
JKP = JK + 1
DO JI = 1, ICONV
ZWORK3(JI,:) = ZWORK3(JI,:) + ZCH1C(JI,JK,:) * &
(ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
END DO
END DO
!
! Mass error (integral must be zero)
!
DO JI = 1, ICONV
IF ( ZTPR(JI) > 0.) THEN
JKP = ICTL(JI) + 1
ZWORK3(JI,:) = ZWORK3(JI,:) * &
XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
END IF
END DO
!
! Apply uniform correction but assure positive mass at each level
!
DO JK = JKM, IKB+1, -1
DO JI = 1, ICONV
IF ( ZTPR(JI) > 0. .AND. JK <= ICTL(JI) ) THEN
ZCH1C(JI,JK,:) = ZCH1C(JI,JK,:) - ZWORK3(JI,:)
ZCH1C(JI,JK,:) = MAX( ZCH1C(JI,JK,:), -ZCH1(JI,JK,:)/ZTIMEC(JI) )
END IF
END DO
END DO
!
DO JK = IKB, IKE
DO JI = 1, ICONV
JL = IJINDEX(JI)
PCH1TEN(JL,JK,:) = ZCH1C(JI,JK,:)
END DO
END DO
END IF
!
!
!* 8.9 Compute convective tendencies for wind
! --------------------------------------
IF ( OUVCONV ) THEN
ALLOCATE( ZUC(ICONV,IKS) )
ALLOCATE( ZVC(ICONV,IKS) )
CALL CONVECT_UV_TRANSPORT( ICONV, KLEV, ZU, ZV, ZUC, ZVC, &
& IDPL, IPBL, ILCL, ICTL, ILFS, IDBL, &
& ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR, &
& ZTIMEC, ZDXDY, ZMIXF, ZLMASS, ZWSUB, &
& IFTSTEPS )
DO JK = IKB, IKE
ZUC(:,JK) = ( ZUC(:,JK)- ZU(:,JK) ) / ZTIMEC(:)
ZVC(:,JK) = ( ZVC(:,JK)- ZV(:,JK) ) / ZTIMEC(:)
ENDDO
!* 8.9 Apply conservation correction
! -----------------------------
! Compute vertical integrals
JKM = MAXVAL( ICTL(:) )
ZWORK2(:) = 0.0
ZWORK2B(:)= 0.0
DO JK = IKB+1, JKM
JKP = JK + 1
DO JI = 1, ICONV
ZW1 = 0.5 * (ZPRES(JI,JK-1) - ZPRES(JI,JKP)) / XG
ZWORK2(JI) = ZWORK2(JI) + ZUC(JI,JK) * ZW1
ZWORK2B(JI)= ZWORK2B(JI)+ ZVC(JI,JK) * ZW1
ENDDO
ENDDO
! error (integral must be zero)
DO JI = 1, ICONV
IF ( ZTPR(JI) > 0.0) THEN
JKP = ICTL(JI)
ZW1 = XG / ( ZPRES(JI,IKB) - ZPRES(JI,JKP) - &
& 0.5*(ZDPRES(JI,IKB+1) - ZDPRES(JI,JKP+1)) )
ZWORK2(JI) = ZWORK2(JI) * ZW1
ZWORK2B(JI)= ZWORK2B(JI)* ZW1
ENDIF
ENDDO
! Apply uniform correction
DO JK = JKM, IKB+1, -1
DO JI = 1, ICONV
IF ( ZTPR(JI) > 0.0 .AND. JK <= ICTL(JI) ) THEN
ZUC(JI,JK) = ZUC(JI,JK) - ZWORK2(JI)
ZVC(JI,JK) = ZVC(JI,JK) - ZWORK2B(JI)
ENDIF
ENDDO
ENDDO
!
! extend tendencies to first model level
! DO JI = 1, ICONV
! ZWORK2(JI) = ZDPRES(JI,IKB+1) + ZDPRES(JI,IKB+2)
! ZUC(JI,IKB) = ZUC(JI,IKB+1) * ZDPRES(JI,IKB+2)/ZWORK2(JI)
! ZUC(JI,IKB+1)= ZUC(JI,IKB+1) * ZDPRES(JI,IKB+1)/ZWORK2(JI)
! ZVC(JI,IKB) = ZVC(JI,IKB+1) * ZDPRES(JI,IKB+2)/ZWORK2(JI)
! ZVC(JI,IKB+1)= ZVC(JI,IKB+1) * ZDPRES(JI,IKB+1)/ZWORK2(JI)
! ENDDO
DO JK = IKB, IKE
DO JI = 1, ICONV
JL = IJINDEX(JI)
PUTEN(JL,JK) = ZUC(JI,JK)
PVTEN(JL,JK) = ZVC(JI,JK)
ENDDO
ENDDO
ENDIF
!
!* 9. Write up- and downdraft mass fluxes
! ------------------------------------
!
!jiao keep mass flux units in kg/s, in consistent with the output of KF
! DO JK = IKB, IKE
! ZUMF(:,JK) = ZUMF(:,JK) / ZDXDY(:) ! Mass flux per unit area
! ZDMF(:,JK) = ZDMF(:,JK) / ZDXDY(:)
! END DO
!jiao keep the units in kg/s, in consistent with the output of KF
ZWORK2(:) = 1.
WHERE ( PPRLTEN(:)<1.E-14 ) ZWORK2(:) = 0.
DO JK = IKB, IKE
DO JI = 1, ICONV
JL = IJINDEX(JI)
PUMF(JL,JK) = ZUMF(JI,JK) * ZWORK2(JL)
PDMF(JL,JK) = ZDMF(JI,JK) * ZWORK2(JL)
!jiao>>> --------------------------------
! Intergrated cloud liquid and ice water in updraft (kg/m2)
PURCINT(JL) = PURCINT(JL) + ZURC(JI,JK)/XG*ZDPRES(JI,JK)
PURIINT(JL) = PURIINT(JL) + ZURI(JI,JK)/XG*ZDPRES(JI,JK)
! Tendency of precipitation in updraft for output (1/s)
PPCTEN (JL,JK) = (ZURR(JI,JK) + ZURS (JI,JK) )/ ZTIMEC(JI)
! Maximum vertical velocity in updraft
PWMAX(JL) = MAX(PWMAX(JL), ZUWW (JI,JK) )
! Diagnose cloud coverage area (m2) for output (see kfcp4.ftn)
IF (ZUWW(JI,JK) .GT. 0.1) THEN
PAREA(JL,JK) = (PUMF(JL,JK)*ZUTHV(JI,JK)*XRD ) / &
( ZPRES(JI,JK)* ZUWW(JI,JK) )
ENDIF
PCLOUD(JL,JK) = MAX(0.0,PAREA(JL,JK)/PDXDY(JL))
! Cloud liquid and ice water mixing ratio in updraft, normalized by convective cloud
PURCOUT(JL,JK) = ZURC(JI,JK)*PCLOUD(JL,JK)
PURIOUT(JL,JK) = ZURI(JI,JK)*PCLOUD(JL,JK)
!jiao<<< --------------------------------
END DO
END DO
!
!
!* 10. Deallocate all local arrays
! ---------------------------
!
! downdraft variables
!
DEALLOCATE( ZDMF )
DEALLOCATE( ZDER )
DEALLOCATE( ZDDR )
DEALLOCATE( ZDTHL )
DEALLOCATE( ZDRW )
DEALLOCATE( ZLMASS )
DEALLOCATE( ZMIXF )
DEALLOCATE( ZTPR )
DEALLOCATE( ZSPR )
DEALLOCATE( ZDTEVR )
DEALLOCATE( ZPREF )
DEALLOCATE( IML )
DEALLOCATE( ILFS )
DEALLOCATE( IDBL )
DEALLOCATE( ZDTEVRF )
DEALLOCATE( ZPRLFLX )
DEALLOCATE( ZPRSFLX )
!
! closure variables
!
DEALLOCATE( ZTIMEA )
DEALLOCATE( ZTIMEC )
DEALLOCATE( ZTHC )
DEALLOCATE( ZRVC )
DEALLOCATE( ZRCC )
DEALLOCATE( ZRIC )
DEALLOCATE( ZWSUB )
!
IF ( OCH1CONV ) THEN
DEALLOCATE( ZCH1 )
DEALLOCATE( ZCH1C )
DEALLOCATE( ZWORK3 )
END IF
!
ENDIF
!
! vertical index
!
DEALLOCATE( IDPL )
DEALLOCATE( IPBL )
DEALLOCATE( ILCL )
DEALLOCATE( ICTL )
DEALLOCATE( IETL )
!
! grid scale variables
!
DEALLOCATE( ZZ )
DEALLOCATE( ZPRES )
DEALLOCATE( ZDPRES )
DEALLOCATE( ZU )
DEALLOCATE( ZV )
DEALLOCATE( ZTT )
DEALLOCATE( ZTH )
DEALLOCATE( ZTHV )
DEALLOCATE( ZTHL )
DEALLOCATE( ZTHES )
DEALLOCATE( ZRW )
DEALLOCATE( ZRV )
DEALLOCATE( ZRC )
DEALLOCATE( ZRI )
DEALLOCATE( ZDXDY )
DEALLOCATE( ZCRAD ) !jiao xcrad
DEALLOCATE( ZCDEP ) !jiao xcdepth
!
! updraft variables
!
DEALLOCATE( ZUMF )
DEALLOCATE( ZUER )
DEALLOCATE( ZUDR )
DEALLOCATE( ZUTHL )
DEALLOCATE( ZUTHV )
DEALLOCATE( ZURW )
DEALLOCATE( ZURC )
DEALLOCATE( ZURI )
DEALLOCATE( ZURR )
DEALLOCATE( ZURS )
DEALLOCATE( ZUWW )
DEALLOCATE( ZUPR )
DEALLOCATE( ZUTPR )
DEALLOCATE( ZTHLCL )
DEALLOCATE( ZTLCL )
DEALLOCATE( ZRVLCL )
DEALLOCATE( ZWLCL )
DEALLOCATE( ZZLCL )
DEALLOCATE( ZTHVELCL )
DEALLOCATE( ZMFLCL )
DEALLOCATE( ZCAPE )
IF ( OSETTADJ ) DEALLOCATE( ZTIMED )
!
! work arrays
!
DEALLOCATE( IINDEX )
DEALLOCATE( IJINDEX )
DEALLOCATE( IJSINDEX )
DEALLOCATE( GTRIG1 )
!
!
END SUBROUTINE DEEP_CONVECTION
!-----------------------------------------------------------------------------
!
! ######################################################################
SUBROUTINE CONVECT_TRIGGER_FUNCT( KLON, KLEV, & 1,5
PPRES, PTH, PTHV, PTHES, &
PRV, PW, PZ, PDXDY, &
PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, &
PTHVELCL, KLCL, KDPL, KPBL, OTRIG, &
PCAPE, PCRAD, PCDEP ) !jiao xcrad xcdepth
! ######################################################################
!
!!**** Determine convective columns as well as the cloudy values of theta,
!! and qv at the lifting condensation level (LCL)
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine convective columns
!!
!!
!!
!!** METHOD
!! ------
!! Computations are done at every model level starting from bottom.
!! The use of masks allows to optimise the inner loops (horizontal loops).
!! What we look for is the undermost unstable level at each grid point.
!!
!!
!!
!! EXTERNAL
!! --------
!! Routine CONVECT_SATMIXRATIO
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XG ! gravity constant
!! XP00 ! Reference pressure
!! XRD, XRV ! Gaz constants for dry air and water vapor
!! XCPD ! Cpd (dry air)
!! XTT ! triple point temperature
!! XBETAW, XGAMW ! constants for vapor saturation pressure
!!
!! Module MODD_CONVPAR
!! XA25 ! reference grid area
!! XZLCL ! maximum height difference between
!! ! the surface and the DPL
!! XZPBL ! minimum mixed layer depth to sustain convection
!! XWTRIG ! constant in vertical velocity trigger
!! XCDEPTH ! minimum necessary cloud depth
!! XNHGAM ! coefficient for buoyancy term in w eq.
!! ! accounting for nh-pressure
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! REFERENCE
!! ---------
!!
!! Book2 of documentation ( routine TRIGGER_FUNCT)
!! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 20/03/97 Select first departure level
!! that produces a cloud thicker than XCDEPTH
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal loop index
INTEGER, INTENT(IN) :: KLEV ! vertical loop index
REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES ! envir. satur. theta_e
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV ! vapor mixing ratio
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES ! pressure
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ ! height of grid point (m)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW ! vertical velocity
!
REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temp. at LCL
REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
REAL, DIMENSION(KLON), INTENT(OUT):: PWLCL ! parcel velocity at LCL
REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
REAL, DIMENSION(KLON), INTENT(OUT):: PTHVELCL ! environm. theta_v at LCL (K)
LOGICAL, DIMENSION(KLON), INTENT(OUT):: OTRIG ! logical mask for convection
INTEGER, DIMENSION(KLON), INTENT(INOUT):: KLCL ! contains vert. index of LCL
INTEGER, DIMENSION(KLON), INTENT(INOUT):: KDPL ! contains vert. index of DPL
INTEGER, DIMENSION(KLON), INTENT(INOUT):: KPBL ! contains index of source layer top
REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! CAPE (J/kg) for diagnostics
REAL, DIMENSION(KLON), INTENT(OUT):: PCRAD ! cloud radius (m) !jiao xcrad
REAL, DIMENSION(KLON), INTENT(OUT):: PCDEP ! cloud depth (m) !jiao xcdepth
!
!* 0.2 Declarations of local variables :
!
INTEGER :: JKK, JK, JKP, JKM, JKDL, JL, JKT, JT! vertical loop index
INTEGER :: JI ! horizontal loop index
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON) :: ZTHLCL, ZTLCL, ZRVLCL, & ! locals for PTHLCL,PTLCL
ZWLCL, ZZLCL, ZTHVELCL ! PRVLCL, ....
INTEGER, DIMENSION(KLON) :: IDPL, IPBL, ILCL ! locals for KDPL, ...
REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
REAL, DIMENSION(KLON) :: ZZDPL ! height of DPL
REAL, DIMENSION(KLON) :: ZTHVLCL ! theta_v at LCL = mixed layer value
REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
REAL, DIMENSION(KLON) :: ZCAPE ! convective available energy (m^2/s^2/g)
REAL, DIMENSION(KLON) :: ZTHEUL ! updraft equiv. pot. temperature (K)
REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
REAL, DIMENSION(KLON) :: ZTOP ! estimated cloud top (m)
REAL, DIMENSION(KLON,KLEV):: ZCAP ! CAPE at every level for diagnostics
!INTEGER, DIMENSION(KLON) :: ITOP ! work array to store highest test layer
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
LOGICAL, DIMENSION(KLON) :: GTRIG, GTRIG2 ! local arrays for OTRIG
LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
!
!
!-------------------------------------------------------------------------------
!
!* 0.3 Compute array bounds
! --------------------
!
IIE = KLON
IKB = 1 + JCVEXB
IKE = KLEV - JCVEXT
!
!
!* 1. Initialize local variables
! --------------------------
!
ZEPS = XRD / XRV
ZEPSA = XRV / XRD
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
OTRIG(:) = .FALSE.
IDPL(:) = KDPL(:)
IPBL(:) = KPBL(:)
ILCL(:) = KLCL(:)
!ITOP(:) = IKB
PWLCL(:) = 0.
ZWLCL(:) = 0.
PTHLCL(:) = 1.
PTHVELCL(:)= 1.
PTLCL(:) = 1.
PRVLCL(:) = 0.
PWLCL(:) = 0.
PZLCL(:) = PZ(:,IKB)
ZZDPL(:) = PZ(:,IKB)
GTRIG2(:) = .TRUE.
ZCAP(:,:) = 0.
!
!
!
! 1. Determine highest necessary loop test layer
! -------------------------------------------
!
JT = IKE - 2
DO JK = IKB + 1, IKE - 2
! DO JI = 1, IIE
! IF ( PZ(JI,JK) - PZ(JI,IKB) <= XZLCL ) ITOP(JI) = JK
! END DO
IF ( PZ(1,JK) - PZ(1,IKB) < 12.E3 ) JT = JK
END DO
!
!
!* 2. Enter loop for convection test
! ------------------------------
!
JKP = MINVAL( IDPL(:) ) + 1
!JKT = MAXVAL( ITOP(:) )
JKT = JT
DO JKK = JKP, JKT
!
GWORK1(:) = ZZDPL(:) - PZ(:,IKB) < XZLCL
! we exit the trigger test when the center of the mixed layer is more
! than 3500 m above soil level.
WHERE ( GWORK1(:) )
ZDPTHMIX(:) = 0.
ZPRESMIX(:) = 0.
ZTHLCL(:) = 0.
ZRVLCL(:) = 0.
ZZDPL(:) = PZ(:,JKK)
IDPL(:) = JKK
END WHERE
!
!
!* 3. Construct a mixed layer of at least 60 hPa (XZPBL)
! ------------------------------------------
!
DO JK = JKK, IKE - 1
JKM = JK + 1
DO JI = 1, IIE
IF ( GWORK1(JI) .AND. ZDPTHMIX(JI) < XZPBL ) THEN
IPBL(JI) = JK
ZWORK1(JI) = PPRES(JI,JK) - PPRES(JI,JKM)
ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
ZTHLCL(JI) = ZTHLCL(JI) + PTH(JI,JK) * ZWORK1(JI)
ZRVLCL(JI) = ZRVLCL(JI) + PRV(JI,JK) * ZWORK1(JI)
END IF
END DO
IF ( MINVAL ( ZDPTHMIX(:) ) >= XZPBL ) EXIT
END DO
!
!
WHERE ( GWORK1(:) )
!
ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
! ZTHLCL(:) = ZTHLCL(:) / ZDPTHMIX(:)
! ZRVLCL(:) = ZRVLCL(:) / ZDPTHMIX(:)
ZTHLCL(:) = ZTHLCL(:) / ZDPTHMIX(:) +.3
ZRVLCL(:) = ZRVLCL(:) / ZDPTHMIX(:) +1.e-4
ZTHVLCL(:) = ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) ) &
/ ( 1. + ZRVLCL(:) )
!
!* 4.1 Use an empirical direct solution ( Bolton formula )
! to determine temperature and pressure at LCL.
! Nota: the adiabatic saturation temperature is not
! equal to the dewpoint temperature
! ----------------------------------------------------
!
!
ZTMIX(:) = ZTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP
ZEVMIX(:) = ZRVLCL(:) * ZPRESMIX(:) / ( ZRVLCL(:) + ZEPS )
ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
ZWORK1(:) = LOG( ZEVMIX(:) / 613.3 )
! dewpoint temperature
ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) )
! adiabatic saturation temperature
ZTLCL(:) = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT ) &
- 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
ZTLCL(:) = MIN( ZTLCL(:), ZTMIX(:) )
ZPLCL(:) = XP00 * ( ZTLCL(:) / ZTHLCL(:) ) ** ZCPORD
!
END WHERE
!
!
!* 4.2 Correct ZTLCL in order to be completely consistent
! with MNH saturation formula
! ---------------------------------------------
!
CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, ZTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
WHERE( GWORK1(:) )
ZWORK2(:) = ZWORK1(:) / ZTLCL(:) * ( XBETAW / ZTLCL(:) - XGAMW ) ! dr_sat/dT
ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) / &
( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
ZTLCL(:) = ZTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
!
END WHERE
!
!
!* 4.3 If ZRVLCL = PRVMIX is oversaturated set humidity
! and temperature to saturation values.
! ---------------------------------------------
!
CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
WHERE( GWORK1(:) .AND. ZRVLCL(:) > ZWORK1(:) )
ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) / &
( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
ZTLCL(:) = ZTMIX(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
ZRVLCL(:) = ZRVLCL(:) - ZWORK2(:)
ZPLCL(:) = ZPRESMIX(:)
ZTHLCL(:) = ZTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
ZTHVLCL(:)= ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) ) &
/ ( 1. + ZRVLCL(:) )
END WHERE
!
!
!* 5.1 Determine vertical loop index at the LCL and DPL
! --------------------------------------------------
!
DO JK = JKK, IKE - 1
DO JI = 1, IIE
IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. GWORK1(JI) ) ILCL(JI) = JK + 1
END DO
END DO
IF ( JKK.GT.MINVAL(ILCL(:)) ) EXIT
!
!
!* 5.2 Estimate height and environm. theta_v at LCL
! --------------------------------------------------
!
DO JI = 1, IIE
JK = ILCL(JI)
JKM = JK - 1
ZDP(JI) = LOG( ZPLCL(JI) / PPRES(JI,JKM) ) / &
LOG( PPRES(JI,JK) / PPRES(JI,JKM) )
ZWORK1(JI) = PTHV(JI,JKM) + ( PTHV(JI,JK) - PTHV(JI,JKM) ) * ZDP(JI)
! we compute the precise value of the LCL
! The precise height is between the levels ILCL and ILCL-1.
ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
END DO
WHERE( GWORK1(:) )
ZTHVELCL(:) = ZWORK1(:)
ZZLCL(:) = ZWORK2(:)
END WHERE
!
!
!* 6. Check to see if cloud is bouyant
! --------------------------------
!
!* 6.1 Compute grid scale vertical velocity perturbation term ZWORK1
! -------------------------------------------------------------
!
! normalize w grid scale to a 25 km refer. grid
DO JI = 1, IIE
JK = ILCL(JI)
JKM = JK - 1
!jiao xcrad beg---------------------------------------------
!Kain (2004), Journal fo applied meteorology, 43, 170-181. eq(2)
IF(ZZLCL(JI) .LE. 2000.) THEN
ZWORK1(JI)=0.02*ZZLCL(JI)/2000.
ELSE
ZWORK1(JI)=0.02
ENDIF
!calculate dlp using z instead of log(p)...
ZWORK2(JI) = (ZZLCL(JI)-PZ(JI,JKM))/(PZ(JI,JK)-PZ(JI,JKM))
ZWORK1(JI)=(PW(JI,JKM) + (PW(JI,JK) - PW(JI,JKM)) * ZWORK2(JI)) &
*SQRT( PDXDY(JI) / XA25 ) - ZWORK1(JI)
!Kain (2004), Journal fo applied meteorology, 43, 170-181. eq(6)
IF(ZWORK1(JI).LT.0.) THEN
PCRAD(JI) = 1000.
ELSEIF(ZWORK1(JI).GT.0.1) THEN
PCRAD(JI) = 2000.
ELSE
PCRAD(JI) = 1000. * (1.0 + ZWORK1(JI)/0.1 )
ENDIF
! PCRAD(JI) = 1500.0 !jiao bkf
!jiao xcrad end---------------------------------------------
ZWORK1(JI) = ( PW(JI,JKM) + ( PW(JI,JK) - PW(JI,JKM) ) * ZDP(JI) ) &
* SQRT( PDXDY(JI) / XA25 )
! - 0.02 * ZZLCL(JI) / XZLCL ! avoid spurious convection
END DO
! compute sign of normalized grid scale w
ZWORK2(:) = SIGN( 1., ZWORK1(:) )
ZWORK1(:) = XWTRIG * ZWORK2(:) * ABS( ZWORK1(:) ) ** 0.333 &
* ( XP00 / ZPLCL(:) ) ** ZRDOCP
!
!* 6.2 Compute parcel vertical velocity at LCL
! ---------------------------------------
!
DO JI = 1, IIE
JKDL = IDPL(JI)
ZWORK3(JI) = XG * ZWORK1(JI) * ( ZZLCL(JI) - PZ(JI,JKDL) ) &
/ ( PTHV(JI,JKDL) + ZTHVELCL(JI) )
END DO
WHERE( GWORK1(:) )
ZWLCL(:) = 1. + .5 * ZWORK2(:) * SQRT( ABS( ZWORK3(:) ) )
GTRIG(:) = ZTHVLCL(:) - ZTHVELCL(:) + ZWORK1(:) > 0. .AND. &
ZWLCL(:) > 0.
END WHERE
!
!
!* 6.3 Look for parcel that produces sufficient cloud depth.
! The cloud top is estimated as the level where the CAPE
! is smaller than a given value (based on vertical velocity eq.)
! --------------------------------------------------------------
!
ZTHEUL(:) = ZTLCL(:) * ( ZTHLCL(:) / ZTLCL(:) ) &
** ( 1. - 0.28 * ZRVLCL(:) ) &
* EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) * &
ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
!
ZCAPE(:) = 0.
ZTOP(:) = 0.
ZWORK3(:)= 0.
JKM = MINVAL( ILCL(:) )
DO JL = JKM, JT
JK = JL + 1
DO JI = 1, IIE
ZWORK1(JI) = ( 2. * ZTHEUL(JI) / &
( PTHES(JI,JK) + PTHES(JI,JL) ) - 1. ) * ( PZ(JI,JK) - PZ(JI,JL) )
IF ( JL < ILCL(JI) ) ZWORK1(JI) = 0.
ZCAPE(JI) = ZCAPE(JI) + ZWORK1(JI)
ZCAP(JI,JKK) = ZCAP(JI,JKK) + XG * MAX( 0., ZWORK1(JI) ) ! actual CAPE
ZWORK2(JI) = XNHGAM * XG * ZCAPE(JI) + 1.05 * ZWLCL(JI) * ZWLCL(JI)
! the factor 1.05 takes entrainment into account
ZWORK2(JI) = SIGN( 1., ZWORK2(JI) )
ZWORK3(JI) = ZWORK3(JI) + MIN(0., ZWORK2(JI) )
ZWORK3(JI) = MAX( -1., ZWORK3(JI) )
! Nota, the factors ZWORK2 and ZWORK3 are only used to avoid
! if and goto statements, the difficulty is to extract only
! the level where the criterium is first fullfilled
ZTOP(JI) = PZ(JI,JL) * .5 * ( 1. + ZWORK2(JI) ) * ( 1. + ZWORK3(JI) ) + &
ZTOP(JI) * .5 * ( 1. - ZWORK2(JI) )
END DO
END DO
!jiao xcdepth beg---------------------
! specifying minimum cloud depth as a function of tlcl
! Kain, 2004, Journal fo applied meteorology, 43, 170-181. eq(7)
DO JI = 1, IIE
IF (ZTLCL(JI).GT.293.0) THEN
PCDEP(JI) = 4000.0
ELSE IF( ZTLCL(JI) .LE. 293.0 .AND. ZTLCL(JI) .GE. 273.0) THEN
PCDEP(JI) = 2000.0 + 100.*(ZTLCL(JI)-273.0)
ELSE IF( ZTLCL(JI) .LT. 273.0) THEN
PCDEP(JI) = 2000.0
END IF
END DO
! PCDEP(JI) = 4000.0 !jiao bkf
!jiao xcdepth end----------------------
!
!
WHERE( ZTOP(:) - ZZLCL(:) .GE. PCDEP(:) .AND. GTRIG(:) .AND. GTRIG2(:) )
GTRIG2(:) = .FALSE.
OTRIG(:) = GTRIG(:) ! we select the first departure level
PTHLCL(:) = ZTHLCL(:) ! that gives sufficient cloud depth
PRVLCL(:) = ZRVLCL(:)
PTLCL(:) = ZTLCL(:)
PWLCL(:) = ZWLCL(:)
PZLCL(:) = ZZLCL(:)
PTHVELCL(:) = ZTHVELCL(:)
KDPL(:) = IDPL(:)
KPBL(:) = IPBL(:)
KLCL(:) = ILCL(:)
END WHERE
!
IF ( COUNT(.NOT.OTRIG(:) ) == 0 ) EXIT
END DO
!
!jiao>>> -------------------
! DO JI = 1, IIE
! PCAPE(JI) = MAXVAL( ZCAP(JI,:) ) ! maximum CAPE for diagnostics
! END DO
!jiao<<< -------------------
!
!
END SUBROUTINE CONVECT_TRIGGER_FUNCT
!
!-------------------------------------------------------------------------------
!
! ###########################################################################
SUBROUTINE CONVECT_UPDRAFT( KLON, KLEV, & 1,6
KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW, &
PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL, &
PMFLCL, OTRIG, KLCL, KDPL, KPBL, &
PUMF, PUER, PUDR, PUTHL, PUTHV, PURW, &
PURC, PURI, PURR, PURS, PUPR, &
PUTPR, PCAPE, KCTL, KETL, PCRAD, PCDEP, PUWW )
!jiao xcrad and xcdepth
! #############################################################################
!
!!**** Compute updraft properties from DPL to CTL.
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine updraft properties
!! ( mass flux, thermodynamics, precipitation )
!!
!!
!!** METHOD
!! ------
!! Computations are done at every model level starting from bottom.
!! The use of masks allows to optimise the inner loops (horizontal loops).
!!
!!
!!
!! EXTERNAL
!! --------
!! Routine CONVECT_MIXING_FUNCT
!! Routine CONVECT_CONDENS
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XG ! gravity constant
!! XP00 ! reference pressure
!! XRD, XRV ! gaz constants for dry air and water vapor
!! XCPD, XCPV, XCL ! Cp of dry air, water vapor and liquid water
!! XTT ! triple point temperature
!! XLVTT ! vaporisation heat at XTT
!!
!!
!! Module MODD_CONVPAR
!! XA25 ! reference grid area
!! XCRAD ! cloud radius
!! XCDEPTH ! minimum necessary cloud depth
!! XENTR ! entrainment constant
!! XRCONV ! constant in precipitation conversion
!! XNHGAM ! coefficient for buoyancy term in w eq.
!! ! accounting for nh-pressure
!! XTFRZ1 ! begin of freezing interval
!! XTFRZ2 ! begin of freezing interval
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation ( routine CONVECT_UPDRAFT)
!! Kain and Fritsch, 1990, J. Atmos. Sci., Vol.
!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 10/12/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
! 0 = no ice )
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV ! grid scale theta_v
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
! mixing ratio
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
! bottom and top of layer (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
REAL, DIMENSION(KLON), INTENT(IN) :: PTHLCL ! theta at LCL
REAL, DIMENSION(KLON), INTENT(IN) :: PTLCL ! temp. at LCL
REAL, DIMENSION(KLON), INTENT(IN) :: PRVLCL ! vapor mixing ratio at LCL
REAL, DIMENSION(KLON), INTENT(IN) :: PWLCL ! parcel velocity at LCL (m/s)
REAL, DIMENSION(KLON), INTENT(IN) :: PMFLCL ! cloud base unit mass flux
! (kg/s)
REAL, DIMENSION(KLON), INTENT(IN) :: PCRAD ! cloud radius !jiao xcrad
REAL, DIMENSION(KLON), INTENT(IN) :: PCDEP ! cloud depth !jiao xcdepth
REAL, DIMENSION(KLON), INTENT(IN) :: PZLCL ! height at LCL (m)
REAL, DIMENSION(KLON), INTENT(IN) :: PTHVELCL! environm. theta_v at LCL (K)
LOGICAL, DIMENSION(KLON), INTENT(INOUT):: OTRIG ! logical mask for convection
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layertop
!
!
INTEGER, DIMENSION(KLON), INTENT(OUT):: KCTL ! contains vert. index of CTL
INTEGER, DIMENSION(KLON), INTENT(OUT):: KETL ! contains vert. index of &
! equilibrium (zero buoyancy) level
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC ! updraft cloud water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI ! updraft cloud ice (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURR ! liquid precipit. (kg/kg)
! produced in model layer
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURS ! solid precipit. (kg/kg)
! produced in model layer
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUWW ! vertical velocity in updraft . (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUPR ! updraft precipitation in
! flux units (kg water / s)
REAL, DIMENSION(KLON), INTENT(OUT):: PUTPR ! total updraft precipitation
! in flux units (kg water / s)
REAL, DIMENSION(KLON), INTENT(OUT):: PCAPE ! available potent. energy
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE ! horizontal and vertical loop bounds
INTEGER :: JI ! horizontal loop index
INTEGER :: JK, JKP, JKM, JK1, JK2, JKMIN ! vertical loop index
REAL :: ZEPSA, ZCVOCD ! R_v / R_d, C_pv / C_pd
REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON) :: ZUT ! updraft temperature (K)
REAL, DIMENSION(KLON) :: ZUW1, ZUW2 ! square of updraft vert.
! velocity at levels k and k+1
REAL, DIMENSION(KLON) :: ZE1,ZE2,ZD1,ZD2 ! fractional entrainm./detrain
! rates at levels k and k+1
REAL, DIMENSION(KLON) :: ZMIXF ! critical mixed fraction
REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
REAL, DIMENSION(KLON) :: ZURV ! updraft water vapor at level k+1
REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5, &
ZWORK6 ! work arrays
INTEGER, DIMENSION(KLON) :: IWORK ! wok array
LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK2, GWORK4, GWORK5
! work arrays
LOGICAL, DIMENSION(KLON,KLEV) :: GWORK6 ! work array
!
!
!-------------------------------------------------------------------------------
!
! 0.3 Set loop bounds
! ---------------
!
IKB = 1 + JCVEXB
IKE = KLEV - JCVEXT
IIE = KLON
!
!
!* 1. Initialize updraft properties and local variables
! -------------------------------------------------
!
ZEPSA = XRV / XRD
ZCVOCD = XCPV / XCPD
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
!
PUMF (:,:) = 0.
PUER (:,:) = 0.
PUDR (:,:) = 0.
PUTHL (:,:) = 0.
PUTHV (:,:) = 0.
PURW (:,:) = 0.
PURC (:,:) = 0.
PURI (:,:) = 0.
PUPR (:,:) = 0.
PURR (:,:) = 0.
PURS (:,:) = 0.
PUWW (:,:) = 0.
PUTPR (:) = 0.
ZUW1 (:) = PWLCL(:) * PWLCL(:)
ZUW2 (:) = 0.
ZE1 (:) = 1.
ZD1 (:) = 0.
PCAPE (:) = 0.
KCTL (:) = IKB
KETL (:) = KLCL(:)
GWORK2(:) = .TRUE.
GWORK5(:) = .TRUE.
ZPI (:) = 1.
ZWORK3(:) = 0.
ZWORK4(:) = 0.
ZWORK5(:) = 0.
ZWORK6(:) = 0.
GWORK1(:) = .FALSE.
GWORK4(:) = .FALSE.
!
!
!* 1.1 Compute undilute updraft theta_e for CAPE computations
! Bolton (1980) formula.
! Define accurate enthalpy for updraft
! -----------------------------------------------------
!
ZTHEUL(:) = PTLCL(:) * ( PTHLCL(:) / PTLCL(:) ) ** ( 1. - 0.28 * PRVLCL(:) ) &
* EXP( ( 3374.6525 / PTLCL(:) - 2.5403 ) * &
PRVLCL(:) * ( 1. + 0.81 * PRVLCL(:) ) )
!
!
ZWORK1(:) = ( XCPD + PRVLCL(:) * XCPV ) * PTLCL(:) &
+ ( 1. + PRVLCL(:) ) * XG * PZLCL(:)
!
!
!* 2. Set updraft properties between DPL and LCL
! ------------------------------------------
!
JKP = MAXVAL( KLCL(:) )
JKM = MINVAL( KDPL(:) )
DO JK = JKM, JKP
DO JI = 1, IIE
IF ( JK >= KDPL(JI) .AND. JK < KLCL(JI) ) THEN
PUMF(JI,JK) = PMFLCL(JI)
PUTHL(JI,JK) = ZWORK1(JI)
PUTHV(JI,JK) = PTHLCL(JI) * ( 1. + ZEPSA * PRVLCL(JI) ) / &
( 1. + PRVLCL(JI) )
PURW(JI,JK) = PRVLCL(JI)
END IF
END DO
END DO
!
!
!* 3. Enter loop for updraft computations
! ------------------------------------
!
JKMIN = MINVAL( KLCL(:) - 1 )
DO JK = MAX( IKB + 1, JKMIN ), IKE - 1
ZWORK6(:) = 1.
JKP = JK + 1
!
GWORK4(:) = JK >= KLCL(:) - 1
GWORK1(:) = GWORK4(:) .AND. GWORK2(:) ! this mask is used to confine
! updraft computations between the LCL and the CTL
!
WHERE( JK == KLCL(:) - 1 ) ZWORK6(:) = 0. ! factor that is used in buoyancy
! computation at first level above LCL
!
!
!* 4. Estimate condensate, L_v L_i, Cph and theta_v at level k+1
! ----------------------------------------------------------
!
ZWORK1(:) = PURC(:,JK) + PURR(:,JK)
ZWORK2(:) = PURI(:,JK) + PURS(:,JK)
CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), PUTHL(:,JK), PURW(:,JK),&
ZWORK1, ZWORK2, PZ(:,JKP), GWORK1, ZUT, ZURV, &
PURC(:,JKP), PURI(:,JKP), ZLV, ZLS, ZCPH )
!
!
ZPI(:) = ( XP00 / PPRES(:,JKP) ) ** ZRDOCP
WHERE ( GWORK1(:) )
!
PUTHV(:,JKP) = ZPI(:) * ZUT(:) * ( 1. + ZEPSA * ZURV(:) ) &
/ ( 1. + PURW(:,JK) )
!
!
!* 5. Compute square of vertical velocity using entrainment
! at level k
! -----------------------------------------------------
!
ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) - &
( 1. - ZWORK6(:) ) * PZLCL(:) ! level thickness
ZWORK4(:) = PTHV(:,JK) * ZWORK6(:) + &
( 1. - ZWORK6(:) ) * PTHVELCL(:)
ZWORK5(:) = 2. * ZUW1(:) * PUER(:,JK) / MAX( .1, PUMF(:,JK) )
ZUW2 (:) = ZUW1(:) + ZWORK3(:) * XNHGAM * XG * &
( ( PUTHV(:,JK) + PUTHV(:,JKP) ) / &
( ZWORK4(:) + PTHV(:,JKP) ) - 1. ) & ! buoyancy term
- ZWORK5(:) ! entrainment term
! save vertical velocity into puww for output
PUWW(:,JKP) = SQRT( MAX( 1.E-2, ZUW2(:) ) )
!
!
!* 6. Update total precipitation: dr_r=(r_c+r_i)*exp(-rate*dz)
! --------------------------------------------------------
!
! compute level mean vertical velocity
ZWORK2(: ) = 0.5 * &
( SQRT( MAX( 1.E-2, ZUW2(:) ) ) + &
SQRT( MAX( 1.E-2, ZUW1(:) ) ) )
PURR (:,JKP) = 0.5 * ( PURC(:,JK) + PURC(:,JKP) + PURI(:,JK) + PURI(:,JKP) )&
* ( 1. - EXP( - XRCONV * ZWORK3(:) / ZWORK2(:) ) )
PUPR (:,JKP) = PURR(:,JKP) * PUMF(:,JK) ! precipitation rate ( kg water / s)
PUTPR (: ) = PUTPR(:) + PUPR(:,JKP) ! total precipitation rate
ZWORK2(: ) = PURR(:,JKP) / MAX( 1.E-8, PURC(:,JKP) + PURI(:,JKP) )
PURR (:,JKP) = ZWORK2(:) * PURC(:,JKP) ! liquid precipitation
PURS (:,JKP) = ZWORK2(:) * PURI(:,JKP) ! solid precipitation
!
!
!* 7. Update r_c, r_i, enthalpy, r_w for precipitation
! -------------------------------------------------------
!
PURW (:,JKP) = PURW(:,JK ) - PURR(:,JKP) - PURS(:,JKP)
PURC (:,JKP) = PURC(:,JKP) - PURR(:,JKP)
PURI (:,JKP) = PURI(:,JKP) - PURS(:,JKP)
PUTHL(:,JKP) = ( XCPD + PURW(:,JKP) * XCPV ) * ZUT(:) &
+ ( 1. + PURW(:,JKP) ) * XG * PZ(:,JKP) &
- ZLV(:) * PURC(:,JKP) - ZLS(:) * PURI(:,JKP)
!
ZUW1(: ) = ZUW2(:)
!
END WHERE
!
!
!* 8. Compute entrainment and detrainment using conservative
! variables adjusted for precipitation ( not for entrainment)
! -----------------------------------------------------------
!
!* 8.1 Compute critical mixed fraction by estimating unknown
! T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
! We determine the zero crossing of the linear curve
! evaluating the derivative using ZMIXF=0.1.
! -----------------------------------------------------
!
ZMIXF(:) = 0.1 ! starting value for critical mixed fraction
ZWORK1(:) = ZMIXF(:) * PTHL(:,JKP) &
+ ( 1. - ZMIXF(:) ) * PUTHL(:,JKP) ! mixed enthalpy
ZWORK2(:) = ZMIXF(:) * PRW(:,JKP) &
+ ( 1. - ZMIXF(:) ) * PURW(:,JKP) ! mixed r_w
!
CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), ZWORK1, ZWORK2, &
PURC(:,JKP), PURI(:,JKP), PZ(:,JKP), GWORK1, ZUT,&
ZWORK3, ZWORK4, ZWORK5, ZLV, ZLS, ZCPH )
! put in enthalpy and r_w and get T r_c, r_i (ZUT, ZWORK4-5)
!
! compute theta_v of mixture
ZWORK3(:) = ZUT(:) * ZPI(:) * ( 1. + ZEPSA * ( &
ZWORK2(:) - ZWORK4(:) - ZWORK5(:) ) ) / ( 1. + ZWORK2(:) )
! compute final value of critical mixed fraction using theta_v
! of mixture, grid-scale and updraft
ZMIXF(:) = MAX( 0., PUTHV(:,JKP) - PTHV(:,JKP) ) * ZMIXF(:) / &
( PUTHV(:,JKP) - ZWORK3(:) + 1.E-10 )
ZMIXF(:) = MAX( 0., MIN( 1., ZMIXF(:) ) )
!
!
!* 8.2 Compute final midlevel values for entr. and detrainment
! after call of distribution function
! -------------------------------------------------------
!
!
CALL CONVECT_MIXING_FUNCT ( KLON, ZMIXF, 1, ZE2, ZD2 )
! Note: routine MIXING_FUNCT returns fractional entrainm/detrainm. rates
!
! ZWORK1(:) = XENTR * PMFLCL(:) * PDPRES(:,JKP) / pcrad(:) ! rate of env. inflow !jiao xcrad
!*MOD
ZWORK1(:) = XENTR * XG / pcrad(:) * PUMF(:,JK) * ( PZ(:,JKP) - PZ(:,JK) ) !jiao xcrad
! ZWORK1(:) = XENTR * pumf(:,jk) * PDPRES(:,JKP) / pcrad(:) ! rate of env. inflow !jiao xcrad
!*MOD
ZWORK2(:) = 0.
WHERE ( GWORK1(:) ) ZWORK2(:) = 1.
WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) )
ze2=.5; zd2=.5 ! modif entrainment=detrainment, this avoids
! too large mass flux values at upper levels
! ze2(:)=max(ze2(:),0.5) !jiao need more test Kain2004,eq(4)
! ze2(:)=max(ze2(:),0.5);zd2(:)=max(zd2(:),0.5) !jiao need more test Kain2004,eq(4)
PUER(:,JKP) = 0.5 * ZWORK1(:) * ( ZE1(:) + ZE2(:) ) * ZWORK2(:)
PUDR(:,JKP) = 0.5 * ZWORK1(:) * ( ZD1(:) + ZD2(:) ) * ZWORK2(:)
ELSEWHERE
PUER(:,JKP) = 0.
PUDR(:,JKP) = ZWORK1(:) * ZWORK2(:)
END WHERE
!
!* 8.3 Determine equilibrium temperature level
! --------------------------------------
!
WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) .AND. JK > KLCL(:) + 1 &
.AND. GWORK1(:) )
KETL(:) = JKP ! equilibrium temperature level
END WHERE
!
!* 8.4 If the calculated detrained mass flux is greater than
! the total updraft mass flux, or vertical velocity is
! negative, all cloud mass detrains at previous model level,
! exit updraft calculations - CTL is attained
! -------------------------------------------------------
!
WHERE( GWORK1(:) ) &
GWORK2(:) = PUMF(:,JK) - PUDR(:,JKP) > 10. .AND. ZUW2(:) > 0.
WHERE ( GWORK2(:) ) KCTL(:) = JKP ! cloud top level
GWORK1(:) = GWORK2(:) .AND. GWORK4(:)
!
IF ( COUNT( GWORK2(:) ) == 0 ) EXIT
!
!
!* 9. Compute CAPE for undilute ascent using theta_e and
! theta_es instead of theta_v. This estimation produces
! a significantly larger value for CAPE than the actual one.
! ----------------------------------------------------------
!
WHERE ( GWORK1(:) )
!
ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) - &
( 1. - ZWORK6(:) ) * PZLCL(:) ! level thickness
ZWORK2(:) = PTHES(:,JK) + ( 1. - ZWORK6(:) ) * &
( PTHES(:,JKP) - PTHES(:,JK) ) / ( PZ(:,JKP) - PZ(:,JK) ) * &
( PZLCL(:) - PZ(:,JK) ) ! linear interpolation for theta_es at LCL
! ( this is only done for model level just above LCL
!
ZWORK1(:) = ( 2. * ZTHEUL(:) ) / ( ZWORK2(:) + PTHES(:,JKP) ) - 1.
!
!jiao dilute beg----------------------------------------------------------
! cape now calculated by an entrainment influenced dilute ascent
! profile rather than the original undilute ascent
!jiao bkf
ZWORK2(:) = PTHVELCL(:)* (1. - ZWORK6(:)) + PUTHV(:,JK) * ZWORK6(:)
ZWORK1(:) = (ZWORK2(:)+PUTHV(:,JKP)) / (PTHV(:,JK) + PTHV(:,JKP)) - 1.
!jiao bkf
!jiao dilute end----------------------------------------------------------
PCAPE(:) = PCAPE(:) + XG * ZWORK3(:) * MAX( 0., ZWORK1(:) )
!
!
!* 10. Compute final values of updraft mass flux, enthalpy, r_w
! at level k+1
! --------------------------------------------------------
!
PUMF(:,JKP) = PUMF(:,JK) - PUDR(:,JKP) + PUER(:,JKP)
PUMF(:,JKP) = MAX( PUMF(:,JKP), 0.1 )
PUTHL(:,JKP) = ( PUMF(:,JK) * PUTHL(:,JK) + &
PUER(:,JKP) * PTHL(:,JK) - PUDR(:,JKP) * PUTHL(:,JK) ) &
/ PUMF(:,JKP) + PUTHL(:,JKP) - PUTHL(:,JK)
PURW(:,JKP) = ( PUMF(:,JK) * PURW(:,JK) + &
PUER(:,JKP) * PRW(:,JK) - PUDR(:,JKP) * PURW(:,JK) ) &
/ PUMF(:,JKP) - PURR(:,JKP) - PURS(:,JKP)
!
ZE1(:) = ZE2(:) ! update fractional entrainment/detrainment
ZD1(:) = ZD2(:)
!
END WHERE
!
END DO
!
!* 12.1 Set OTRIG to False if cloud thickness < XCDEPTH
! or CAPE < 1
! ------------------------------------------------
!
DO JI = 1, IIE
JK = KCTL(JI)
OTRIG(JI) = PZ(JI,JK) - PZLCL(JI) >= PCDEP(JI) &
.AND. PCAPE(JI) > 1.
END DO
WHERE( .NOT. OTRIG(:) )
KCTL(:) = IKB
END WHERE
KETL(:) = MAX( KETL(:), KLCL(:) + 2 )
KETL(:) = MIN( KETL(:), KCTL(:) )
!
!
!* 12.2 If the ETL and CTL are the same detrain updraft mass
! flux at this level
! -------------------------------------------------------
!
ZWORK1(:) = 0.
WHERE ( KETL(:) == KCTL(:) ) ZWORK1(:) = 1.
!
DO JI = 1, IIE
JK = KETL(JI)
PUDR(JI,JK) = PUDR(JI,JK) + &
( PUMF(JI,JK) - PUER(JI,JK) ) * ZWORK1(JI)
PUER(JI,JK) = PUER(JI,JK) * ( 1. - ZWORK1(JI) )
PUMF(JI,JK) = PUMF(JI,JK) * ( 1. - ZWORK1(JI) )
JKP = KCTL(JI) + 1
PUER(JI,JKP) = 0. ! entrainm/detr rates have been already computed
PUDR(JI,JKP) = 0. ! at level KCTL+1, set them to zero
END DO
!
!* 12.3 Adjust mass flux profiles, detrainment rates, and
! precipitation fallout rates to reflect linear decrease
! in mass flux between the ETL and CTL
! -------------------------------------------------------
!
ZWORK1(:) = 0.
JK1 = MINVAL( KETL(:) )
JK2 = MAXVAL( KCTL(:) )
DO JK = JK1, JK2
DO JI = 1, IIE
IF( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
ZWORK1(JI) = ZWORK1(JI) + PDPRES(JI,JK)
END IF
END DO
END DO
!
DO JI = 1, IIE
JK = KETL(JI)
ZWORK1(JI) = PUMF(JI,JK) / MAX( 1., ZWORK1(JI) )
END DO
!
DO JK = JK1 + 1, JK2
JKP = JK - 1
DO JI = 1, IIE
IF ( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
! PUTPR(JI) = PUTPR(JI) - ( PURR(JI,JK) + PURS(JI,JK) ) * PUMF(JI,JKP)
PUTPR(JI) = PUTPR(JI) - PUPR(JI,JK)
PUDR(JI,JK) = PDPRES(JI,JK) * ZWORK1(JI)
PUMF(JI,JK) = PUMF(JI,JKP) - PUDR(JI,JK)
PUPR(JI,JK) = PUMF(JI,JKP) * ( PURR(JI,JK) + PURS(JI,JK) )
PUTPR(JI) = PUTPR(JI) + PUPR(JI,JK)
END IF
END DO
END DO
!
! 12.4 Set mass flux and entrainment in the source layer.
! Linear increase throughout the source layer.
! -------------------------------------------------------
!
!IWORK(:) = MIN( KPBL(:), KLCL(:) - 1 )
IWORK(:) = KPBL(:)
DO JI = 1, IIE
JK = KDPL(JI)
JKP = IWORK(JI)
! mixed layer depth
ZWORK2(JI) = PPRES(JI,JK) - PPRES(JI,JKP) + PDPRES(JI,JK)
END DO
!
JKP = MAXVAL( IWORK(:) )
DO JK = JKM, JKP
DO JI = 1, IIE
IF ( JK >= KDPL(JI) .AND. JK <= IWORK(JI) ) THEN
PUER(JI,JK) = PUER(JI,JK) + PMFLCL(JI) * PDPRES(JI,JK) / ( ZWORK2(JI) + 0.1 )
PUMF(JI,JK) = PUMF(JI,JK-1) + PUER(JI,JK)
END IF
END DO
END DO
!
!
!* 13. If cloud thickness is smaller than 3 km, no
! convection is allowed
! Nota: For technical reasons, we stop the convection
! computations in this case and do not go back to
! TRIGGER_FUNCT to look for the next unstable LCL
! which could produce a thicker cloud.
! ---------------------------------------------------
!
GWORK6(:,:) = SPREAD( OTRIG(:), DIM=2, NCOPIES=KLEV )
WHERE ( .NOT. OTRIG(:) ) PUTPR(:) = 0.
WHERE ( .NOT. GWORK6(:,:) )
PUMF(:,:) = 0.
PUDR(:,:) = 0.
PUER(:,:) = 0.
PUTHL(:,:) = PTHL(:,:)
PURW(:,:) = PRW(:,:)
PUPR(:,:) = 0.
PURC(:,:) = 0.
PURI(:,:) = 0.
PURR(:,:) = 0.
PURS(:,:) = 0.
PUWW(:,:) = 0.
END WHERE
!
END SUBROUTINE CONVECT_UPDRAFT
!
!
!-------------------------------------------------------------------------------
!
! ##########################################################################
SUBROUTINE CONVECT_CONDENS( KLON, & 4,2
KICE, PPRES, PTHL, PRW, PRCO, PRIO, PZ, OWORK1, &
PT, PEW, PRC, PRI, PLV, PLS, PCPH )
! ###########################################################################
!
!!**** Compute temperature cloud and ice water content from enthalpy and r_w
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine cloud condensate
!! and to return values for L_v, L_s and C_ph
!!
!!
!!** METHOD
!! ------
!! Condensate is extracted iteratively
!!
!!
!! EXTERNAL
!! --------
!! None
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! Module MODD_CSTS
!! XG ! gravity constant
!! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
!! XALPI, XBETAI, XGAMI ! constants for ice saturation pressure
!! XP00 ! reference pressure
!! XRD, XRV ! gaz constants for dry air and water vapor
!! XCPD, XCPV ! specific heat for dry air and water vapor
!! XCL, XCI ! specific heat for liquid water and ice
!! XTT ! triple point temperature
!! XLVTT, XLSTT ! vaporization, sublimation heat constant
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CONVPAR
!! XTFRZ1 ! begin of freezing interval
!! XTFRZ2 ! end of freezing interval
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation ( routine CONVECT_CONDENS)
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 04/10/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAR
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal loop index
INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
! 0 = no ice )
REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
REAL, DIMENSION(KLON), INTENT(IN) :: PTHL ! enthalpy (J/kg)
REAL, DIMENSION(KLON), INTENT(IN) :: PRW ! total water mixing ratio
REAL, DIMENSION(KLON), INTENT(IN) :: PRCO ! cloud water estimate (kg/kg)
REAL, DIMENSION(KLON), INTENT(IN) :: PRIO ! cloud ice estimate (kg/kg)
REAL, DIMENSION(KLON), INTENT(IN) :: PZ ! level height (m)
LOGICAL, DIMENSION(KLON),INTENT(IN) :: OWORK1 ! logical mask
!
!
REAL, DIMENSION(KLON), INTENT(OUT):: PT ! temperature
REAL, DIMENSION(KLON), INTENT(OUT):: PRC ! cloud water mixing ratio(kg/kg)
REAL, DIMENSION(KLON), INTENT(OUT):: PRI ! cloud ice mixing ratio (kg/kg)
REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! water saturation mixing ratio
!
!* 0.2 Declarations of local variables KLON
!
INTEGER :: JITER ! iteration index
REAL :: ZEPS, ZEPSA ! R_d / R_v, 1 / ZEPS
REAL :: ZCVOCD ! XCPV / XCPD
REAL :: ZRDOCP ! R_d / C_pd
!
REAL, DIMENSION(KLON) :: ZEI ! ice saturation mixing ratio
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZT ! work arrays
!
!
!-------------------------------------------------------------------------------
!
!* 1. Initialize temperature and Exner function
! -----------------------------------------
!
ZRDOCP = XRD / XCPD
ZEPS = XRD / XRV
ZEPSA = 1. / ZEPS
ZCVOCD = XCPV / XCPD
!
!
! Make a first temperature estimate, based e.g. on values of
! r_c and r_i at lower level
!
!! Note that the definition of ZCPH is not the same as used in
!! routine CONVECT_SATMIXRATIO
PCPH(:) = XCPD + XCPV * PRW(:)
ZWORK1(:) = ( 1. + PRW(:) ) * XG * PZ(:)
PT(:) = ( PTHL(:) + PRCO(:) * XLVTT + PRIO(:) * XLSTT - ZWORK1(:) ) &
/ PCPH(:)
PT(:) = MAX(180., MIN( 330., PT(:) ) ) ! set overflow bounds in
! case that PTHL=0
!
!
!* 2. Enter the iteration loop
! ------------------------
!
DO JITER = 1,6
PEW(:) = EXP( XALPW - XBETAW / PT(:) - XGAMW * LOG( PT(:) ) )
ZEI(:) = EXP( XALPI - XBETAI / PT(:) - XGAMI * LOG( PT(:) ) )
PEW(:) = ZEPS * PEW(:) / ( PPRES(:) - PEW(:) )
ZEI(:) = ZEPS * ZEI(:) / ( PPRES(:) - ZEI(:) )
!
PLV(:) = XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT ) ! compute L_v
PLS(:) = XLSTT + ( XCPV - XCI ) * ( PT(:) - XTT ) ! compute L_i
!
ZWORK2(:) = ( XTFRZ1 - PT(:) ) / ( XTFRZ1 - XTFRZ2 ) ! freezing interval
ZWORK2(:) = MAX( 0., MIN(1., ZWORK2(:) ) ) * REAL( KICE )
ZWORK3(:) = ( 1. - ZWORK2(:) ) * PEW(:) + ZWORK2(:) * ZEI(:)
PRC(:) = MAX( 0., ( 1. - ZWORK2(:) ) * ( PRW(:) - ZWORK3(:) ) )
PRI(:) = MAX( 0., ZWORK2(:) * ( PRW(:) - ZWORK3(:) ) )
ZT(:) = ( PTHL(:) + PRC(:) * PLV(:) + PRI(:) * PLS(:) - ZWORK1(:) ) &
/ PCPH(:)
PT(:) = PT(:) + ( ZT(:) - PT(:) ) * 0.4 ! force convergence
PT(:) = MAX( 175., MIN( 330., PT(:) ) )
END DO
!
!
END SUBROUTINE CONVECT_CONDENS
!
!---------------------------------------------------------------------------
!
! ################################################################
SUBROUTINE CONVECT_SATMIXRATIO( KLON, & 12,1
PPRES, PT, PEW, PLV, PLS, PCPH )
! ################################################################
!
!!**** Compute vapor saturation mixing ratio over liquid water
!!
!!
!! PDRPOSE
!! -------
!! The purpose of this routine is to determine saturation mixing ratio
!! and to return values for L_v L_s and C_ph
!!
!!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!! None
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XALPW, XBETAW, XGAMW ! constants for water saturation pressure
!! XRD, XRV ! gaz constants for dry air and water vapor
!! XCPD, XCPV ! specific heat for dry air and water vapor
!! XCL, XCI ! specific heat for liquid water and ice
!! XTT ! triple point temperature
!! XLVTT, XLSTT ! vaporization, sublimation heat constant
!!
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation ( routine CONVECT_SATMIXRATIO)
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 04/10/97
!------------------------- ------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
INTEGER, INTENT(IN) :: KLON ! horizontal loop index
REAL, DIMENSION(KLON), INTENT(IN) :: PPRES ! pressure
REAL, DIMENSION(KLON), INTENT(IN) :: PT ! temperature
!
REAL, DIMENSION(KLON), INTENT(OUT):: PEW ! vapor saturation mixing ratio
REAL, DIMENSION(KLON), INTENT(OUT):: PLV ! latent heat L_v
REAL, DIMENSION(KLON), INTENT(OUT):: PLS ! latent heat L_s
REAL, DIMENSION(KLON), INTENT(OUT):: PCPH ! specific heat C_ph
!
!* 0.2 Declarations of local variables :
!
REAL, DIMENSION(KLON) :: ZT ! temperature
REAL :: ZEPS ! R_d / R_v
!
!
!-------------------------------------------------------------------------------
!
ZEPS = XRD / XRV
!
ZT(:) = MIN( 400., MAX( PT(:), 10. ) ) ! overflow bound
PEW(:) = EXP( XALPW - XBETAW / ZT(:) - XGAMW * LOG( ZT(:) ) )
PEW(:) = ZEPS * PEW(:) / ( PPRES(:) - PEW(:) )
!
PLV(:) = XLVTT + ( XCPV - XCL ) * ( ZT(:) - XTT ) ! compute L_v
PLS(:) = XLSTT + ( XCPV - XCI ) * ( ZT(:) - XTT ) ! compute L_i
!
PCPH(:) = XCPD + XCPV * PEW(:) ! compute C_ph
!
END SUBROUTINE CONVECT_SATMIXRATIO
!
!--------------------------------------------------------------------------
!
! #######################################################
SUBROUTINE CONVECT_MIXING_FUNCT( KLON, & 2
PMIXC, KMF, PER, PDR )
! #######################################################
!
!!**** Determine the area under the distribution function
!! KMF = 1 : gaussian KMF = 2 : triangular distribution function
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine the entrainment and
!! detrainment rate by evaluating the are under the distribution
!! function. The integration interval is limited by the critical
!! mixed fraction PMIXC
!!
!!
!!
!!** METHOD
!! ------
!! Use handbook of mathemat. functions by Abramowitz and Stegun, 1968
!!
!!
!!
!! EXTERNAL
!! --------
!! None
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! None
!!
!!
!! REFERENCE
!! ---------
!!
!! Book2 of documentation ( routine MIXING_FUNCT)
!! Abramovitz and Stegun (1968), handbook of math. functions
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 04/10/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KMF ! switch for dist. function
REAL, DIMENSION(KLON), INTENT(IN) :: PMIXC ! critical mixed fraction
!
REAL, DIMENSION(KLON), INTENT(OUT):: PER ! normalized entrainment rate
REAL, DIMENSION(KLON), INTENT(OUT):: PDR ! normalized detrainment rate
!
!* 0.2 Declarations of local variables :
!
REAL :: ZSIGMA = 0.166666667 ! standard deviation
REAL :: ZFE = 4.931813949 ! integral normalization
REAL :: ZSQRTP = 2.506628, ZP = 0.33267 ! constants
REAL :: ZA1 = 0.4361836, ZA2 =-0.1201676 ! constants
REAL :: ZA3 = 0.9372980, ZT1 = 0.500498 ! constants
REAL :: ZE45 = 0.01111 ! constant
!
REAL, DIMENSION(KLON) :: ZX, ZY, ZW1, ZW2 ! work variables
REAL :: ZW11
!
!
!-------------------------------------------------------------------------------
!
! 1. Use gaussian function for KMF=1
! -------------------------------
!
IF( KMF == 1 ) THEN
! ZX(:) = ( PMIXC(:) - 0.5 ) / ZSIGMA
ZX(:) = 6. * PMIXC(:) - 3.
ZW1(:) = 1. / ( 1.+ ZP * ABS ( ZX(:) ) )
ZY(:) = EXP( -0.5 * ZX(:) * ZX(:) )
ZW2(:) = ZA1 * ZW1(:) + ZA2 * ZW1(:) * ZW1(:) + &
ZA3 * ZW1(:) * ZW1(:) * ZW1(:)
ZW11 = ZA1 * ZT1 + ZA2 * ZT1 * ZT1 + ZA3 * ZT1 * ZT1 * ZT1
ENDIF
!
WHERE ( KMF == 1 .AND. ZX(:) >= 0. )
PER(:) = ZSIGMA * ( 0.5 * ( ZSQRTP - ZE45 * ZW11 &
- ZY(:) * ZW2(:) ) + ZSIGMA * ( ZE45 - ZY(:) ) ) &
- 0.5 * ZE45 * PMIXC(:) * PMIXC(:)
PDR(:) = ZSIGMA*( 0.5 * ( ZY(:) * ZW2(:) - ZE45 * ZW11 ) &
+ ZSIGMA * ( ZE45 - ZY(:) ) ) &
- ZE45 * ( 0.5 + 0.5 * PMIXC(:) * PMIXC(:) - PMIXC(:) )
END WHERE
WHERE ( KMF == 1 .AND. ZX(:) < 0. )
PER(:) = ZSIGMA*( 0.5 * ( ZY(:) * ZW2(:) - ZE45 * ZW11 ) &
+ ZSIGMA * ( ZE45 - ZY(:) ) ) &
- 0.5 * ZE45 * PMIXC(:) * PMIXC(:)
PDR(:) = ZSIGMA * ( 0.5 * ( ZSQRTP - ZE45 * ZW11 - ZY(:) &
* ZW2(:) ) + ZSIGMA * ( ZE45 - ZY(:) ) ) &
- ZE45 * ( 0.5 + 0.5 * PMIXC(:) * PMIXC(:) - PMIXC(:) )
END WHERE
!
PER(:) = PER(:) * ZFE
PDR(:) = PDR(:) * ZFE
!
!
! 2. Use triangular function KMF=2
! -------------------------------
!
! not yet released
!
!
END SUBROUTINE CONVECT_MIXING_FUNCT
!
!
!-------------------------------------------------------------------------------
!
! ######################################################################
SUBROUTINE CONVECT_TSTEP_PREF( KLON, KLEV, & 1,1
PU, PV, PPRES, PZ, PDXDY, KLCL, KCTL, &
PTIMEA, PPREF )
! ######################################################################
!
!!**** Routine to compute convective advection time step and precipitation
!! efficiency
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine the convective
!! advection time step PTIMEC as a function of the mean ambient
!! wind as well as the precipitation efficiency as a function
!! of wind shear and cloud base height.
!!
!!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!! None
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation
!! Fritsch and Chappell, 1980, J. Atmos. Sci.
!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 04/10/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU ! grid scale horiz. wind u
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV ! grid scale horiz. wind v
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! lifting condensation level index
INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! cloud top level index
!
REAL, DIMENSION(KLON), INTENT(OUT):: PTIMEA ! advective time period
REAL, DIMENSION(KLON), INTENT(OUT):: PPREF ! precipitation efficiency
!
!
!* 0.2 Declarations of local variables KLON
!
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
INTEGER :: JI ! horizontal loop index
INTEGER :: JK, JKLC, JKP5, JKCT ! vertical loop index
!
INTEGER, DIMENSION(KLON) :: IP500 ! index of 500 hPa levels
REAL, DIMENSION(KLON) :: ZCBH ! cloud base height
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3 ! work arrays
!
!
!-------------------------------------------------------------------------------
!
! 0.3 Set loop bounds
! ---------------
!
IIE = KLON
IKB = 1 + JCVEXB
IKE = KLEV - JCVEXT
!
!
!* 1. Determine vertical index for 500 hPa levels
! ------------------------------------------
!
!
IP500(:) = IKB
DO JK = IKB, IKE
WHERE ( PPRES(:,JK) >= 500.E2 ) IP500(:) = JK
END DO
!
!
!* 2. Compute convective time step
! ----------------------------
!
! compute wind speed at LCL, 500 hPa, CTL
DO JI = 1, IIE
JKLC = KLCL(JI)
JKP5 = IP500(JI)
JKCT = KCTL(JI)
ZWORK1(JI) = SQRT( PU(JI,JKLC) * PU(JI,JKLC) + &
PV(JI,JKLC) * PV(JI,JKLC) )
ZWORK2(JI) = SQRT( PU(JI,JKP5) * PU(JI,JKP5) + &
PV(JI,JKP5) * PV(JI,JKP5) )
ZWORK3(JI) = SQRT( PU(JI,JKCT) * PU(JI,JKCT) + &
PV(JI,JKCT) * PV(JI,JKCT) )
END DO
!
ZWORK2(:) = MAX( 0.1, 0.5 * ( ZWORK1(:) + ZWORK2(:) ) )
!
!correction debordement domi
DO JI = 1, IIE
PTIMEA(:) = SQRT( PDXDY(:) ) / ZWORK2(:)
END DO
!
!
!* 3. Compute precipitation efficiency
! -----------------------------------
!
!* 3.1 Precipitation efficiency as a function of wind shear
! ----------------------------------------------------
!
ZWORK2(:) = SIGN( 1., ZWORK3(:) - ZWORK1(:) )
DO JI = 1, IIE
JKLC = KLCL(JI)
JKCT = KCTL(JI)
ZWORK1(JI) = ( PU(JI,JKCT) - PU(JI,JKLC) ) * &
( PU(JI,JKCT) - PU(JI,JKLC) ) + &
( PV(JI,JKCT) - PV(JI,JKLC) ) * &
( PV(JI,JKCT) - PV(JI,JKLC) )
ZWORK1(JI) = 1.E3 * ZWORK2(JI) * SQRT( ZWORK1(JI) ) / &
MAX( 1.E-2, PZ(JI,JKCT) - PZ(JI,JKLC) )
END DO
!
PPREF(:) = 1.591 + ZWORK1(:) * ( -.639 + ZWORK1(:) * ( &
9.53E-2 - ZWORK1(:) * 4.96E-3 ) )
PPREF(:) = MAX( .4, MIN( PPREF(:), .92 ) )
!PPREF(:) = MAX( .2, MIN( PPREF(:), .90 ) ) !jiao bkf
!
!* 3.2 Precipitation efficiency as a function of cloud base height
! ----------------------------------------------------------
!
DO JI = 1, IIE
JKLC = KLCL(JI)
ZCBH(JI) = MAX( 3., ( PZ(JI,JKLC) - PZ(JI,IKB) ) * 3.281E-3 )
END DO
ZWORK1(:) = .9673 + ZCBH(:) * ( -.7003 + ZCBH(:) * ( .1622 + &
ZCBH(:) * ( -1.2570E-2 + ZCBH(:) * ( 4.2772E-4 - &
ZCBH(:) * 5.44E-6 ) ) ) )
ZWORK1(:) = MAX( .4, MIN( .92, 1./ ( 1. + ZWORK1(:) ) ) )
!ZWORK1(:) = MAX( .2, MIN( .90, 1./ ( 1. + ZWORK1(:) ) ) ) !jiao bkf
!
!* 3.3 Mean precipitation efficiency is used to compute rainfall
! ----------------------------------------------------------
!
PPREF(:) = 0.5 * ( PPREF(:) + ZWORK1(:) )
!
!
END SUBROUTINE CONVECT_TSTEP_PREF
!
!-------------------------------------------------------------------------------
!
! #######################################################################
SUBROUTINE CONVECT_DOWNDRAFT( KLON, KLEV, & 1,5
KICE, PPRES, PDPRES, PZ, PTH, PTHES, &
PRW, PRC, PRI, &
PPREF, KLCL, KCTL, KETL, &
PUTHL, PURW, PURC, PURI, &
PDMF, PDER, PDDR, PDTHL, PDRW, &
PMIXF, PDTEVR, KLFS, KDBL, KML, &
PDTEVRF, PCRAD ) !jiao xcrad
! ########################################################################
!
!!**** Compute downdraft properties from LFS to DBL.
!!
!!
!! PDRPOSE
!! -------
!! The purpose of this routine is to determine downdraft properties
!! ( mass flux, thermodynamics )
!!
!!
!!** METHOD
!! ------
!! Computations are done at every model level starting from top.
!! The use of masks allows to optimise the inner loops (horizontal loops).
!!
!!
!!
!! EXTERNAL
!! --------
!! Routine CONVECT_SATMIXRATIO
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! Module MODD_CSTS
!! XG ! gravity constant
!! XPI ! Pi
!! XP00 ! reference pressure
!! XRD, XRV ! gaz constants for dry air and water vapor
!! XCPD ! Cpd (dry air)
!! XCPV, XCL, XCI ! Cp of water vapor, liquid water and ice
!! XTT ! triple point temperature
!! XLVTT, XLSTT ! vaporisation/sublimation heat at XTT
!!
!! Module MODD_CONVPAR
!! XCRAD ! cloud radius
!! XZPBL ! thickness of downdraft detrainment layer
!! XENTR ! entrainment constant in pressure coordinates
!! XRHDBC ! relative humidity in downdraft below cloud
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation ( routine CONVECT_DOWNDRAFT)
!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 04/10/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
INTEGER, INTENT(IN) :: KICE ! flag for ice ( 1 = yes,
! 0 = no ice )
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! grid scale theta
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW ! grid scale total water
! mixing ratio
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRC ! grid scale r_c (cloud water)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRI ! grid scale r_i (cloud ice)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between
! bottom and top of layer (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! level height (m)
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of
! equilibrium (zero buoyancy) level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! " vert. index of melting level
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft r_c (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft r_i (kg/kg)
REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
REAL, DIMENSION(KLON), INTENT(IN) :: PCRAD ! jiao xcrad
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDMF ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDER ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDDR ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTHL ! downdraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDRW ! downdraft total water (kg/kg)
REAL, DIMENSION(KLON), INTENT(OUT):: PMIXF ! mixed fraction at LFS
REAL, DIMENSION(KLON), INTENT(OUT):: PDTEVR ! total downdraft evaporation
! rate at LFS (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTEVRF! downdraft evaporation rate
INTEGER, DIMENSION(KLON), INTENT(OUT):: KLFS ! contains vert. index of LFS
INTEGER, DIMENSION(KLON), INTENT(OUT):: KDBL ! contains vert. index of DBL
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
INTEGER :: JK, JKP, JKM, JKT ! vertical loop index
INTEGER :: JI, JL ! horizontal loop index
INTEGER :: JITER ! iteration loop index
REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
REAL :: ZEPS ! R_d / R_v
REAL :: ZEPSA, ZCVOCD ! R_v / R_d, C_pv / C_pd
!
INTEGER, DIMENSION(KLON) :: IDDT ! top level of detrainm. layer
REAL, DIMENSION(KLON) :: ZTHE ! environm. theta_e (K)
REAL, DIMENSION(KLON) :: ZDT, ZDTP ! downdraft temperature (K)
REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
REAL, DIMENSION(KLON) :: ZLV, ZLS ! latent heat of vaporis., sublim.
REAL, DIMENSION(KLON) :: ZDDT ! thickness (hPa) of detrainm. layer
REAL, DIMENSION(KLON) :: ZPI ! Pi=(P0/P)**(Rd/Cpd)
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, &
ZWORK5 ! work arrays
LOGICAL, DIMENSION(KLON) :: GWORK1 ! work array
!
!
!-------------------------------------------------------------------------------
!
! 0.3 Set loop bounds
! ---------------
!
IIE = KLON
IKB = 1 + JCVEXB
IKE = KLEV - JCVEXT
!
!
!* 1. Initialize downdraft properties
! -------------------------------
!
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
ZEPS = XRD / XRV
ZEPSA = XRV / XRD
ZCVOCD = XCPV / XCPD
PDMF(:,:) = 0.
PDER(:,:) = 0.
PDDR(:,:) = 0.
PDRW(:,:) = 0.
PDTHL(:,:) = 0.
PDTEVR(:) = 0.
PMIXF(:) = 0.
ZTHE(:) = 0.
ZDDT(:) = PDPRES(:,IKB+2)
KDBL(:) = IKB + 1
KLFS(:) = IKB + 1
IDDT(:) = KDBL(:) + 1
!
!
!* 2. Determine the LFS by looking for minimum of environmental
! saturated theta_e
! ----------------------------------------------------------
!
ZWORK1(:) = 900. ! starting value for search of minimum envir. theta_e
DO JK = MINVAL( KLCL(:) ) + 2, MAXVAL( KETL(:) )
DO JI = 1, IIE
GWORK1(JI) = JK >= KLCL(JI) + 2 .AND. JK < KETL(JI)
IF ( GWORK1(JI) .AND. ZWORK1(JI) > PTHES(JI,JK) ) THEN
KLFS(JI) = JK
ZWORK1(JI) = MIN( ZWORK1(JI), PTHES(JI,JK) )
END IF
END DO
END DO
!
!
!* 3. Determine the mixed fraction using environmental and updraft
! values of theta_e at LFS
! ---------------------------------------------------------
!
DO JI = 1, IIE
JK = KLFS(JI)
ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
! compute updraft theta_e
ZWORK3(JI) = PURW(JI,JK) - PURC(JI,JK) - PURI(JI,JK)
ZDT(JI) = PTH(JI,JK) / ZPI(JI)
ZLV(JI) = XLVTT + ( XCPV - XCL ) * ( ZDT(JI) - XTT )
ZLS(JI) = XLSTT + ( XCPV - XCI ) * ( ZDT(JI) - XTT )
ZCPH(JI) = XCPD + XCPV * PURW(JI,JK)
ZDT(JI) = ( PUTHL(JI,JK) - ( 1. + PURW(JI,JK) ) * XG * PZ(JI,JK) &
+ ZLV(JI) * PURC(JI,JK) + ZLS(JI) * PURI(JI,JK) ) / ZCPH(JI)
ZWORK1(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) ) &
* EXP( ( 3374.6525 / ZDT(JI) - 2.5403 ) &
* ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
! compute environmental theta_e
ZDT(JI) = PTH(JI,JK) / ZPI(JI)
ZLV(JI) = XLVTT + ( XCPV - XCL ) * ( ZDT(JI) - XTT )
ZLS(JI) = XLSTT + ( XCPV - XCI ) * ( ZDT(JI) - XTT )
ZWORK3(JI) = PRW(JI,JK) - PRC(JI,JK) - PRI(JI,JK)
ZCPH(JI) = XCPD + XCPV * PRW(JI,JK)
ZWORK2(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) ) &
* EXP( ( 3374.6525 / ZDT(JI) - 2.5403 ) &
* ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
! compute mixed fraction
PMIXF(JI) = MAX( 0., ( ZWORK1(JI) - PTHES(JI,JK) ) ) &
/ ( ZWORK1(JI) - ZWORK2(JI) + 1.E-10 )
PMIXF(JI) = MAX(0., MIN( 1., PMIXF(JI) ) )
ZWORK4(JI) = PPRES(JI,JK)
END DO
!
!
!* 4. Estimate the effect of melting on the downdraft
! ---------------------------------------------
!
ZWORK1(:) = 0.
! use total solid precipitation
!DO JK = IKB + 1, IKE
! ZWORK1(:) = ZWORK1(:) + PURS(:,JK) ! total snow/hail content
!END DO
!
DO JI = 1, IIE
JK = KLCL(JI)
JKP = KCTL(JI)
ZWORK1(JI) = 0.5 * ( PURW(JI,JK) - PURW(JI,JKP) )
END DO
!
! temperature perturbation due to melting at LFS
ZWORK3(:) = 0.
WHERE( KML(:) > IKB + 2 )
ZWORK3(:) = ZWORK1(:) * ( ZLS(:) - ZLV(:) ) / ZCPH(:)
ZDT(:) = ZDT(:) - ZWORK3(:) * REAL(KICE)
END WHERE
!
!
!* 5. Initialize humidity at LFS as a saturated mixture of
! updraft and environmental air
! -----------------------------------------------------
!
DO JI = 1, IIE
JK = KLFS(JI)
PDRW(JI,JK) = PMIXF(JI) * PRW(JI,JK) + ( 1. - PMIXF(JI) ) * PURW(JI,JK)
ZWORK2(JI) = PDRW(JI,JK) - ( 1. - PMIXF(JI) ) &
* ( PURC(JI,JK) + PURI(JI,JK) )
END DO
!
!
!* 6.1 Determine the DBL by looking for level where the envir.
! theta_es at the LFS corrected by melting effects becomes
! larger than envir. value
! ---------------------------------------------------------
!
! compute satur. mixing ratio for melting corrected temperature
CALL CONVECT_SATMIXRATIO( KLON, ZWORK4, ZDT, ZWORK3, ZLV, ZLS, ZCPH )
!
! compute envir. saturated theta_e for melting corrected temperature
ZWORK1(:) = MIN( ZWORK2(:), ZWORK3(:) )
ZWORK3(:) = ZWORK3(:) * ZWORK4(:) / ( ZWORK3(:) + ZEPS ) ! sat. pressure
ZWORK3(:) = LOG( ZWORK3(:) / 613.3 )
! dewp point temperature
ZWORK3(:) = ( 4780.8 - 32.19 * ZWORK3(:) ) / ( 17.502 - ZWORK3(:) )
! adiabatic saturation temperature
ZWORK3(:) = ZWORK3(:) - ( .212 + 1.571E-3 * ( ZWORK3(:) - XTT ) &
- 4.36E-4 * ( ZDT(:) - XTT ) ) * ( ZDT(:) - ZWORK3(:) )
ZWORK4(:) = SIGN(0.5, ZWORK2(:) - ZWORK3(:) )
ZDT(:) = ZDT(:) * ( .5 + ZWORK4(:) ) + ( .5 - ZWORK4(:) ) * ZWORK3(:)
ZWORK2(:) = ZDT(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK2(:) ) &
* EXP( ( 3374.6525 / ZDT(:) - 2.5403 ) &
* ZWORK1(:) * ( 1. + 0.81 * ZWORK1(:) ) )
!
GWORK1(:) = .TRUE.
JKM = MAXVAL( KLFS(:) )
DO JK = JKM - 1, IKB + 1, -1
DO JI = 1, IIE
IF ( JK < KLFS(JI) .AND. ZWORK2(JI) > PTHES(JI,JK) .AND. GWORK1(JI) ) THEN
KDBL(JI) = JK
GWORK1(JI) = .FALSE.
END IF
END DO
END DO
!
!
!* 7. Define mass flux and entr/detr. rates at LFS
! -------------------------------------------
!
DO JI = 1, IIE
JK = KLFS(JI)
ZWORK1(JI) = PPRES(JI,JK) / &
( XRD * ZDT(JI) * ( 1. + ZEPS * ZWORK1(JI) ) ) ! density
PDMF(JI,JK) = - ( 1. - PPREF(JI) ) * ZWORK1(JI) * XPI * PCRAD(JI) * PCRAD(JI) !jiao xcrad
PDTHL(JI,JK)= ZWORK2(JI) ! theta_l is here actually theta_e
ZWORK2(JI) = PDMF(JI,JK)
PDDR(JI,JK) = 0.
PDER(JI,JK) = - PMIXF(JI) * PDMF(JI,JK)
END DO
!
!
! 7.1 Downdraft detrainment is assumed to occur in a layer
! of 60 hPa, determine top level IDDT of this layer
! ---------------------------------------------------------
!
ZWORK1(:) = 0.
DO JK = IKB + 2, JKM
ZWORK1(:) = ZWORK1(:) + PDPRES(:,JK)
WHERE ( JK > KDBL(:) .AND. ZWORK1(:) <= XZPBL )
ZDDT(:) = ZWORK1(:)
IDDT(:) = JK
END WHERE
END DO
!
!
!* 8. Enter loop for downdraft computations. Make a first guess
! of initial downdraft mass flux.
! In the downdraft computations we use theta_es instead of
! enthalpy as it allows to better take into account evaporation
! effects. As the downdraft detrainment rate is zero apart
! from the detrainment layer, we just compute enthalpy
! downdraft from theta_es in this layer.
! ----------------------------------------------------------
!
!
ZWORK5(:) = 0.
!
DO JK = JKM - 1, IKB + 1, -1
JKP = JK + 1
DO JI = 1, IIE
IF ( JK < KLFS(JI) .AND. JK >= IDDT(JI) ) THEN
PDER(JI,JK) = - ZWORK2(JI) * XENTR * PDPRES(JI,JKP) / PCRAD(JI) !jiao xcrad
! DER and DPRES are positive
PDMF(JI,JK) = PDMF(JI,JKP) - PDER(JI,JK)
ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
ZDT(JI) = PTH(JI,JK) / ZPI(JI)
ZWORK1(JI) = PRW(JI,JK) - PRC(JI,JK) - PRI(JI,JK)
ZTHE(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK1(JI) ) &
* EXP( ( 3374.6525 / ZDT(JI) - 2.5403 ) &
* ZWORK1(JI) * ( 1. + 0.81 * ZWORK1(JI) ) )
! PDTHL is here theta_es, later on in this routine this table is
! reskipped to enthalpy
PDTHL(JI,JK) = ( PDTHL(JI,JKP) * PDMF(JI,JKP) - ZTHE(JI) * PDER(JI,JK) &
) / ( PDMF(JI,JK) - 1.E-7 )
PDRW(JI,JK) = ( PDRW(JI,JKP) * PDMF(JI,JKP) - PRW(JI,JK) * PDER(JI,JK) &
) / ( PDMF(JI,JK) - 1.E-7 )
END IF
IF ( JK < IDDT(JI) .AND. JK >= KDBL(JI) ) THEN
JL = IDDT(JI)
PDDR(JI,JK) = - PDMF(JI,JL) * PDPRES(JI,JKP) / ZDDT(JI)
PDMF(JI,JK) = PDMF(JI,JKP) + PDDR(JI,JK)
PDTHL(JI,JK) = PDTHL(JI,JKP)
PDRW(JI,JK) = PDRW(JI,JKP)
END IF
END DO
END DO
!
!
!* 9. Calculate total downdraft evaporation
! rate for given mass flux (between DBL and IDDT)
! -----------------------------------------------
!
PDTEVRF(:,:) = 0.
!
JKT = MAXVAL( IDDT(:) )
DO JK = IKB + 1, JKT
!
ZPI(:) = ( XP00 / PPRES(:,JK) ) ** ZRDOCP
ZDT(:) = PTH(:,JK) / ZPI(:)
!
!* 9.1 Determine wet bulb temperature at DBL from theta_e.
! The iteration algoritm is similar to that used in
! routine CONVECT_CONDENS
! --------------------------------------------------
!
DO JITER = 1, 4
CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZDT, ZWORK1, ZLV, ZLS, ZCPH )
ZDTP(:) = PDTHL(:,JK) / ( ZPI(:) ** ( 1. - 0.28 * ZWORK1(:) ) &
* EXP( ( 3374.6525 / ZDT(:) - 2.5403 ) &
* ZWORK1(:) * ( 1. + 0.81 * ZWORK1(:) ) ) )
ZDT(:) = 0.4 * ZDTP(:) + 0.6 * ZDT(:) ! force convergence
END DO
!
!
!* 9.2 Sum total downdraft evaporation rate. No evaporation
! if actual humidity is larger than specified one.
! -----------------------------------------------------
!
ZWORK2(:) = ZWORK1(:) / ZDT(:) * ( XBETAW / ZDT(:) - XGAMW ) ! dr_sat/dT
ZWORK2(:) = ZLV(:) / ZCPH(:) * ZWORK1(:) * ( 1. - XRHDBC ) / &
( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) ) ! temperature perturb ! due to evaporation
ZDT(:) = ZDT(:) + ZWORK2(:)
!
CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZDT, ZWORK3, ZLV, ZLS, ZCPH )
!
ZWORK3(:) = ZWORK3(:) * XRHDBC
ZWORK1(:) = MAX( 0., ZWORK3(:) - PDRW(:,JK) )
PDTEVR(:) = PDTEVR(:) + ZWORK1(:) * PDDR(:,JK)
PDTEVRF(:,JK)= PDTEVRF(:,JK) + ZWORK1(:) * PDDR(:,JK)
! compute enthalpie and humidity in the detrainment layer
PDRW(:,JK) = MAX( PDRW(:,JK), ZWORK3(:) )
PDTHL(:,JK) = ( ( XCPD + PDRW(:,JK) * XCPV ) * ZDT(:) &
+ ( 1. + PDRW(:,JK) ) * XG * PZ(:,JK) )
!
END DO
!
!
!* 12. If downdraft does not evaporate any water for specified
! relative humidity, no downdraft is allowed
! ---------------------------------------------------------
!
ZWORK2(:) = 1.
WHERE ( PDTEVR(:) < 1. .OR. KLFS(:) == IKB + 1 ) ZWORK2(:) = 0.
DO JK = IKB, JKM
KDBL(:) = KDBL(:) * INT( ZWORK2(:) ) + ( 1 - INT( ZWORK2(:) ) ) * IKB
KLFS(:) = KLFS(:) * INT( ZWORK2(:) ) + ( 1 - INT( ZWORK2(:) ) ) * IKB
PDMF(:,JK) = PDMF(:,JK) * ZWORK2(:)
PDER(:,JK) = PDER(:,JK) * ZWORK2(:)
PDDR(:,JK) = PDDR(:,JK) * ZWORK2(:)
ZWORK1(:) = REAL( KLFS(:) - JK ) ! use this to reset thl_d
ZWORK1(:) = MAX( 0.,MIN(1.,ZWORK1(:) ) ) ! and rv_d to zero above LFS
PDTHL(:,JK) = PDTHL(:,JK) * ZWORK2(:) * ZWORK1(:)
PDRW(:,JK) = PDRW(:,JK) * ZWORK2(:) * ZWORK1(:)
PDTEVR(:) = PDTEVR(:) * ZWORK2(:)
PDTEVRF(:,JK)= PDTEVRF(:,JK) * ZWORK2(:)
END DO
!
END SUBROUTINE CONVECT_DOWNDRAFT
!
!-----------------------------------------------------------------------------
! ######################################################################
SUBROUTINE CONVECT_PRECIP_ADJUST( KLON, KLEV, & 1,2
PPRES, PUMF, PUER, PUDR, &
PUPR, PUTPR, PURW, &
PDMF, PDER, PDDR, PDTHL, PDRW, &
PPREF, PTPR, PMIXF, PDTEVR, &
KLFS, KDBL, KLCL, KCTL, KETL, &
PDTEVRF )
! ######################################################################
!
!!**** Adjust up- and downdraft mass fluxes to be consistent with the
!! mass transport at the LFS given by the precipitation efficiency
!! relation.
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to adjust up- and downdraft mass
!! fluxes below the LFS to be consistent with the precipitation
!! efficiency relation
!!
!!
!!
!!** METHOD
!! ------
!!
!!
!! EXTERNAL
!! --------
!! None
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! Module MODD_CONVPAR
!! XUSRDPTH ! pressure depth to compute updraft humidity
!! ! supply rate for downdraft
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation ( routine CONVECT_PRECIP_ADJUST)
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 04/10/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONVPAREXT
USE MODD_CONVPAR
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
REAL, DIMENSION(KLON), INTENT(IN) :: PUTPR ! updraft total precipit. (kg/s
REAL, DIMENSION(KLON), INTENT(IN) :: PPREF ! precipitation efficiency
REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! critical mixed fraction at LCL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! contains vert. index of LCL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! contains vert. index of CTL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KETL ! contains vert. index of equilibrium
! (zero buoyancy) level
INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KLFS ! contains vert. index of LFS
INTEGER, DIMENSION(KLON), INTENT(INOUT) :: KDBL ! contains vert. index of DBL
!
REAL, DIMENSION(KLON), INTENT(INOUT) :: PDTEVR ! total downdraft evaporation
! rate at LFS
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTEVRF! downdraft evaporation rate
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUPR ! updraft precipit. (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTHL ! downdraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDRW ! downdraft total water (kg/kg)
!
REAL, DIMENSION(KLON), INTENT(OUT) :: PTPR ! total precipitation (kg/s)
! = downdraft precipitation
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
INTEGER :: JK, JKT1, JKT2, JKT3 ! vertical loop index
INTEGER :: JI ! horizontal loop index
!
INTEGER, DIMENSION(KLON) :: IPRL
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, &
ZWORK4, ZWORK5, ZWORK6 ! work arrays
!
!
!-------------------------------------------------------------------------------
!
! 0.3 Set loop bounds
! ---------------
!
IKB = 1 + JCVEXB
IKE = KLEV - JCVEXT
IIE = KLON
JKT1 = MAXVAL( KLFS(:) )
JKT2 = MAXVAL( KCTL(:) )
JKT3 = MINVAL( KLCL(:) )
!
!
! 1. Set some output variables for columns where no downdraft
! exists. Exit if there is no downdraft at all.
! --------------------------------------------------------
!
IPRL(:) = IKB
PTPR(:) = 0.
!
WHERE ( PDTEVR(:) == 0. )
PTPR(:) = PUTPR(:) ! no downdraft evaporation => no downdraft, all
! precipitation occurs in updraft
END WHERE
IF ( COUNT( PDTEVR(:) > 0. ) == 0 ) RETURN ! exit routine if no downdraft exists
!
!* 2. The total mass transported from the updraft to the down-
! draft at the LFS must be consistent with the three water
! budget terms :
! ---------------------------------------------------------
!
!* 2.1 Downdraft evaporation rate at the DBL. The evaporation
! rate in downdraft must be consistent with precipitation
! efficiency relation.
! --------------------------------------------------------
!
!
DO JI = 1, IIE
JK = KLFS(JI)
ZWORK1(JI) = PDTEVR(JI) / MIN( -1.E-1, PDMF(JI,JK) )
ZWORK6(JI) = PDMF(JI,JK)
END DO
!
!* 2.2 Some preliminar computations for downdraft = total
! precipitation rate. The precipitation is evaluated in
! a layer thickness DP=XUSRDPTH=165 hPa above the LCL.
! The difference between updraft precipitation and downdraft
! precipitation (updraft supply rate) is used to drive the
! downdraft through evaporational cooling.
! --------------------------------------------------------
!
DO JI = 1, IIE
JK = KLCL(JI)
ZWORK5(JI) = PPRES(JI,JK)
END DO
!
PTPR(:) = 0.
DO JK = JKT3, JKT2
WHERE ( JK >= KLCL(:) .AND. PPRES(:,JK) >= ZWORK5(:) - XUSRDPTH )
PTPR(:) = PTPR(:) + PUPR(:,JK)
IPRL(:) = JK
END WHERE
END DO
IPRL(:) = MIN( KETL(:), IPRL(:) )
!
DO JI = 1, IIE
JK = IPRL(JI)
PTPR(JI) = PUMF(JI,JK+1) * PURW(JI,JK+1) + PTPR(JI)
END DO
!
PTPR(:) = PPREF(:) * MIN( PUTPR(:), PTPR(:) )
ZWORK4(:) = PUTPR(:) - PTPR(:)
!
!
!* 2.3 Total amount of precipitation that falls out of the up-
! draft between the LCL and the LFS.
! Condensate transfer from up to downdraft at LFS
! ---------------------------------------------------------
!
ZWORK5(:) = 0.
DO JK = JKT3, JKT1
WHERE ( JK >= KLCL(:) .AND. JK <= KLFS(:) )
ZWORK5(:) = ZWORK5(:) + PUPR(:,JK)
END WHERE
END DO
!
DO JI = 1, IIE
JK = KLFS(JI)
ZWORK2(JI) = ( 1. - PPREF(JI) ) * ZWORK5(JI) * &
( 1. - PMIXF(JI) ) / MAX( 1.E-1, PUMF(JI,JK) )
END DO
!
!
!* 2.4 Increase the first guess downdraft mass flux to satisfy
! precipitation efficiency relation.
! If downdraft does not evaporate any water at the DBL for
! the specified relative humidity, or if the corrected mass
! flux at the LFS is positive no downdraft is allowed
! ---------------------------------------------------------
!
!
ZWORK1(:) = ZWORK4(:) / ( ZWORK1(:) + ZWORK2(:) + 1.E-8 )
ZWORK2(:) = ZWORK1(:) / MIN( -1.E-1, ZWORK6(:) ) ! ratio of budget consistent to actual DMF
!
ZWORK3(:) = 1.
ZWORK6(:) = 1.
WHERE ( ZWORK1(:) > 0. .OR. PDTEVR(:) < 1. )
KDBL(:) = IKB
KLFS(:) = IKB
PDTEVR(:) = 0.
ZWORK2(:) = 0.
ZWORK3(:) = 0.
ZWORK6(:) = 0.
END WHERE
!
DO JK = IKB, JKT1
PDMF(:,JK) = PDMF(:,JK) * ZWORK2(:)
PDER(:,JK) = PDER(:,JK) * ZWORK2(:)
PDDR(:,JK) = PDDR(:,JK) * ZWORK2(:)
PDTEVRF(:,JK) = PDTEVRF(:,JK)* ZWORK2(:)
PDRW(:,JK) = PDRW(:,JK) * ZWORK3(:)
PDTHL(:,JK) = PDTHL(:,JK) * ZWORK3(:)
END DO
ZWORK4(:) = ZWORK2(:)
!
!
!* 3. Increase updraft mass flux, mass detrainment rate, and water
! substance detrainment rates to be consistent with the transfer
! of the estimated mass from the up- to the downdraft at the LFS
! --------------------------------------------------------------
!
DO JI = 1, IIE
JK = KLFS(JI)
ZWORK2(JI) = ( 1. - ZWORK6(JI) ) + ZWORK6(JI) * &
( PUMF(JI,JK) - ( 1. - PMIXF(JI) ) * ZWORK1(JI) ) / &
MAX( 1.E-1, PUMF(JI,JK) )
END DO
!
!
JKT1 = MAXVAL( KLFS(:) ) ! value of KLFS might have been reset to IKB above
DO JK = IKB, JKT1
DO JI = 1, IIE
IF ( JK <= KLFS(JI) ) THEN
PUMF(JI,JK) = PUMF(JI,JK) * ZWORK2(JI)
PUER(JI,JK) = PUER(JI,JK) * ZWORK2(JI)
PUDR(JI,JK) = PUDR(JI,JK) * ZWORK2(JI)
PUPR(JI,JK) = PUPR(JI,JK) * ZWORK2(JI)
END IF
END DO
END DO
!
!
!* 4. Increase total = downdraft precipitation and evaporation rate
! -------------------------------------------------------------
!
WHERE ( PDTEVR(:) > 0. )
PDTEVR(:) = PDTEVR(:) * ZWORK4(:)
PTPR(:) = PTPR(:) + PPREF(:) * ZWORK5(:) * ( ZWORK2(:) - 1. )
ELSEWHERE
PTPR(:) = PUTPR(:)
END WHERE
!
!
END SUBROUTINE CONVECT_PRECIP_ADJUST
!
! ---------------------------------------------------------------------------
SUBROUTINE CONVECT_CLOSURE( KLON, KLEV, & 1,7
PPRES, PDPRES, PZ, PDXDY, PLMASS, &
PTHL, PTH, PRW, PRC, PRI, OTRIG1, &
PTHC, PRWC, PRCC, PRIC, PWSUB, &
KLCL, KDPL, KPBL, KLFS, KCTL, KML, &
PUMF, PUER, PUDR, PUTHL, PURW, &
PURC, PURI, PUPR, &
PDMF, PDER, PDDR, PDTHL, PDRW, &
PTPR, PSPR, PDTEVR, &
PCAPE, PTIMEC, &
KFTSTEPS, &
PDTEVRF, PPRLFLX, PPRSFLX )
! #######################################################################
!
!!**** Uses modified Fritsch-Chappell closure
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine the final adjusted
!! (over a time step PTIMEC) environmental values of THETA_l, R_w, R_c, R_i
!! The final convective tendencies can then be evaluated in the main
!! routine DEEP_CONVECT by (PTHC-PTH)/PTIMEC
!!
!!
!!** METHOD
!! ------
!! Computations are done at every model level starting from bottom.
!! The use of masks allows to optimise the inner loops (horizontal loops).
!!
!!
!!
!! EXTERNAL
!! --------
!!
!! CONVECT_CLOSURE_THRVLCL
!! CONVECT_CLOSURE_ADJUST
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XG ! gravity constant
!! XP00 ! reference pressure
!! XRD, XRV ! gaz constants for dry air and water vapor
!! XCPD, XCPV ! specific heat for dry air and water vapor
!! XCL, XCI ! specific heat for liquid water and ice
!! XTT ! triple point temperature
!! XLVTT, XLSTT ! vaporization, sublimation heat constant
!!
!! Module MODD_CONVPAR
!! XA25 ! reference grid area
!! XSTABT ! stability factor in time integration
!! XSTABC ! stability factor in CAPE adjustment
!! XMELDPTH ! allow melting over specific pressure depth
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation ( routine CONVECT_CLOSURE)
!! Fritsch and Chappell, 1980, J. Atmos. Sci.
!! Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 26/03/96
!! Peter Bechtold 04/10/97 change for enthalpie, r_c + r_i tendencies
!! Dominique Paquin UQAM suivi des corrections de debordements
!! OURANOS Avril 2003 correction pcp < 0
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
INTEGER, DIMENSION(KLON), INTENT(IN) :: KML ! index for melting level
REAL, DIMENSION(KLON), INTENT(INOUT) :: PTIMEC ! convection time step
REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL ! grid scale enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH ! grid scale theta
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW ! grid scale total water
! mixing ratio
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC ! grid scale r_c
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI ! grid scale r_i
LOGICAL, DIMENSION(KLON), INTENT(IN) :: OTRIG1 ! logical to keep trace of
! convective arrays modified in UPDRAFT
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between
! bottom and top of layer (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of model layer (m)
REAL, DIMENSION(KLON), INTENT(IN) :: PCAPE ! available potent. energy
INTEGER, INTENT(OUT) :: KFTSTEPS! maximum of fract time steps
! only used for chemical tracers
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUPR ! updraft precipitation in
! flux units (kg water / s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC ! updraft cloud water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI ! updraft cloud ice (kg/kg)
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDER ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDDR ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDTHL ! downdraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDRW ! downdraft total water (kg/kg)
REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total surf precipitation (kg/s)
REAL, DIMENSION(KLON), INTENT(OUT) :: PSPR ! solid surf precipitation (kg/s)
REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR! donwndraft evapor. (kg/s)
!
REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PTHC ! conv. adj. grid scale theta
REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRWC ! conv. adj. grid scale r_w
REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRCC ! conv. adj. grid scale r_c
REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PRIC ! conv. adj. grid scale r_i
REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PWSUB ! envir. compensating subsidence(Pa/s)
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDTEVRF! downdraft evaporation rate
REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRLFLX! liquid precip flux
REAL, DIMENSION(KLON,KLEV), INTENT(OUT) :: PPRSFLX! solid precip flux
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
INTEGER :: IKS ! vertical dimension
INTEGER :: JK, JKP, JKMAX ! vertical loop index
INTEGER :: JI ! horizontal loop index
INTEGER :: JITER ! iteration loop index
INTEGER :: JSTEP ! fractional time loop index
REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
REAL :: ZCVOCD, ZEPSA ! C_pv / C_pd, R_v / R_d
!
REAL, DIMENSION(KLON,KLEV) :: ZTHLC ! convectively adjusted
! grid scale enthalpy
REAL, DIMENSION(KLON,KLEV) :: ZOMG ! conv. environm. subsidence (Pa/s)
REAL, DIMENSION(KLON,KLEV) :: ZUMF ! non-adjusted updraft mass flux
REAL, DIMENSION(KLON,KLEV) :: ZUER ! " updraft entrainm. rate
REAL, DIMENSION(KLON,KLEV) :: ZUDR ! " updraft detrainm. rate
REAL, DIMENSION(KLON,KLEV) :: ZDMF ! " downdraft mass flux
REAL, DIMENSION(KLON,KLEV) :: ZDER ! " downdraft entrainm. rate
REAL, DIMENSION(KLON,KLEV) :: ZDDR ! " downdraft detrainm. rate
REAL, DIMENSION(KLON) :: ZTPR ! " total precipitation
REAL, DIMENSION(KLON) :: ZDTEVR ! " total downdraft evapor.
REAL, DIMENSION(KLON,KLEV):: ZPRLFLX ! " liquid precip flux
REAL, DIMENSION(KLON,KLEV):: ZPRSFLX ! " solid precip flux
REAL, DIMENSION(KLON) :: ZPRMELT ! melting of precipitation
REAL, DIMENSION(KLON) :: ZPRMELTO ! non-adjusted "
REAL, DIMENSION(KLON) :: ZADJ ! mass adjustment factor
REAL, DIMENSION(KLON) :: ZADJMAX ! limit value for ZADJ
REAL, DIMENSION(KLON) :: ZCAPE ! new CAPE after adjustment
REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
REAL, DIMENSION(KLON,KLEV):: ZTIMC ! 2D work array for ZTIMEC
!
REAL, DIMENSION(KLON) :: ZTHLCL ! new theta at LCL
REAL, DIMENSION(KLON) :: ZRVLCL ! new r_v at LCL
REAL, DIMENSION(KLON) :: ZZLCL ! height of LCL
REAL, DIMENSION(KLON) :: ZTLCL ! temperature at LCL
REAL, DIMENSION(KLON) :: ZTELCL ! envir. temper. at LCL
REAL, DIMENSION(KLON) :: ZTHEUL ! theta_e for undilute ascent
REAL, DIMENSION(KLON) :: ZTHES1, ZTHES2! saturation environm. theta_e
REAL, DIMENSION(KLON,KLEV) :: ZTHMFIN, ZTHMFOUT, ZRWMFIN, ZRWMFOUT
REAL, DIMENSION(KLON,KLEV) :: ZRCMFIN, ZRCMFOUT, ZRIMFIN, ZRIMFOUT
! work arrays for environm. compensat. mass flux
REAL, DIMENSION(KLON) :: ZPI ! (P/P00)**R_d/C_pd
REAL, DIMENSION(KLON) :: ZLV ! latent heat of vaporisation
REAL, DIMENSION(KLON) :: ZLS ! latent heat of sublimation
REAL, DIMENSION(KLON) :: ZLM ! latent heat of melting
REAL, DIMENSION(KLON) :: ZCPH ! specific heat C_ph
REAL, DIMENSION(KLON) :: ZMELDPTH ! actual depth of melting layer
INTEGER, DIMENSION(KLON) :: ITSTEP ! fractional convective time step
INTEGER, DIMENSION(KLON) :: ICOUNT ! timestep counter
INTEGER, DIMENSION(KLON) :: ILCL ! index lifting condens. level
INTEGER, DIMENSION(KLON) :: IWORK1 ! work array
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
REAL, DIMENSION(KLON,KLEV):: ZWORK6
LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK3! work arrays
LOGICAL, DIMENSION(KLON,KLEV) :: GWORK4 ! work array
REAL, DIMENSION(KLON) :: ZUTHED1,ZUTHED2 ! jiao dilute updraft theta_e
REAL :: ZUFR ! jiao dilute updraft fraction
!
!
!-------------------------------------------------------------------------------
!
!* 0.2 Initialize local variables
! ----------------------------
!
!
PSPR(:) = 0.
ZTIMC(:,:) = 0.
ZTHES2(:) = 0.
ZWORK1(:) = 0.
ZWORK2(:) = 0.
ZWORK3(:) = 0.
ZWORK4(:) = 0.
ZWORK5(:) = 0.
GWORK1(:) = .FALSE.
GWORK3(:) = .FALSE.
GWORK4(:,:) = .FALSE.
ILCL(:) = KLCL(:)
!
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
ZCVOCD = XCPV / XCPD
ZEPSA = XRV / XRD
!
ZADJ(:) = 1.
ZWORK5(:) = 1.
WHERE( .NOT. OTRIG1(:) ) ZWORK5(:) = 0.
!
!
!* 0.3 Compute loop bounds
! -------------------
!
IIE = KLON
IKB = 1 + JCVEXB
IKS = KLEV
IKE = KLEV - JCVEXT
JKMAX = MAXVAL( KCTL(:) )
!
!
!* 2. Save initial mass flux values to be used in adjustment procedure
! ---------------------------------------------------------------
!
ZUMF (:,:) = PUMF(:,:)
ZUER (:,:) = PUER(:,:)
ZUDR (:,:) = PUDR(:,:)
ZDMF (:,:) = PDMF(:,:)
ZDER (:,:) = PDER(:,:)
ZDDR (:,:) = PDDR(:,:)
ZTPR (: ) = PTPR(:)
ZDTEVR (: ) = PDTEVR(:)
ZOMG (:,:) = 0.
PWSUB (:,:) = 0.
ZPRMELT(: ) = 0.
PPRLFLX(:,:) = 0.
ZPRLFLX(:,:) = 0.
PPRSFLX(:,:) = 0.
ZPRSFLX(:,:) = 0.
!
!
!* 2.1 Some preliminar computations for melting of precipitation
! used later in section 9 and computation of precip fluxes
! Precipitation fluxes are updated for melting and evaporation
! ---------------------------------------------------------
!
!
ZWORK1(:) = 0.
ZMELDPTH(:) = 0.
ZWORK6(:,:) = 0.
DO JK = JKMAX + 1, IKB + 1, -1
! Nota: PUPR is total precipitation flux, but the solid, liquid
! precipitation is stored in units kg/kg; therefore we compute here
! the solid fraction of the total precipitation flux.
DO JI = 1, IIE
ZWORK2(JI) = PUPR(JI,JK) / ( PURC(JI,JK) + PURI(JI,JK) + 1.E-8 )
ZPRMELT(JI) = ZPRMELT(JI) + PURI(JI,JK) * ZWORK2(JI)
ZWORK1(JI) = ZWORK1(JI) + PURC(JI,JK) * ZWORK2(JI) - PDTEVRF(JI,JK)
ZPRLFLX(JI,JK)= MAX( 0., ZWORK1(JI) )
ZPRMELT(JI) = ZPRMELT(JI) + MIN( 0., ZWORK1(JI) )
ZPRSFLX(JI,JK)= ZPRMELT(JI)
IF ( KML(JI) >= JK .AND. ZMELDPTH(JI) <= XMELDPTH ) THEN
ZPI(JI) = ( PPRES(JI,JK) / XP00 ) ** ZRDOCP
ZWORK3(JI) = PTH(JI,JK) * ZPI(JI) ! temperature estimate
ZLM(JI) = XLSTT + ( XCPV - XCI ) * ( ZWORK3(JI) - XTT ) - &
( XLVTT + ( XCPV - XCL ) * ( ZWORK3(JI) - XTT ) ) ! L_s - L_v
ZCPH(JI) = XCPD + XCPV * PRW(JI,JK)
ZMELDPTH(JI) = ZMELDPTH(JI) + PDPRES(JI,JK)
ZWORK6(JI,JK)= ZLM(JI) * PTIMEC(JI) / PLMASS(JI,JK) * PDPRES(JI,JK)
ZOMG(JI,JK)= 1. ! at this place only used as work variable
END IF
END DO
!
END DO
!
ZWORK2(:) = 0.
DO JK = JKMAX, IKB + 1, -1
ZWORK1(:) = ZPRMELT(:) * PDPRES(:,JK) / MAX( XMELDPTH, ZMELDPTH(:) )
ZWORK2(:) = ZWORK2(:) + ZWORK1(:) * ZOMG(:,JK)
ZPRLFLX(:,JK) = ZPRLFLX(:,JK) + ZWORK2(:)
ZPRSFLX(:,JK) = ZPRSFLX(:,JK) - ZWORK2(:)
END DO
WHERE( ZPRSFLX(:,:) < 1. ) ZPRSFLX(:,:)=0.
ZPRMELTO(:) = ZPRMELT(:)
!
!
!* 3. Compute limits on the closure adjustment factor so that the
! inflow in convective drafts from a given layer can't be larger
! than the mass contained in this layer initially.
! ---------------------------------------------------------------
!
ZADJMAX(:) = 1000.
IWORK1(:) = MAX( ILCL(:), KLFS(:) )
JKP = MINVAL( KDPL(:) )
DO JK = JKP, IKE
DO JI = 1, IIE
IF( JK > KDPL(JI) .AND. JK <= IWORK1(JI) ) THEN
ZWORK1(JI) = PLMASS(JI,JK) / &
( ( PUER(JI,JK) + PDER(JI,JK) + 1.E-5 ) * PTIMEC(JI) )
ZADJMAX(JI) = MIN( ZADJMAX(JI), ZWORK1(JI) )
END IF
END DO
END DO
!
!
GWORK1(:) = OTRIG1(:) ! logical array to limit adjustment to not definitively
! adjusted columns
!
DO JK = IKB, IKE
ZTHLC(:,:) = PTHL(:,:) ! initialize adjusted envir. values
PRWC(:,:) = PRW(:,:)
PRCC(:,:) = PRC(:,:)
PRIC(:,:) = PRI(:,:)
PTHC(:,:) = PTH(:,:)
END DO
!
!
!
DO JITER = 1, 7 ! Enter adjustment loop to assure that all CAPE is
! removed within the advective time interval TIMEC
!
ZTIMEC(:) = PTIMEC(:)
GWORK4(:,:) = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKS )
WHERE( GWORK4(:,:) ) PWSUB(:,:) = 0.
ZOMG(:,:)=0.
!
DO JK = IKB + 1, JKMAX
JKP = MAX( IKB + 1, JK - 1 )
WHERE ( GWORK1(:) .AND. JK <= KCTL(:) )
!
!
!* 4. Determine vertical velocity at top and bottom of each layer
! to satisfy mass continuity.
! ---------------------------------------------------------------
! we compute here Domega/Dp = - g rho Dw/Dz = 1/Dt
!
ZWORK1(:) = - ( PUER(:,JKP) + PDER(:,JKP) - &
PUDR(:,JKP) - PDDR(:,JKP) ) / PLMASS(:,JKP)
!
PWSUB(:,JK) = PWSUB(:,JKP) - PDPRES(:,JK-1) * ZWORK1(:)
! we use PDPRES(JK-1) and not JKP in order to have zero subsidence
! at the first layer
!
!
!* 5. Compute fractional time step. For stability or
! mass conservation reasons one must split full time step PTIMEC)
! ---------------------------------------------------------------
!
ZWORK1(:) = XSTABT * PDPRES(:,JKP) / ( ABS( PWSUB(:,JK) ) + 1.E-10 )
! the factor XSTABT is used for stability reasons
ZTIMEC(:) = MIN( ZTIMEC(:), ZWORK1(:) )
!
! transform vertical velocity in mass flux units
ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG
END WHERE
END DO
!
!
WHERE( GWORK4(:,:) )
ZTHLC(:,:) = PTHL(:,:) ! reinitialize adjusted envir. values
PRWC(:,:) = PRW(:,:) ! when iteration criterium not attained
PRCC(:,:) = PRC(:,:)
PRIC(:,:) = PRI(:,:)
PTHC(:,:) = PTH(:,:)
END WHERE
!
!
! 6. Check for mass conservation, i.e. ZWORK1 > 1.E-2
! If mass is not conserved, the convective tendencies
! automatically become zero.
! ----------------------------------------------------
!
DO JI = 1, IIE
JK=KCTL(JI)
ZWORK1(JI) = PUDR(JI,JK) * PDPRES(JI,JK) / ( PLMASS(JI,JK) + .1 ) &
- PWSUB(JI,JK)
END DO
WHERE( GWORK1(:) .AND. ABS( ZWORK1(:) ) - .01 > 0. )
GWORK1(:) = .FALSE.
PTIMEC(:) = 1.E-1
ZTPR(:) = 0.
ZWORK5(:) = 0.
END WHERE
DO JK = IKB, IKE
PWSUB(:,JK) = PWSUB(:,JK) * ZWORK5(:)
ZPRLFLX(:,JK) = ZPRLFLX(:,JK) * ZWORK5(:)
ZPRSFLX(:,JK) = ZPRSFLX(:,JK) * ZWORK5(:)
END DO
GWORK4(:,1:IKB) = .FALSE.
GWORK4(:,IKS) = .FALSE.
!
ITSTEP(:) = INT( PTIMEC(:) / ZTIMEC(:) ) + 1
ZTIMEC(:) = PTIMEC(:) / REAL( ITSTEP(:) ) ! adjust fractional time step
! to be an integer multiple of PTIMEC
ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
ICOUNT(:) = 0
!
!
!
KFTSTEPS = MAXVAL( ITSTEP(:) )
DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop here
!
ICOUNT(:) = ICOUNT(:) + 1
!
GWORK3(:) = ITSTEP(:) >= ICOUNT(:) .AND. GWORK1(:)
!
!
!* 7. Assign enthalpy and r_w values at the top and bottom of each
! layer based on the sign of w
! ------------------------------------------------------------
!
ZTHMFIN(:,:) = 0.
ZRWMFIN(:,:) = 0.
ZRCMFIN(:,:) = 0.
ZRIMFIN(:,:) = 0.
ZTHMFOUT(:,:) = 0.
ZRWMFOUT(:,:) = 0.
ZRCMFOUT(:,:) = 0.
ZRIMFOUT(:,:) = 0.
!
DO JK = IKB + 1, JKMAX
GWORK4(:,JK) = GWORK3(:) .AND. JK <= KCTL(:)
JKP = MAX( IKB + 1, JK - 1 )
DO JI = 1, IIE
IF ( GWORK3(JI) ) THEN
!
ZWORK1(JI) = SIGN( 1., ZOMG(JI,JK) )
ZWORK2(JI) = 0.5 * ( 1. + ZWORK1(JI) )
ZWORK1(JI) = 0.5 * ( 1. - ZWORK1(JI) )
ZTHMFIN(JI,JK) = - ZOMG(JI,JK) * ZTHLC(JI,JKP) * ZWORK1(JI)
ZTHMFOUT(JI,JK) = ZOMG(JI,JK) * ZTHLC(JI,JK) * ZWORK2(JI)
ZTHMFIN(JI,JKP) = ZTHMFIN(JI,JKP) + ZTHMFOUT(JI,JK) * ZWORK2(JI)
ZTHMFOUT(JI,JKP) = ZTHMFOUT(JI,JKP) + ZTHMFIN(JI,JK) * ZWORK1(JI)
ZRWMFIN(JI,JK) = - ZOMG(JI,JK) * PRWC(JI,JKP) * ZWORK1(JI)
ZRWMFOUT(JI,JK) = ZOMG(JI,JK) * PRWC(JI,JK) * ZWORK2(JI)
ZRWMFIN(JI,JKP) = ZRWMFIN(JI,JKP) + ZRWMFOUT(JI,JK) * ZWORK2(JI)
ZRWMFOUT(JI,JKP) = ZRWMFOUT(JI,JKP) + ZRWMFIN(JI,JK) * ZWORK1(JI)
ZRCMFIN(JI,JK) = - ZOMG(JI,JK) * PRCC(JI,JKP) * ZWORK1(JI)
ZRCMFOUT(JI,JK) = ZOMG(JI,JK) * PRCC(JI,JK) * ZWORK2(JI)
ZRCMFIN(JI,JKP) = ZRCMFIN(JI,JKP) + ZRCMFOUT(JI,JK) * ZWORK2(JI)
ZRCMFOUT(JI,JKP) = ZRCMFOUT(JI,JKP) + ZRCMFIN(JI,JK) * ZWORK1(JI)
ZRIMFIN(JI,JK) = - ZOMG(JI,JK) * PRIC(JI,JKP) * ZWORK1(JI)
ZRIMFOUT(JI,JK) = ZOMG(JI,JK) * PRIC(JI,JK) * ZWORK2(JI)
ZRIMFIN(JI,JKP) = ZRIMFIN(JI,JKP) + ZRIMFOUT(JI,JK) * ZWORK2(JI)
ZRIMFOUT(JI,JKP) = ZRIMFOUT(JI,JKP) + ZRIMFIN(JI,JK) * ZWORK1(JI)
!
END IF
END DO
END DO
!
WHERE ( GWORK4(:,:) )
!
!******************************************************************************
!
!* 8. Update the environmental values of enthalpy and r_w at each level
! NOTA: These are the MAIN EQUATIONS of the scheme
! -----------------------------------------------------------------
!
!
ZTHLC(:,:) = ZTHLC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
ZTHMFIN(:,:) + PUDR(:,:) * PUTHL(:,:) + &
PDDR(:,:) * PDTHL(:,:) - ZTHMFOUT(:,:) - &
( PUER(:,:) + PDER(:,:) ) * PTHL(:,:) )
PRWC(:,:) = PRWC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
ZRWMFIN(:,:) + PUDR(:,:) * PURW(:,:) + &
PDDR(:,:) * PDRW(:,:) - ZRWMFOUT(:,:) - &
( PUER(:,:) + PDER(:,:) ) * PRW(:,:) )
PRCC(:,:) = PRCC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
ZRCMFIN(:,:) + PUDR(:,:) * PURC(:,:) - ZRCMFOUT(:,:) - &
( PUER(:,:) + PDER(:,:) ) * PRC(:,:) )
PRIC(:,:) = PRIC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * ( &
ZRIMFIN(:,:) + PUDR(:,:) * PURI(:,:) - ZRIMFOUT(:,:) - &
( PUER(:,:) + PDER(:,:) ) * PRI(:,:) )
!
!
!******************************************************************************
!
END WHERE
!
END DO ! Exit the fractional time step loop
!
!
!* 9. Allow frozen precipitation to melt over a 200 mb deep layer
! -----------------------------------------------------------
!
DO JK = JKMAX, IKB + 1, -1
ZTHLC(:,JK) = ZTHLC(:,JK) - &
ZPRMELT(:) * ZWORK6(:,JK) / MAX( XMELDPTH, ZMELDPTH(:) )
END DO
!
!
!* 10. Compute final linearized value of theta envir.
! ----------------------------------------------
!
DO JK = IKB + 1, JKMAX
DO JI = 1, IIE
IF( GWORK1(JI) .AND. JK <= KCTL(JI) ) THEN
ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
ZCPH(JI) = XCPD + PRWC(JI,JK) * XCPV
ZWORK2(JI) = PTH(JI,JK) / ZPI(JI) ! first temperature estimate
ZLV(JI) = XLVTT + ( XCPV - XCL ) * ( ZWORK2(JI) - XTT )
ZLS(JI) = XLVTT + ( XCPV - XCI ) * ( ZWORK2(JI) - XTT )
! final linearized temperature
ZWORK2(JI) = ( ZTHLC(JI,JK) + ZLV(JI) * PRCC(JI,JK) + ZLS(JI) * PRIC(JI,JK) &
- (1. + PRWC(JI,JK) ) * XG * PZ(JI,JK) ) / ZCPH(JI)
ZWORK2(JI) = MAX( 180., MIN( 340., ZWORK2(JI) ) )
PTHC(JI,JK)= ZWORK2(JI) * ZPI(JI) ! final adjusted envir. theta
END IF
END DO
END DO
!
!
!* 11. Compute new cloud ( properties at new LCL )
! NOTA: The computations are very close to
! that in routine TRIGGER_FUNCT
! ---------------------------------------------
!
CALL CONVECT_CLOSURE_THRVLCL( KLON, KLEV, &
PPRES, PTHC, PRWC, PZ, GWORK1, &
ZTHLCL, ZRVLCL, ZZLCL, ZTLCL, ZTELCL, &
ILCL, KDPL, KPBL )
!
!
ZTLCL(:) = MAX( 230., MIN( 335., ZTLCL(:) ) ) ! set some overflow bounds
ZTELCL(:) = MAX( 230., MIN( 335., ZTELCL(:) ) )
ZTHLCL(:) = MAX( 230., MIN( 345., ZTHLCL(:) ) )
ZRVLCL(:) = MAX( 0., MIN( 1., ZRVLCL(:) ) )
!
!
!* 12. Compute adjusted CAPE
! ---------------------
!
ZCAPE(:) = 0.
ZPI(:) = ZTHLCL(:) / ZTLCL(:)
ZPI(:) = MAX( 0.95, MIN( 1.5, ZPI(:) ) )
ZWORK1(:) = XP00 / ZPI(:) ** ZCPORD ! pressure at LCL
!
CALL CONVECT_SATMIXRATIO( KLON, ZWORK1, ZTELCL, ZWORK3, ZLV, ZLS, ZCPH )
ZWORK3(:) = MIN( .1, MAX( 0., ZWORK3(:) ) )
!
! compute theta_e updraft undilute
ZTHEUL(:) = ZTLCL(:) * ZPI(:) ** ( 1. - 0.28 * ZRVLCL(:) ) &
* EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) &
* ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
!jiao dilute updraft theta_e at lcl
ZUTHED1(:) = ZTHEUL(:)
!
! compute theta_e saturated environment at LCL
ZTHES1(:) = ZTELCL(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK3(:) ) &
* EXP( ( 3374.6525 / ZTELCL(:) - 2.5403 ) &
* ZWORK3(:) * ( 1. + 0.81 * ZWORK3(:) ) )
!
DO JK = MINVAL( ILCL(:) ), JKMAX
JKP = JK - 1
DO JI = 1, IIE
ZWORK4(JI) = 1.
IF ( JK == ILCL(JI) ) ZWORK4(JI) = 0.
!
! compute theta_e saturated environment and adjusted values
! of theta
!
GWORK3(JI) = JK >= ILCL(JI) .AND. JK <= KCTL(JI) .AND. GWORK1(JI)
!
ZPI(JI) = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
ZWORK2(JI) = PTHC(JI,JK) / ZPI(JI)
END DO
!
CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZWORK2, ZWORK3, ZLV, ZLS, ZCPH )
!
!
DO JI = 1, IIE
IF ( GWORK3(JI) ) THEN
ZTHES2(JI) = ZWORK2(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) ) &
* EXP( ( 3374.6525 / ZWORK2(JI) - 2.5403 ) &
* ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
!
ZWORK3(JI) = PZ(JI,JK) - PZ(JI,JKP) * ZWORK4(JI) - &
( 1. - ZWORK4(JI) ) * ZZLCL(JI) ! level thickness
ZWORK1(JI) = ( 2. * ZTHEUL(JI) ) / ( ZTHES1(JI) + ZTHES2(JI) ) - 1.
!jiao dilute beg--------------------------------------------
!calculate updraft dilute fraction using mass fluxes
ZUFR = (PUMF(JI,JKP)-PUDR(JI,JK))/(PUMF(JI,JKP)-PUDR(JI,JK)+PUER(JI,JK)+0.000001)
ZUFR = MAX(0.0, MIN(ZUFR,1.0) )
!update theta_e of updraft dilute
ZUTHED2(JI) = ZUTHED1(JI)*ZUFR + ZTHES2(JI)*(1.0-ZUFR)
!the bracket part in eq. (16.29) for calculating cape
ZWORK1(JI) = ( ZUTHED1(JI) + ZUTHED2(JI) ) / ( ZTHES1(JI) + ZTHES2(JI) ) - 1. !jiao bkf
!update theta_e for the next upper layer
ZUTHED1(JI) = ZUTHED2(JI)
!jiao dilute end--------------------------------------------
ZCAPE(JI) = ZCAPE(JI) + XG * ZWORK3(JI) * MAX( 0., ZWORK1(JI) )
ZTHES1(JI) = ZTHES2(JI)
END IF
END DO
END DO
!
!
!* 13. Determine mass adjustment factor knowing how much
! CAPE has been removed.
! -------------------------------------------------
!
WHERE ( GWORK1(:) )
ZWORK1(:) = MAX( PCAPE(:) - ZCAPE(:), 0.1 * PCAPE(:) )
ZWORK2(:) = ZCAPE(:) / ( PCAPE(:) + 1.E-8 )
!
GWORK1(:) = ZWORK2(:) > 0.1 .OR. ZCAPE(:) == 0. ! mask for adjustment
END WHERE
!
WHERE ( ZCAPE(:) == 0. .AND. GWORK1(:) ) ZADJ(:) = ZADJ(:) * 0.5
WHERE ( ZCAPE(:) /= 0. .AND. GWORK1(:) ) &
ZADJ(:) = ZADJ(:) * XSTABC * PCAPE(:) / ( ZWORK1(:) + 1.E-8 )
ZADJ(:) = MIN( ZADJ(:), ZADJMAX(:) )
!
!
!* 13. Adjust mass flux by the factor ZADJ to converge to
! specified degree of stabilization
! ----------------------------------------------------
!
CALL CONVECT_CLOSURE_ADJUST( KLON, KLEV, ZADJ, &
PUMF, ZUMF, PUER, ZUER, PUDR, ZUDR, &
PDMF, ZDMF, PDER, ZDER, PDDR, ZDDR, &
ZPRMELT, ZPRMELTO, PDTEVR, ZDTEVR, &
PTPR, ZTPR, &
PPRLFLX, ZPRLFLX, PPRSFLX, ZPRSFLX )
!
!
IF ( COUNT( GWORK1(:) ) == 0 ) EXIT ! exit big adjustment iteration loop
! when all columns have reached
! desired degree of stabilization.
!
END DO ! end of big adjustment iteration loop
!
!
! skip adj. total water array to water vapor
DO JK = IKB, IKE
PRWC(:,JK) = MAX( 0., PRWC(:,JK) - PRCC(:,JK) - PRIC(:,JK) )
END DO
!
! compute surface solid (ice) precipitation
PSPR(:) = ZPRMELT(:) * ( 1. - ZMELDPTH(:) / XMELDPTH )
PSPR(:) = MAX( 0., PSPR(:) )
!
!domi correction pcp < 0
PTPR(:) = MAX( PTPR(:) , PSPR(:) )
!fin correction domi
!
!
END SUBROUTINE CONVECT_CLOSURE
!-------------------------------------------------------------------------------
!
! #########################################################################
SUBROUTINE CONVECT_CLOSURE_ADJUST( KLON, KLEV, PADJ, & 1,1
PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR, &
PDMF, PZDMF, PDER, PZDER, PDDR, PZDDR, &
PPRMELT, PZPRMELT, PDTEVR, PZDTEVR, &
PTPR, PZTPR, &
PPRLFLX, PZPRLFL, PPRSFLX, PZPRSFL )
! #########################################################################
!
!!**** Uses closure adjustment factor to adjust mass flux and to modify
!! precipitation efficiency when necessary. The computations are
!! similar to routine CONVECT_PRECIP_ADJUST.
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to adjust the mass flux using the
!! factor PADJ computed in CONVECT_CLOSURE
!!
!!
!!** METHOD
!! ------
!! Computations are done at every model level starting from bottom.
!! The use of masks allows to optimise the inner loops (horizontal loops).
!!
!!
!! EXTERNAL
!! --------
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! None
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!!
!! None
!!
!! REFERENCE
!! ---------
!!
!! Book1,2 of documentation ( routine CONVECT_CLOSURE_ADJUST)
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 26/03/96
!! Last modified 04/10/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CONVPAREXT
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
REAL, DIMENSION(KLON), INTENT(IN) :: PADJ ! mass adjustment factor
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDMF ! initial value of "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDER ! initial value of "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDDR ! initial value of "
REAL, DIMENSION(KLON), INTENT(INOUT):: PTPR ! total precipitation (kg/s)
REAL, DIMENSION(KLON), INTENT(INOUT):: PZTPR ! initial value of "
REAL, DIMENSION(KLON), INTENT(INOUT):: PDTEVR ! donwndraft evapor. (kg/s)
REAL, DIMENSION(KLON), INTENT(INOUT):: PZDTEVR ! initial value of "
REAL, DIMENSION(KLON), INTENT(INOUT):: PPRMELT ! melting of precipitation
REAL, DIMENSION(KLON), INTENT(INOUT):: PZPRMELT ! initial value of "
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRLFLX! liquid precip flux
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRLFL! initial value "
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PPRSFLX! solid precip flux
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT) :: PZPRSFL! initial value "
!
!
!* 0.2 Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE ! horiz. + vert. loop bounds
INTEGER :: JK ! vertical loop index
!
!
!-------------------------------------------------------------------------------
!
!* 0.3 Compute loop bounds
! -------------------
!
IIE = KLON
IKB = 1 + JCVEXB
IKE = KLEV - JCVEXT
!
!
!* 1. Adjust mass flux by the factor PADJ to converge to
! specified degree of stabilization
! ----------------------------------------------------
!
PPRMELT(:) = PZPRMELT(:) * PADJ(:)
PDTEVR(:) = PZDTEVR(:) * PADJ(:)
PTPR(:) = PZTPR(:) * PADJ(:)
!
DO JK = IKB + 1, IKE
PUMF(:,JK) = PZUMF(:,JK) * PADJ(:)
PUER(:,JK) = PZUER(:,JK) * PADJ(:)
PUDR(:,JK) = PZUDR(:,JK) * PADJ(:)
PDMF(:,JK) = PZDMF(:,JK) * PADJ(:)
PDER(:,JK) = PZDER(:,JK) * PADJ(:)
PDDR(:,JK) = PZDDR(:,JK) * PADJ(:)
PPRLFLX(:,JK) = PZPRLFL(:,JK) * PADJ(:)
PPRSFLX(:,JK) = PZPRSFL(:,JK) * PADJ(:)
END DO
!
END SUBROUTINE CONVECT_CLOSURE_ADJUST
!
!-------------------------------------------------------------------------------
!
! ######################################################################
SUBROUTINE CONVECT_CLOSURE_THRVLCL( KLON, KLEV, & 2,5
PPRES, PTH, PRV, PZ, OWORK1, &
PTHLCL, PRVLCL, PZLCL, PTLCL, PTELCL,&
KLCL, KDPL, KPBL )
! ######################################################################
!
!!**** Determine thermodynamic properties at new LCL
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine the thermodynamic
!! properties at the new lifting condensation level LCL
!!
!!
!!
!!** METHOD
!! ------
!! see CONVECT_TRIGGER_FUNCT
!!
!!
!!
!! EXTERNAL
!! --------
!! Routine CONVECT_SATMIXRATIO
!!
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XG ! gravity constant
!! XP00 ! Reference pressure
!! XRD, XRV ! Gaz constants for dry air and water vapor
!! XCPD ! Cpd (dry air)
!! XTT ! triple point temperature
!! XBETAW, XGAMW ! constants for vapor saturation pressure
!!
!! Module MODD_CONVPAR
!! XA25 ! reference grid area
!! XZLCL ! lowest allowed pressure difference between
!! ! surface and LCL
!! XZPBL ! minimum mixed layer depth to sustain convection
!! XWTRIG ! constant in vertical velocity trigger
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! REFERENCE
!! ---------
!!
!! Book2 of documentation ( routine TRIGGER_FUNCT)
!! Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!! Original 07/11/95
!! Last modified 04/10/97
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH ! theta
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRV ! vapor mixing ratio
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ ! height of grid point (m)
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! contains vert. index of DPL
INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! " vert. index of source layer top
LOGICAL, DIMENSION(KLON), INTENT(IN) :: OWORK1! logical mask
!
REAL, DIMENSION(KLON), INTENT(OUT):: PTHLCL ! theta at LCL
REAL, DIMENSION(KLON), INTENT(OUT):: PRVLCL ! vapor mixing ratio at LCL
REAL, DIMENSION(KLON), INTENT(OUT):: PZLCL ! height at LCL (m)
REAL, DIMENSION(KLON), INTENT(OUT):: PTLCL ! temperature at LCL (m)
REAL, DIMENSION(KLON), INTENT(OUT):: PTELCL ! environm. temp. at LCL (K)
INTEGER, DIMENSION(KLON), INTENT(OUT):: KLCL ! contains vert. index of LCL
!
!* 0.2 Declarations of local variables :
!
INTEGER :: JK, JKM, JKMIN, JKMAX ! vertical loop index
INTEGER :: JI ! horizontal loop index
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
REAL :: ZEPS, ZEPSA ! R_d / R_v, R_v / R_d
REAL :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON) :: ZPLCL ! pressure at LCL
REAL, DIMENSION(KLON) :: ZTMIX ! mixed layer temperature
REAL, DIMENSION(KLON) :: ZEVMIX ! mixed layer water vapor pressure
REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
REAL, DIMENSION(KLON) :: ZDP ! pressure between LCL and model layer
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2 ! work arrays
!
!
!-------------------------------------------------------------------------------
!
!* 0.3 Compute array bounds
! --------------------
!
IIE = KLON
IKB = 1 + JCVEXB
IKE = KLEV - JCVEXT
!
!
!* 1. Initialize local variables
! --------------------------
!
ZEPS = XRD / XRV
ZEPSA = XRV / XRD
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
!
ZDPTHMIX(:) = 0.
ZPRESMIX(:) = 0.
PTHLCL(:) = 300.
PTLCL(:) = 300.
PTELCL(:) = 300.
PRVLCL(:) = 0.
PZLCL(:) = PZ(:,IKB)
ZTMIX(:) = 230.
ZPLCL(:) = 1.E4
KLCL(:) = IKB + 1
!
!
!* 2. Construct a mixed layer as in TRIGGER_FUNCT
! -------------------------------------------
!
JKMAX = MAXVAL( KPBL(:) )
JKMIN = MINVAL( KDPL(:) )
DO JK = IKB + 1, JKMAX
JKM = JK + 1
DO JI = 1, IIE
IF ( JK >= KDPL(JI) .AND. JK <= KPBL(JI) ) THEN
!
ZWORK1(JI) = PPRES(JI,JK) - PPRES(JI,JKM)
ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
PTHLCL(JI) = PTHLCL(JI) + PTH(JI,JK) * ZWORK1(JI)
PRVLCL(JI) = PRVLCL(JI) + PRV(JI,JK) * ZWORK1(JI)
!
END IF
END DO
END DO
!
!
WHERE ( OWORK1(:) )
!
ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
PTHLCL(:) = PTHLCL(:) / ZDPTHMIX(:)
PRVLCL(:) = PRVLCL(:) / ZDPTHMIX(:)
!
!* 3.1 Use an empirical direct solution ( Bolton formula )
! to determine temperature and pressure at LCL.
! Nota: the adiabatic saturation temperature is not
! equal to the dewpoint temperature
! --------------------------------------------------
!
!
ZTMIX(:) = PTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP
ZEVMIX(:) = PRVLCL(:) * ZPRESMIX(:) / ( PRVLCL(:) + ZEPS )
ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
ZWORK1(:) = LOG( ZEVMIX(:) / 613.3 )
! dewpoint temperature
ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) )
! adiabatic saturation temperature
PTLCL(:) = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT ) &
- 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
PTLCL(:) = MIN( PTLCL(:), ZTMIX(:) )
ZPLCL(:) = XP00 * ( PTLCL(:) / PTHLCL(:) ) ** ZCPORD
!
END WHERE
!
ZPLCL(:) = MIN( 2.E5, MAX( 10., ZPLCL(:) ) ) ! bound to avoid overflow
!
!
!* 3.2 Correct PTLCL in order to be completely consistent
! with MNH saturation formula
! --------------------------------------------------
!
CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, PTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
WHERE( OWORK1(:) )
ZWORK2(:) = ZWORK1(:) / PTLCL(:) * ( XBETAW / PTLCL(:) - XGAMW ) ! dr_sat/dT
ZWORK2(:) = ( ZWORK1(:) - PRVLCL(:) ) / &
( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
PTLCL(:) = PTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
!
END WHERE
!
!
!* 3.3 If PRVLCL is oversaturated set humidity and temperature
! to saturation values.
! -------------------------------------------------------
!
CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
WHERE( OWORK1(:) .AND. PRVLCL(:) > ZWORK1(:) )
ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
ZWORK2(:) = ( ZWORK1(:) - PRVLCL(:) ) / &
( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
PTLCL(:) = ZTMIX(:) + ZLV(:) / ZCPH(:) * ZWORK2(:)
PRVLCL(:) = PRVLCL(:) - ZWORK2(:)
ZPLCL(:) = ZPRESMIX(:)
PTHLCL(:) = PTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
END WHERE
!
!
!* 4.1 Determine vertical loop index at the LCL
! -----------------------------------------
!
DO JK = JKMIN, IKE - 1
DO JI = 1, IIE
IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. OWORK1(JI) ) THEN
KLCL(JI) = JK + 1
PZLCL(JI) = PZ(JI,JK+1)
END IF
END DO
END DO
!
!
!* 4.2 Estimate height and environmental temperature at LCL
! ----------------------------------------------------
!
DO JI = 1, IIE
JK = KLCL(JI)
JKM = JK - 1
ZDP(JI) = LOG( ZPLCL(JI) / PPRES(JI,JKM) ) / &
LOG( PPRES(JI,JK) / PPRES(JI,JKM) )
ZWORK1(JI) = PTH(JI,JK) * ( PPRES(JI,JK) / XP00 ) ** ZRDOCP
ZWORK2(JI) = PTH(JI,JKM) * ( PPRES(JI,JKM) / XP00 ) ** ZRDOCP
ZWORK1(JI) = ZWORK2(JI) + ( ZWORK1(JI) - ZWORK2(JI) ) * ZDP(JI)
! we compute the precise value of the LCL
! The precise height is between the levels KLCL and KLCL-1.
ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
END DO
WHERE( OWORK1(:) )
PTELCL(:) = ZWORK1(:)
PZLCL(:) = ZWORK2(:)
END WHERE
!
!
!
END SUBROUTINE CONVECT_CLOSURE_THRVLCL
!
!
!-------------------------------------------------------------------------------
!
! #######################################################################
SUBROUTINE CONVECT_CHEM_TRANSPORT( KLON, KLEV, KCH, PCH1, PCH1C, & 2,2
KDPL, KPBL, KLCL, KCTL, KLFS, KDBL, &
PUMF, PUER, PUDR, PDMF, PDER, PDDR, &
PTIMEC, PDXDY, PMIXF, PLMASS, PWSUB,&
KFTSTEPS )
! #######################################################################
!
!!**** Compute modified chemical tracer values due to convective event
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine the final adjusted
!! environmental values of the chemical tracers
!! The final convective tendencies can then be evaluated in the main
!! routine DEEP_CONVECT by (PCH1C-PCH1)/PTIMEC
!!
!!
!!** METHOD
!! ------
!! Identical to the computation of the conservative variables in the
!! main deep convection code
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XG ! gravity constant
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!!
!! Original 11/12/97
!!
!-------------------------------------------------------------------------------
!
!* 0. DECLARATIONS
! ------------
!
USE MODD_CSTS
USE MODD_CONVPAREXT
!
IMPLICIT NONE
!
!* 0.1 Declarations of dummy arguments :
!
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
INTEGER, INTENT(IN) :: KCH ! number of passive tracers
!
REAL,DIMENSION(KLON,KLEV,KCH),INTENT(IN) :: PCH1 ! grid scale tracer concentr.
REAL,DIMENSION(KLON,KLEV,KCH),INTENT(OUT):: PCH1C! conv adjusted tracer concntr.
!
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDBL ! index for downdraft base level
!
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUMF ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUER ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUDR ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDMF ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDER ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDDR ! downdraft detrainment (kg/s)
!
REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC! convection time step
REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! mixed fraction at LFS
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PLMASS! mass of model layer (kg)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PWSUB ! envir. compensating subsidence(Pa/s)
INTEGER, INTENT(IN) :: KFTSTEPS ! maximum fractional time steps
!
!
!* 0.2 Declarations of local variables :
!
INTEGER :: INCH1 ! number of chemical tracers
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
INTEGER :: IKS ! vertical dimension
INTEGER :: JI ! horizontal loop index
INTEGER :: JK, JKP ! vertical loop index
INTEGER :: JN ! chemical tracer loop index
INTEGER :: JSTEP ! fractional time loop index
INTEGER :: JKLC, JKLD, JKLP, JKMAX ! loop index for levels
!
REAL, DIMENSION(KLON,KLEV) :: ZOMG ! compensat. subsidence (Pa/s)
REAL, DIMENSION(KLON,KLEV,KCH) :: ZUCH1, ZDCH1 ! updraft/downdraft values
REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
REAL, DIMENSION(KLON,KLEV) :: ZTIMC! 2D work array for ZTIMEC
REAL, DIMENSION(KLON,KLEV,KCH) :: ZCH1MFIN, ZCH1MFOUT
! work arrays for environm. compensat. mass
REAL, DIMENSION(KLON,KCH) :: ZWORK1, ZWORK2, ZWORK3
!
!-------------------------------------------------------------------------------
!
!* 0.3 Compute loop bounds
! -------------------
!
INCH1 = KCH
IIE = KLON
IKB = 1 + JCVEXB
IKS = KLEV
IKE = KLEV - JCVEXT
JKMAX = MAXVAL( KCTL(:) )
!
!
!* 2. Updraft computations
! --------------------
!
ZUCH1(:,:,:) = 0.
!
!* 2.1 Initialization at LCL
! ----------------------------------
!
DO JI = 1, IIE
JKLC = KLCL(JI)
JKLD = KDPL(JI)
JKLP = KPBL(JI)
ZWORK1(JI,:) = .5 * ( PCH1(JI,JKLD,:) + PCH1(JI,JKLP,:) )
END DO
!
!* 2.2 Final updraft loop
! ------------------
!
DO JK = MINVAL( KDPL(:) ), JKMAX
JKP = JK + 1
!
DO JN = 1, INCH1
DO JI = 1, IIE
IF ( KDPL(JI) <= JK .AND. KLCL(JI) > JK ) &
ZUCH1(JI,JK,JN) = ZWORK1(JI,JN)
!
IF ( KLCL(JI) - 1 <= JK .AND. KCTL(JI) > JK ) THEN
ZUCH1(JI,JKP,JN) = ZUCH1(JI,JK,JN)
!if you have reactive i.e. non-passive tracers
! update their values here and add the corresponding
! sink term in the following equation
ZUCH1(JI,JKP,JN) = ( PUMF(JI,JK) * ZUCH1(JI,JK,JN) + &
PUER(JI,JKP) * PCH1(JI,JK,JN) ) / &
( PUMF(JI,JKP) + PUDR(JI,JKP) + 1.E-7 )
END IF
END DO
END DO
!
END DO
!
!* 3. Downdraft computations
! ----------------------
!
ZDCH1(:,:,:) = 0.
!
!* 3.1 Initialization at the LFS
! -------------------------
!
ZWORK1(:,:) = SPREAD( PMIXF(:), DIM=2, NCOPIES=INCH1 )
DO JI = 1, IIE
JK = KLFS(JI)
ZDCH1(JI,JK,:) = ZWORK1(JI,:) * PCH1(JI,JK,:) + &
( 1. - ZWORK1(JI,:) ) * ZUCH1(JI,JK,:)
END DO
!
!* 3.2 Final downdraft loop
! --------------------
!
DO JK = MAXVAL( KLFS(:) ), IKB + 1, -1
JKP = JK - 1
DO JN = 1, INCH1
DO JI = 1, IIE
IF ( JK <= KLFS(JI) .AND. JKP >= KDBL(JI) ) THEN
ZDCH1(JI,JKP,JN) = ( ZDCH1(JI,JK,JN) * PDMF(JI,JK) - &
PCH1(JI,JK,JN) * PDER(JI,JKP) ) / &
( PDMF(JI,JKP) - PDDR(JI,JKP) - 1.E-7 )
END IF
END DO
END DO
END DO
!
!
!* 4. Final closure (environmental) computations
! ------------------------------------------
!
PCH1C(:,IKB:IKE,:) = PCH1(:,IKB:IKE,:) ! initialize adjusted envir. values
!
DO JK = IKB, IKE
ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG ! environmental subsidence
END DO
!
ZTIMEC(:) = PTIMEC(:) / REAL( KFTSTEPS ) ! adjust fractional time step
! to be an integer multiple of PTIMEC
WHERE ( PTIMEC(:) < 1. ) ZTIMEC(:) = 0.
ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
!
ZCH1MFIN(:,:,:) = 0.
ZCH1MFOUT(:,:,:) = 0.
!
DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop
!
DO JK = IKB + 1, JKMAX
JKP = MAX( IKB + 1, JK - 1 )
ZWORK3(:,:) = SPREAD( ZOMG(:,JK), DIM=2, NCOPIES=INCH1 )
ZWORK1(:,:) = SIGN( 1., ZWORK3(:,:) )
ZWORK2(:,:) = 0.5 * ( 1. + ZWORK1(:,:) )
ZWORK1(:,:) = 0.5 * ( 1. - ZWORK1(:,:) )
ZCH1MFIN(:,JK,:) = - ZWORK3(:,:) * PCH1C(:,JKP,:) * ZWORK1(:,:)
ZCH1MFOUT(:,JK,:) = ZWORK3(:,:) * PCH1C(:,JK,:) * ZWORK2(:,:)
ZCH1MFIN(:,JKP,:) = ZCH1MFIN(:,JKP,:) + ZCH1MFOUT(:,JK,:) * ZWORK2(:,:)
ZCH1MFOUT(:,JKP,:)= ZCH1MFOUT(:,JKP,:) + ZCH1MFIN(:,JK,:) * ZWORK1(:,:)
END DO
!
DO JN = 1, INCH1
DO JK = IKB + 1, JKMAX
PCH1C(:,JK,JN) = PCH1C(:,JK,JN) + ZTIMC(:,JK) / PLMASS(:,JK) * ( &
ZCH1MFIN(:,JK,JN) + PUDR(:,JK) * ZUCH1(:,JK,JN) + &
PDDR(:,JK) * ZDCH1(:,JK,JN) - ZCH1MFOUT(:,JK,JN) - &
( PUER(:,JK) + PDER(:,JK) ) * PCH1(:,JK,JN) )
PCH1C(:,JK,JN) = MAX( 0., PCH1C(:,JK,JN) )
END DO
END DO
!
END DO ! Exit the fractional time step loop
!
!
END SUBROUTINE CONVECT_CHEM_TRANSPORT
!
!
!----------------------------------------------------------------------------
! ######################################################################
SUBROUTINE CONVECT_UV_TRANSPORT( KLON, KLEV, PU, PV, PUC, PVC, & 1,3
KDPL, KPBL, KLCL, KCTL, KLFS, KDBL, &
PUMF, PUER, PUDR, PDMF, PDER, PDDR, &
PTIMEC, PDXDY, PMIXF, PLMASS, PWSUB,&
KFTSTEPS )
! ######################################################################
!!**** Compute modified horizontal wind components due to convective event
!!
!!
!! PURPOSE
!! -------
!! The purpose of this routine is to determine convective adjusted
!! horizontal wind components u and v
!! The final convective tendencies can then be evaluated in the main
!! routine DEEP_CONVECT by (PUC-PU)/PTIMEC
!!
!!
!!** METHOD
!! ------
!! Identical to the computation of the conservative variables in the
!! tracer routine but includes pressure term
!!
!! EXTERNAL
!! --------
!!
!! IMPLICIT ARGUMENTS
!! ------------------
!! Module MODD_CSTS
!! XG ! gravity constant
!!
!! Module MODD_CONVPAREXT
!! JCVEXB, JCVEXT ! extra levels on the vertical boundaries
!!
!! AUTHOR
!! ------
!! P. BECHTOLD * Laboratoire d'Aerologie *
!!
!! MODIFICATIONS
!! -------------
!!
!! Original 11/02/02
!!
!-------------------------------------------------------------------------------
!* 0. DECLARATIONS
! ------------
USE MODD_CSTS
USE MODD_CONVPAR
USE MODD_CONVPAREXT
IMPLICIT NONE
!* 0.1 Declarations of dummy arguments :
INTEGER, INTENT(IN) :: KLON ! horizontal dimension
INTEGER, INTENT(IN) :: KLEV ! vertical dimension
REAL,DIMENSION(KLON,KLEV),INTENT(IN) :: PU ! horizontal wind in x (m/s)
REAL,DIMENSION(KLON,KLEV),INTENT(IN) :: PV ! horizontal wind in x (m/s)
REAL,DIMENSION(KLON,KLEV),INTENT(OUT):: PUC ! convective adjusted value of u (m/s)
REAL,DIMENSION(KLON,KLEV),INTENT(OUT):: PVC ! convective adjusted value of v (m/s)
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL ! index for departure level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL ! index for top of source layer
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL ! index lifting condens. level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL ! index for cloud top level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS ! index for level of free sink
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDBL ! index for downdraft base level
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUMF ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUER ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUDR ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDMF ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDER ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDDR ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON), INTENT(IN) :: PTIMEC! convection time step
REAL, DIMENSION(KLON), INTENT(IN) :: PDXDY ! grid area (m^2)
REAL, DIMENSION(KLON), INTENT(IN) :: PMIXF ! mixed fraction at LFS
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PLMASS! mass of model layer (kg)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PWSUB ! envir. compensating subsidence(Pa/s)
INTEGER, INTENT(IN) :: KFTSTEPS ! maximum fractional time steps
!* 0.2 Declarations of local variables :
INTEGER :: IIE, IKB, IKE ! horizontal + vertical loop bounds
INTEGER :: IKS ! vertical dimension
INTEGER :: JI ! horizontal loop index
INTEGER :: JK, JKP ! vertical loop index
INTEGER :: JSTEP ! fractional time loop index
INTEGER :: JKLD, JKLP, JKMAX ! loop index for levels
INTEGER, PARAMETER :: IUV = 2 ! for u and v
REAL, DIMENSION(KLON,KLEV) :: ZOMG ! compensat. subsidence (Pa/s)
REAL, DIMENSION(KLON,KLEV,IUV) :: ZUUV, ZDUV ! updraft/downdraft values
REAL, DIMENSION(KLON) :: ZTIMEC ! fractional convective time step
REAL, DIMENSION(KLON,KLEV) :: ZTIMC ! 2D work array for ZTIMEC
REAL, DIMENSION(KLON,KLEV,IUV) :: ZUVMFIN, ZUVMFOUT
! work arrays for environm. compensat. mass
REAL, DIMENSION(KLON,IUV) :: ZWORK1, ZWORK2, ZWORK3
!-------------------------------------------------------------------------------
!* 0.3 Compute loop bounds
! -------------------
IIE = KLON
IKB = 1 + JCVEXB
IKS = KLEV
IKE = KLEV - JCVEXT
JKMAX = MAXVAL( KCTL(:) )
!* 2. Updraft computations
! --------------------
ZUUV(:,:,:) = 0.0
!* 2.1 Initialization at LCL
! ----------------------------------
DO JI = 1, IIE
JKLD = KDPL(JI)
JKLP = KPBL(JI)
ZWORK1(JI,1) = 0.5 * ( PU(JI,JKLD) + PU(JI,JKLP) )
ZWORK1(JI,2) = 0.5 * ( PV(JI,JKLD) + PV(JI,JKLP) )
ENDDO
!* 2.2 Final updraft loop
! ------------------
DO JK = MINVAL( KDPL(:) ), JKMAX
JKP = JK + 1
DO JI = 1, IIE
IF ( KDPL(JI) <= JK .AND. KLCL(JI) > JK ) THEN
ZUUV(JI,JK,1) = ZWORK1(JI,1)
ZUUV(JI,JK,2) = ZWORK1(JI,2)
END IF
IF ( KLCL(JI) - 1 <= JK .AND. KCTL(JI) > JK ) THEN
! instead of passive tracers equations
! wind equations also include pressure term
ZUUV(JI,JKP,1) = ( PUMF(JI,JK) * ZUUV(JI,JK,1) + &
& PUER(JI,JKP) * PU(JI,JK) ) / &
& ( PUMF(JI,JKP) + PUDR(JI,JKP) + 1.E-7 ) + &
& XUVDP * ( PU(JI,JKP) - PU(JI,JK) )
ZUUV(JI,JKP,2) = ( PUMF(JI,JK) * ZUUV(JI,JK,2) + &
& PUER(JI,JKP) * PV(JI,JK) ) / &
& ( PUMF(JI,JKP) + PUDR(JI,JKP) + 1.E-7 ) + &
& XUVDP * ( PV(JI,JKP) - PV(JI,JK) )
ENDIF
ENDDO
ENDDO
!* 3. Downdraft computations
! ----------------------
ZDUV(:,:,:) = 0.0
!* 3.1 Initialization at the LFS
! -------------------------
ZWORK1(:,:) = SPREAD( PMIXF(:), DIM=2, NCOPIES=IUV )
DO JI = 1, IIE
JK = KLFS(JI)
ZDUV(JI,JK,1) = ZWORK1(JI,1) * PU(JI,JK) + &
& ( 1.0 - ZWORK1(JI,1) ) * ZUUV(JI,JK,1)
ZDUV(JI,JK,2) = ZWORK1(JI,2) * PV(JI,JK) + &
& ( 1.0 - ZWORK1(JI,2) ) * ZUUV(JI,JK,2)
ENDDO
!* 3.2 Final downdraft loop
! --------------------
DO JK = MAXVAL( KLFS(:) ), IKB + 1, -1
JKP = JK - 1
DO JI = 1, IIE
IF ( JK <= KLFS(JI) .AND. JKP >= KDBL(JI) ) THEN
ZDUV(JI,JKP,1) = ( ZDUV(JI,JK,1) * PDMF(JI,JK) - &
& PU(JI,JK) * PDER(JI,JKP) ) / &
& ( PDMF(JI,JKP) - PDDR(JI,JKP) - 1.E-7 ) + &
& XUVDP * ( PU(JI,JKP) - PU(JI,JK) )
ZDUV(JI,JKP,2) = ( ZDUV(JI,JK,2) * PDMF(JI,JK) - &
& PV(JI,JK) * PDER(JI,JKP) ) / &
& ( PDMF(JI,JKP) - PDDR(JI,JKP) - 1.E-7 ) + &
& XUVDP * ( PV(JI,JKP) - PV(JI,JK) )
ENDIF
ENDDO
ENDDO
!* 4. Final closure (environmental) computations
! ------------------------------------------
PUC(:,IKB:IKE) = PU(:,IKB:IKE) ! initialize adjusted envir. values
PVC(:,IKB:IKE) = PV(:,IKB:IKE) ! initialize adjusted envir. values
DO JK = IKB, IKE
ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG ! environmental subsidence
ENDDO
ZTIMEC(:) = PTIMEC(:) / REAL( KFTSTEPS ) ! adjust fractional time step
! to be an integer multiple of PTIMEC
WHERE ( PTIMEC(:) < 1.0 ) ZTIMEC(:) = 0.0
ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
ZUVMFIN(:,:,:) = 0.0
ZUVMFOUT(:,:,:) = 0.0
DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop
DO JK = IKB + 1, JKMAX
JKP = MAX( IKB + 1, JK - 1 )
DO JI = 1, IIE
IF ( JK <= KCTL(JI) ) THEN
ZWORK3(JI,1) = ZOMG(JI,JK)
ZWORK1(JI,1) = SIGN( 1.0, ZWORK3(JI,1) )
ZWORK2(JI,1) = 0.5 * ( 1.0 + ZWORK1(JI,1) )
ZWORK1(JI,1) = 0.5 * ( 1.0 - ZWORK1(JI,1) )
ZUVMFIN(JI,JK,1) = - ZWORK3(JI,1) * PUC(JI,JKP) * ZWORK1(JI,1)
ZUVMFOUT(JI,JK,1) = ZWORK3(JI,1) * PUC(JI,JK) * ZWORK2(JI,1)
ZUVMFIN(JI,JK,2) = - ZWORK3(JI,1) * PVC(JI,JKP) * ZWORK1(JI,1)
ZUVMFOUT(JI,JK,2) = ZWORK3(JI,1) * PVC(JI,JK) * ZWORK2(JI,1)
ZUVMFIN(JI,JKP,1) = ZUVMFIN(JI,JKP,1) + ZUVMFOUT(JI,JK,1) * ZWORK2(JI,1)
ZUVMFIN(JI,JKP,2) = ZUVMFIN(JI,JKP,2) + ZUVMFOUT(JI,JK,2) * ZWORK2(JI,1)
ZUVMFOUT(JI,JKP,1)= ZUVMFOUT(JI,JKP,1)+ ZUVMFIN(JI,JK,1) * ZWORK1(JI,1)
ZUVMFOUT(JI,JKP,2)= ZUVMFOUT(JI,JKP,2)+ ZUVMFIN(JI,JK,2) * ZWORK1(JI,1)
END IF
END DO
END DO
DO JK = IKB + 1, JKMAX
DO JI = 1, IIE
IF ( JK <= KCTL(JI) ) THEN
PUC(JI,JK) = PUC(JI,JK) + ZTIMC(JI,JK) / PLMASS(JI,JK) * ( &
& ZUVMFIN(JI,JK,1) + PUDR(JI,JK) * ZUUV(JI,JK,1) + &
& PDDR(JI,JK) * ZDUV(JI,JK,1) - ZUVMFOUT(JI,JK,1) - &
& ( PUER(JI,JK) + PDER(JI,JK) ) * PU(JI,JK) )
PVC(JI,JK) = PVC(JI,JK) + ZTIMC(JI,JK) / PLMASS(JI,JK) * ( &
& ZUVMFIN(JI,JK,2) + PUDR(JI,JK) * ZUUV(JI,JK,2) + &
& PDDR(JI,JK) * ZDUV(JI,JK,2) - ZUVMFOUT(JI,JK,2) - &
& ( PUER(JI,JK) + PDER(JI,JK) ) * PV(JI,JK) )
END IF
END DO
END DO
ENDDO ! Exit the fractional time step loop
END SUBROUTINE CONVECT_UV_TRANSPORT
!
!----------------------------------------------------------------------------