SUBROUTINE CLOUDTL ( KIDIA    , KFDIA , KLON   , KLEV,&
 & KBASECM  , KTOPCM,&
 & PQM15    , PQS5  , PTM15  , PARPRCM5,&
 & PCLC5    , PCT5  , PQIWP5 , PQLWP5,&
 & PQM1     , PQS   , PTM1   , PARPRCM,&
 & PCLC     , PCT   , PQIWP  , PQLWP )  

!**** *CLOUDTL*  -  COMPUTES CLOUD COVER AND LIQUID WATER PATH
!                   (Tangent linear)

!     PURPOSE.
!     --------

!             THIS ROUTINE COMPUTES CLOUD AMOUNTS REQUIRED BY THE
!     RADIATION SCHEME FOR COMPUTATION OF THE FLUXES. 

!     CLOUDS ARE ESTIMATED FROM RELATIVE HUMIDITY AND  
!     CONVECTIVE RAINFALL

!**   INTERFACE.
!     ----------
!              *CLOUDTL* IS CALLED FROM *CALLPARTL*

!     PARAMETER     DESCRIPTION                                   UNITS
!     ---------     -----------                                   -----

!     INPUT PARAMETERS (INTEGER):

!    *KIDIA*        START POINT
!    *KFDIA*        END POINT
!    *KLON*         NUMBER OF GRID POINTS PER PACKET
!    *KLEV*         NUMBER OF LEVELS
!    *KBASECM*      CONVECTIVE CLOUD BASE
!    *KTOPCM*       CONVECTIVE CLOUD TOP

!    INPUT PARAMETERS (REAL):

!    *PQM15*        SPECIFIC HUMIDITY AT T-1                  (Trajectory)
!    *PQS5*         SATURATION SPECIFIC HUMIDITY              (Trajectory)
!    *PTM15*        TEMPERATURE AT T-1                        (Trajectory)
!    *PARPRCM5*     CONVECTIVE PRECIPITATION                  (Trajectory) 
!    *PQM1*         SPECIFIC HUMIDITY AT T-1                     KG/KG
!    *PQS*          SATURATION SPECIFIC HUMIDITY                 KG/KG
!    *PTM1*         TEMPERATURE AT T-1                             K
!    *PARPRCM*      CONVECTIVE PRECIPITATION                      MM

!    OUTPUT PARAMETERS (REAL):

!    *PCLC5*        CLOUD COVER OF INDIVIDUAL LAYER           (Trajectory)
!    *PCT5*         TOTAL CLOUD COVER                         (Trajectory)
!    *PQIWP5*       ICE WATER CONTENT                         (Trajectory)   
!    *PQLWP5*       LIQUID WATER CONTENT                      (Trajectory)   
!    *PCLC*         CLOUD COVER OF INDIVIDUAL LAYER
!    *PCT*          TOTAL CLOUD COVER
!    *PQIWP*        ICE WATER CONTENT                             KG/KG
!    *PQLWP*        LIQUID WATER CONTENT                          KG/KG

!     METHOD.
!     -------

!     EXTERNALS.
!     ----------

!          NONE

!     REFERENCE.
!     ----------

!        SEE RADIATION'S PART OF THE MODEL'S DOCUMENTATION AND
!        ECMWF RESEARCH DEPARTMENT DOCUMENTATION OF THE "I.F.S"

!     AUTHOR.
!     -------
!     J.F. MAHFOUF                E.C.M.W.F.    96/05/17

!     MODIFICATIONS.
!     --------------
!     M. Janiskova - 2002/05/10 - different computation of RHcrit
!                               - modified ZOEALFA for linearized model
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

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

USE YOMCST   , ONLY : R        ,RLVTT    ,RLSTT    ,RTT
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
 & RALVDCP  ,RALSDCP  ,RTWAT    ,RTICE    ,RTICECU  ,&
 & RTWAT_RTICE_R      ,RTWAT_RTICECU_R  
USE YOECLD   , ONLY : CETA     ,RANVA    ,RANVB    ,RANVH    ,&
 & RCCA     ,RCCB     ,RCCC     ,RCFCT    ,RCLWMR   ,&
 & RCSCAL   ,RETAHB   ,RETAMB   ,RLONIA   ,RGAMMAS  ,REPSCR   ,REPSEC   ,&
 & LOMEGA  
