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

!options xopt(noeval)
 subroutine hlcondst(                              & 
! scalars and logicals 
 &                  kscall,    khor,     klev,     &
 &                  kstep,     kstart,   kstop,    &
 &                  pdtime,                        &
! prognostic variables 
 &                  pt,        pq,       pcw,      &
 &                  pcice,     pqampli,            &
! diagnostic fields 
 &                  ppf,       pdpf,               &
! work arrays 
 &                  klabcv,    klab,               &
 &                  pzpsp,     pzldcp,   pzqsat,   &
 &                  pzdqsdt,   pzdqsdp,  pzqp,     &
 &                  pztp,      pzcwp,    pzcicep,  &
! fluxes/tendencies  
 &                  pfcsql,    pfcsqn              )
!     ---------------------------------------------------------------
!     PURPOSE: (*)  Compute changes of temperature, specific humidity
!     --------      and specific cloud water due to stratiform 
!                   condensation processes.
!              (*)  A necessary condition for condensation
!                   is that the relative humidity exceeds a threshold 
!                   value that is defined by the variable dimension-
!                   less amplitude 'pqampli' computed in subroutine 
!                   'hlqcampli' 
!              (*)  For lower relative humidity the existing 
!                   cloud water decays exponentially towards zero
!                   within a suitable time scale if no active 
!                   convection occurs.
!              (*)  Stratiform condensation is always computed 
!                   if a given layer has become supersaturated. 
!     ----------------------------------------------------------------
!     INTERFACE  :  subroutine 'hlcondst' is called 
!     ------------  from subroutine 'hlconds'        

