! Library:phys $Id: hlcloudcv.F90 5664 2008-01-12 09:13:28Z moene $

!options xopt(noeval)
  subroutine hlcloudcv (                               &
! scalars and logicals 
 &                     khor,      klev,     kstart,    &
 &                     kstop,     kstep,    pdtime,    &
 &                     pconacc,                        &
! prognostic variables 
 &                     pt,        pq,       pcw,       &
 &                     pcice,     pqampli,             & 
! diagnostic fields 
 &                     ptotcov,   ppf,                 &
! work arrays  
 &                     klab,      klabcv,              &      
 &                     pzrhuc,    pzgpot,    pztc,     &
 &                     pzqp,      pzcwp,     pzcicep,  & 
 &                     pzqsat,    pzqsatc,   pzqac     )  
!     ------------------------------------------------------------
!     PURPOSE:
!     --------

! (*) Compute cloud cover in every model layer taking into account 
!     both stratiform and convective condensation processes.

! (*) For 'stratiform' type of clouds the cloud cover
!     (fractional volumetric) is determined from a statistical  
!     distribution of 'total specific humidity', together
!     with saturation specific humidity. The amplitude 'pqampli'
!     of the moisture variations is time dependedent (see 
!     DMI Technical Report no. 02-10).

! (*) For convective condensation the distribution function is 
!     asymmetric and involves 3 piecewise rectangular parts 
!     (see DMI Tech. Rep. no. 02-10). The formulation involves
!     also a characteristic temperature of convective air parcel. 
!     of convective air parcel ascent. The cloud cover approaches 
!     100 percent when the grid box reaches saturation.

! (*) To counteract unrealistic 'on/off' switches a relaxation  
!     of volumetric fractional cloud cover towards 'equilibrium'
!     (determined from the statistical distribution) is carried 
!     out. 

! (*) All cloud cover is carried in one field, 'ptotcov'. 
!     -----------------------------------------------------------

!     LITTERATURE:
!     ------------
!     The condensation and convection scheme is described in
!     the DMI Technical Report no. 02-10, 24 pp.
!     -----------      
!     INTERFACE:
!     -----------
!     subroutine 'hlcloudcv' is called from subroutine 'hlconds'
!     ------     
!     INPUT:
!     * Arguments - unmodified input *
!     ------------------------------------------------------------
!       khor        number of grid points in horizontal loops  
!       klev        number of vertical levels
!       kstart      start index of horizontal loops. 
!       kstop       end index of horizontal loops.
!       kstep       time step number 
!       pdtime      time step used for this process
!       pt          temperature at old time step 
!       pq          specific humidity at old time step           
!       pcw         cloud water content at old time step.
!       ppf         pressure at 'full' levels
!       klab        integer number of the convective entity  
!       klabcv      Convective label transferred from
!                   the convection routine 'condcv'         
!       pzrhuc      maximum amplitude of moisture fluctuation 
!       pzgpot      geopotential at model full level.
!       pztc        convective cloud temperature   
!       pzqp        provisional value of specific humidity
!       pzcwp       provisional value of specific cloud water
!       pzcicep     provisional value of specific cloud ice 
!     ------
!     OUTPUT 
!     * Arguments - modified input or output *
!     --------------------------------------------------------------
!       pzqsat      saturation specific humidity   
!       pzqsatc     saturation specific humidity
!                   at cloud temperature.
!       pzqac       vertically integrated moisture convergence
!       pqampli     dimensionless amplitude of humidity fluctuations   
!       ptotcov     total cloud cover (3-D) field 
!     --------------------------------------------------------------
!     EXTERNAL SUBROUTINES: none
!     --------------------------     

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

!     MODIFICATIONS:
!     --------------
!     Original version for ALADIN/ARPEGE 2005-12-29 

!     =========================================================
!     1. DECLARATIONS. 
!     =========================================================

!     1.1 MODULES USED.

use parkind1  ,only : jpim,    jprb
use yomhook   ,only : lhook,   dr_hook

use yhlconst  ,only : epsilo,   tmelt
use yhlcond   ,only : prbice,  dttabl

!     1.2 OTHER DECLARATIONS.

