!OPTIONS XOPT(HSFUN)
SUBROUTINE CUASCNAD &
 & ( KIDIA,    KFDIA,    KLON,    KLEV,&
 & PTSPHY,&
 & PTENH5,   PQENH5,   PUEN5,    PVEN5,&
 & PTEN5,    PQEN5,    PQSEN5,   PLITOT5,&
 & PGEO5,    PGEOH5,   PAP5,     PAPH5,&
 & PVERVEL5, pwubase5, KLWMIN,&
 & LDLAND,   LDCUM,    KTYPE,    KLAB,&
 & PTU5,     PQU5,     PLU5,&
 & PMFU5,    PMFUB5,   PENTR5,   PLGLAC5,&
 & PMFUS5,   PMFUQ5,   PMFUL5,   PLUDE5,   PDMFUP5,&
 & PDMFEN5,  PMFUDE_RATE5,       PKINEU5,  PWMEAN5,&
 & KCBOT,    KCTOP,    KCTOP0,   KDPL )  

!          THIS ROUTINE DOES THE CALCULATIONS FOR CLOUD ASCENTS
!          FOR CUMULUS PARAMETERIZATION
!          (Adjoint)

!          J.F. MAHFOUF      E.C.M.W.F.     16/01/97

!          Adapted from

!          M.TIEDTKE         E.C.M.W.F.     7/86 MODIF. 12/89

!          PURPOSE.
!          --------
!          TO PRODUCE CLOUD ASCENTS FOR CU-PARAMETRIZATION
!          (VERTICAL PROFILES OF T,Q,L,U AND V AND CORRESPONDING
!           FLUXES AS WELL AS PRECIPITATION RATES)

!          INTERFACE
!          ---------

!          THIS ROUTINE IS CALLED FROM *CUMASTRNAD*.

!          METHOD.
!          --------
!          LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD BASE
!          AND THEN CALCULATE MOIST ASCENT FOR
!          ENTRAINING/DETRAINING PLUME.
!          ENTRAINMENT AND DETRAINMENT RATES DIFFER FOR
!          SHALLOW AND DEEP CUMULUS CONVECTION.
!          IN CASE THERE IS NO PENETRATIVE OR SHALLOW CONVECTION
!          CHECK FOR POSSIBILITY OF MID LEVEL CONVECTION
!          (CLOUD BASE VALUES CALCULATED IN *CUBASMC*)

!     PARAMETER     DESCRIPTION                                   UNITS
!     ---------     -----------                                   -----
!     INPUT PARAMETERS (INTEGER):

!    *KIDIA*        START POINT
!    *KFDIA*        END POINT
!    *KLON*         NUMBER OF GRID POINTS PER PACKET
!    *KLEV*         NUMBER OF LEVELS
!    *KLWMIN*       LEVEL OF MAXIMUM VERTICAL VELOCITY
!    *KTYPE*        TYPE OF CONVECTION
!                       1 = PENETRATIVE CONVECTION
!                       2 = SHALLOW CONVECTION
!                       3 = MIDLEVEL CONVECTION
!    *KCBOT*        CLOUD BASE LEVEL

!    INPUT PARAMETERS (REAL):

!    *PTSPHY*       TIME STEP FOR THE PHYSICS                      S
!    *PTENH5*       ENV. TEMPERATURE (T+1) ON HALF LEVELS       (Trajectory)
!    *PQENH5*       ENV. SPEC. HUMIDITY (T+1) ON HALF LEVELS    (Trajectory)
!    *PUEN5*        PROVISIONAL ENVIRONMENT U-VELOCITY (T+1)    (Trajectory)
!    *PVEN5*        PROVISIONAL ENVIRONMENT V-VELOCITY (T+1)    (Trajectory)
!    *PTEN5*        PROVISIONAL ENVIRONMENT TEMPERATURE (T+1)   (Trajectory)
!    *PQEN5*        PROVISIONAL ENVIRONMENT SPEC. HUMIDITY (T+1)(Trajectory)
!    *PQSEN5*       ENVIRONMENT SPEC. SATURATION HUMIDITY (T+1) (Trajectory)
!    *PGEO5*        GEOPOTENTIAL                                (Trajectory)
!    *PLITOT5*      GRID MEAN LIQUID WATER+ICE CONTENT          (Trajectory)
!    *PGEOH5*       GEOPOTENTIAL ON HALF LEVELS                 (Trajectory)
!    *PAP5*         PROVISIONAL PRESSURE ON FULL LEVELS         (Trajectory)
!    *PAPH5*        PROVISIONAL PRESSURE ON HALF LEVELS         (Trajectory)
!    *PVERVEL5*     VERTICAL VELOCITY                           (Trajectory)

!    INPUT PARAMETERS (LOGICAL):

!    *LDLAND*       LAND SEA MASK (.TRUE. FOR LAND)
!    *LDCUM*        FLAG: .TRUE. FOR CONVECTIVE POINTS 

!    UPDATED PARAMETERS (INTEGER):

!    *KLAB*         FLAG KLAB=1 FOR SUBCLOUD LEVELS
!                        KLAB=2 FOR CLOUD LEVELS

!    UPDATED PARAMETERS (REAL):

!    *PTU5*         TEMPERATURE IN UPDRAFTS                    (Trajectory) 
!    *PQU5*         SPEC. HUMIDITY IN UPDRAFTS                 (Trajectory) 
!    *PLU5*         LIQUID WATER CONTENT IN UPDRAFTS           (Trajectory) 

!    OUTPUT PARAMETERS (INTEGER):

!    *KCTOP*        CLOUD TOP LEVEL
!    *KCTOP0*       FIRST GUESS OF CLOUD TOP LEVEL 
!    *KDPL*         DEPARTURE LEVEL

