! Library:phys $Id: hlcondcv.F90 5391 2007-09-25 09:22:24Z xiaohua $

!options xopt(noeval)
 subroutine  hlcondcv (                               &
! scalars and logicals 
 &                     kcall,     khor,     klev,     &
 &                     kstart,    kstop,    kstep,    &
 &                     pdtime,    pconacc,  pdtheta,  &
! prognostic variables 
 &                     pu,        pv,       pt,       &
 &                     pq,        pcw,      pcice,    &  
 &                     pqampli,   ptke,               &
! diagnostic fields
 &                     ptotcov,   pahyb,    pbhyb,    & 
 &                     ppf,       pdpf,     pdqdtin,  &
! work arrays  
 &                     klabcv,    klabc,    klab,     & 
 &                     kindic,                        &
 &                     pzpsp,     pzldcp,   pztc,     &
 &                     pztcdif,   pzqc,     pzqcdif,  &
 &                     pzqp,      pztp,     pzcwp,    &
 &                     pzcicep,   pzwt,     pzedep,   &
 &                     pzqsat,    pzqsatc,  pzdqsdt,  &
 &                     pzrhu,     pzqmax,   pzqliq,   &
 &                     pzqac,     pzbfrac,  pzdift,   &
 &                     pzdifq,    pzscdif,  pzdifs,   &      
 &                     pzbu,      pzbuca,   pzdpcld,  &
 &                     pzdptot,   pzgpot,   pzdptop,  &
 &                     pzcptop,   pzcpcld,  pzten,    &
 &                     pztentop,  pztencld, pzqen,    &
 &                     pzqentop,  pzqencld, pzqcen,   &
 &                     pzqcetop,  pzqcecld, pzimfac,  &
 &                     pztet,     pzcoefh,            &
! fluxes/tendencies 
 &                     pdifcq,    pdifcql,  pdifcqn,  &
 &                     pdifcs,    pfccql,   pfccqn    )
!     ------------------------------------------------------------------
!     PURPOSE    Compute changes of temperature, specific humidity,
!     --------   specific cloud water and ice due to convective 
!                condensation processes. The closure is based on
!                moisture budget. Several convective 'entities' 
!                can be treated. First, convective labels 
!                ('klab' ,'klabc' and 'klabcv') are determined.
!     ------------------------------------------------------------------
!     INTERFACE  : subroutine 'condcv' is called from subroutine 'conds'
!     ------------
!     INPUT      :  (from argument list)
!     ------------
!       pdqdtin   input forcing specific humidity tendency from dynamics 
!                 and turbulence added together.  
!       pcw       specific cloud water content at current time
!       pcice     specific cloud ice at current time
!       pdpf      delta-p around 'full' level
!       ppf       pressure at 'full' levels
!       pztp      provisional value of temperature
!       pzcwp     provisional value of specific cloud water
!       klab      identifies potential convective 'entities', that is,
!                 a cluster of consecutive layers where air parcel
!                 lifting is buoyant.
!       klabc     is a label assigned a value of 1 in all convective layers
!                 of the convective entities that contain at least one 
!                 convective cloud layer, otherwise a label value of 0. 
!       klabcv    is a convective label. Layers with the same
!                 value of 'klab(jl,jk)' can only be accepted as
!                 convective. Convective cloud layers are first
!                 assigned a value of klabcv(jl,jk)=2, and a final
!                 value of 3. Convective sub-cloud layers are
!                 assigned a value of 1. New lifting levels
!                 however, are assigned a value of 4.
!       pzdift    weighting parameters for temperature change 
!       pztcdif   function involving temp. difference between cloud and env. 
!       pzdifq    weighting parameters for humidity 
!       pzqcdif   function involving humidity diff. between cloud and env. 
!       pzdifs    weighting parameters for cloud condensate
!       pzscdif   function involving condensate difference between cloud and env. 
!       pzqac     vertically integrated moisture convergence
!                 for the convective 'entity'.
!       pzdptot   total pressure thickness of convective 'entity'
!       pzdpcld   total pressure thickness of convective
!                'cloud entity'
!       pzbfrac   moisture partitioning parameter in the
!                 convection scheme
!       pzbu      averarage buoyancy '(tc -t)/t)' in the
!                 convective 'entity'
!       pzdptop   pressure thickness (Pa) of the top detrainment 
!                 zone of a convective entity where convective 
!                 buoyancy force is negative. 
!       pzcptop   vertical mean of the specific heat capacity 
!                 in the top detrainment zone (J/(kg K)).
!       pzcpcld   vertical mean of the specific heat capacity  
!                 in the convective cloud layers with a positive 
!                 buoyancy (J/(Kg K)). 
!       pzten     parameterized heat flux (W/m2) at the cloud
!                 top down to the cloud, as a result of mixing 
!                 warm dry air into the cloud. 
!       pztentop  Heating rate (K/s) in the top detrainment zone
!                 due to inflow of cloudy air from below.
!       pztencld  Heating rate (K/s) in the convective cloud layers
!                 due to the entrainment process of dry air above cloud. 
!       pzqen     parameterized flux of specific humidity 
!                 ( Kg w)/( m2 * s), at the convective cloud top  
!                 as a result of moisture exchange between the           
!                 active convective cloud and the detrainment zone.
!       pzqentop  Moistening rate (Kg water)/( Kg a * s) 
!                 in the detrainment zone due to the flux `wqen'.
!       pzqencld  Moistening rate (Kg water)/( Kg a * s) 
!                 in the convective cloud due to the flux `wqen'.
!       pzqcen    parameterized flux of specific cloud condensate 
!                 ( Kg w)/( m2 * s), at the convective cloud top
!                 as a result of moisture exchange between the
!                 active convective cloud and the detrainment zone.
!       pzqcetop  cloud condensate moistening rate
!                 (Kg water)/( Kg a * s)
!                 in the detrainment zone due to the flux `wqcen'.
!       pzqcecld  cloud condensate moistening rate 
!                 (Kg water)/( Kg a * s)
!                 in the convective cloud due to the flux `wqcen'.
!       pzimfac   factor designed for semi-implicit treatment
!                 of shallow convection effects.
!       pztet     potential temperature.
!       pzcoefh   coefficient for heat transport used in the 
!                 context of shallow convection. 
!     ------------
!     OUTPUT     :  ( new output or modified input) 
!     ------------
!       pzldcp(jl,jk)  (1/cp)*"latent heat" as a function of
!                      temperature by weighting in latent heat of
!                      freezing times probability of ice crystals
!       pzqsat(jl,jk)  saturation mixing ratio with respect to
!                      gridpoint temperature
!       pzdqsdt(jl,jk) derivative of saturation water vapour pressure
!                      with respect to temperature
!       pzqp           provisional value of specific humidity
!       pztp           provisional value of temperature
!       pzcwp          provisional value of specific cloud water
!       pzcicep        provisional value of specific ice
!       pzwt           total cloud condensate value
!       pztc           cloud parcel temperature
!       pzqc           cloud parcel specific humidity
!       pdifcs        convective temperature tendency associated with 
!                     transport processes
!                     (disregarding precipitation and condensation processes) 
!       pdifcq        convective specific humidity tendency associated with
!                     transport processes
!                     (disregarding precipitation and condensation processes)
!       pdifcql       convective tendency of liquid water associated with  
!                     transport processes
!                     (disregarding precipitation and condensation processes)  
!       pdifcqn       convective tendency of ice associated with  
!                     transport processes  
!                     (disregarding precipitation and sublimation processes) 
!       pfccql        convective tendency for specific humidity (normally negative)
!                     associated with the convective liquid water condensation
!                     (disregarding precipitation)
!       pfccqn        convective tendency for specific humidity (normally negative)
!                     associated with the convective ice condensation
!                     (disregarding precipitation)
!     ---------------------
!     EXTERNAL SUBROUTINES:  none
!     ---------------------     

!     AUTHOR:       Bent H. Sass, (DMI),
!     -------       based on research during the HIRLAM I-V projects.

!     MODIFICATIONS:   
!     --------------  
!     Original version for ALADIN/ARPEGE: 2004-08-31.