implicit none

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)    :: pt(khor,klev)
real(kind=jprb)   ,intent(in)    :: pq(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)

integer(kind=jpim),intent(in)    :: klab(khor,klev)
integer(kind=jpim),intent(in)    :: klabcv(khor,klev)

real(kind=jprb)   ,intent(in)    :: pzrhuc(khor,klev)    
real(kind=jprb)   ,intent(in)    :: pzgpot(khor,klev) 
real(kind=jprb)   ,intent(in)    :: pztc(khor,klev) 
real(kind=jprb)   ,intent(in)    :: pzqp(khor,klev)  
real(kind=jprb)   ,intent(in)    :: pzcwp(khor,klev)
real(kind=jprb)   ,intent(in)    :: pzcicep(khor,klev) 
real(kind=jprb)   ,intent(inout) :: pzqsat(khor,klev)
real(kind=jprb)   ,intent(inout) :: pzqsatc(khor)
real(kind=jprb)   ,intent(in)    :: pzqac(khor,klev)

real(kind=jprb)   ,intent(inout) :: pqampli(khor,klev)
real(kind=jprb)   ,intent(inout) :: ptotcov(khor,klev)

integer(kind=jpim):: jk, jl, jkm1, jintt, jklab

real(kind=jprb)   :: ztmp0,                         &
 &                   ztmp,      ztmp1,     zlimhu,  &
 &                   ztceff,    zfa,       zfb,     &  
 &                   zcwsca,    zese,      zc0,     &
 &                   zc1,       zc2,       ztfac,   &             
 &                   zfaca,     zfacb,     zfacc,   &
 &                   zqamplic,  ztmp2,     zlifec,  &
 &                   zadc,      zcwlim,    zpf,     & 
 &                   zqctot,    zqmax,     zqmin,   &
 &                   zrhu,      zeqcov,    zeqcos,  &
 &                   zeqcot,    zresat,    zcwi,    &
 &                   zqlimit,   zqlimfr
 
real(kind=jprb) ::  zhook_handle

#include "hlesat.h"

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

!     ========================================================
!     2. Initialize various constants and 
!        arrays including labels.
!     ========================================================

!     2.1 local constants or adjustable scalars.   
!     --------------------------------------------------------
!     'zlifec'   is a relaxation time (s) for adjusting
!                cloud cover towards current  
!                'equilibrium conditions'.
!     'ztceff'  effective convective cloud parcel temperature

!     --------------------------------------------------------
!     Timescales for convective and stratiform cloud cover 
!     adjustments.  
!     --------------------------------------------------------
      zlifec=900._jprb
      ztfac=pconacc*pdtime 
      zadc=1._jprb
      zadc=min( ztfac/zlifec, 1.0_jprb )

      zcwsca=1.0e5_jprb
!     --------------------------------------------------------
!     Tuning coefficients `zfaca,zfacb,zfacc' 
!     for defining the humidity distribution. 
!     --------------------------------------------------------
      zfaca=0.018_jprb
      zfacb=6.00_jprb
      zfacc=3.0E-8_jprb
      zqlimfr = 0.9990_jprb
!     --------------------------------------------------------
!     specific cloud water threshold 'zcwlim'.
!     --------------------------------------------------------
      zcwlim=1.e-8_jprb
!     --------------------------------------------------------
!     dummy value for convective cloud temperature.
!     --------------------------------------------------------
      ztceff=300._jprb
!     --------------------------------------------------------
!     threshold minimum relative saturation fraction (zlimhu)
!     --------------------------------------------------------
      zlimhu=0.005_jprb
!     ========================================================
!     3.  Determine fractional cloud cover in both the 
!         convective and stratiform case. 

!    (*)  The basic strategy is to compute a convective cloud
!         cover at levels where the convective labels 
!         (klavcv = 2 or 3) have been assigned in the  
!         convection scheme. 

!    (*)  The label 'klabcv=1' is assigned to unstable
!         layers where no convective clouds have been identified 
!         in the convection scheme. Hence, the equilibrium cloud  
!         cover in this situation is zero cloud cover. 

!    (*)  Stratiform type of cloud is assigned in association 
!         with labels 'klabcv=4' (new lifting level).
!         At transitions between stratiform and convective regimes, 
!         that is, if 'klabcv=-1' (at the current level) stratiform 
!         cloud cover is assigned. 

!     =============================================================
!     3.1 (set zero cloud cover at the top of the model atmosphere)    
!     -------------------------------------------------------------
      do jl=kstart,kstop
         ptotcov(jl,1)=0._jprb
      enddo
!     ---------------------------------------------------------
!     3.3 Check bounds for amplitude `qampli'
!     ---------------------------------------------------------
      do jk=1,klev
        do jl=kstart,kstop
          jintt = max(1, 1 + int((tmelt - pt(jl,jk))/dttabl))
          jintt = min(jintt, 1750)
          zfa= pcw(jl,jk)*zcwsca
          zfb=max( 0._jprb , min( zfa,1._jprb) )
          zese=zfb*( esatw(pt(jl,jk))*(1._jprb -prbice(jintt)) + &
     &               esati(pt(jl,jk))*prbice(jintt) ) +          &
     &               (1._jprb -zfb)*esatw(pt(jl,jk))

          zpf=ppf(jl,jk)
          zresat=1./pecor(zpf,pt(jl,jk))

