#include <misc.h>#include <params.h>module moistconvection!! Moist convection. Primarily data used by both Zhang-McFarlane convection! and Hack shallow convective schemes.!! $Id: moistconvection.F90,v 1.1.4.3 2002/04/22 19:10:05 erik Exp $!   use precision, only: r8   implicit none   private   save!! Public interfaces!   public mfinti   !  Initialization of data for moist convection   public cmfmca   !  Hack shallow convection!! Public Data for moist convection!   real(r8), public :: cp          ! specific heat of dry air   real(r8), public :: grav        ! gravitational constant          real(r8), public :: rgrav       ! reciprocal of grav   real(r8), public :: rgas        ! gas constant for dry air   integer, public :: limcnv       ! top interface level limit for convection!! Private data used for Hack shallow convection!   real(r8) :: hlat        ! latent heat of vaporization   real(r8) :: c0          ! rain water autoconversion coefficient   real(r8) :: betamn      ! minimum overshoot parameter   real(r8) :: rhlat       ! reciprocal of hlat   real(r8) :: rcp         ! reciprocal of cp   real(r8) :: cmftau      ! characteristic adjustment time scale   real(r8) :: rhoh2o      ! density of liquid water (STP)   real(r8) :: dzmin       ! minimum convective depth for precipitation   real(r8) :: tiny        ! arbitrary small num used in transport estimates   real(r8) :: eps         ! convergence criteria (machine dependent)   real(r8) :: tpmax       ! maximum acceptable t perturbation (degrees C)   real(r8) :: shpmax      ! maximum acceptable q perturbation (g/g)              integer :: iloc         ! longitude location for diagnostics   integer :: jloc         ! latitude  location for diagnostics   integer :: nsloc        ! nstep for which to produce diagnostics!   logical :: rlxclm       ! logical to relax column versus cloud tripletcontainssubroutine mfinti (rair    ,cpair   ,gravit  ,latvap  ,rhowtr  )!----------------------------------------------------------------------- ! ! Purpose: ! Initialize moist convective mass flux procedure common block, cmfmca! ! Method: ! <Describe the algorithm(s) used in the routine.> ! <Also include any applicable external references.> ! ! Author: J. Hack! !-----------------------------------------------------------------------   use pmgrid, only: plev, plevp, masterproc#include <comhyb.h>!------------------------------Arguments--------------------------------!! Input arguments!   real(r8), intent(in) :: rair              ! gas constant for dry air   real(r8), intent(in) :: cpair             ! specific heat of dry air   real(r8), intent(in) :: gravit            ! acceleration due to gravity   real(r8), intent(in) :: latvap            ! latent heat of vaporization   real(r8), intent(in) :: rhowtr            ! density of liquid water (STP)   integer k              ! vertical level index!!-----------------------------------------------------------------------!! Initialize physical constants for moist convective mass flux procedure!   cp     = cpair         ! specific heat of dry air   hlat   = latvap        ! latent heat of vaporization   grav   = gravit        ! gravitational constant   rgas   = rair          ! gas constant for dry air   rhoh2o = rhowtr        ! density of liquid water (STP)!! Initialize free parameters for moist convective mass flux procedure!   c0     = 1.0e-4        ! rain water autoconversion coeff (1/m)   dzmin  = 0.0           ! minimum cloud depth to precipitate (m)   betamn = 0.10          ! minimum overshoot parameter   cmftau = 3600.         ! characteristic adjustment time scale!! Limit convection to regions below 40 mb!   if (hypi(1) >= 4.e3) then      limcnv = 1   else      do k=1,plev         if (hypi(k) < 4.e3 .and. hypi(k+1) >= 4.e3) then            limcnv = k            goto 10         end if      end do      limcnv = plevp   end if10 continue   if (masterproc) then      write(6,*)'MFINTI: Convection will be capped at intfc ',limcnv, &                ' which is ',hypi(limcnv),' pascals'   end if   tpmax  = 1.50          ! maximum acceptable t perturbation (deg C)   shpmax = 1.50e-3       ! maximum acceptable q perturbation (g/g)   rlxclm = .true.        ! logical variable to specify that relaxation!                                time scale should applied to column as!                                opposed to triplets individually!! Initialize miscellaneous (frequently used) constants!   rhlat  = 1.0/hlat      ! reciprocal latent heat of vaporization   rcp    = 1.0/cp        ! reciprocal specific heat of dry air   rgrav  = 1.0/grav      ! reciprocal gravitational constant!! Initialize diagnostic location information for moist convection scheme!   iloc   = 1             ! longitude point for diagnostic info   jloc   = 1             ! latitude  point for diagnostic info   nsloc  = 1             ! nstep value at which to begin diagnostics!! Initialize other miscellaneous parameters!   tiny   = 1.0e-36       ! arbitrary small number (scalar transport)   eps    = 1.0e-13       ! convergence criteria (machine dependent)!   returnend subroutine mfintisubroutine cmfmca(lchnk   ,ncol    , &                  nstep   ,ztodt     ,pmid    ,pdel    , &                  rpdel   ,zm      ,tpert   ,qpert   ,phis    , &                  pblht   ,t       ,q       ,cmfdt   ,dq      , &                  cmfmc   ,cmfdqr  ,cmfsl   ,cmflq   ,precc   , &                  qc      ,cnt     ,cnb     ,icwmr   )!----------------------------------------------------------------------- ! ! Purpose: ! Moist convective mass flux procedure:! ! Method: ! If stratification is unstable to nonentraining parcel ascent,! complete an adjustment making successive use of a simple cloud model! consisting of three layers (sometimes referred to as a triplet)!! Code generalized to allow specification of parcel ("updraft")! properties, as well as convective transport of an arbitrary! number of passive constituents (see q array).  The code! is written so the water vapor field is passed independently! in the calling list from the block of other transported! constituents, even though as currently designed, it is the! first component in the constituents field.! ! Author: J. Hack!! BAB: changed code to report tendencies in cmfdt and dq, instead of! updating profiles. Cmfdq contains water only, made it a local variable! made dq (all constituents) the argument.! !-----------------------------------------------------------------------!#######################################################################!#                                                                     #!# Debugging blocks are marked this way for easy identification        #!#                                                                     #!#######################################################################   use tracers,   only: pcnst, pnats   use ppgrid,    only: pcols, pver, pverp   use phys_grid, only: get_lat_all_p, get_lon_all_p   use wv_saturation, only: aqsatd, vqsatd   real(r8) ssfac               ! supersaturation bound (detrained air)   parameter (ssfac = 1.001)!------------------------------Arguments--------------------------------!! Input arguments!   integer, intent(in) :: lchnk                ! chunk identifier   integer, intent(in) :: ncol                 ! number of atmospheric columns   integer, intent(in) :: nstep                ! current time step index   real(r8), intent(in) :: ztodt               ! 2 delta-t (seconds)   real(r8), intent(in) :: pmid(pcols,pver)    ! pressure   real(r8), intent(in) :: pdel(pcols,pver)    ! delta-p   real(r8), intent(in) :: rpdel(pcols,pver)   ! 1./pdel   real(r8), intent(in) :: zm(pcols,pver)      ! height abv sfc at midpoints   real(r8), intent(in) :: tpert(pcols)        ! PBL perturbation theta   real(r8), intent(in) :: qpert(pcols,pcnst+pnats)  ! PBL perturbation specific humidity   real(r8), intent(in) :: phis(pcols)         ! surface geopotential   real(r8), intent(in) :: pblht(pcols)        ! PBL height (provided by PBL routine)   real(r8), intent(in) :: t(pcols,pver)       ! temperature (t bar)   real(r8), intent(in) :: q(pcols,pver,pcnst+pnats) ! specific humidity (sh bar)!! Output arguments!   real(r8), intent(out) :: cmfdt(pcols,pver)   ! dt/dt due to moist convection   real(r8), intent(out) :: cmfmc(pcols,pver )  ! moist convection cloud mass flux   real(r8), intent(out) :: cmfdqr(pcols,pver)  ! dq/dt due to convective rainout   real(r8), intent(out) :: cmfsl(pcols,pver )  ! convective lw static energy flux   real(r8), intent(out) :: cmflq(pcols,pver )  ! convective total water flux   real(r8), intent(out) :: precc(pcols)        ! convective precipitation rate   real(r8), intent(out) :: qc(pcols,pver)      ! dq/dt due to rainout terms   real(r8), intent(out) :: cnt(pcols)          ! top level of convective activity   real(r8), intent(out) :: cnb(pcols)          ! bottom level of convective activity   real(r8), intent(out) :: dq(pcols,pver,pcnst+pnats) ! constituent tendencies   real(r8), intent(out) :: icwmr(pcols,pver)!!---------------------------Local workspace-----------------------------!   real(r8) cmfdq(pcols,pver)   ! dq/dt due to moist convection   real(r8) gam(pcols,pver)     ! 1/cp (d(qsat)/dT)   real(r8) sb(pcols,pver)      ! dry static energy (s bar)   real(r8) hb(pcols,pver)      ! moist static energy (h bar)   real(r8) shbs(pcols,pver)    ! sat. specific humidity (sh bar star)   real(r8) hbs(pcols,pver)     ! sat. moist static energy (h bar star)   real(r8) shbh(pcols,pverp)   ! specific humidity on interfaces   real(r8) sbh(pcols,pverp)    ! s bar on interfaces   real(r8) hbh(pcols,pverp)    ! h bar on interfaces   real(r8) cmrh(pcols,pverp)   ! interface constituent mixing ratio   real(r8) prec(pcols)         ! instantaneous total precipitation   real(r8) dzcld(pcols)        ! depth of convective layer (m)   real(r8) beta(pcols)         ! overshoot parameter (fraction)   real(r8) betamx(pcols)       ! local maximum on overshoot   real(r8) eta(pcols)          ! convective mass flux (kg/m^2 s)   real(r8) etagdt(pcols)       ! eta*grav*dt   real(r8) cldwtr(pcols)       ! cloud water (mass)   real(r8) rnwtr(pcols)        ! rain water  (mass)   real(r8) sc  (pcols)         ! dry static energy   ("in-cloud")   real(r8) shc (pcols)         ! specific humidity   ("in-cloud")   real(r8) hc  (pcols)         ! moist static energy ("in-cloud")   real(r8) cmrc(pcols)         ! constituent mix rat ("in-cloud")   real(r8) dq1(pcols)          ! shb  convective change (lower lvl)   real(r8) dq2(pcols)          ! shb  convective change (mid level)   real(r8) dq3(pcols)          ! shb  convective change (upper lvl)   real(r8) ds1(pcols)          ! sb   convective change (lower lvl)   real(r8) ds2(pcols)          ! sb   convective change (mid level)   real(r8) ds3(pcols)          ! sb   convective change (upper lvl)   real(r8) dcmr1(pcols)        ! q convective change (lower lvl)   real(r8) dcmr2(pcols)        ! q convective change (mid level)   real(r8) dcmr3(pcols)        ! q convective change (upper lvl)   real(r8) estemp(pcols,pver)  ! saturation vapor pressure (scratch)   real(r8) vtemp1(2*pcols)     ! intermediate scratch vector   real(r8) vtemp2(2*pcols)     ! intermediate scratch vector   real(r8) vtemp3(2*pcols)     ! intermediate scratch vector   real(r8) vtemp4(2*pcols)     ! intermediate scratch vector   integer indx1(pcols)     ! longitude indices for condition true   logical etagt0           ! true if eta > 0.0   real(r8) sh1                 ! dummy arg in qhalf statement func.   real(r8) sh2                 ! dummy arg in qhalf statement func.   real(r8) shbs1               ! dummy arg in qhalf statement func.   real(r8) shbs2               ! dummy arg in qhalf statement func.   real(r8) cats                ! modified characteristic adj. time   real(r8) rtdt                ! 1./ztodt   real(r8) qprime              ! modified specific humidity pert.   real(r8) tprime              ! modified thermal perturbation   real(r8) pblhgt              ! bounded pbl height (max[pblh,1m])   real(r8) fac1                ! intermediate scratch variable   real(r8) shprme              ! intermediate specific humidity pert.   real(r8) qsattp              ! sat mix rat for thermally pert PBL parcels   real(r8) dz                  ! local layer depth   real(r8) temp1               ! intermediate scratch variable   real(r8) b1                  ! bouyancy measure in detrainment lvl   real(r8) b2                  ! bouyancy measure in condensation lvl   real(r8) temp2               ! intermediate scratch variable   real(r8) temp3               ! intermediate scratch variable   real(r8) g                   ! bounded vertical gradient of hb   real(r8) tmass               ! total mass available for convective exch   real(r8) denom               ! intermediate scratch variable   real(r8) qtest1              ! used in negative q test (middle lvl)   real(r8) qtest2              ! used in negative q test (lower lvl)   real(r8) fslkp               ! flux lw static energy (bot interface)   real(r8) fslkm               ! flux lw static energy (top interface)   real(r8) fqlkp               ! flux total water (bottom interface)   real(r8) fqlkm               ! flux total water (top interface)   real(r8) botflx              ! bottom constituent mixing ratio flux   real(r8) topflx              ! top constituent mixing ratio flux   real(r8) efac1               ! ratio q to convectively induced chg (btm lvl)   real(r8) efac2               ! ratio q to convectively induced chg (mid lvl)   real(r8) efac3               ! ratio q to convectively induced chg (top lvl)   real(r8) tb(pcols,pver)      ! working storage for temp (t bar)   real(r8) shb(pcols,pver)     ! working storage for spec hum (sh bar)   real(r8) adjfac              ! adjustment factor (relaxation related)   real(r8) rktp   real(r8) rk#if ( defined DIAGNS )!!  Following 7 real variables are used in diagnostics calculations!   real(r8) rh                  ! relative humidity   real(r8) es                  ! sat vapor pressure   real(r8) hsum1               ! moist static energy integral   real(r8) qsum1               ! total water integral   real(r8) hsum2               ! final moist static energy integral   real(r8) qsum2               ! final total water integral   real(r8) fac                 ! intermediate scratch variable#endif   integer i,k              ! longitude, level indices   integer ii               ! index on "gathered" vectors   integer len1             ! vector length of "gathered" vectors   integer m                ! constituent index   integer ktp              ! tmp indx used to track top of convective layer#if ( defined DIAGNS )   integer n                ! vertical index     (diagnostics)   integer kp               ! vertical index     (diagnostics)   integer kpp              ! index offset, kp+1 (diagnostics)   integer kpm1             ! index offset, kp-1 (diagnostics)   integer lat(pcols)       ! latitude indices   integer lon(pcols)       ! longitude indices#endif!!---------------------------Statement functions-------------------------!   real(r8) qhalf   qhalf(sh1,sh2,shbs1,shbs2) = min(max(sh1,sh2),(shbs2*sh1 + shbs1*sh2)/(shbs1+shbs2))!!-----------------------------------------------------------------------!** BAB initialize output tendencies here!       copy q to dq; use dq below for passive tracer transport   cmfdt(:ncol,:)  = 0.   cmfdq(:ncol,:)  = 0.   dq(:ncol,:,2:)  = q(:ncol,:,2:)   cmfmc(:ncol,:)  = 0.   cmfdqr(:ncol,:) = 0.   cmfsl(:ncol,:)  = 0.   cmflq(:ncol,:)  = 0.   qc(:ncol,:)     = 0.!