!    OUTPUT PARAMETERS (REAL):

!    *PMFU5*        MASSFLUX IN UPDRAFTS                       (Trajectory)
!    *PMFUB5*       MASSFLUX IN UPDRAFTS AT CLOUD BASE         (Trajectory)
!    *PENTR5*       FRACTIONAL MASS ENTRAINMENT RATE           (Trajectory)
!    *PMFUS5*       FLUX OF DRY STATIC ENERGY IN UPDRAFTS      (Trajectory)
!    *PMFUQ5*       FLUX OF SPEC. HUMIDITY IN UPDRAFTS         (Trajectory)
!    *PMFUL5*       FLUX OF LIQUID WATER IN UPDRAFTS           (Trajectory)
!    *PLUDE5*       DETRAINED LIQUID WATER                     (Trajectory)
!    *PLGLAC5*      FROZEN CLOUD WATER CONTENT                 (Trajectory)
!    *PDMFUP5*      FLUX DIFFERENCE OF PRECIP. IN UPDRAFTS     (Trajectory)
!    *PMFUDE_RATE5* UPDRAFT DETRAINMENT RATE                   (Trajectory)
!    *PWMEAN5*      MEAN UPDRAFT VELOCITY                      (Trajectory)

!          EXTERNALS
!          ---------
!          *CUADJTQ*   ADJUST T AND Q DUE TO CONDENSATION IN ASCENT
!          *CUENTR*    CALCULATE ENTRAINMENT/DETRAINMENT RATES
!          *CUBASMC*   CALCULATE CLOUD BASE VALUES FOR MIDLEVEL CONVECTION
!          *CUADJTQAD* ADJUST T AND Q DUE TO CONDENSATION IN ASCENT
!          *CUBASMCAD* CALCULATE CLOUD BASE VALUES FOR MIDLEVEL CONVECTION

!          REFERENCE
!          ---------
!          (TIEDTKE,1989)

!          MODIFICATIONS
!          -------------
!             92-09-21 : Update to Cy44      J.-J. MORCRETTE
!             99-06-04 : Optimisation        D.SALMOND
!           2000-04-11 : modified flux limiter 
!                        as in nonlinear routine  - M. Janiskova
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

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

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

USE YOMCST   , ONLY : RG       ,RCPD     ,RETV     ,RLVTT    ,RLSTT    ,RTT
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
 & RALVDCP  ,RALSDCP  ,RALFDCP  ,RTWAT    ,RTBER    ,&
 & RTICE    ,RTICECU  ,&
 & RTWAT_RTICE_R      ,RTWAT_RTICECU_R  