!     ================================================================
!     1. Declarations. 
!     ================================================================

!     1.1:  MODULES USED.

use parkind1  ,only : jpim,    jprb
use yomhook   ,only : lhook,   dr_hook
use yhlconst  ,only : pi,      latvap,      rair,         &
     &                cpair,   ccpq,        epsilo,       &        
     &                gravit,  tmelt,       latice,       &
     &                rearth 
use yhlcond   ,only : hdl,     tvirtc,      prbice,       &
     &                dttabl

!     1.2: OTHER DECLARATIONS.  

implicit none

integer(kind=jpim),  intent(in)    ::  kcall     
integer(kind=jpim),  intent(in)    ::  khor
integer(kind=jpim),  intent(in)    ::  klev
integer(kind=jpim),  intent(in)    ::  kstart
integer(kind=jpim),  intent(in)    ::  kstop
integer(kind=jpim),  intent(in)    ::  kstep 
real(kind=jprb)   ,  intent(in)    ::  pdtime
real(kind=jprb)   ,  intent(in)    ::  pconacc
real(kind=jprb)   ,  intent(in)    ::  pdtheta
real(kind=jprb)   ,  intent(in)    ::  pahyb(khor,klev+1)
real(kind=jprb)   ,  intent(in)    ::  pbhyb(khor,klev+1)
real(kind=jprb)   ,  intent(in)    ::  pt(khor,klev) 
real(kind=jprb)   ,  intent(in)    ::  pq(khor,klev) 
real(kind=jprb)   ,  intent(in)    ::  pdqdtin(khor,klev)
real(kind=jprb)   ,  intent(in)    ::  pcw(khor,klev)
real(kind=jprb)   ,  intent(in)    ::  pcice(khor,klev)
real(kind=jprb)   ,  intent(in)    ::  ppf(khor,klev)
real(kind=jprb)   ,  intent(in)    ::  pdpf(khor,klev) 
real(kind=jprb)   ,  intent(in)    ::  pu(khor,klev)
real(kind=jprb)   ,  intent(in)    ::  pv(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pqampli(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  ptke(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  ptotcov(khor,klev)

integer(kind=jpim),  intent(inout) ::  klabcv(khor,klev) 
integer(kind=jpim),  intent(inout) ::  klabc(khor,klev)
integer(kind=jpim),  intent(inout) ::  klab(khor,klev)
integer(kind=jpim),  intent(inout) ::  kindic(khor)

real(kind=jprb)   ,  intent(in)    ::  pzpsp(khor) 
real(kind=jprb)   ,  intent(inout) ::  pzldcp(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pztc(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pztcdif(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzqc(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzqcdif(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzqp(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pztp(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzcwp(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzcicep(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzwt(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzqsat(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzqsatc(khor)
real(kind=jprb)   ,  intent(inout) ::  pzdqsdt(khor)  
real(kind=jprb)   ,  intent(inout) ::  pzrhu(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzqmax(khor)
real(kind=jprb)   ,  intent(inout) ::  pzqliq(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzqac(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzbfrac(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzdift(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzdifq(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzscdif(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzdifs(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzbu(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzbuca(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzdpcld(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzdptot(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzgpot(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzdptop(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzcptop(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzcpcld(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzten(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pztentop(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pztencld(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzqen(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzqentop(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzqencld(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzqcen(khor,klev) 
real(kind=jprb)   ,  intent(inout) ::  pzqcetop(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzqcecld(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzimfac(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pztet(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzcoefh(khor,klev)
real(kind=jprb)   ,  intent(inout) ::  pzedep(khor)
real(kind=jprb)   ,  intent(inout) ::  pdifcs(khor, 0:klev)
real(kind=jprb)   ,  intent(inout) ::  pdifcq(khor, 0:klev)
real(kind=jprb)   ,  intent(inout) ::  pdifcql(khor,0:klev)
real(kind=jprb)   ,  intent(inout) ::  pdifcqn(khor,0:klev) 
real(kind=jprb)   ,  intent(inout) ::  pfccql(khor, 0:klev) 
real(kind=jprb)   ,  intent(inout) ::  pfccqn(khor, 0:klev) 

integer(kind=jpim)   ::  ilevm,  ilevp,              &
     &                   jk,      jl,      jkm1,     & 
     &                   jkp1,    jkp2,              &
     &                   iklab,   ikla,    jintt

real(kind=jprb)      ::  zcflxh, zcflxq,  zcvelo,    &
     &     zsqgra, zgrtet, zrdcp, zcpair, zcflxc,    &
     &     zdptop, zlimten, zlimqen, zlimwen, zcoef, &
     &     zcomax, zrest, zuv2, zfen, zfen1, zfen2,  &
     &     zfen3, zfrc2, zcenfac0, zcenfac1,         &
     &     zcenfac2, zidist, zdistfac, zdist,        &
     &     zdistcv, zcenfac3, zpa1, zpa2, ztparc,    &
     &     zqparc, zinvers

real(kind=jprb)      :: zpf, zpfp1, zsec, zpcr,      &
     &     ztvir, ztvirp, ztvirc, zqsat, zceva,      &
     &     zdift, zdifq, zdifq1, zt, zdifp, zqcd,    &
     &     zqcd1, zdgpot, zbucr, zcpi,               &
     &     zcev, zdpf, zc1,                          &
     &     zc2, zc3, zc4, zc5, zc6, zc7, ztunc,      &  
     &     zcc1, zcc2, zcc3, zcc4, zcc5, zcc6,       &
     &     zfrc1, zpardt, zmepsi, zresat, zkaccr,    &  
     &     zqpar, ztpar, zdelta, ztmp, zkaccr0,      & 
     &     zspar, zqcmax, zent, zepa,                &
     &     zrgrav,zidtime,zupdt,zupd,zupdq,zupdcw,   &
     &     zupdci,zdif

real(kind=jprb)      :: zdepfrac
real(kind=jprb)      :: zbetreso, zbethumi, zbetbuoy
real(kind=jprb)      :: ztem1, ztem2, ztem3
real(kind=jprb)      :: ztke
real(kind=jprb)      :: zed
real(kind=jprb)  ::   zhook_handle


real(kind=jprb)      :: zcevb, zcevc, zcevd
!     =============================================================
!     2. Initialize various constants and arrays including labels
!     =============================================================

!     2.1 local constants   
!     -------------------
!     'zceva'   is a coefficient for cloud water evaporation
!               reflecting the invese life time of convective 
!               clouds in the absence of a convective moisture 
!               source.
!     'zpardt'  air parcel initial excess temperature increment.
!     'zbucr'   is a threshold buoyancy that must be reached 
!               as a mean vertical buoyancy in the convective
!               'entities', in order for convective activity 
!               to be fully developed. 
!     'zkaccr'  tuning constant to control maximum convective
!               cloud depth as a function of moisture                
!               availability. 
!     'zqpar'   moistening parameter not available in the ECMWF
!               type of KUO convection scheme.
!     'ztpar'   heating parameter not available in the ECMWF
!               type of KUO convection scheme.
!     'zspar'   cloud condensate parameter similar to 'zqpar'
!               for specific humidity.
!     'zqcmax'  maximum value for cloud condensate in cloud          
!               ascent (tuning parameter)
!     'zpcr'    is a threshold value of the pressure thickness
!               of convective 'entities' to exceed.
!     'zcpi'    inverse of specific heat capacity
!     'zsec'    is a security constant.
!     'ztunc'   tuning constant to control numerical stability
!               in computing evaporation of cloud water.
!     'zfrc1'   absolute minimim specific cloud water 
!               allowed in the atmosphere.
!     'zcflxh'  flux coefficient for heat exchange 
!     'zcflxq'  flux coefficient for humidity exchange 
!     'zcflxc'  flux coefficient for cloud condensate exchange 
!     'zcvelo'  characteristic cloud parcel velocity at cloud top.
!     'zbetreso'resolution dependence of moistening parameter  
!     'zbethumi'effect of humidity subsat. on moistening param. 
!     'zbetbuoy'effect of buoyancy on moistening param. 
!     ============================================================
!     Include saturation table functions 

#include "hlesat.h"

      if (lhook) call dr_hook('hlcondcv',0,zhook_handle)

!     Initialize constants 
      zceva=0.35_JPRB
      zcevd=1.0_JPRB/(tmelt*tmelt)
      zpardt=1.0_JPRB
      ztunc=0.50_JPRB
      zbucr=0.0030_JPRB
      zkaccr=4.0E7_JPRB/pdtime
      zkaccr0=12500._JPRB
      zqpar=0.0_JPRB
      ztpar=0.0_JPRB
      zspar=0.0_JPRB
      zqcmax=0.0060_JPRB
      zrgrav=1._JPRB/gravit
      zidtime=1._JPRB/pdtime

!     Parameters used to describe resolution dependent 
!     'triggering' of convective temperature and moisture
!     increments. 

      zdist=pi*rearth*pdtheta/180._JPRB
      zdistfac=4000._JPRB
      zdistcv=4000._JPRB
      zidist=1.0_JPRB
      if( zdist < zdistfac ) zidist=zdistfac/zdist
      zinvers=1._JPRB/zdist
      zpa1=0.8859_JPRB
      zpa2=5.0_JPRB
      ztparc=0.75_JPRB/( zpa1 +zpa2*sqrt(zinvers) )
      zqparc=0.024_JPRB*sqrt(sqrt(zdist/zdistfac))
      zbetreso=sqrt( zdistcv/zdist )
      zbethumi=15.0E-3_JPRB
      zbetbuoy=0.00_JPRB 
      zcoef=0.15_JPRB
      zcomax=0.10_JPRB
      zcflxh=1.0_JPRB
      zcflxq=1.0_JPRB
      zcflxc=1.0_JPRB
      zcvelo=27._JPRB
      zed=10000._JPRB

!     Coefficients used to describe local dilution of convective
!     buoyant cloud parcel from lateral mixing.    

      zcenfac0=5.00E-4_JPRB
      zcenfac1=0.75E-3_JPRB
      zcenfac2=1.0E-4_JPRB
      zcenfac3=22500._JPRB
      zdepfrac=0.15_JPRB
      zlimten=300._JPRB
      zlimqen=1.2E-3_JPRB
      zlimwen=1.2E-3_JPRB
      zsqgra=sqrt(gravit)
      zrdcp=rair/cpair
      zsec=0.00001_JPRB
      zfrc1=1.0E-7_JPRB
      zfrc2=1.0E-8_JPRB

!     'zpcr' is a small value to garantee deactivation of
!     only 'partial weight' to convective updates.
!     This change is found very benefitial after
!     The introduction of 'moist CBR'.

      zpcr=10._JPRB
      zcpi=1._JPRB/cpair
      zmepsi=1._JPRB -epsilo

      ilevm=klev-1
      ilevp=klev+1

!     2.2 arrays 

      do jk=1,klev
        do jl=kstart,kstop
          klabcv(jl,jk)   =0
          klabc(jl,jk)    =0
          klab(jl,jk)     =0
          pzqac(jl,jk)    =0._JPRB
          pzdptot(jl,jk)  =0._JPRB
          pzdpcld(jl,jk)  =0._JPRB
          pzbfrac(jl,jk)  =0._JPRB
          pzbu(jl,jk)     =0._JPRB
          pzbuca(jl,jk)   =0._JPRB
          pzgpot(jl,jk)   =0._JPRB
          pztc(jl,jk)     =0._JPRB
          pztcdif(jl,jk)  =0._JPRB
          pzdift(jl,jk)   =0._JPRB
          pzdifq(jl,jk)   =0._JPRB
          pzscdif(jl,jk)  =0._JPRB
          pzdifs(jl,jk)   =0._JPRB
          pzqc(jl,jk)     =0._JPRB
          pzqcdif(jl,jk)  =0._JPRB
          pzqliq(jl,jk)   =0._JPRB
          pzwt(jl,jk)=pzcwp(jl,jk) +pzcicep(jl,jk)

!         Latent heat as a function of temperature.

          jintt = max(1, 1 + int((tmelt - pztp(jl,jk))/dttabl))
          jintt = min(jintt, 1750)
          pzldcp(jl,jk) = zcpi * (latvap + hdl &
     &                  * prbice(jintt))

!         Trivial initialization of variables connected to shallow 
!         convection.

          pzdptop(jl,jk)  =0._JPRB
          pzcptop(jl,jk)  =cpair
          pzcpcld(jl,jk)  =cpair
          pzten(jl,jk)    =0._JPRB
          pztentop(jl,jk) =0._JPRB
          pztencld(jl,jk) =0._JPRB
          pzqen(jl,jk)    =0._JPRB
          pzqentop(jl,jk) =0._JPRB
          pzqencld(jl,jk) =0._JPRB
          pzqcen(jl,jk)   =0._JPRB
          pzqcetop(jl,jk) =0._JPRB
          pzqcecld(jl,jk) =0._JPRB
          pzimfac(jl,jk)  =1._JPRB
          pzcoefh(jl,jk)  =0._JPRB
          pztet(jl,jk)    =pztp(jl,jk)*  &
     &    ( (ppf(jl,jk)/ 100000.) )**( -zrdcp )
        enddo 
      enddo 

      do jl=kstart,kstop
        pzqsatc(jl) =0._JPRB
        pzdqsdt(jl) =0._JPRB
        pzqmax(jl)  =0._JPRB
        pzedep(jl)  =0._JPRB
        kindic(jl)  =0
      enddo

      do jk=1,klev
        do jl=kstart,kstop
          pzqsat(jl,jk)=0._JPRB
        enddo 
      enddo 

!     =================================================================
!     3.  First step towards determining labels and arrays used in the
!         convective parameterization. This involves air parcel lifting.
!     'klab(jl,jk)'   identifies all model layers participating  
!                     in convection, including the top 'detraining' 
!                     layers where the convective cloud is negatively
!                     buoyant and the cloud is dissipating in the 
!                     stable environment. Model layers in the same 
!                     convective `entity' must have the same value 
!                     of this label `klab' counting the convective 
!                     entity . 
!     'klabcv(jl,jk)' is a convective label. Convective cloud layers 
!                     are first assigned a value of klabcv(jl,jk)=2,
!                     and possibly a final value of 3. Convective
!                     sub-cloud layers are assigned a value of 1.
!                    However, new lifting levels are assigned a
!                     value of 4. Finally the detraining cloud
!                     level(s) at top where the cloud is dissipating 
!                     has 'klabcv'=-1.
!     'klabc(jl,jk)'  is a label assigned a value of 1 in all convec-
!                     tive layers of the convective entities except
!                     the detraining top layers (with 'klabcv'=-1).
!                     A value of 0 for `klabc' is assigned for all
!                     layers that have not an assigned value of 1. 
!     ================================================================= 

      do jl=kstart,kstop
        ztke=0.5_jprb*( ptke(jl,klev) +ptke(jl,klev-1) )
        ztke=min( ztke, 5.0_jprb )
        pztc(jl,klev)=pztp(jl,klev) +ztparc*ztke

        zpf=0.5_jprb*( pahyb(jl,klev) +pahyb(jl,ilevp) +  &
     &  (pbhyb(jl,klev) +pbhyb(jl,ilevp))*pzpsp(jl) )
        zresat=1._jprb /pecor(zpf,pztc(jl,klev))
        zqsat=epsilo*esat(pztc(jl,klev))*zresat
        pzqc(jl,klev)=pzqp(jl,klev)*(1._JPRB +zqparc*ztke)
        pzqc(jl,klev)=min( pzqc(jl,klev), zqsat )
        pzqmax(jl)=pzqp(jl,klev)
        pzqliq(jl,klev)=0._jprb 
        zdifp=pzpsp(jl)*(1._jprb -pbhyb(jl,klev))  -pahyb(jl,klev)
        ztvir=pztp(jl,klev)*  &
     &  (1._jprb +tvirtc*pzqp(jl,klev) -pzcwp(jl,klev) -   &
     &  0.9_jprb*pzcicep(jl,klev))
        pzgpot(jl,klev)=log(pzpsp(jl)/(zpf +zsec))
        pzgpot(jl,klev)=rair*ztvir*pzgpot(jl,klev)

        klabcv(jl,klev)=4
        klab(jl,klev)=1

        pzdptot(jl,1)=2._jprb*(pzpsp(jl) -zpf)
        pzqac(jl,1)=zdifp*pzqp(jl,klev) -pdpf(jl,klev)*pq(jl,klev)
      enddo

      do jk=ilevm,2,-1
        jkp1=jk+1
        jkp2=jk+2

        do jl=kstart,kstop
          zpf=0.5_jprb*( pahyb(jl,jk) +pahyb(jl,jkp1) + &
     &           (pbhyb(jl,jk) +pbhyb(jl,jkp1))*pzpsp(jl) )
          zpfp1=0.5_jprb*( pahyb(jl,jkp1) +pahyb(jl,jkp2) + &
     &           (pbhyb(jl,jkp1) +pbhyb(jl,jkp2))*pzpsp(jl) )
          zdifp=pahyb(jl,jkp1) -pahyb(jl,jk) + &
     &          ( pbhyb(jl,jkp1) -pbhyb(jl,jk))*pzpsp(jl)
          ztvir=pztp(jl,jk)*(1._jprb +tvirtc*pzqp(jl,jk) - &
     &          pzcwp(jl,jk) -0.9_jprb*pzcicep(jl,jk))
          ztvirp=pztp(jl,jkp1)*  &
     &           (1._jprb +tvirtc*pzqp(jl,jkp1) - &
     &           pzcwp(jl,jkp1) -0.9_jprb*pzcicep(jl,jkp1) )
          pzgpot(jl,jk)=pzgpot(jl,jkp1) + rair*log(zpfp1/zpf)*  &      
     &                 0.5_jprb * (ztvirp + ztvir)

          jintt = max(1, 1 + int((tmelt - pztc(jl,jkp1))/dttabl))
          jintt = min(jintt, 1750)
          pzldcp(jl,jk) =(latvap + latice*  &  
     &                  prbice(jintt))/cpair

          zdgpot =pzgpot(jl,jkp1) - pzgpot(jl,jk)

          zresat=1._jprb/pecor(zpf,pztp(jl,jk)) 
          zqsat=epsilo*esat(pztp(jl,jk))*zresat 
          pzrhu(jl,jk)=pzqp(jl,jk)/zqsat
          pzrhu(jl,jk)=min(1.0_jprb, pzqp(jl,jk)/zqsat)

!         Do dry adiabatic lifting

          pztc(jl,jk)=pztc(jl,jkp1) + &
     &    pztc(jl,jkp1)*(1._jprb +tvirtc*pzqc(jl,jkp1) - &
     &    pzqliq(jl,jkp1))*  &
     &    zdgpot /(ztvirp*cpair )

!         Release latent heat during parcel lifting

          zresat=1._jprb /pecor(zpf,pztc(jl,jk))
          pzqsatc(jl)=epsilo*esat(pztc(jl,jk))*zresat
          pzqc(jl,jk)=pzqc(jl,jkp1) 
          pzqliq(jl,jk)=pzqliq(jl,jkp1) 

!         Determine fractional volume lateral entrainment 
!         leading to cloud 'dilution'. A dependency on a
!         local Richadson number is defined.          

          zuv2=(pu(jl,jk) -pu(jl,jkp1))*(pu(jl,jk) -pu(jl,jkp1)) +  &
     &         (pv(jl,jk) -pv(jl,jkp1))*(pv(jl,jk) -pv(jl,jkp1))
          ztvirc=pztc(jl,jk)*(1._jprb +tvirtc*pzqc(jl,jk) -  &
     &           pzqliq(jl,jk))
          zfen1=zcenfac1*gravit*pztet(jl,jk)*zuv2
          zfen2=-zdgpot*( -zcenfac2*zdgpot +  &
     &           gravit*abs( pztet(jl,jk) -pztet(jl,jkp1) ) ) 
          zfen2=max( zfen2, 0.00001_jprb )

!         The lateral volumetic entrainment factor 'zfen' is then
!         computed as the one applicable over one layer depth. 

          ztem1=zcenfac0 +zfen1/zfen2
          ztem2=(pzgpot(jl,jk)/zcenfac3)**2
          ztem3=ztem1*min( ztem2, 2.0_jprb )*zidist
          zfen3=ztem3*(-zdgpot)/gravit
          zfen=min( max( zfen3, zfrc2 ), 0.99_jprb )

!         Compute cloud parcel variables after cloud lateral
!         entrainment proces.

          pztc(jl,jk)=(1._jprb -zfen)*pztc(jl,jk) +zfen*pztp(jl,jk)
          pzqc(jl,jk)=(1._jprb -zfen)*pzqc(jl,jk) +zfen*pzqp(jl,jk)
       
!         Condensation checks and computations in parcel ascent.
!         (e.g., it is not certain that the air parcel is buoyant
!         after the lateral mixing process)

          zresat=1._jprb/ pecor(zpf,pztc(jl,jk))
          pzqsatc(jl)=epsilo*esat(pztc(jl,jk))*zresat
          zdifq=pzqc(jl,jk) -pzqsatc(jl)
          zt=pztc(jl,jk)
          pzdqsdt(jl)=epsilo*zpf*desdt(zt)*zresat*zresat
          zqcd=zdifq/(1._jprb +pzldcp(jl,jk)*pzdqsdt(jl))
          if( zqcd < 0._jprb ) then 
            zqcd=max( zqcd, -pzqliq(jl,jk) )
          endif 
            zrest=pzqliq(jl,jk) +zqcd

!         New cloud parcel humidity and temperature

          pzqc(jl,jk)=pzqc(jl,jk) -zqcd
          pztc(jl,jk)=pztc(jl,jk) +zqcd * pzldcp(jl,jk)

!         Adjust a second time towards cloud parcel saturation.

          if((zrest > 0._jprb).or.(zqcd > 0._jprb)) then 

            zresat=1._jprb /pecor(zpf,pztc(jl,jk)) 
            pzqsatc(jl)=epsilo*esat(pztc(jl,jk))*zresat
            zdifq1=pzqc(jl,jk) -pzqsatc(jl)
            zqcd1=zdifq1/(1._jprb +pzldcp(jl,jk)*pzdqsdt(jl))
   
            if( zqcd1 < 0._jprb)  zqcd1=max(  zqcd1, -zrest )
            pzqc(jl,jk)=pzqc(jl,jk) -zqcd1
            pztc(jl,jk)=pztc(jl,jk) +zqcd1 * pzldcp(jl,jk)

          else 

            zqcd1=0._jprb

          endif

!         Buoyancy check 

!         Update cloud parcel condensate as a result
!         of condensation and evaporation during
!         air parcel ascent. 

          pzqliq(jl,jk)=pzqliq(jl,jk) +zqcd +zqcd1
          pzqliq(jl,jk)=min( pzqliq(jl,jk), zqcmax )
          ztvirc=pztc(jl,jk)*(1._jprb +tvirtc*pzqc(jl,jk) - &
     &           pzqliq(jl,jk))
          zdift=ztvirc -ztvir

          pzbuca(jl,jk)=zdift/ztvirc 

!         ---------------------------------------------------------
!         Check if the convection can continue, i.e. the cloud
!         parcel should be positively buoyant.
!         It is also assumed that there is a maximum depth of a
!         convective entity depending on the available moisture
!         supply. This assumption regulates the interaction between 
!         turbulent transports and deep convection transports 
!         (parameter 'ztmp') 
!         ---------------------------------------------------------

          iklab=klab(jl,jkp1)

          ztmp=zkaccr*max( pzqac(jl,iklab), 0._jprb ) -  &
     &          pzdptot(jl,iklab) -zdifp +zkaccr0 
 
          if((zdift > 0._jprb).and.(ztmp > 0._jprb).and.  &
     &       (kindic(jl) == 0)) then
!         ======================================================
            pzqac(jl,iklab)=pzqac(jl,iklab) +  &
     &                     zdifp*pzqp(jl,jk) -pdpf(jl,jk)*pq(jl,jk)
            pzbu(jl,iklab)=pzbu(jl,iklab) +zdifp*zdift/ztvir
            pzdptot(jl,iklab)=pzdptot(jl,iklab) +zdifp

            klab(jl,jk)=klab(jl,jkp1)
            klabcv(jl,jk)=1

            pzdift(jl,jk)=ztvirc -ztvir +ztpar 
            pzdifq(jl,jk)=pzqc(jl,jk) -pzqp(jl,jk) +zqpar 
            pzdifq(jl,jk)=max( pzdifq(jl,jk),0._jprb )
            pzdifs(jl,jk)=pzqliq(jl,jk) +zspar 
            pzdifs(jl,jk)=max( pzdifs(jl,jk),0._jprb )

            if( zdifq > 0. ) then
!           -------------------------------------------------------
              klabcv(jl,jk)=2

              pztcdif(jl,iklab)=pztcdif(jl,iklab) +zdifp*pzdift(jl,jk)
              pzqcdif(jl,iklab)=pzqcdif(jl,iklab) +zdifp*pzdifq(jl,jk)
              pzscdif(jl,iklab)=pzscdif(jl,iklab) +zdifp*pzdifs(jl,jk)
              pzdpcld(jl,iklab)=pzdpcld(jl,iklab) +zdifp
              pzcpcld(jl,iklab)=pzcpcld(jl,iklab) +  &
     &                         zdifp*cpair*(1._jprb +ccpq*pq(jl,jk))
            endif
!           ------------------------------------------------------------
          else
!         ==============================================================

!           `pzedep' is the estimated mixing depth (in Pa) above 
!            the onset of the stable stratification of the 
!            detrainment zone.

            zgrtet=pztp(jl,jk)*gravit*( pztc(jl,jk) -pztc(jl,jkp1)  &
     &             -pztp(jl,jk) +pztp(jl,jkp1) )/  &
     &             ( pzgpot(jl,jk) -pzgpot(jl,jkp1) )

            zgrtet=min( zgrtet, -0.0005_jprb )

            zent=0.000001_jprb

            if( kindic(jl) == 0 )  then
!           --------------------------------------------------------
              zent=max( pzdift(jl,jkp1) -ztpar, 0.0_jprb)
              pzedep(jl)=zcvelo*zsqgra*ppf(jl,jk)*  &
     &        sqrt( abs( zent/(pztp(jl,jkp1)*zgrtet)) +  &
     &        0.000001_jprb )/rair
              pzedep(jl)=min( pzedep(jl), zed )
            endif 
!           --------------------------------------------------------
            kindic(jl)=1

            if( klabcv(jl,jkp1) == 2 ) then 
!           --------------------------------------------------------
!             Describe conditions in the detrainment mixing zone.

              klab(jl,jk)=klab(jl,jkp1)
              iklab=klab(jl,jk)
              pzdptop(jl,iklab)=pzdptop(jl,iklab) +pdpf(jl,jk) 

              zcpair=cpair*(1._jprb +ccpq*pq(jl,jk))
              pzcptop(jl,iklab)=pzcptop(jl,iklab) + &
     &                         zdifp*zcpair

!             Sensible heat flux (J/(m2 s))
!             ( at most a numerical value of 'zlimten' )
!             `zepa' is an estimated minimum velocity variance
!              due to the turbulent motions (double of a 
!              corresponding `tke').

              zepa=max( pzbuca(jl,jkp1), 0._jprb )
              pzcoefh(jl,jk)=zcoef*sqrt( zepa )
              pzcoefh(jl,jk)=min( pzcoefh(jl,jk), zcomax )

              pzten(jl,iklab)=pzcoefh(jl,jk)*zcpair*pzedep(jl)*  &
     &        (pztet(jl,jk) -pztet(jl,jkp1))/  &
     &        (pzgpot(jl,jk)-pzgpot(jl,jkp1))
              pzten(jl,iklab)=  &
     &        max( min( pzten(jl,iklab), zlimten), -zlimten )

!             Specific humidity flux (kg water/(m2 s))
!             ( at most a numerical value of 'zlimqen' ) 

              pzqen(jl,iklab)=zcflxq*pzcoefh(jl,jk)*pzedep(jl)* &
     &        (pzqp(jl,jk) -pzqp(jl,jkp1))/  &
     &        (pzgpot(jl,jk) -pzgpot(jl,jkp1))
              pzqen(jl,iklab)=  &
     &        max( min( pzqen(jl,iklab),zlimqen ), -zlimqen )

!             Specific cloud water flux (kg water/(m2 s))
!             ( at most a numerical value of 'zlimwen' )

              pzqcen(jl,iklab)=zcflxc*pzcoefh(jl,jk)*pzedep(jl)* &
     &        (pzwt(jl,jk) -pzwt(jl,jkp1))/  &
     &        (pzgpot(jl,jk) -pzgpot(jl,jkp1))
              pzqcen(jl,iklab)=  &
     &        max( min( pzqcen(jl,iklab),zlimwen ), -zlimwen )

!             compute first step of the semi-implicit 
!             factor 'wimfac'.

              pzimfac(jl,iklab)=0.5_jprb*ppf(jl,jk)*  &
     &        gravit*pzedep(jl)/(rair*pztp(jl,jk)*pdpf(jl,jk))

              klabcv(jl,jk)=-1
!           ----------------------------------------------------
            endif 

            zdptop=pzdptop(jl,iklab)

!      NB!  it assumed that /= means "non equal to" 

            if( (klabcv(jl,jkp1) /= 2).and.  &
     &      (pzedep(jl) > zdptop +pdpf(jl,jk)) ) then
!           ----------------------------------------------------
              if( klabcv(jl,jkp1) == -1 ) then
                klab(jl,jk)=klab(jl,jkp1)
                klabcv(jl,jk)=-1  
                iklab=klab(jl,jk)
                pzdptop(jl,iklab)=pzdptop(jl,iklab) +pdpf(jl,jk)
                pzcptop(jl,iklab)=pzcptop(jl,iklab) +  &
     &          zdifp*cpair*(1._jprb +ccpq*pzqc(jl,jk))
              endif  

              if( klabcv(jl,jkp1) /= -1 ) then 

!               Prepare for finding new convective entities

                ztke=0.50_jprb*( ptke(jl,jk) + ptke(jl,jk-1) )
                ztke=min( ztke, 5.0_jprb )
                pztc(jl,jk)=pztp(jl,jk) +ztparc*ztke

                zpf=ppf(jl,jk)
                zresat=1._jprb /pecor(zpf,pztc(jl,jk))
                zqsat=epsilo*esat(pztc(jl,jk))*zresat
                pzqc(jl,jk)=pzqp(jl,jk)*(1._jprb +zqparc*ztke)
                pzqc(jl,jk)=min( pzqc(jl,jk), zqsat )
                pzqmax(jl)=pzqp(jl,jk)
                pzqliq(jl,jk)=0.0_jprb
                klabcv(jl,jk)=4
                ikla=klab(jl,jkp1)+1
                klab(jl,jk)=ikla
                pztcdif(jl,ikla)=0._JPRB
                pzqcdif(jl,ikla)=0._JPRB
                pzscdif(jl,ikla)=0._JPRB

                pzqac(jl,ikla)=  &
     &          zdifp*pzqp(jl,jk) -pdpf(jl,jk)*pq(jl,jk)

                pzbu(jl,ikla)    =0._jprb
                pzdptot(jl,ikla) =zdifp
                pzdpcld(jl,ikla) =0._jprb

                pzdptop(jl,ikla) =0._jprb
                pzcptop(jl,ikla) =cpair
                pzcpcld(jl,ikla) =cpair
                pzten(jl,ikla)   =0._jprb
                pzqen(jl,ikla)   =0._jprb
                pzqcen(jl,ikla)  =0._jprb
                pzimfac(jl,ikla) =1._jprb
                pzedep(jl)       =0._jprb
                kindic(jl)       =0
!           ----------------------------------------------------
              endif
            endif 
!           ----------------------------------------------------
             if( (klabcv(jl,jkp1) /= 2).and.  &
     &        (pzedep(jl) <= zdptop +pdpf(jl,jk)) ) then
!           ----------------------------------------------------

!             Prepare for finding new convective entities

              ztke=0.50_jprb*( ptke(jl,jk) +ptke(jl,jk-1) ) 
              ztke=min( ztke, 5.0_jprb )
              pztc(jl,jk)=pztp(jl,jk) +ztparc*ztke 
              zpf=ppf(jl,jk)
              zresat=1._jprb/pecor(zpf,pztc(jl,jk))
              zqsat=epsilo*esat(pztc(jl,jk))*zresat

              pzqc(jl,jk)=pzqp(jl,jk)*(1._jprb +zqparc*ztke)
              pzqc(jl,jk)=min( pzqc(jl,jk), zqsat )
              pzqmax(jl)=pzqp(jl,jk)
              pzqliq(jl,jk)=0._jprb
              klabcv(jl,jk)=4
              ikla=klab(jl,jkp1)+1
              klab(jl,jk)=ikla
              pztcdif(jl,ikla)=0._jprb
              pzqcdif(jl,ikla)=0._jprb
              pzscdif(jl,ikla)=0._jprb
              pzqac(jl,ikla)=zdifp*pzqp(jl,jk) -pdpf(jl,jk)*pq(jl,jk)
              pzbu(jl,ikla)   =0._jprb
              pzdptot(jl,ikla)=zdifp
              pzdpcld(jl,ikla)=0._jprb

              pzdptop(jl,ikla)=0._jprb
              pzcptop(jl,ikla)=cpair
              pzcpcld(jl,ikla)=cpair
              pzten(jl,ikla)  =0._jprb
              pzqen(jl,ikla)  =0._jprb
              pzqcen(jl,ikla) =0._jprb
              pzimfac(jl,ikla)=1._jprb
              pzedep(jl)      =0._jprb 
              kindic(jl)      =0
!           -------------------------------------------------------------
            endif
!         ===============================================================
          endif 
!         ===============================================================
        enddo
      enddo
!     ===================================================================
!     4.  Last steps towards determining labels and arrays used in the
!         convective parameterization. The model layers are investigated 
!         `from top to bottom'
!         (*) Some re-arrangement of the label values of 'klabcv' is  
!             enabled in order to make the vertical structure of 
!             convective clouds coherent (the value of klabcv is in
!             some cases changed from 1 to 2). 
!         (*) Then a value `klabcv=3' can be assigned to the top cloud  
!             layer of a convective entity provided that

!            i) 'klabcv' has already been assigned a value of 2 
!           ii) the vertical integral of moisture accession over 
!               the entire convective entity is positive 

!         If the top cloud layer convective label 'klabcv' is set to 3 
!         the convective indicator 'klabc' is set to 1, which means 
!         that the convective entity is finally classified as being active.

!     (*) Secondly, the label 'klabcv' is adjusted to a value of 3 in other
!         layers below the cloud top provided that the appropriate
!         conditions are met as mentioned above for the top layer.
!     (*) Thirdly it is assured that all layers below the detrainment
!          zone of the convective entity have a value `klabc'=1. 
!     ====================================================================
!        The label 'klabcv' above a level with a value of 
!        2 should also be 2 and not +1 which may happen 
!        in rare circumstances. 

      do jk=1,ilevm-1
        jkp1=jk+1
        do jl=kstart,kstop
          if( (klabcv(jl,jk) == 1).and.   &
     &    (klabcv(jl,jkp1) == 2) ) then

            klabcv(jl,jk)=2

            iklab=klab(jl,jk)
            zdifp=pahyb(jl,jkp1) -pahyb(jl,jk) +  &
     &      ( pbhyb(jl,jkp1) -pbhyb(jl,jk) )*pzpsp(jl)

            pztcdif(jl,iklab)=pztcdif(jl,iklab) +zdifp*pzdift(jl,jk)    
            pzqcdif(jl,iklab)=pzqcdif(jl,iklab) +zdifp*pzdifq(jl,jk)
            pzscdif(jl,iklab)=pzscdif(jl,iklab) +zdifp*pzdifs(jl,jk)
            pzdpcld(jl,iklab)=pzdpcld(jl,iklab) +zdifp
            pzcpcld(jl,iklab)=pzcpcld(jl,iklab) +  & 
     &                       zdifp*cpair*(1. +ccpq*pq(jl,jk))
          endif
        enddo
      enddo

!        Close to saturation it is assumed that some convective 
!        clouds will be formed, that is, above the threshold 
!        relative humidity for stratiform condensation

      do jk=2,ilevm 
        jkm1=jk-1
        jkp1=jk+1
        do jl=kstart,kstop
          ztmp=1._jprb -pqampli(jl,jk)
          if( (klabcv(jl,jk) == 1).and. &
     &        (pzrhu(jl,jk) > ztmp) ) then

          klabcv(jl,jk)=2

          iklab=klab(jl,jk) 
          zdifp=pahyb(jl,jkp1) -pahyb(jl,jk) +  &
     &          (pbhyb(jl,jkp1) -pbhyb(jl,jk))*pzpsp(jl)
          pztcdif(jl,iklab)=pztcdif(jl,iklab) +zdifp*pzdift(jl,jk)    
          pzqcdif(jl,iklab)=pzqcdif(jl,iklab) +zdifp*pzdifq(jl,jk)
          pzscdif(jl,iklab)=pzscdif(jl,iklab) +zdifp*pzdifs(jl,jk)
          pzdpcld(jl,iklab)=pzdpcld(jl,iklab) +zdifp
          pzcpcld(jl,iklab)=pzcpcld(jl,iklab) +  &
     &                     zdifp*cpair*(1._jprb +ccpq*pq(jl,jk))
          endif
        enddo 
      enddo

      do jk=2,klev
        jkm1=jk-1
        do jl=kstart,kstop
!       -------------------------------------------
          iklab=klab(jl,jk)
          ztmp=pzdpcld(jl,iklab)/(pzdptot(jl,iklab) +zsec)
          if( (klabcv(jl,jkm1) == -1).and. &
     &        (klabcv(jl,jk) == 2).and.    &
     &        ( ztmp > zdepfrac ).and.     &
     &        (pzqac(jl,iklab) > 0._jprb ) ) then 

             klabcv(jl,jk)=3
             klabc(jl,jk)=1 
             pdifcq(jl,jk)=pdifcq(jl,jk) -1._jprb*pdqdtin(jl,jk)

          endif

          if( (klab(jl,jk) == klab(jl,jkm1)).and. &
     &        (klabc(jl,jkm1) == 1) ) then

            klabc(jl,jk)=1
            pdifcq(jl,jk)=pdifcq(jl,jk) -1._jprb*pdqdtin(jl,jk)

          endif

          if( (klabcv(jl,jk) == 2).and.  &
     &      (klabcv(jl,jkm1) == 3).and.  &
     &      (pzqac(jl,iklab) > 0._jprb)   ) then

            klabcv(jl,jk)=3

!           Update also pdifcq in the line below ? (new 200506)

            pdifcq(jl,jk)=pdifcq(jl,jk) -1._jprb*pdqdtin(jl,jk)    

          endif

        enddo
      enddo

      do jk=2,klev
        jkm1=jk-1
        do jl=kstart,kstop

          if( (klabcv(jl,jkm1) == -1).and. &
     &    (klabcv(jl,jk) > 1) ) then
!           -------------------------------------------------------
!           do final computation of convective work arrays
!           for traditional convection based on a moisture
!           budget closure.
!           i) buoyancy 'pzbu' is averaged over all layers 
!              including convective sub-cloud layers)
!           ii) other parameters are to be averaged  
!               over the total convective cloud depth. 
!           Computation of moistening parameter 'wbfrac'
!           ('beta'-parameter in KUO-type of schemes). 
!           It is noted that this parameter is difficult 
!           to parameterize. 
!           Currently 'wbfrac' is parametrized only as a function
!           of model resolution. Experience shows that for synop-
!           tic scale resolutions alamost all moisture accession 
!           should be condensed to clouds (condensate in clouds
!           can re-evaporate before precipitation release). 
!           According to Braham (1952) more than 50 percent of 
!           moisture supply to small thunder storms do condense
!           into the clouds. The formula below respects these
!           experiences, but increases moistening as the model 
!           resolution gets very high.
!           -----------------------------------------------------

            iklab=klab(jl,jk)
            pzqac(jl,iklab)=pzqac(jl,iklab)/(pzdpcld(jl,iklab) +zsec)
            pztcdif(jl,iklab)=pztcdif(jl,iklab)/ &
     &                       (pzdpcld(jl,iklab) +zsec)
            pzqcdif(jl,iklab)=pzqcdif(jl,iklab)/ &
     &                       (pzdpcld(jl,iklab) +zsec)
            pzscdif(jl,iklab)=pzscdif(jl,iklab)/ &
     &                       (pzdpcld(jl,iklab) +zsec)
            pzbfrac(jl,iklab)=1.0_jprb -1.0_jprb/(1.0_jprb +zbetreso* &
     &      ( pzqcdif(jl,iklab)/zbethumi + zbetbuoy/pzbu(jl,iklab) ) )

          endif

        enddo
      enddo

!     =============================================================
!     5.  Convective updates. 
!         First  adjust values of specific humidity in 
!         convective layers, that is, update to old time
!         values must be done before redistributing moisture 
!         due to convection in the convective 'entities'.
!     =============================================================

      if( kcall == 1 ) then 
!     =====================
      do jk=1,klev
        jkp1=jk+1
        do jl=kstart,kstop
!       ------------------

!         5.0 Make critical small cloud condensation if 'klabcv=2'  
!         (passive moist condensation), in case no cloud condensate
!         was present. Remove corresponding amount from specific
!         humidity. 

          if( (klabcv(jl,jk) == 2).and.(pzwt(jl,jk) < zfrc2) ) then

            ztmp=zfrc2 -pzwt(jl,jk)

!           (1) Compute condensation fluxes 

            jintt = max(1, 1 + int((tmelt - pztp(jl,jk))/dttabl))
            jintt = min(jintt, 1750)

            pfccql(jl,jk)=pfccql(jl,jk) - 1.0_jprb*zidtime*  &
     &      (1. -prbice(jintt))*ztmp
            pfccqn(jl,jk)=pfccqn(jl,jk) - 1.0_jprb*zidtime*  &
     &      prbice(jintt)*ztmp

            pzcwp(jl,jk)=(1. -prbice(jintt))*zfrc2
            pzcicep(jl,jk)=prbice(jintt)*zfrc2 
            pzqp(jl,jk)=pzqp(jl,jk) -ztmp
            pztp(jl,jk)=pztp(jl,jk) +pzldcp(jl,jk)*ztmp

          endif 

!         ---------------------------------------------------------
!         5.1  Define 'help' coefficients 
!         'zdpf' is pressure thickness between 'half' levels at
!         new time step
!         Do only convective updates if 'kcall=1'
!         --------------------------------------------------------

          zdpf=pahyb(jl,jkp1) -pahyb(jl,jk) + &
     &         pzpsp(jl)*(pbhyb(jl,jkp1) -pbhyb(jl,jk))    
          zpf=0.5_jprb*( pahyb(jl,jk) +pahyb(jl,jkp1) +  &
     &           (pbhyb(jl,jk) +pbhyb(jl,jkp1))*pzpsp(jl) )
          zresat=1._jprb/pecor(zpf,pt(jl,jk))
          pzqsat(jl,jk)=epsilo*esat( pt(jl,jk) )*zresat
          pzdqsdt(jl)=epsilo*zpf*desdt(pt(jl,jk))* &
     &               zresat*zresat 

          iklab=klab(jl,jk)

!         ---------------------------------------------------------
!         5.2  Adjust variables in convective entities
!         For shallow convective entities there
!         is a linear weighting (paramameter 'zdelta') between
!         updates due to dynamics and vertical diffusion (as 
!         an average over the convective entity) on one
!         hand and updates due to convection on the other. 
!         The idea is to describe a gradual transition (linear)
!         between 'small scale vertical mixing', that is ,
!         vertical diffusion dominating for shallow phenomena 
!         ( small 'pzdptot' )  and deep convective phenomena 
!         ( large 'pzdptot' ). 
!         ---------------------------------------------------------

          zdelta=min( pzdptot(jl,iklab)/zpcr, 1._jprb )

!         ---------------------------------------------------------
!         5.3  Adjustment towards old values 
!         (taking into account mass changes), before adding 
!         convective updates during the current time step.
!         --------------------------------------------------------

          if( klabc(jl,jk) == 1 ) then
            zc1=(1._jprb -zdelta)*pzqp(jl,jk)
            pzqp(jl,jk)=zdelta*pq(jl,jk)*pdpf(jl,jk)/(zdpf+zsec) +zc1
          endif

!         --------------------------------------------------------
!         5.4 Add convective updates (only if 'kcall =1' )
!         numerical control of cloud water evaporation 
!         by parameters 'ztunc' and 'zcev'.
!         ----------------------------------------------------------

          if( klabcv(jl,jk) == 3 ) then

            jintt = max(1, 1 + int((tmelt - pztp(jl,jk))/dttabl))
            jintt = min(jintt, 1750)

            zc1=pzqsat(jl,jk)
            zc2=pzdqsdt(jl)
            zc3=zdelta*pzqac(jl,iklab)*(1._jprb -pzbfrac(jl,iklab))* &
     &          pzdifs(jl,jk)/(pzscdif(jl,iklab) +zsec)
            zc4=zdelta*pzqac(jl,iklab)*pzbfrac(jl,iklab)* &
     &          pzdifq(jl,jk)/(pzqcdif(jl,iklab) +zsec)
            zcev=ztunc/(pdtime*max( pzqsat(jl,jk) -pq(jl,jk), zsec) )
            zcevb= pt(jl,jk)*pt(jl,jk)*zcevd
            zcevc=zceva*min( zcevb, 1.0_jprb )
            zcev=min( zcevc, zcev )            
            zc5=pzldcp(jl,jk)*zdelta*pzqac(jl,iklab)* &
     &          (1._jprb -pzbfrac(jl,iklab))* &
     &          pzdift(jl,jk)/(pztcdif(jl,iklab) +zsec)

            zc6=zcev*pdtime*pzwt(jl,jk)
            zc7=pzldcp(jl,jk)*zc6

            zcc1=( pztp(jl,jk) +zc5 -zc1*zc7 +zc2*zc7*pt(jl,jk) )/ &
     &           (1._jprb +zc2*zc7)
            zcc2=zc7/(1._jprb +zc2*zc7)
            zcc3=( pzqp(jl,jk) +zc4 +zc1*zc6 -zc2*zc6*pt(jl,jk) )/ &
     &           (1._jprb +zc6)
            zcc4=zc2*zc6/(1._jprb +zc6) 
            zcc5=pzwt(jl,jk) +zc3 -zc1*zc6 +zc2*zc6*pt(jl,jk)
            zcc6=-zc2*zc6 

            zupdt=pztp(jl,jk) 
            pztp(jl,jk)=(zcc1 +zcc2*zcc3)/(1._jprb -zcc2*zcc4)
            zupd=(pztp(jl,jk) -zupdt)/(pdtime*pzldcp(jl,jk))

!           -----------------------------------------------------------
            pfccql(jl,jk)=pfccql(jl,jk) - &
     &                    1.0_jprb*zupd*(1. -prbice(jintt)) 
            pfccqn(jl,jk)=pfccqn(jl,jk) - &
     &                    1.0_jprb*zupd*prbice(jintt)
!           -----------------------------------------------------------
            zupdq=pq(jl,jk)
            pzqp(jl,jk)=(zcc3 +zcc1*zcc4)/(1._jprb -zcc2*zcc4)

!           -----------------------------------------------------------
            pdifcq(jl,jk)=pdifcq(jl,jk) +  & 
     &      1.0_jprb*( zidtime*(pzqp(jl,jk) -zupdq) +zupd )
!           -----------------------------------------------------------
            zupdcw=pzcwp(jl,jk)
            zupdci=pzcicep(jl,jk)
!           pzcwp(jl,jk)=zcc5 +zcc6*pztp(jl,jk) +zc6*pzqp(jl,jk)
            pzcwp(jl,jk)=(1._jprb -prbice(jintt))* &
      &                 ( zcc5 +zcc6*pztp(jl,jk) +zc6*pzqp(jl,jk) )
            pzcicep(jl,jk)=prbice(jintt)*   &
      &                 ( zcc5 +zcc6*pztp(jl,jk) +zc6*pzqp(jl,jk) )

!           -----------------------------------------------------------
            pdifcql(jl,jk)= pdifcql(jl,jk) + &
      &                     1.0_jprb*zidtime*(pzcwp(jl,jk) -zupdcw) - &
      &                     1.0_jprb*(1. -prbice(jintt))*zupd
            pdifcqn(jl,jk)= pdifcqn(jl,jk) + &
      &                     1.0_jprb*zidtime*(pzcicep(jl,jk) -zupdci) - &
      &                     1.0_jprb*prbice(jintt)*zupd

          endif

        enddo
      enddo

!     -------------------------------------------------------------------
!     Final preparation of variables connected to
!     the detrainment mixing. Updates due to the detrainment
!     mixing above clouds are included. 

      do jk=2,klev
        jkm1=jk-1

        do jl=kstart,kstop
          iklab=klab(jl,jk)

          if( klab(jl,jk) /= klab(jl,jkm1) ) then
            pzcptop(jl,iklab)=pzcptop(jl,iklab)/(pzdptop(jl,iklab) +zsec)
            pzcpcld(jl,iklab)=pzcpcld(jl,iklab)/(pzdpcld(jl,iklab) +zsec)
          endif 

          if( klabcv(jl,jk) == -1 ) then
!         ----------------------------------------------------------
            pztentop(jl,jk)=-pzten(jl,iklab)*gravit/ &
     &                     (pzdptop(jl,iklab)*pzcptop(jl,iklab) +zsec)   
            pzqentop(jl,jk)=-pzqen(jl,iklab)*gravit/ &
     &                     (pzdptop(jl,iklab) +zsec)
            pzqcetop(jl,jk)=-pzqcen(jl,iklab)*gravit/ &
     &                     (pzdptop(jl,iklab) +zsec)

            zdif=pztentop(jl,jk)/ &
     &      (1._jprb + pdtime*pzcoefh(jl,jk)*pzimfac(jl,iklab)/ &
     &      (pzdptop(jl,iklab) +zsec))
            pztp(jl,jk)=pztp(jl,jk) + pdtime*zdif

!           Save temperature transport term 

            pdifcs(jl,jk)=pdifcs(jl,jk) +1.0_jprb*zdif

!           ---------------------------------------------------------
            zdif=pzqentop(jl,jk)/ &
     &      (1._jprb + pdtime*zcflxq*pzcoefh(jl,jk)*pzimfac(jl,iklab)/ &
     &      (pzdptop(jl,iklab) +zsec))
            pzqp(jl,jk)=pzqp(jl,jk) +pdtime*zdif 

            pdifcq(jl,jk)=pdifcq(jl,jk) +1.0_jprb*zdif

!           ---------------------------------------------------------
            zdif=pzqcetop(jl,jk)/ &
     &      (1._jprb + pdtime*zcflxc*pzcoefh(jl,jk)*pzimfac(jl,iklab)/ &
     &      (pzdptop(jl,iklab) +zsec))

            jintt = max(1, 1 + int((tmelt - pztp(jl,jk))/dttabl))
            jintt = min(jintt, 1750)

            pzcwp(jl,jk)  =pzcwp(jl,jk) + &
     &                     pdtime*zdif*(1._jprb -prbice(jintt))
            pzcicep(jl,jk)=pzcicep(jl,jk) + pdtime*zdif*prbice(jintt)

            pdifcql(jl,jk)=pdifcql(jl,jk) +  &
     &                     1.0_jprb*zdif*(1. -prbice(jintt))
            pdifcqn(jl,jk)=pdifcqn(jl,jk) +  &
     &                     1.0_jprb*zdif*prbice(jintt) 

!         ----------------------------------------------------------
          endif

          if( (klabcv(jl,jk) == 2).or.(klabcv(jl,jk) == 3) ) then 
!         ----------------------------------------------------------
            pztencld(jl,jk)=pzten(jl,iklab)*gravit/ &
     &                    (pzdpcld(jl,iklab)*pzcpcld(jl,iklab) +zsec)
            pzqencld(jl,jk)=pzqen(jl,iklab)*gravit/ &
     &                    (pzdpcld(jl,iklab) +zsec)
            pzqcecld(jl,jk)=pzqcen(jl,iklab)*gravit/ &
     &                    (pzdpcld(jl,iklab) +zsec)
!           ----------------------------------------------------------
            zdif=pztencld(jl,jk)/ &
     &      (1._jprb + pdtime*pzcoefh(jl,jk)*pzimfac(jl,iklab)/ &
     &      (pzdptop(jl,iklab) +zsec))
            pztp(jl,jk)=pztp(jl,jk) + pdtime*zdif

!           Simplified enthalpy treatment at this place

            pdifcs(jl,jk)=pdifcs(jl,jk) + 1.0_jprb*zdif

!           ---------------------------------------------------------
            zdif=pzqencld(jl,jk)/ &
     &      (1._jprb + pdtime*zcflxq*pzcoefh(jl,jk)*pzimfac(jl,iklab)/ &
     &      (pzdptop(jl,iklab) +zsec))

            pzqp(jl,jk)=pzqp(jl,jk) +pdtime*zdif
            pdifcq(jl,jk)=pdifcq(jl,jk) +1.0_jprb*zdif

!           ---------------------------------------------------------
            zdif=pzqcecld(jl,jk)/ &
     &      (1._jprb + pdtime*zcflxc*pzcoefh(jl,jk)*pzimfac(jl,iklab)/ &
     &      (pzdptop(jl,iklab) +zsec))

            jintt = max(1, 1 + int((tmelt - pztp(jl,jk))/dttabl))
            jintt = min(jintt, 1750)

            pzcwp(jl,jk)=pzcwp(jl,jk) + pdtime*zdif*(1. -prbice(jintt))
            pzcicep(jl,jk)=pzcicep(jl,jk) + pdtime*zdif*prbice(jintt)

            pdifcql(jl,jk)=pdifcql(jl,jk) +  &
     &                     1.0_jprb*zdif*(1. -prbice(jintt))
            pdifcqn(jl,jk)=pdifcqn(jl,jk) +  &
     &                     1.0_jprb*zdif*prbice(jintt)
!           --------------------------------------------------------- 
          endif 
        enddo
      enddo 

      do jk=1,klev
        do jl=kstart,kstop

!         -------------------------------------------------------
!         5.5  Allow cloud water to possibly evaporate completely
!              Make associated correction of specific humidity
!              and temperature.  
!              This action makes it possible to counteract 
!              possible deficiencies in the numerics of the 
!              vertical diffusion which may create cloud 
!              condensate close to the surface.
!         -------------------------------------------------------

           pzwt(jl,jk)=pzcwp(jl,jk) +pzcicep(jl,jk)

           if( (pzwt(jl,jk) < zfrc1).or.  &
     &         (klabcv(jl,jk) == 1) ) then       

!          Compute condensation fluxes

             jintt = max(1, 1 + int((tmelt - pztp(jl,jk))/dttabl))
             jintt = min(jintt, 1750)
             pfccql(jl,jk)=pfccql(jl,jk) + 1.0_jprb*zidtime*pzcwp(jl,jk)
             pfccqn(jl,jk)=pfccqn(jl,jk) + 1.0_jprb*zidtime*pzcicep(jl,jk)

             pzqp(jl,jk)=pzqp(jl,jk) + pzwt(jl,jk)
             pztp(jl,jk)=pztp(jl,jk) -pzldcp(jl,jk)*pzwt(jl,jk)
             pzcwp(jl,jk)  =0._JPRB
             pzcicep(jl,jk)=0._JPRB
          endif

        enddo 
      enddo 

   endif

   if (lhook) call dr_hook('hlcondcv',1,zhook_handle)

end subroutine hlcondcv