!         pzqsat(jl,jk)=epsilo*esat( pt(jl,jk) )*zresat
          pzqsat(jl,jk)=epsilo*zese*zresat

          pqampli(jl,jk)= &
     &    min( max( pqampli(jl,jk),zlimhu ), pzrhuc(jl,jk))
        enddo            
      enddo

!     -----------------------------------------------------------
!     3.4 Big loop where both stratiform and convective cloud
!         cover are computed.        
!     -----------------------------------------------------------
      do jk=2,klev
        jkm1=jk-1
        do jl=kstart,kstop

!         assign zero cloud values as a default.
!         --------------------------------------
          zeqcot=0._jprb
          zeqcov=0._jprb
          zeqcos=0._jprb

!         pressure 'zpf' at model full levels 
!         --------------------------------------
          zpf=ppf(jl,jk) 

!         total specific humidity        
!         --------------------------------------
          zqctot=pzqp(jl,jk) +pzcwp(jl,jk) +pzcicep(jl,jk)
          zqctot=max( zqctot, zcwlim )

!        3.4.1 Convective clouds 
!        =======================================================

!        Relative humidity 'zrhu' 
!        -------------------------------------------------------
         zrhu=min( pq(jl,jk)/pzqsat(jl,jk), 1.0_jprb )

!        -------------------------------------------------------
!        Specific computations for convective conditions. 
!        -------------------------------------------------------
         if( (klabcv(jl,jk) == 3).or.(klabcv(jl,jk) == 2).or. &
    &        (klabcv(jl,jk) ==-1) ) then
!        ------------------------------------------------------- 
            zc0=pq(jl,jk) +pcw(jl,jk) +pcice(jl,jk)

!           -------------------------------------------------------
!           Convective cloud temperature "ztceff" and
!           associated saturation specific humidity "pzqsatc" 
!           -------------------------------------------------------   
            ztceff=pztc(jl,jk)
            ztmp1=1._jprb -1.0_jprb*pqampli(jl,jk)
            ztmp0=max( zrhu, ztmp1 ) 
            ztmp2=(ztmp0 -ztmp1)/(1._jprb -ztmp1) 

            if( zrhu > ztmp1 ) then
               ztmp2=min( ztmp2, 1._jprb ) 
               ztceff=ztceff +(pt(jl,jk) -ztceff)*ztmp2*ztmp2
            endif

            ztceff=max( ztceff, pt(jl,jk) +0.001_jprb )
            jintt = max(1, 1 + int((tmelt - ztceff)/dttabl))
            jintt = min(jintt, 1750)
            zcwi=pcw(jl,jk) +pcice(jl,jk)
            zfa=pcw(jl,jk)*zcwsca
            zfb=max( 0._jprb , min( zfa,1._jprb) )
            zese=zfb*( esatw(ztceff)*(1._jprb -prbice(jintt)) +  &
     &                 esati(ztceff)*prbice(jintt) ) +           &
     &                 (1._jprb -zfb)*esatw(ztceff)
            zresat=1._jprb/pecor(zpf,ztceff)
            pzqsatc(jl)=epsilo*zese*zresat
            zqlimit = min( pq(jl,jk),  zqlimfr*pzqsatc(jl) )

            zqamplic=zcwi/pzqsatc(jl)
            jklab=klab(jl,jk)
            zc1=max( pzqac(jl,jklab)/pdtime  ,0.0_jprb )/zfacc
            zc2=min( zc1, 1.0_jprb )
            zqmin=pq(jl,jk)*(1._jprb -zfaca*zc2)/  &
     &                      (1.0_jprb +zfacb*zqamplic)
            zqmin=min( max( zqmin, zcwlim ), zqlimit )