USE YOEPHLI  , ONLY : RLPTRC   

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KBASECM(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTOPCM(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM15(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PARPRCM5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLC5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCT5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQIWP5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQLWP5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTM1(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PARPRCM(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLC(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCT(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQIWP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQLWP(KLON,KLEV) 
!     -----------------------------------------------------------------

!*       0.1   ARGUMENTS.
!              ----------

!     -----------------------------------------------------------------

!*       0.2   LOCAL ARRAYS.
!              -------------

REAL(KIND=JPRB) :: ZFICE5(KLON) ,  ZRH5(KLON,KLEV) , ZCC5(KLON)
REAL(KIND=JPRB) :: ZFICE(KLON)  ,  ZRH(KLON,KLEV)  , ZCC (KLON)
REAL(KIND=JPRB) :: ZWCRIT(KLEV)

INTEGER(KIND=JPIM) :: IANV, JK, JL
INTEGER(KIND=JPIM) :: IPCLO1,IPCLO2

LOGICAL :: LLM

REAL(KIND=JPRB) :: Z1S, Z1S5, Z1ST, Z1ST5, Z2S, Z2S5,&
 & Z2ST, Z2ST5, ZCANV, ZCANV5, ZCLOUD, ZCLOUD5, &
 & ZCRH, ZFACTW, ZOEALFA, ZOEALFA5, ZQLAY, ZQLAY5, &
 & ZZEPSEC, ZZRH, ZZRH5  
REAL(KIND=JPRB) :: ZEPS1,ZHUCOE,ZHUTIL
REAL(KIND=JPRB) :: ZHOOK_HANDLE

!     ------------------------------------------------------------------
#include "fcttre.h"
!     ------------------------------------------------------------------

!*         1.0    SET-UP CONSTANTS
!                 ----------------

IF (LHOOK) CALL DR_HOOK('CLOUDTL',0,ZHOOK_HANDLE)
ZEPS1=1.E-12_JPRB
ZHUCOE=1.8_JPRB
ZHUTIL=0.9_JPRB
IPCLO1=1
IPCLO2=1

!     ------------------------------------------------------------------

!*         1.1    COMPUTE RELATIVE HUMIDITY 
!                 -------------------------

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZRH(JL,JK)=(PQM1(JL,JK)*PQS5(JL,JK) - PQM15(JL,JK)*PQS(JL,&
     & JK))/&
     & PQS5(JL,JK)**2  
    ZRH5(JL,JK)=PQM15(JL,JK)/PQS5(JL,JK)
    IF (ZRH5(JL,JK) < 0.0_JPRB) THEN
      ZRH (JL,JK)=0.0_JPRB
      ZRH5(JL,JK)=0.0_JPRB
    ELSEIF (ZRH5(JL,JK) > 1.0_JPRB) THEN
      ZRH (JL,JK)=0.0_JPRB
      ZRH5(JL,JK)=1.0_JPRB
    ENDIF
  ENDDO
ENDDO

!     ------------------------------------------------------------------

!*         1.2    COMPUTE ETA AT FULL LEVELS
!                 --------------------------

DO JK=1,KLEV
  LLM     =CETA(JK) > RETAHB.AND.CETA(JK) <= RETAMB
  ZFACTW = MAX( 0.0_JPRB , MIN (1.0_JPRB, (CETA(JK)-RETAHB)/(RETAMB-RETAHB)  )  )
  IF (LLM     .AND..NOT.LOMEGA) ZFACTW=0.0_JPRB
  ZWCRIT(JK)=ZFACTW*RLONIA
ENDDO

!     ------------------------------------------------------------------

!*         1.3    CLEAR CLOUD ARRAYS
!                 ------------------

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    PCLC  (JL,JK)=0.0_JPRB
    PQIWP (JL,JK)=0.0_JPRB
    PQLWP (JL,JK)=0.0_JPRB
    PCLC5 (JL,JK)=0.0_JPRB
    PQIWP5(JL,JK)=0.0_JPRB
    PQLWP5(JL,JK)=0.0_JPRB
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
  ZCC    (JL)=0.0_JPRB
  ZCC5   (JL)=0.0_JPRB
  PCT    (JL)=0.0_JPRB
  PCT5   (JL)=0.0_JPRB
ENDDO

!    ------------------------------------------------------------------

!*        2. COMPUTE CONVECTIVE CLOUD COVER FOR EACH LEVEL
!            ---------------------------------------------

DO JL=KIDIA,KFDIA
  IF(PARPRCM5(JL) > 0.0_JPRB) THEN
    IF (PARPRCM5(JL)*RCSCAL > REPSCR) THEN
      Z2S  = PARPRCM (JL)*RCSCAL
      Z2S5 = PARPRCM5(JL)*RCSCAL
    ELSE
      Z2S  = 0.0_JPRB
      Z2S5 = REPSCR
    ENDIF
    ZCC (JL)= RCCA * Z2S/Z2S5
    ZCC5(JL)= RCCA * LOG(Z2S5)-RCCB
    IF (ZCC5(JL) > RCCC) THEN
      ZCC  (JL) = 0.0_JPRB
      ZCC5 (JL) = RCCC
    ELSEIF (ZCC5(JL) < 0.0_JPRB) THEN
      ZCC  (JL) = 0.0_JPRB
      ZCC5 (JL) = 0.0_JPRB
    ENDIF
  ENDIF
  ZCANV =RANVA* ZCC (JL)
  ZCANV5=RANVA*(ZCC5(JL)-RANVB)
  IANV=KTOPCM(JL)
  IF(ZCC5(JL) >= RANVH.AND.CETA(KTOPCM(JL)) <= RETAHB) THEN
    IF (ZCC5(JL)*RCFCT > ZCANV5) THEN
      PCLC (JL,IANV) = ZCC (JL)*RCFCT
      PCLC5(JL,IANV) = ZCC5(JL)*RCFCT
    ELSE
      PCLC (JL,IANV) = ZCANV
      PCLC5(JL,IANV) = ZCANV5
    ENDIF
  ELSE
    PCLC (JL,IANV) = ZCC (JL)*RCFCT
    PCLC5(JL,IANV )= ZCC5(JL)*RCFCT
  ENDIF
  PQLWP (JL,IANV)=RGAMMAS*PQS (JL,IANV)*PCLC5(JL,IANV) +&
   & RGAMMAS*PQS5(JL,IANV)*PCLC (JL,IANV)  
  PQLWP5(JL,IANV)=RGAMMAS*PQS5(JL,IANV)*PCLC5(JL,IANV)
  ZRH (JL,IANV)=ZRH (JL,IANV)-PCLC (JL,IANV)
  ZRH5(JL,IANV)=ZRH5(JL,IANV)-PCLC5(JL,IANV)
ENDDO

!*         2.1    ADJUST RELATIVE HUMIDITY FOR PRESENCE OF CONVECTION
!                 ---------------------------------------------------

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZZRH =ZRH (JL,JK)-ZCC (JL)*RCFCT
    ZZRH5=ZRH5(JL,JK)-ZCC5(JL)*RCFCT
    ZQLAY =RCLWMR       *ZCC (JL)*RCFCT
    ZQLAY5=RCLWMR       *ZCC5(JL)*RCFCT
    IF(JK > KTOPCM(JL).AND.JK <= KBASECM(JL)) THEN
      ZRH   (JL,JK)=ZZRH
      ZRH5  (JL,JK)=ZZRH5
      PCLC  (JL,JK)=ZCC (JL)*RCFCT
      PCLC5 (JL,JK)=ZCC5(JL)*RCFCT
      PQLWP (JL,JK)=ZQLAY
      PQLWP5(JL,JK)=ZQLAY5
    ENDIF
    IF (ZRH5(JL,JK) < 0.0_JPRB) THEN
      ZRH (JL,JK)=0.0_JPRB
      ZRH5(JL,JK)=0.0_JPRB
    ELSEIF (ZRH5(JL,JK) > 1.0_JPRB) THEN
      ZRH (JL,JK)=0.0_JPRB
      ZRH5(JL,JK)=1.0_JPRB
    ENDIF
  ENDDO
ENDDO

!     ------------------------------------------------------------------

!*        3. COMPUTE LAYER CLOUD AMOUNTS
!            ---------------------------

DO JK=2,KLEV-1

! original version
!  ZCRH = MIN(MAX(RRHL,RRHL+(RRHH-RRHL)*&
!   &(RETAMB-CETA(JK))/(RETAMB-RETAHB)),RRHH)

! new version
  ZCRH = 1.0_JPRB-MAX( ZHUCOE*CETA(JK)**IPCLO1*&
   & (1.0_JPRB-CETA(JK))**IPCLO2*&
   & (1.0_JPRB+SQRT(ZHUTIL)*(CETA(JK)-0.5_JPRB)),ZEPS1)  

  DO JL=KIDIA,KFDIA
    ZQLAY =RGAMMAS*PQS (JL,JK)
    ZQLAY5=RGAMMAS*PQS5(JL,JK)
    Z1S =   ZRH (JL,JK)      /(1.0_JPRB-ZCRH)
    Z1S5 = (ZRH5(JL,JK)-ZCRH)/(1.0_JPRB-ZCRH)
    IF (Z1S5 < 0.0_JPRB) THEN
      Z1S  = 0.0_JPRB
      Z1S5 = 0.0_JPRB
    ENDIF
! for removing noise
    Z1S  = 0.0_JPRB

    ZCLOUD =2.0_JPRB*Z1S*Z1S5
    ZCLOUD5=Z1S5*Z1S5

!*    MEDIUM AND LOW (NO INVERSION) CLOUD - NONE IF SUBSIDENCE

! original version
!    IF(CETA(JK) > RETAHB)THEN
!      IF(PVERVEL5(JL,JK) >= _ZERO_)THEN
!        ZCLOUD =_ZERO_
!        ZCLOUD5=_ZERO_
!      ELSEIF(PVERVEL5(JL,JK) >= ZWCRIT(JK))THEN
!        ZCLOUD =ZCLOUD *PVERVEL5(JL,JK)* RLONIB +&
!         &ZCLOUD5*PVERVEL (JL,JK)* RLONIB
!        ZCLOUD5=ZCLOUD5*PVERVEL5(JL,JK)* RLONIB
!      ENDIF
!    ENDIF

    PCLC (JL,JK) = PCLC (JL,JK) + ZCLOUD
    PCLC5(JL,JK) = PCLC5(JL,JK) + ZCLOUD5
    PQLWP (JL,JK) = PQLWP (JL,JK) + ZCLOUD5*ZQLAY + ZCLOUD*ZQLAY5
    PQLWP5(JL,JK) = PQLWP5(JL,JK) + ZCLOUD5*ZQLAY5
  ENDDO
ENDDO

!     ------------------------------------------------------------------

!*        4. COMPUTE CLOUD LIQUID PATH AND TOTAL CLOUDINESS
!            ----------------------------------------------

DO JL=KIDIA,KFDIA
  IF (PCLC5(JL,1) < 0.0_JPRB) THEN
    PCLC (JL,1)=0.0_JPRB
    PCLC5(JL,1)=0.0_JPRB
  ELSEIF (PCLC5(JL,1) > 1.0_JPRB) THEN
    PCLC (JL,1)=0.0_JPRB
    PCLC5(JL,1)=1.0_JPRB
  ENDIF
  PCT (JL)=   -PCLC (JL,1)
  PCT5(JL)=1.0_JPRB-PCLC5(JL,1)
! original version
!  ZOEALFA  = _HALF_*RLPAL1*PTM1(JL,1)&
!   &/COSH(RLPAL1*(PTM15(JL,1)-RLPTRC))**2
!  ZOEALFA5 = _HALF_*(TANH(RLPAL1*(PTM15(JL,1)-RLPTRC))+_ONE_)
!  ZFICE (JL)=  -ZOEALFA
!  ZFICE5(JL)=_ONE_-ZOEALFA5

! new version
  ZOEALFA  = 0.545_JPRB*0.17_JPRB*PTM1(JL,1)&
   & /COSH(0.17_JPRB*(PTM15(JL,1)-RLPTRC))**2  
  ZOEALFA5 = 0.545_JPRB*(TANH(0.17_JPRB*(PTM15(JL,1)-RLPTRC))+1.0_JPRB)
  IF (PTM15(JL,1) < RTT) THEN
    ZFICE (JL)=  -ZOEALFA
    ZFICE5(JL)=1.0_JPRB-ZOEALFA5
  ELSE
    ZFICE(JL)=0.0_JPRB
    ZFICE5(JL)=0.0_JPRB
  ENDIF

  PQIWP (JL, 1)=PQLWP5(JL, 1)*ZFICE(JL) + PQLWP(JL, 1)*ZFICE5(JL)
  PQIWP5(JL, 1)=PQLWP5(JL, 1)*ZFICE5(JL)
  PQLWP (JL, 1)=PQLWP (JL, 1)*(1.0_JPRB-ZFICE5(JL)) -&
   & PQLWP5(JL, 1)*    ZFICE (JL)  
  PQLWP5(JL, 1)=PQLWP5(JL, 1)*(1.0_JPRB-ZFICE5(JL))
ENDDO

DO JK=2,KLEV
  DO JL=KIDIA,KFDIA
    IF (PCLC5(JL,JK) < 0.0_JPRB) THEN
      PCLC (JL,JK)=0.0_JPRB
      PCLC5(JL,JK)=0.0_JPRB
    ELSEIF (PCLC5(JL,JK) > 1.0_JPRB) THEN
      PCLC (JL,JK)=0.0_JPRB
      PCLC5(JL,JK)=1.0_JPRB
    ENDIF
    ZZEPSEC=1.0_JPRB-REPSEC

    IF (PCLC5(JL,JK) > PCLC5(JL,JK-1)) THEN
      Z1ST  = PCLC (JL,JK)
      Z1ST5 = PCLC5(JL,JK)
    ELSE
      Z1ST  = PCLC (JL,JK-1)
      Z1ST5 = PCLC5(JL,JK-1)
    ENDIF
    IF (PCLC5(JL,JK-1) > ZZEPSEC) THEN
      Z2ST  = 0.0_JPRB
      Z2ST5 = ZZEPSEC
    ELSE
      Z2ST  = PCLC (JL,JK-1)
      Z2ST5 = PCLC5(JL,JK-1)
    ENDIF
    PCT(JL)=PCT (JL)*(1.0_JPRB-Z1ST5)/(1.0_JPRB-Z2ST5) -&
     & PCT5(JL)*Z1ST/(1.0_JPRB-Z2ST5) +&
     & PCT5(JL)*Z2ST*(1.0_JPRB-Z1ST5)/(1.0_JPRB-Z2ST5)**2  
    PCT5(JL)=PCT5(JL)*(1.0_JPRB-Z1ST5)/(1.0_JPRB-Z2ST5)
! original version
!    ZOEALFA  = _HALF_*RLPAL1*PTM1(JL,JK)/&
!     &COSH(RLPAL1*(PTM15(JL,JK)-RLPTRC))**2
!    ZOEALFA5 = _HALF_*(TANH(RLPAL1*(PTM15(JL,JK)-RLPTRC))+_ONE_)
!    ZFICE (JL)=  -ZOEALFA
!    ZFICE5(JL)=_ONE_-ZOEALFA5

! new version
    ZOEALFA  = 0.545_JPRB*0.17_JPRB*PTM1(JL,JK)/&
     & COSH(0.17_JPRB*(PTM15(JL,JK)-RLPTRC))**2  
    ZOEALFA5 = 0.545_JPRB*(TANH(0.17_JPRB*(PTM15(JL,JK)-RLPTRC))+1.0_JPRB)
    IF (PTM15(JL,JK) < RTT) THEN
      ZFICE (JL)=  -ZOEALFA
      ZFICE5(JL)=1.0_JPRB-ZOEALFA5
    ELSE
      ZFICE(JL)=0.0_JPRB
      ZFICE5(JL)=0.0_JPRB
    ENDIF

    PQIWP (JL,JK)=PQLWP5(JL,JK)*ZFICE (JL) + PQLWP(JL,JK)*ZFICE5(JL)
    PQIWP5(JL,JK)=PQLWP5(JL,JK)*ZFICE5(JL)
    PQLWP (JL,JK)=PQLWP (JL,JK)*(1.0_JPRB-ZFICE5(JL)) -&
     & PQLWP5(JL,JK)*    ZFICE (JL)  
    PQLWP5(JL,JK)=PQLWP5(JL,JK)*(1.0_JPRB-ZFICE5(JL))
  ENDDO
ENDDO

DO JL=KIDIA,KFDIA
  PCT(JL)=   -PCT (JL)
  PCT5(JL)=1.0_JPRB-PCT5(JL)
ENDDO

!     ------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('CLOUDTL',1,ZHOOK_HANDLE)
END SUBROUTINE CLOUDTL
