! Library:phys $Id: hlcldiag.F90 5805 2008-03-28 15:13:50Z xiaohua $

!OPTIONS XOPT(NOEVAL)
SUBROUTINE HLCLDIAG ( khor    , klev  , kstart , kstop, pt    ,  &
    &                 pq      , pcw   , pf     , pdpf , phybf ,  &
    &                 ldcw    , ldcov , ldci   ,                 &
!   -- IN-/OUTPUT --
    &                 ptotcov , pcice ,                          &
!   -- OUTPUT --
    &                 pclq    )

!     Purpose:
!     --------
!     *HLCLDIAG* :  Provides cloud information to the radiation scheme.

!     Interface:
!     ----------
!     variable        type         content
!     ========        ====         =======
!     khor            input        Number of horizontal grid points pro-
!                                  cessed at a time.
!     klev            input        Number of vertical levels
!     kstart          input        Starting index for horizontal loops
!     kstop           input        Ending index for horizontal loops
!     pt              input        Layer temperature (K)
!     pq              input        Layer specific humidity (kg/kg)
!     pcw             input        Layer specific cloud cond. (lq+ice). (kg/kg)
!     pf              input        Pressure (Pa) at model full levels.
!     pdpf            input        Pressure difference between model
!                                  half levels.
!     ldcw            input        Switch for cloud water availabilty
!     ldcov           input        Switch for total cloud cover availabilty
!     ldci            input        Switch for cloud ice availabilty
!     phybf           input        Hybrid levels (full)
!     ----------------------------------------------------------------
!     ptotcov         in-/output   Fractional cloud cover for each
!                                  model layer
!     pcice           in-/output   Layer specific cloud ice.(kg/kg)
!     pclq            output       Layer specific cloud water (liquid).(kg/kg)
!     ----------------------------------------------------------------
!     zcsusa(1:klev)      work Constant array involved in estimating
!                         layer integrated cloud water, when cloud water is not
!                         an explicit forecast variable.

!     Externals:
!     ----------

!     Modules YHLCONST, YHLCOND

!     Method:
!     -------
!     This subroutine combines the routine CLOUD.f and
!     cloud diagnostics from RADIA.f  

!       I) If combined cloud condensate is available (ldcw = .TRUE.)
!      ---> Split it into liquid and ice by using probability
!           for ice (from YHLCOND) or use cloud ice (ldci = .TRUE.)
!      II) Cloud condensate unavailable (ldcw = .FALSE.).
!      ---> Diagnose cloud condenstate by using pq.
!      ---> Split it in liquid and ice parts (see II).
!      III)If ptotcov not available from condensation (ldcov = .FALSE.) 
!      ---> Diagnose the total cloud cover (former CLOUD.f).


!     Reference:
!     ----------

!     Author:
!     -------

!     Modifications:
!     --------------
!     04-Oct-2005    S.Niemela, FMI   Original version for HIRLAM and
!                                     ARPEGE/IFS/ALADIN
!     19-Oct-2005    S.Niemela        ldcov added as input parameter.
!     10-Sep-2006    L.Rontu, FMI     allow for input cloud ice
!     End modifications
!     --------------------------------------------------------------------

USE PARKIND1  ,ONLY : JPIM ,   JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YHLCONST  ,ONLY : EPSILO

IMPLICIT NONE

! INPUT AND OUTPUT VARIABLES
INTEGER(KIND=JPIM), INTENT(IN)    :: khor
INTEGER(KIND=JPIM), INTENT(IN)    :: klev
INTEGER(KIND=JPIM), INTENT(IN)    :: kstart
INTEGER(KIND=JPIM), INTENT(IN)    :: kstop

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)    :: pf(khor,klev)
REAL(KIND=JPRB),    INTENT(IN)    :: pdpf(khor,klev)
REAL(KIND=JPRB),    INTENT(IN)    :: phybf(klev)

LOGICAL,            INTENT(IN)    :: ldcw
LOGICAL,            INTENT(IN)    :: ldci
LOGICAL,            INTENT(IN)    :: ldcov

REAL(KIND=JPRB),    INTENT(INOUT) :: ptotcov(khor,klev)
REAL(KIND=JPRB),    INTENT(OUT)   :: pclq(khor,klev)
REAL(KIND=JPRB),    INTENT(OUT)   :: pcice(khor,klev)

! OTHER VARIABLES
INTEGER(KIND=JPIM) :: jk, jl