!         Nomenclature:
!         -------------
!         'pzqsat'  saturation specific humidity at preliminary 
!                   input temperature.
!         'pzdqsdt' partial derivative of saturation vapour pressure with
!                   respect to temperature.
!         'pztp'    preliminary updated temperature due to all other
!                   processes
!                   than stratiform condensation
!         'pzqp'    preliminary updated specific humidity due to all
!                   other processes
!                   than stratiform condensation
!         'pzcwp'   preliminary updated cloud condensate due to all other
!                   processes than stratiform condensation
!         'pzcicep' preliminary updated cloud ice 
!         'pqampli' threshold fraction of total specific humidity 'zqtot'
!         'zqtot'   sum of preliminary cloud condensate and specific humidity
!         'zs1'     intermediate variable
!         'zs2'     intermediate variable
!         'zs3'     intermediate variable
!         'zs4'     intermediate variable
!         'zss1'    coefficient in final update of temperature and
!                   humidity due to evaporation of cloud water
!         'zss2'    coefficient in final update of temperature and 
!                   humidity due to evaporation of cloud water
!         'zss3'    coefficient in final update of temperature and 
!                   humidity due to evaporation of cloud water
!         'zss4'    coefficient in final update of temperature and
!                   humidity due to evaporation of cloud water
!         'zss5'    coefficient in final update of cloud water
!                   due to evaporation of cloud water.
!         'zss6'    coefficient in final update of cloud water
!                   due to evaporation of cloud water.
!         'zss7'    coefficient in final update of cloud water
!                   due to evaporation of cloud water.
!     ------------
!     INPUT:      :  ( from argument list )
!     ------------
!       pt            temperature at old time step 
!       pq            specific humidity at old time step           
!       pcw           cloud water content at old time step.
!       pdpf          delta-p around 'full' level
!       ppf           pressure at 'full' levels
!       pzpsp         provisional value of surface pressure
!       pzqp          provisional value of specific humidity
!       pztp          provisional value of temperature
!       pzcwp         provisional value of specific cloud water
!       pzcicep       provisional values of specific cloud ice
!       klab         identifies potential convective 'entities',
!                    that is a cluster of consecutive layers where
!                    air parcel lifting is buoyant.
!       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 
!                    sometimes 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.
!                    (see subroutine `hlcondcv')
!       pfcsql      tendency of specific humidity associated with 
!                   condensation of cloud water 
!                   involving latent heat release but not
!                   precipitation.
!       pfcsqn      tendency of specific humidity associated with 
!                   condensation of cloud ice 
!                   involving latent heat release but not
!                   precipitation.
!     ------------
!     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 cloud ice  
!     ----------------------
!     EXTERNAL SUBROUTINES:  none
!     ----------------------     

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

!     MODIFICATIONS:
!     ---------------
!                     Original version for ALADIN/ARPEGE from 2005-12-27
!     ==================================================================
!     1. Declarations. 
!     ==================================================================

!     1.1 MODULES USED  

use parkind1  ,only : jpim,    jprb
use yomhook   ,only : lhook,   dr_hook
use yhlconst  ,only : latvap, cpair, epsilo, tmelt, gravit
use yhlcond   ,only : hdl, ht273,  prbice, dttabl

!      1.2 ARGUMENT DECLARATIONS

implicit none

integer(kind=jpim),  intent(in)  ::   kscall
integer(kind=jpim),  intent(in)  ::   khor
integer(kind=jpim),  intent(in)  ::   klev
integer(kind=jpim),  intent(in)  ::   kstep
integer(kind=jpim),  intent(in)  ::   kstart
integer(kind=jpim),  intent(in)  ::   kstop

real(kind=jprb),  intent(in)     ::   pdtime 

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

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

real(kind=jprb),  intent(in)     ::   pzpsp(khor)
real(kind=jprb),  intent(inout)  ::   pzldcp(khor,klev)
real(kind=jprb),  intent(inout)  ::   pzqsat(khor,klev)
real(kind=jprb),  intent(inout)  ::   pzdqsdt(khor) 
real(kind=jprb),  intent(in)     ::   pzdqsdp(khor) 
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)  ::   pfcsql(khor,0:klev)
real(kind=jprb),  intent(inout)  ::   pfcsqn(khor,0:klev)

!  1.3  OTHER DECLARATIONS 

real(kind=jprb)  ::   zfa,      zfb,              &
 &                    zcwsca,   zese,    zcwmin,  &
 &                    zsec,     zseva,   zqmin,   &   
 &                    zqmax,    zcpi,    z1,      &
 &                    zsev,     zstun,   zdqliq,  &
 &                    zqtot,    zqceq,   zpf,     &
 &                    zads,     zlife,   zs1,     &
 &                    zs2,      zs3,     zs4,     &   
 &                    zss1,     zss2,    zss3,    &     
 &                    zss4,     zss5,    zss6,    &
 &                    zss7,     zresat,  ztmp,    &
 &                    zigrav,   zidtime, zupdt,   &
 &                    zupd,     zcwi
real(kind=jprb)  ::   zsevb, zsevc, zsevd
integer(kind=jpim)   ::   jk, jl, iit, ji, jintt
real(kind=jprb)      ::   zhook_handle 

#include "hlesat.h"

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

!     ===========================================================
!     2. Initialize various constants and arrays including labels
!     ===========================================================
!     2.1 local constants   
!     -------------------
!     'zseva'   is a coefficient for cloud water evaporation
!     'zlife'   adjustment time scale
!     'zads'    adjustment factor
!     'zcwmin'  minimum allowed specific humidity or cloud water
!     'zsec'    is a security constant.
!     'zstun'   numerical tuning constant
!               for evaporation of cloud water.
!     'zidtime' inverse of time step 
!     'iit'     number of iterations in stratiform calculations.
!     ----------------------------------------------------------
      zseva=0.35_jprb
      zsevd=1.0_JPRB/(tmelt*tmelt)
      zlife=900._jprb
      zads=min( 0.5_jprb*pdtime/zlife , 1.0_jprb )
      zads=max( zads, 0.50_jprb )
      zsec=1.E-7_jprb
      zcwmin=1.0E-7_jprb
      zstun=0.5_jprb
      zcpi=1._jprb/cpair 

      zcwsca=1.0E5_jprb
      zigrav=1._jprb/gravit
      zidtime=1._jprb/pdtime

      iit=2

!     ------------------------------------------------------------
!     2.2 arrays 
!     ------------------------------------------------------------

      do jk=1,klev
        do jl=kstart,kstop
        
!         Latent heat as a function of temperature.

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

!     ========================================================
!     3.  Do stratiform condensation computations.
!     The previously updates of temperature, specific humidity 
!     and cloud water are used, and also a preliminary 
!     'supersaturation' specific humidity inside the 
!     stratiform clouds.

!     Jump over computation computations if 'kscall.ne.1'

      if( kscall == 1 ) then  
!     ===========================

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

!         3.1  
!         ----
!         First case: Cloud water evaporates provided that
!                     i) convection including evaporation 
!                        was not already active (klavcv=3) 
!                        while the air is so dry that stratiform 
!                        condensation cannot occur. 
!                     ii) the air is absolutly unstable with 
!                         no convective clouds diagnosed 
!                         ( klabcv(jl,jk) = 1 )  

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

          zfa=pcw(jl,jk)*zcwsca
          zfb=max( 0._jprb , min( zfa,1._jprb) )
          zese=zfb*( esatw(pztp(jl,jk))*(1._jprb -prbice(jintt))+ &
     &               esati(pztp(jl,jk))*prbice(jintt) ) +         &
     &               (1._jprb -zfb)*esatw(pztp(jl,jk))

          zpf=ppf(jl,jk)
          zresat=1./pecor(zpf,pztp(jl,jk))
          pzqsat(jl,jk)=epsilo*zese*zresat
          pzdqsdt(jl)=epsilo*zpf*desdt(pztp(jl,jk))*  &
     &               zresat*zresat

          zqtot=pzqp(jl,jk) +pzcwp(jl,jk) +pzcicep(jl,jk) 
          zqtot=max( zqtot, zcwmin )
          zqmax=zqtot*(1._jprb +pqampli(jl,jk))
          zqmin=zqtot*(1._jprb -pqampli(jl,jk))

!         ----------------------------------------------------------
          if( (klabcv(jl,jk) /= 3).and.  &
     &      (zqmax < pzqsat(jl,jk)) ) then 
!         ----------------------------------------------------------

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

              zsev=zstun/( pdtime*max( pzqsat(jl,jk)-pzqp(jl,jk), zsec )) 
              zsevb=pztp(jl,jk)*pztp(jl,jk)*zsevd
              zsevc=zseva*min( zsevb, 1.0_jprb )
              zsev=min( zsevc, zsev )
              zs1=pdtime*zsev*pzldcp(jl,jk)*(pzcwp(jl,jk) +pzcicep(jl,jk))
              zs2=pzqsat(jl,jk)                                       
              zs3=pzdqsdt(jl)
              zs4=zs1/pzldcp(jl,jk)

              zss1=(pztp(jl,jk) -zs1*zs2 +zs1*zs3*pztp(jl,jk))/  &
     &             (1._jprb +zs1*zs3)
              zss2=zs1/(1._jprb +zs1*zs3)
              zss3=(pzqp(jl,jk) +zs2*zs4 -zs3*zs4*pztp(jl,jk))/  &
     &             (1._jprb +zs4)
              zss4=zs3*zs4/(1._jprb +zs4)
              zss5=pzcwp(jl,jk) +pzcicep(jl,jk) -zs2*zs4 +       &
     &             zs3*zs4*pztp(jl,jk)
              zss6=-zs3*zs4 
              zss7=zs4   

!             flux updates  

              zupdt=pztp(jl,jk) 
              pztp(jl,jk)=zss1 + zss2*(zss3 +zss1*zss4)/   &
     &                   (1._jprb -zss2*zss4)
              zupd=(pztp(jl,jk) -zupdt)/(pdtime*pzldcp(jl,jk))

              pfcsql(jl,jk)=pfcsql(jl,jk) -zupd*(1. -prbice(jintt))
              pfcsqn(jl,jk)=pfcsqn(jl,jk) -zupd*prbice(jintt)

              pzqp(jl,jk)=(zss3 +zss1*zss4)/(1._jprb -zss2*zss4) 

!          NB:  split up between water and ice has been made 051228

              pzcwp(jl,jk)=(1._jprb -prbice(jintt))*  &
     &                     ( zss5 +zss6*pztp(jl,jk) +zss7*pzqp(jl,jk) )
              pzcicep(jl,jk)= prbice(jintt)*    &
     &                     ( zss5 +zss6*pztp(jl,jk) +zss7*pzqp(jl,jk) )

!         -----
          endif
!         -----
        enddo
        enddo

!     ========================================================

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

!         3.2 Second case: Normal stratiform conditions 
!         ---------------------------------------------

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

          zfa=pcw(jl,jk)*zcwsca
          zfb=max( 0._jprb , min( zfa,1._jprb) )
          zese=zfb*( esatw(pztp(jl,jk))*(1._jprb -prbice(jintt)) + &
     &               esati(pztp(jl,jk))*prbice(jintt) ) +          &
     &               (1._jprb -zfb)*esatw(pztp(jl,jk))

          zpf=ppf(jl,jk)
          zresat=1._jprb/pecor(zpf,pztp(jl,jk))
          pzqsat(jl,jk)=epsilo*zese*zresat
          pzdqsdt(jl)=epsilo*zpf*desdt(pztp(jl,jk))*  &
     &               zresat*zresat 
          zqtot=pzqp(jl,jk) +pzcwp(jl,jk) +pzcicep(jl,jk)
          zqtot=max( zqtot, zcwmin ) 
          zqmin=zqtot*(1._jprb -pqampli(jl,jk))
          zqmax=zqtot*(1._jprb +pqampli(jl,jk))

          if( (zqmin <= pzqsat(jl,jk)).and.(pzqsat(jl,jk) < zqmax) ) then 
!           --------------------------------------------------------
              jintt = max(1, 1 + int((ht273 - pztp(jl,jk))/dttabl))
              jintt = min(jintt, 1750)

              zqceq=( pzqsat(jl,jk)*pzqsat(jl,jk)/zqtot +            & 
     &        (1._jprb +pqampli(jl,jk))*(1. +pqampli(jl,jk))*zqtot - &
     &        2.0_jprb*pzqsat(jl,jk)*(1._jprb +pqampli(jl,jk)) )/    &
     &        (4.0_jprb*pqampli(jl,jk))
              z1=(zqmax -pzqsat(jl,jk))/(2._jprb*pqampli(jl,jk)*zqtot)

              zdqliq=(zqceq -pzcwp(jl,jk) -pzcicep(jl,jk))/  &
     &        (1._jprb +pzldcp(jl,jk)*pzdqsdt(jl)*min( z1,1._jprb))

              pfcsql(jl,jk)=pfcsql(jl,jk) -                         &
     &                      zads*zdqliq*zidtime*(1. -prbice(jintt))
              pfcsqn(jl,jk)=pfcsqn(jl,jk) -                         &
     &                      zads*zdqliq*zidtime*prbice(jintt)

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

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

!         ---------------------------------------------------
!         3.3 Third case: Supersaturated case
!             It is demanded that the model 
!             atmospheric mean relative humidity 
!             does not exceed 100 percent.
!         ---------------------------------------------------

            if( pzqsat(jl,jk) <= pzqp(jl,jk) ) then
!           ---------------------------------------

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

              zqceq=zqtot -pzqsat(jl,jk)
              zdqliq=(zqceq -pzcwp(jl,jk) -pzcicep(jl,jk))/  &
     &        (1._jprb +pzldcp(jl,jk)*pzdqsdt(jl) )

              zqceq=max( zqceq, 0._jprb )
              zdqliq=max(zdqliq, 0._jprb )

              pfcsql(jl,jk)=pfcsql(jl,jk)   -                       &
     &                      zdqliq*zidtime*(1. -prbice(jintt))
              pfcsqn(jl,jk)=pfcsqn(jl,jk)   -                       &
     &                      zdqliq*zidtime*prbice(jintt)

              pzcwp(jl,jk)=pzcwp(jl,jk) +zdqliq*(1. -prbice(jintt))
              pzcwp(jl,jk)=max( pzcwp(jl,jk), 0._jprb ) 
              pzcicep(jl,jk)=pzcicep(jl,jk) + zdqliq*prbice(jintt)
              pzqp(jl,jk)=pzqp(jl,jk) -zdqliq
              pztp(jl,jk)=pztp(jl,jk) +pzldcp(jl,jk)*zdqliq

!           -----
            endif  
!           -----
        enddo 
        enddo 
        enddo 
!  =====
   endif 
!  =====

!  end of stratiform iterations 
!  ============================

!  ----------------------------------------------------------
!  4.  Allow cloud condensate to possibly evaporate or 
!      sublimate completely.
!      Make associated correction of specific humidity.
!      and temperature.
!  ---------------------------------------------------------

   do jk=1,klev 
      do jl=kstart,kstop 
         ztmp=pzqsat(jl,jk)*(1._jprb -pqampli(jl,jk))
         
         zcwi=pzcwp(jl,jk) +pzcicep(jl,jk)
         if( (zcwi < zcwmin).and.(pzqp(jl,jk) < ztmp) ) then

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

            pfcsql(jl,jk) = pfcsql(jl,jk)   +                    &
     &                      zcwi*zidtime*(1. -prbice(jintt))
            pfcsqn(jl,jk) = pfcsqn(jl,jk)   +                    &
     &                      zcwi*zidtime*prbice(jintt)

            pzqp(jl,jk)   = pzqp(jl,jk) +zcwi
            pztp(jl,jk)   = pztp(jl,jk) -pzldcp(jl,jk)*zcwi
            pzcwp(jl,jk)  = 0._jprb
            pzcicep(jl,jk)= 0._jprb
         endif
      enddo
   enddo
   
!  -----------------------------------------------------------

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

end subroutine hlcondst