!           -----------------------------------------------------------
!           Now follows the "equilibrium cloud cover of a
!           convective cloud based on a simple 3-BOX humidity
!           probability distribution function.
!           -----------------------------------------------------------
            zeqcov=1.0_jprb - 2.0_jprb*(pzqsatc(jl) - zqlimit )/ &
     &             (2.0_jprb*pzqsatc(jl) - zqlimit - zqmin )
         endif

!        Do stratiform cloud cover 
!        if q is greater than qsat*(1- pqampli)

!        3.4.6 Stratiform cloud cover
!        -------------------------------------------------
         zqctot=pq(jl,jk) +pcw(jl,jk) +pcice(jl,jk)
         zqctot=max( zqctot, zcwlim )
         zqmax=zqctot*(1._jprb +pqampli(jl,jk))
         zqmin=zqctot*(1._jprb -pqampli(jl,jk))

!        3.4.7 First case ( pzqsat >= zqmax )
!        -------------------------------------------------
         zeqcos=0._jprb

         if( pq(jl,jk) > pzqsat(jl,jk)*(1._JPRB -pqampli(jl,jk)) ) then

!          3.4.8 Second case ( zqctot > pzqsat )
!          -------------------------------------------------
           if( (zqmin <= pzqsat(jl,jk)).and. &
     &       (pzqsat(jl,jk) < zqmax) ) then  
             zeqcos=( zqmax -pzqsat(jl,jk))/ &
     &       (2._jprb*zqctot*pqampli(jl,jk))
           endif 

!          3.4.9 Third case: overcast
!          -------------------------------------------------
           if( zqmin > pzqsat(jl,jk) ) then
             zeqcos=1.0_jprb
           endif  

         endif

!        3.4.10 No clouds exist in the absolutely unstable atmosphere 
!        where convective clouds were not diagnosed. 
!        --------------------------------------------------------
         if( (klabcv(jl,jk) == 4).and.(klabcv(jl,jk-1) == 1) ) then
           zeqcos=0._jprb
           zeqcov=0._jprb
         endif

         if( (klabcv(jl,jk) == 1).and.(kstep > 1) ) then 
           zeqcov=0._jprb 
           zeqcos=0._jprb
         endif 

!        3.4.11  Ajust cloud cover towards 'equilibrium'
!        --------------------------------------------------------
         zeqcot=max( zeqcov, zeqcos )

         ptotcov(jl,jk)=ptotcov(jl,jk) + zadc*   &
     &                 (zeqcot -ptotcov(jl,jk))

!        3.4.12 Security computation 
!        --------------------------------------------------------
         ptotcov(jl,jk)=max(0._jprb, min(ptotcov(jl,jk),1._jprb))

        enddo    
      enddo
 
!     ===========================================================
!     4. Final cloud cover check. It is set to zero if
!     if the minimum value 'zcwlim' of cloud condensate
!     has been reached. This is consistent with the 
!     adjustment in stratiform condensation which 
!     completely evaporates this small amount of 
!     cloud condensate to enable zero-values.
!     ===========================================================

      do jk=1,klev
        do jl=kstart,kstop
          ztmp=pzqsat(jl,jk)*(1._jprb -pqampli(jl,jk))

          if( (pzcwp(jl,jk) +pzcicep(jl,jk) < zcwlim).and.  &
     &        (pq(jl,jk) < ztmp) ) then
            ptotcov(jl,jk)=0.00_jprb
          endif         
        enddo
      enddo

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

end subroutine hlcloudcv