REAL(KIND=JPRB)    :: zfice
REAL(KIND=JPRB)    :: zcsusa
REAL(KIND=JPRB)    :: zcw1(khor,klev)
REAL(KIND=JPRB)    :: zq(khor,klev)

REAL(KIND=JPRB)    :: zcons,zacrit,zrelh,zrelhc,zrelhi,zcl

REAL(KIND=JPRB)    :: ZHOOK_HANDLE

#include "hlesat.h"
! -----------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('HLCLDIAG',0,ZHOOK_HANDLE)

! ------------------------------
! definition of local constants.
! ------------------------------
zacrit=1._JPRB
zcons=epsilo*zacrit
zrelhc=0.9_JPRB
zrelhi=1._JPRB/(1._JPRB-zrelhc)

! Initialize output arrays
DO jk=1,klev
  DO jl=kstart,kstop
    pclq(jl,jk)    = 0.0_JPRB
!   -----------------------------------------------------------------
!   Security check for negative humidity 
!   -----------------------------------------------------------------
    zq(jl,jk)=MAX(pq(jl,jk),0._JPRB)
  ENDDO
ENDDO


IF ( ldcw ) THEN

  DO jk=1,klev
    DO jl=kstart,kstop
      zcw1(jl,jk) = pcw(jl,jk)
    ENDDO
  ENDDO

ELSE ! .NOT.ldcw

!     -----------------------------------------------------------------
!     Security check for negative humidity.
!     -----------------------------------------------------------------
  DO jk=1,klev
    DO jl=kstart,kstop
      zq(jl,jk)=MAX(pq(jl,jk),0._JPRB)
    ENDDO
  ENDDO

  DO jk=1,klev
!   -----------------------------------------------------
!   Constant array "zcsusa(jk)" involved in estimating
!   layer integrated cloud water, when cloud water is not
!   an explicit forecast variable.
!   -----------------------------------------------------
    zcsusa = 0.10_JPRB -0.05_JPRB*phybf(jk)

    DO jl=kstart,kstop
      zcw1(jl,jk) = zcsusa * zq(jl,jk)
    ENDDO

  ENDDO

ENDIF 

! Split the cloud condensate to liquid and ice.
IF (.not.ldci) then

  DO jk=1,klev
    DO jl=kstart,kstop
!simple linear formula from 0...-40 for KFRK and others without ice
       zfice = max(0._jprb,min((269.16_jprb-pt(jl,jk))*0.03125_jprb,1.0_jprb))
       pcice(jl,jk) = zfice*zcw1(jl,jk)
       pclq(jl,jk)  = (1.0_JPRB-zfice)*zcw1(jl,jk)
    ENDDO
  ENDDO
    
ELSE
! input zcw1 is liquid water if ldci=true

DO jk=1,klev
  DO jl=kstart,kstop
     pclq(jl,jk)= zcw1(jl,jk)
  ENDDO
ENDDO

ENDIF ! cloud ice and liquid split 

IF (.NOT.ldcov) THEN
  DO jk=1,klev
    DO jl=kstart,kstop
!       ------------------------------------------------------
!       determination of cloud cover 'ptotcov(jl,jk)'.
!       ------------------------------------------------------
!       zrelh=relative humidity/zacrit= "effective" relative humidity

        zrelh = zq(jl,jk)*pf(jl,jk)/(esat(pt(jl,jk))*zcons)
        zcl = ( zrelh-zrelhc ) * zrelhi

!       note that ptotcov(jl,1)=0., since pf(jl,1)=0. => zrelh=0.

        ptotcov(jl,jk)=(MIN(MAX(zcl,0._JPRB),1._JPRB))**2
    ENDDO
  ENDDO
ENDIF
DO jk=1,klev
  DO jl=kstart,kstop
     IF ((pclq(jl,jk)+pcice(jl,jk)) < 1.0E-08_JPRB) THEN
        ptotcov(jl,jk) = 1.0E-04_JPRB
     ENDIF
     IF (ptotcov(jl,jk) <  1.0E-03_JPRB) THEN
        pclq(jl,jk) = 1.0E-09_JPRB
        pcice(jl,jk) = 1.0E-09_JPRB
     ENDIF
  ENDDO
ENDDO

IF (LHOOK) CALL DR_HOOK('HLCLDIAG',1,ZHOOK_HANDLE)

END SUBROUTINE HLCLDIAG