USE YOECUMF  , ONLY : ENTRORG  ,RMFCMIN  ,RPRCON   ,RMFCFL   ,RMFLIC   ,RMFLIA
USE YOEPHLI  , ONLY : LPHYLIN  ,RLPTRC
USE YOECLDP  , ONLY : RLMIN

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 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTSPHY 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTENH5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQENH5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQSEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLITOT5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEO5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOH5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAP5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVERVEL5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWUBASE5(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLWMIN(KLON) 
LOGICAL           ,INTENT(IN)    :: LDLAND(KLON) 
LOGICAL           ,INTENT(INOUT) :: LDCUM(KLON) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KTYPE(KLON) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KLAB(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PTU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PMFU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PMFUB5(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PENTR5(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLGLAC5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PMFUS5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PMFUQ5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PMFUL5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLUDE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDMFUP5(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDMFEN5(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PMFUDE_RATE5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PKINEU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWMEAN5(KLON) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KCBOT(KLON) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KCTOP(KLON) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KCTOP0(KLON) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KDPL(KLON) 
REAL(KIND=JPRB) ::     ZDMFEN5(KLON),          ZDMFDE5(KLON),&
 & ZQOLD5(KLON),       ZLRAIN5(KLON,KLEV),&
 & ZBUO5(KLON,KLEV),   ZLUOLD5(KLON),&
 & ZPRECIP5(KLON)  
REAL(KIND=JPRB) ::     ZDPMEAN5(KLON)
REAL(KIND=JPRB) ::     ZOENTR5(KLON), ZPH5(KLON)

LOGICAL ::  LLFLAG(KLON), LLFLAGUV(KLON), LLO1(KLON), LLO3, LLO4
INTEGER(KIND=JPIM) :: JLL, JLM, JLX(KLON)

INTEGER(KIND=JPIM) :: ICALL, IK, IS, JK, JL, IKB

REAL(KIND=JPRB) :: Z_CLDMAX, Z_CPRC2, Z_CWDRAG, Z_CWIFRAC, &
 & Z10S5, Z2S5, Z3S5, Z4S5, Z6S5, Z7S5, &
 & Z8S5, Z9S5, ZALFAW5, ZBC5, ZBE5, ZBUOC5, &
 & ZC5, ZCBF5, ZCONS2, ZD5, ZDFI5, ZDKBUO5, &
 & ZDKEN5, ZDNOPRC5, &
 & ZDT5, ZFAC5, ZFACBUO, ZINT5, ZKEDKE5, ZLCRIT5, &
 & ZLEEN5, ZLNEW5, ZMFMAX5, ZMFTEST5, ZMFULK5, &
 & ZMFUN5, ZMFUQK5, ZMFUSK5, ZOEALFA5, ZOEALFAP5, &
 & ZPRCDGW, ZPRCON5, ZQEEN5, ZQUDE5, ZRNEW5, &
 & ZROLD5, ZSCDE5, ZSEEN5, ZTGLACE, ZVI5, ZVV5, &
 & ZVW5, ZWU5, ZZCO5  
REAL(KIND=JPRB) ::  ZCHANGE5,ZXS5,ZXE5
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "cuadjtq.intfb.h"
#include "cubasmcn.intfb.h"
#include "cuentr.intfb.h"

!DIR$ VFUNCTION EXPHF
#include "fcttre.h"
!----------------------------------------------------------------------

!*    1.           SPECIFY PARAMETERS
!                  ------------------

IF (LHOOK) CALL DR_HOOK('CUASCNAD',0,ZHOOK_HANDLE)
ZCONS2=RMFCFL/(RG*PTSPHY)
ZTGLACE=RTT  -13._JPRB
ZFACBUO=0.5_JPRB/(1.0_JPRB+0.5_JPRB)
ZPRCDGW=RPRCON/RG
Z_CLDMAX=5.E-3_JPRB
Z_CWIFRAC=0.5_JPRB
Z_CPRC2=0.5_JPRB
Z_CWDRAG=(3._JPRB/8._JPRB)*0.506_JPRB/0.2_JPRB/RG

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

!     2.           SET DEFAULT VALUES
!                  ------------------

LLO3=.FALSE.
DO JL=KIDIA,KFDIA
  ZLUOLD5(JL)=0.0_JPRB
  IF(.NOT.LDCUM(JL)) THEN
    KCBOT(JL)=-1
    PMFUB5(JL)=0.0_JPRB
    PQU5(JL,KLEV)=0.0_JPRB
    KTYPE(JL)=0
  ENDIF
  ZOENTR5(JL)=0.0_JPRB
  PWMEAN5(JL)=0.0_JPRB
  ZDPMEAN5(JL)=0.0_JPRB
ENDDO

! initalize various quantities
! note that liquid water and kinetic energy at cloud base is 
! preserved from cubase

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    IF (JK /= KCBOT(JL)) THEN 
      PLU5(JL,JK)=0.0_JPRB
      PKINEU5(JL,JK)=0.0_JPRB
    ENDIF
    PMFU5(JL,JK)=0.0_JPRB
    PMFUS5(JL,JK)=0.0_JPRB
    PMFUQ5(JL,JK)=0.0_JPRB
    PMFUL5(JL,JK)=0.0_JPRB
    PLUDE5(JL,JK)=0.0_JPRB
    PLGLAC5(JL,JK)=0.0_JPRB
    PDMFUP5(JL,JK)=0.0_JPRB
    ZLRAIN5(JL,JK)=0.0_JPRB
    ZBUO5(JL,JK)=0.0_JPRB
    IF(.NOT.LDCUM(JL).OR.KTYPE(JL) == 3) KLAB(JL,JK)=0
    IF(.NOT.LDCUM(JL).AND.PAPH5(JL,JK) < 4.E4_JPRB) KCTOP0(JL)=JK

    PDMFEN5(JL,JK)=0.0_JPRB
    PMFUDE_RATE5(JL,JK)=0.0_JPRB        
  ENDDO
ENDDO
!DIR$ IVDEP
!OCL NOVREC
DO JL=KIDIA,KFDIA
  IF(KTYPE(JL) == 3) THEN
    LDCUM(JL)=.FALSE.
  ENDIF
ENDDO

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

!     3.0          INITIALIZE VALUES AT LI LEVEL
!                  ----------------------------------

DO JL=KIDIA,KFDIA
  KCTOP(JL)=kcbot(jl)
  IF(LDCUM(JL)) THEN
    IKB=KCBOT(JL)
    PKINEU5(JL,ikb)=0.5*PWUBASE5(JL)**2
    PMFU5(JL,IKB)=PMFUB5(JL)
    PMFUS5(JL,IKB)=PMFUB5(JL)*(RCPD*PTU5(JL,IKB)+PGEOH5(JL,IKB))
    PMFUQ5(JL,IKB)=PMFUB5(JL)*PQU5(JL,IKB)
    PMFUL5(JL,IKB)=PMFUB5(JL)*PLU5(JL,IKB)
  ENDIF
ENDDO

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

!     4.           DO ASCENT: SUBCLOUD LAYER (KLAB=1) ,CLOUDS (KLAB=2)
!                  BY DOING FIRST DRY-ADIABATIC ASCENT AND THEN
!                  BY ADJUSTING T,Q AND L ACCORDINGLY IN *CUADJTQ*,
!                  THEN CHECK FOR BUOYANCY AND SET FLAGS ACCORDINGLY
!                  -------------------------------------------------

DO JK=KLEV-1,3,-1

!                  SPECIFY CLOUD BASE VALUES FOR MIDLEVEL CONVECTION
!                  IN *CUBASMCN* IN CASE THERE IS NOT ALREADY CONVECTION
!                  ----------------------------------------------------

  IK=JK
  CALL CUBASMCN &
   & ( KIDIA,    KFDIA,    KLON,     KLEV,&
   & IK,&
   & PTEN5,    PQEN5,    PQSEN5,&
   & PVERVEL5, PGEO5,    PGEOH5,   LDCUM,    KTYPE,    KLAB,&
   & KCBOT,    PMFU5,    PMFUB5,   PENTR5,   ZLRAIN5,&
   & PTU5,     PQU5,     PLU5,&
   & PMFUS5,   PMFUQ5,   PMFUL5,   PDMFUP5 )  

  IS=0
  JLM=0
  DO JL=KIDIA,KFDIA
    LLFLAG(JL)=.FALSE.
    ZPRECIP5(JL)=0.0_JPRB
    LLO1(JL)=.FALSE.
    IS=IS+KLAB(JL,JK+1)
    IF(KLAB(JL,JK+1) == 0) KLAB(JL,JK)=0
    IF((LDCUM(JL).AND.KLAB(JL,JK+1) == 2).OR.&
       & (KTYPE(JL) == 3 .and. KLAB(JL,JK+1) == 1)) THEN  
      LLFLAG(JL)=.TRUE.
      JLM=JLM+1
      JLX(JLM)=JL
    ENDIF
    IF(KLAB(JL,JK+1) > 0) THEN
      LLFLAGUV(JL)=.TRUE.
    ELSE
      LLFLAGUV(JL)=.FALSE.
    ENDIF
    ZPH5(JL)=PAPH5(JL,JK)
    IF(KTYPE(JL) == 3.AND.JK == KCBOT(JL)) THEN
      ZMFMAX5=(PAPH5(JL,JK)-PAPH5(JL,JK-1))*ZCONS2*RMFLIC+RMFLIA
      IF(PMFUB5(JL) > ZMFMAX5) THEN
        ZFAC5=ZMFMAX5/PMFUB5(JL)
        PMFU5(JL,JK+1)=PMFU5(JL,JK+1)*ZFAC5
        PMFUS5(JL,JK+1)=PMFUS5(JL,JK+1)*ZFAC5
        PMFUQ5(JL,JK+1)=PMFUQ5(JL,JK+1)*ZFAC5
        PMFUB5(JL)=ZMFMAX5
      ENDIF
    ENDIF
  ENDDO

  IF(IS > 0) LLO3=.TRUE.

!*                  SPECIFY ENTRAINMENT RATES IN *CUENTR*
!                   -------------------------------------

  IK=JK
  CALL CUENTR &
   & ( KIDIA,    KFDIA,    KLON,     KLEV,&
   & IK,       KCBOT,&
   & LDCUM,    LLO3,&
   & PQSEN5,   PAPH5,    PGEOH5,&
   & PMFU5,    PENTR5,&
   & ZDMFEN5,  ZDMFDE5 )  

!                  DO ADIABATIC ASCENT FOR ENTRAINING/DETRAINING PLUME
!                  ---------------------------------------------------

  IF(LLO3) THEN

    llo4=ptsphy>1800.0_jprb.and.rmfcfl==1.0_jprb
    DO JL=KIDIA,KFDIA
      ZQOLD5(JL)=0.0_JPRB
    ENDDO
    DO JLL=1,JLM
        JL=JLX(JLL)
!jfm        ZDMFDE5(JL)=MIN(ZDMFDE5(JL),0.75*PMFU5(JL,JK+1))
        IF (ZDMFDE5(JL) > 0.75_JPRB*PMFU5(JL,JK+1)) THEN
          ZDMFDE5(JL) = 0.75_JPRB*PMFU5(JL,JK+1)
        ENDIF
        IF(JK==KCBOT(JL)-1) THEN
          ZOENTR5(JL)=-ENTRORG*(MIN(1.0_JPRB,PQEN5(JL,JK)/PQSEN5(JL,JK))-1.0_JPRB)*&
          &(PGEOH5(JL,JK)-PGEOH5(JL,JK+1))
          ZOENTR5(JL)=MIN(0.4_JPRB,ZOENTR5(JL))*PMFU5(JL,JK+1)
        ENDIF
        IF(JK < KCBOT(JL)) THEN
          ZMFMAX5=(PAPH5(JL,JK)-PAPH5(JL,JK-1))*ZCONS2*RMFLIC+RMFLIA
          if(ktype(jl)==2.and.llo4) ZMFMAX5=ZMFMAX5*3._JPRB
          ZXS5=MAX(PMFU5(JL,JK+1)-ZMFMAX5,0.0_JPRB)
        ! IF(KTYPE(JL)>=2)ZOENTR5(JL)=0.0_JPRB
        ! ZDMFEN5(JL)=ZDMFEN5(JL)+ZOENTR5(JL)
          ZDMFEN5(JL)=ZOENTR5(JL)
          IF(KTYPE(JL)>=2)THEN
             ZDMFEN5(JL)=2.0_JPRB*ZDMFEN5(JL)
             ZDMFDE5(JL)=ZDMFEN5(JL)
          ENDIF
          PWMEAN5(JL)=PWMEAN5(JL)+PKINEU5(JL,JK+1)*(PAP5(JL,JK+1)-PAP5(JL,JK))
          ZDPMEAN5(JL)=ZDPMEAN5(JL)+PAP5(JL,JK+1)-PAP5(JL,JK)
          ZMFTEST5=PMFU5(JL,JK+1)+ZDMFEN5(JL)-ZDMFDE5(JL)
          ZCHANGE5=MAX(ZMFTEST5-ZMFMAX5,0.0_JPRB)
          ZXE5=MAX(ZCHANGE5-ZXS5,0.0_JPRB)
          ZDMFEN5(JL)=ZDMFEN5(JL)-ZXE5
          ZCHANGE5=ZCHANGE5-ZXE5
          ZDMFDE5(JL)=ZDMFDE5(JL)+ZCHANGE5
        ENDIF
          
        PDMFEN5(JL,JK) = ZDMFEN5(JL)-ZDMFDE5(JL)
        
        PMFU5(JL,JK)=PMFU5(JL,JK+1)+ZDMFEN5(JL)-ZDMFDE5(JL)
        ZQEEN5=PQENH5(JL,JK+1)*ZDMFEN5(JL)
        ZSEEN5=(RCPD*PTENH5(JL,JK+1)+PGEOH5(JL,JK+1))*ZDMFEN5(JL)
        IF (PLITOT5(JL,JK) > RLMIN) THEN
          ZLEEN5=PLITOT5(JL,JK)*ZDMFEN5(JL)
        ELSE
          ZLEEN5=0.0_JPRB
        ENDIF
        ZSCDE5=(RCPD*PTU5(JL,JK+1)+PGEOH5(JL,JK+1))*ZDMFDE5(JL)
        ZQUDE5=PQU5(JL,JK+1)*ZDMFDE5(JL)
        PLUDE5(JL,JK)=PLU5(JL,JK+1)*ZDMFDE5(JL)
        ZMFUSK5=PMFUS5(JL,JK+1)+ZSEEN5-ZSCDE5
        ZMFUQK5=PMFUQ5(JL,JK+1)+ZQEEN5-ZQUDE5
        ZMFULK5=PMFUL5(JL,JK+1)+ZLEEN5-PLUDE5(JL,JK)
!jfm            PLU5(JL,JK)=ZMFULK5*(1./MAX(RMFCMIN,PMFU5(JL,JK)))
!jfm            PQU5(JL,JK)=ZMFUQK5*(1./MAX(RMFCMIN,PMFU5(JL,JK)))
!jfm            PTU5(JL,JK)=(ZMFUSK5*(1./MAX(RMFCMIN,PMFU5(JL,JK)))-
!jfm     1               PGEOH5(JL,JK))/RCPD
!jfm            PTU5(JL,JK)=MAX(100.,PTU5(JL,JK))
!jfm            PTU5(JL,JK)=MIN(400.,PTU5(JL,JK))
        IF (PMFU5(JL,JK) < RMFCMIN) THEN
          Z2S5 = 1.0_JPRB/RMFCMIN
        ELSE
          Z2S5 = 1.0_JPRB/PMFU5(JL,JK)
        ENDIF
        PLU5(JL,JK)=ZMFULK5*Z2S5
        PQU5(JL,JK)=ZMFUQK5*Z2S5
        PTU5(JL,JK)=(ZMFUSK5*Z2S5-PGEOH5(JL,JK))/RCPD
        IF (PTU5(JL,JK) > 400._JPRB) THEN
          PTU5(JL,JK) = 400._JPRB
        ELSEIF (PTU5(JL,JK) < 100._JPRB) THEN
          PTU5(JL,JK) = 100._JPRB
        ENDIF

        ZQOLD5(JL)=PQU5(JL,JK)
        ZLRAIN5(JL,JK)=ZLRAIN5(JL,JK+1)*(PMFU5(JL,JK+1)-ZDMFDE5(JL))*Z2S5
        ZLUOLD5(JL)=PLU5(JL,JK)
    ENDDO
        ! reset to environmental values if below departure level
    DO JL=KIDIA,KFDIA
      IF ( JK > KDPL(JL) ) THEN
        PTU5(JL,JK)=PTENH5(JL,JK)
        PQU5(JL,JK)=PQENH5(JL,JK)
        PLU5(JL,JK)=0.0_JPRB
        ZLUOLD5(JL)=PLU5(JL,JK)
      ENDIF
    ENDDO

!                  DO CORRECTIONS FOR MOIST ASCENT
!                  BY ADJUSTING T,Q AND L IN *CUADJTQTL*
!                  -------------------------------------

    IK=JK
    ICALL=1

    IF(JLM > 0) THEN
      CALL CUADJTQ &
       & ( KIDIA,    KFDIA,   KLON,     KLEV,    IK,&
       &   ZPH5,     PTU5,    PQU5,     LLFLAG,  ICALL )  
    ENDIF

!DIR$ IVDEP
!OCL NOVREC
    IF (LPHYLIN) THEN
      DO JLL=1,JLM
        JL=JLX(JLL)
        IF(PQU5(JL,JK) /= ZQOLD5(JL)) THEN
          ZOEALFA5  = 0.545_JPRB*(TANH(0.17_JPRB*(PTU5(JL,JK  )-RLPTRC))+1.0_JPRB)
          ZOEALFAP5 = 0.545_JPRB*(TANH(0.17_JPRB*(PTU5(JL,JK+1)-RLPTRC))+1.0_JPRB)
          PLGLAC5(JL,JK)=PLU5(JL,JK)*((1.0_JPRB-ZOEALFA5)-(1.0_JPRB-ZOEALFAP5))
          PTU5(JL,JK)=PTU5(JL,JK)+RALFDCP*PLGLAC5(JL,JK)
        ENDIF
      ENDDO

    ELSE

      DO JLL=1,JLM
        JL=JLX(JLL)
        IF(PQU5(JL,JK) /= ZQOLD5(JL)) THEN
          PLGLAC5(JL,JK)=PLU5(JL,JK)*((1.0_JPRB-FOEALFA(PTU5(JL,JK)))-&
           & (1.0_JPRB-FOEALFA(PTU5(JL,JK+1))))  
          PTU5(JL,JK)=PTU5(JL,JK)+RALFDCP*PLGLAC5(JL,JK)
        ENDIF
      ENDDO

    ENDIF

    DO JLL=1,JLM
      JL=JLX(JLL)
      IF(PQU5(JL,JK) /= ZQOLD5(JL)) THEN
        KLAB(JL,JK)=2
        PLU5(JL,JK)=PLU5(JL,JK)+ZQOLD5(JL)-PQU5(JL,JK)
        ZBC5=PTU5(JL,JK)*(1.0_JPRB+RETV*PQU5(JL,JK)-PLU5(JL,JK+1)-&
         & ZLRAIN5(JL,JK+1))  
        ZBE5=PTENH5(JL,JK)*(1.0_JPRB+RETV*PQENH5(JL,JK))
        ZBUO5(JL,JK)=ZBC5-ZBE5

! set flags in case of midlevel convection

        IF(KTYPE(JL) == 3 .AND. KLAB(JL,JK+1)== 1) THEN
          IF(ZBUO5(JL,JK) > -0.5_JPRB) THEN
            LDCUM(JL)=.TRUE.
            KCTOP(JL)=JK
            PKINEU5(JL,JK)=0.5_JPRB
          ELSE
            KLAB(JL,JK)=0
            PMFU5(JL,JK)=0.0_JPRB
            PLUDE5(JL,JK)=0.0_JPRB
            PLU5(JL,JK)=0.0_JPRB
          ENDIF
        ENDIF

        IF(KLAB(JL,JK+1) == 2) THEN

          IF(ZBUO5(JL,JK) < 0.0_JPRB.AND.KLAB(JL,JK+1) == 2) THEN
            PTENH5(JL,JK)=0.5_JPRB*(PTEN5(JL,JK)+PTEN5(JL,JK-1))
            PQENH5(JL,JK)=0.5_JPRB*(PQEN5(JL,JK)+PQEN5(JL,JK-1))
            ZBUO5(JL,JK)=ZBC5-PTENH5(JL,JK)*(1.0_JPRB+RETV*PQENH5(JL,JK))
          ENDIF
          ZBUOC5=(ZBUO5(JL,JK)/(PTENH5(JL,JK)*(1.0_JPRB+RETV*PQENH5(JL,&
           & JK)))&
           & +ZBUO5(JL,JK+1)/(PTENH5(JL,JK+1)*(1.0_JPRB+RETV*&
           & PQENH5(JL,JK+1))))*0.5_JPRB  
          ZDKBUO5=(PGEOH5(JL,JK)-PGEOH5(JL,JK+1))*ZFACBUO*ZBUOC5
!jfm            ZDKEN5=MIN(1.,(1 + RG*CWDRAG)* 
!jfm     1            ZDMFEN5(JL)/MAX(RMFCMIN,PMFU5(JL,JK+1)))
          IF (PMFU5(JL,JK+1) < RMFCMIN) THEN
            Z3S5 = 1.0_JPRB/RMFCMIN
          ELSE
            Z3S5 = 1.0_JPRB/PMFU5(JL,JK+1)
          ENDIF

! either use entrainment rate or if zero
! use detrainmnet rate as a subsitute for 
! mixing and "pressure" gradient term in upper
! troposphere

          if(zdmfen5(jl) > 0.0_JPRB)then
            IF (((1.0_JPRB + RG*Z_CWDRAG)* ZDMFEN5(JL)*Z3S5) < 1.0_JPRB) THEN
              ZDKEN5 = (1.0_JPRB + RG*Z_CWDRAG)* ZDMFEN5(JL)*Z3S5
            ELSE
              ZDKEN5 = 1.0_JPRB
            ENDIF
          else
            IF (((1.0_JPRB + RG*Z_CWDRAG)* ZDMFDE5(JL)*Z3S5) < 1.0_JPRB) THEN
              ZDKEN5 = (1.0_JPRB + RG*Z_CWDRAG)* ZDMFDE5(JL)*Z3S5
            ELSE
              ZDKEN5 = 1.0_JPRB
            ENDIF
          ENDIF           
          PKINEU5(JL,JK)=(PKINEU5(JL,JK+1)*(1-ZDKEN5)+ZDKBUO5)/(1+ZDKEN5)
          IF(ZBUO5(JL,JK) < 0.0_JPRB.AND.KLAB(JL,JK+1) == 2) THEN
!jfm               ZKEDKE5=PKINEU5(JL,JK)/MAX(1.E-10,PKINEU5(JL,JK+1))
!jfm               ZKEDKE5=MAX(0.,MIN(1.,ZKEDKE5))
            IF (PKINEU5(JL,JK+1) < 1.E-10_JPRB) THEN
              Z4S5 = 1.E-10_JPRB
            ELSE
              Z4S5 = PKINEU5(JL,JK+1)
            ENDIF
            ZKEDKE5= PKINEU5(JL,JK)/Z4S5
            IF (ZKEDKE5 > 1.0_JPRB) THEN
              ZKEDKE5 = 1.0_JPRB
            ELSEIF (ZKEDKE5 < 0.0_JPRB) THEN
              ZKEDKE5 = 0.0_JPRB
            ENDIF
            ZMFUN5=SQRT(ZKEDKE5)*PMFU5(JL,JK+1)
!jfm               ZDMFDE5(JL)=MAX(ZDMFDE5(JL),PMFU5(JL,JK+1)-ZMFUN5)
            IF ((PMFU5(JL,JK+1)-ZMFUN5) > ZDMFDE5(JL)) THEN
              ZDMFDE5(JL) = PMFU5(JL,JK+1)-ZMFUN5
            ENDIF
            PLUDE5(JL,JK)=PLU5(JL,JK+1)*ZDMFDE5(JL)
            PMFU5(JL,JK)=PMFU5(JL,JK+1)+ZDMFEN5(JL)-ZDMFDE5(JL)
          ENDIF

          IF(ZBUO5(JL,JK) > -0.2_JPRB.AND.KLAB(JL,JK+1) == 2) THEN
            IKB=KCBOT(JL)
          ! ZOENTR5(JL)=-ENTRORG*(MIN(1.0_JPRB,PQEN5(JL,JK-1)/PQSEN5(JL,JK-1))-1.0_JPRB)*&
          !    &(PGEOH5(JL,JK-1)-PGEOH5(JL,JK))*MIN(1.0_JPRB,PQSEN5(JL,JK)/PQSEN5(JL,IKB))**3
            ZOENTR5(JL)=ENTRORG*(0.3_JPRB-(MIN(1.0_JPRB,PQEN5(JL,JK-1)/PQSEN5(JL,JK-1))-1.0_JPRB))*&
               &(PGEOH5(JL,JK-1)-PGEOH5(JL,JK))*MIN(1.0_JPRB,PQSEN5(JL,JK)/PQSEN5(JL,IKB))**3
            ZOENTR5(JL)=MIN(0.4_JPRB,ZOENTR5(JL))*PMFU5(JL,JK)
          ELSE
            ZOENTR5(JL)=0.0_JPRB
          ENDIF

           ! Erase values if below departure level
          IF ( JK > KDPL(JL) ) THEN
            PMFU5(JL,JK)=PMFU5(JL,JK+1)
            PKINEU5(JL,JK)=0.5_JPRB
          ENDIF

          IF(PKINEU5(JL,JK) > 0.0_JPRB.AND.PMFU5(JL,JK) > 0.0_JPRB) THEN
            KCTOP(JL)=JK
            LLO1(JL)=.TRUE.
          ELSE
            KLAB(JL,JK)=0
            PMFU5(JL,JK)=0.0_JPRB
            PKINEU5(JL,JK)=0.0_JPRB
            ZDMFDE5(JL)=PMFU5(JL,JK+1)
            PLUDE5(JL,JK)=PLU5(JL,JK+1)*ZDMFDE5(JL)
          ENDIF
  
! store detrainment rates for updraught

          IF ( PMFU5(JL,JK+1) > 0.0_JPRB ) THEN
            PMFUDE_RATE5(JL,JK)=ZDMFDE5(JL)
          ENDIF

        ENDIF

      ELSEIF(KTYPE(JL)==2.AND.PQU5(JL,JK) == ZQOLD5(JL)) THEN
        KLAB(JL,JK)=0
        PMFU5(JL,JK)=0.0_JPRB
        PKINEU5(JL,JK)=0.0_JPRB
        ZDMFDE5(JL)=PMFU5(JL,JK+1)
        PLUDE5(JL,JK)=PLU5(JL,JK+1)*ZDMFDE5(JL)
        PMFUDE_RATE5(JL,JK)=ZDMFDE5(JL)

      ENDIF
    ENDDO

!              CALCULATE PRECIPITATION RATE BY
!              ANALYTIC INTEGRATION OF EQUATION FOR L

    DO JL=KIDIA,KFDIA
      IF(LLO1(JL)) THEN
        IF(LDLAND(JL)) THEN
          ZDNOPRC5=5.E-4_JPRB
        ELSE
          ZDNOPRC5=3.E-4_JPRB
        ENDIF
        IF(PLU5(JL,JK) > ZDNOPRC5) THEN
!jfm            ZWU5=MIN(15.,SQRT(2.*MAX(0.1,PKINEU5(JL,JK+1))))
          IF (PKINEU5(JL,JK+1) < 0.1_JPRB) THEN
            Z6S5 = SQRT(2.0_JPRB*0.1_JPRB)
          ELSE
            Z6S5 = SQRT(2.0_JPRB*PKINEU5(JL,JK+1))
          ENDIF
          IF (Z6S5 < 15._JPRB) THEN
            ZWU5 = Z6S5
          ELSE
            ZWU5 = 15._JPRB
          ENDIF
          ZPRCON5=ZPRCDGW/(0.75_JPRB*ZWU5)

!           PARAMETERS FOR BERGERON-FINDEISEN PROCESS (T < -5C)

!jfm            ZDT5=MIN(RTBER-RTICE,MAX(RTBER-PTU5(JL,JK),0.))
          IF ((RTBER-PTU5(JL,JK)) > 0.0_JPRB) THEN
            Z7S5 = RTBER-PTU5(JL,JK)
          ELSE
            Z7S5 = 0.0_JPRB
          ENDIF
          IF ((RTBER-RTICE) < Z7S5) THEN
            ZDT5 = RTBER-RTICE
          ELSE
            ZDT5 = Z7S5
          ENDIF
          ZCBF5=1+Z_CPRC2*SQRT(ZDT5)
          ZZCO5=ZPRCON5*ZCBF5
          ZLCRIT5=ZDNOPRC5/ZCBF5

          ZDFI5=PGEOH5(JL,JK)-PGEOH5(JL,JK+1)
          ZC5=(PLU5(JL,JK)-ZLUOLD5(JL))
          ZD5=ZZCO5*(1.0_JPRB-EXP(-(PLU5(JL,JK)/ZLCRIT5)**2))*ZDFI5
          ZINT5=EXP(-ZD5)
          ZLNEW5=ZLUOLD5(JL)*ZINT5+ZC5/ZD5*(1.0_JPRB-ZINT5)
!jfm            ZLNEW5=MAX(0.,MIN(PLU5(JL,JK),ZLNEW5))
!jfm            ZLNEW5=MIN(CLDMAX,ZLNEW5)
!jfm            ZPRECIP5(JL)=MAX(0.,ZLUOLD5(JL)+ZC5-ZLNEW5)
          IF (PLU5(JL,JK) < ZLNEW5) THEN
            Z8S5 = PLU5(JL,JK)
          ELSE
            Z8S5 =  ZLNEW5
          ENDIF
          IF (Z8S5 < 0.0_JPRB) THEN
            ZLNEW5 = 0.0_JPRB
          ELSE
            ZLNEW5 = Z8S5
          ENDIF
          IF (ZLNEW5 > Z_CLDMAX) THEN
            ZLNEW5 = Z_CLDMAX
          ENDIF
          IF ((ZLUOLD5(JL)+ZC5-ZLNEW5) > 0.0_JPRB) THEN
            ZPRECIP5(JL) = ZLUOLD5(JL)+ZC5-ZLNEW5
          ELSE
            ZPRECIP5(JL) = 0.0_JPRB
          ENDIF
          PDMFUP5(JL,JK)=ZPRECIP5(JL)*PMFU5(JL,JK)
          ZLRAIN5(JL,JK)=ZLRAIN5(JL,JK)+ZPRECIP5(JL)
          PLU5(JL,JK)=ZLNEW5
        ENDIF
      ENDIF
    ENDDO

    IF (LPHYLIN) THEN

      DO JL=KIDIA,KFDIA
        IF(LLO1(JL)) THEN
          IF(ZLRAIN5(JL,JK) > 0.0_JPRB) THEN
            ZVW5=21.18_JPRB*ZLRAIN5(JL,JK)**0.2_JPRB
            ZVI5=Z_CWIFRAC*ZVW5
            ZALFAW5=0.545_JPRB*(TANH(0.17_JPRB*(PTU5(JL,JK)-RLPTRC))+1.0_JPRB)
            ZVV5=ZALFAW5*ZVW5+(1.0_JPRB-ZALFAW5)*ZVI5
            ZROLD5=ZLRAIN5(JL,JK)-ZPRECIP5(JL)
            ZC5=ZPRECIP5(JL)
!jfm            ZWU5=MIN(15.,SQRT(2.*MAX(0.1,PKINEU5(JL,JK))))
            IF (PKINEU5(JL,JK) < 0.1_JPRB) THEN
              Z9S5 = SQRT(2.0_JPRB*0.1_JPRB)
            ELSE
              Z9S5 = SQRT(2.0_JPRB*PKINEU5(JL,JK))
            ENDIF
            IF (Z9S5 > 15._JPRB) THEN
              ZWU5 = 15._JPRB
            ELSE
              ZWU5 = Z9S5
            ENDIF
            ZD5=ZVV5/ZWU5
            ZINT5=EXP(-ZD5)
            ZRNEW5=ZROLD5*ZINT5+ZC5/ZD5*(1.0_JPRB-ZINT5)
!jfm            ZRNEW5=MAX(0.,MIN(ZLRAIN5(JL,JK),ZRNEW5))
            IF (ZLRAIN5(JL,JK) < ZRNEW5) THEN
              Z10S5 = ZLRAIN5(JL,JK)
            ELSE
              Z10S5 = ZRNEW5
            ENDIF
            IF (Z10S5 > 0.0_JPRB) THEN
              ZRNEW5 = Z10S5
            ELSE
              ZRNEW5 = 0.0_JPRB
            ENDIF
            ZLRAIN5(JL,JK)=ZRNEW5
          ENDIF
        ENDIF
      ENDDO

    ELSE

      DO JL=KIDIA,KFDIA
        IF(LLO1(JL)) THEN
          IF(ZLRAIN5(JL,JK) > 0.0_JPRB) THEN
            ZVW5=21.18_JPRB*ZLRAIN5(JL,JK)**0.2_JPRB
            ZVI5=Z_CWIFRAC*ZVW5
            ZALFAW5=FOEALFA(PTU5(JL,JK))
            ZVV5=ZALFAW5*ZVW5+(1.0_JPRB-ZALFAW5)*ZVI5
            ZROLD5=ZLRAIN5(JL,JK)-ZPRECIP5(JL)
            ZC5=ZPRECIP5(JL)
!jfm            ZWU5=MIN(15.,SQRT(2.*MAX(0.1,PKINEU5(JL,JK))))
            IF (PKINEU5(JL,JK) < 0.1_JPRB) THEN
              Z9S5 = SQRT(2.0_JPRB*0.1_JPRB)
            ELSE
              Z9S5 = SQRT(2.0_JPRB*PKINEU5(JL,JK))
            ENDIF
            IF (Z9S5 > 15._JPRB) THEN
              ZWU5 = 15._JPRB
            ELSE
              ZWU5 = Z9S5
            ENDIF
            ZD5=ZVV5/ZWU5
            ZINT5=EXP(-ZD5)
            ZRNEW5=ZROLD5*ZINT5+ZC5/ZD5*(1.0_JPRB-ZINT5)
!jfm            ZRNEW5=MAX(0.,MIN(ZLRAIN5(JL,JK),ZRNEW5))
            IF (ZLRAIN5(JL,JK) < ZRNEW5) THEN
              Z10S5 = ZLRAIN5(JL,JK)
            ELSE
              Z10S5 = ZRNEW5
            ENDIF
            IF (Z10S5 > 0.0_JPRB) THEN
              ZRNEW5 = Z10S5
            ELSE
              ZRNEW5 = 0.0_JPRB
            ENDIF
            ZLRAIN5(JL,JK)=ZRNEW5
          ENDIF
        ENDIF
      ENDDO

    ENDIF

    DO JLL=1,JLM
      JL=JLX(JLL)
      PMFUL5(JL,JK)=PLU5(JL,JK)*PMFU5(JL,JK)
      PMFUS5(JL,JK)=(RCPD*PTU5(JL,JK)+PGEOH5(JL,JK))*PMFU5(JL,JK)
      PMFUQ5(JL,JK)=PQU5(JL,JK)*PMFU5(JL,JK)
    ENDDO

  ENDIF
ENDDO

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

!     5.           FINAL CALCULATIONS 
!                  ------------------

DO JL=KIDIA,KFDIA
  IF(KCTOP(JL) == -1) LDCUM(JL)=.FALSE.
  KCBOT(JL)=MAX(KCBOT(JL),KCTOP(JL))
  IF(LDCUM(JL)) THEN
    PWMEAN5(JL)=MAX(1.E-2_JPRB,PWMEAN5(JL)/MAX(1.0_JPRB,ZDPMEAN5(JL)))
    PWMEAN5(JL)=SQRT(2.0_JPRB*PWMEAN5(JL))
  ENDIF
ENDDO

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