SUBROUTINE CUBASENAD &
 & ( KIDIA,    KFDIA,    KLON,     KLEV,&
 & PTENH5,   PQENH5,   PGEOH5,   PAPH5,&
 & PQHFL5,   PAHFS5,&
 & PTEN5,    PQEN5,    PGEO5,&
 & PUEN5,    PVEN5,&
 & PTU5,     PQU5,     PLU5,     PUU5,     PVU5 ,  pwubase5,&
 & KLAB,     LDCUM,    LDSC,     KCBOT,    KBOTSC,&
 & KCTOP,    KDPL )  

!          THIS ROUTINE CALCULATES CLOUD BASE FIELDS
!          CLOUD BASE HEIGHT AND CLOUD TOP HEIGHT
!          (Trajectory for Adjoint)

!          C Jakob (ECMWF) (complete rewrite 06/2001) 
!          P Bechtold (ECMWF) (looping, mix layer etc. 09/2002) 

!          PURPOSE.
!          --------
!          TO PRODUCE CLOUD BASE AND CLOUD TOP VALUES FOR CU-PARAMETRIZATION

!          INTERFACE
!          ---------
!          THIS ROUTINE IS CALLED FROM *CUMASTRNTL*.
!          INPUT ARE ENVIRONM. VALUES OF T,Q,P,PHI AT HALF LEVELS.
!          IT RETURNS CLOUD FIELDS VALUES AND FLAGS AS FOLLOWS;
!                 KLAB=0 FOR STABLE LAYERS
!                 KLAB=1 FOR SUBCLOUD LEVELS
!                 KLAB=2 FOR CLOUD LEVELS LEVEL

!          METHOD.
!          --------
!          LIFT SURFACE AIR DRY-ADIABATICALLY TO CLOUD TOP
!          (ENTRAINING PLUME, WITH ENTRAINMENT PROPORTIONAL TO (1/Z))

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

!    *KIDIA*        START POINT
!    *KFDIA*        END POINT
!    *KLON*         NUMBER OF GRID POINTS PER PACKET
!    *KLEV*         NUMBER OF LEVELS

!    INPUT PARAMETERS (REAL):

!    *PTENH5*       ENV. TEMPERATURE (T+1) ON HALF LEVELS         (Trajectory)  K
!    *PQENH5*       ENV. SPEC. HUMIDITY (T+1) ON HALF LEVELS      (Trajectory) KG/KG
!    *PQHFL5*       MOISTURE FLUX (EXCEPT FROM SNOW EVAP.)        (Trajectory) KG/(SM2)
!    *PAHFS5*       SENSIBLE HEAT FLUX                            (Trajectory) W/M2

!    *PGEOH5*       GEOPOTENTIAL ON HALF LEVELS                   (Trajectory) M2/S2
!    *PAPH5*        PROVISIONAL PRESSURE ON HALF LEVELS           (Trajectory)  PA
!    *PTEN5*        PROVISIONAL ENVIRONMENT TEMPERATURE (T+1)     (Trajectory) K
!    *PQEN5*        PROVISIONAL ENVIRONMENT SPEC. HUMIDITY (T+1)  (Trajectory) KG/KG
!    *PGEO5*        GEOPOTENTIAL                                  (Trajectory) M2/S2
!    *PUEN5*        PROVISIONAL ENVIRONMENT U-VELOCITY (T+1)      (Trajectory) M/S
!    *PVEN5*        PROVISIONAL ENVIRONMENT V-VELOCITY (T+1)      (Trajectory) M/S
!    *PQHFL5*       MOISTURE FLUX (EXCEPT FROM SNOW EVAP.)        (Trajectory) KG/(SM2)
!    *PAHFS5*       SENSIBLE HEAT FLUX                            (Trajectory) W/M2

!    UPDATED PARAMETERS (REAL):

!    *PTU5*         TEMPERATURE IN UPDRAFTS                      (Trajectory)
!    *PQU5*         SPEC. HUMIDITY IN UPDRAFTS                   (Trajectory)
!    *PLU5*         LIQUID WATER CONTENT IN UPDRAFTS             (Trajectory)
!    *PUU5*         U-VELOCITY IN UPDRAFTS                       (Trajectory)
!    *PVU5*         V-VELOCITY IN UPDRAFTS                       (Trajectory)

!    *PTU*          TEMPERATURE IN UPDRAFTS                         K
!    *PQU*          SPEC. HUMIDITY IN UPDRAFTS                    KG/KG
!    *PLU*          LIQUID WATER CONTENT IN UPDRAFTS              KG/KG
!    *PUU*          U-VELOCITY IN UPDRAFTS                         M/S
!    *PVU*          V-VELOCITY IN UPDRAFTS                         M/S

!    UPDATED PARAMETERS (INTEGER):

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

!    OUTPUT PARAMETERS (LOGICAL):

!    *LDCUM*        FLAG: .TRUE. FOR CONVECTIVE POINTS 
!    *LDSC*         FLAG: .TRUE. IF BL-CLOUDS EXIST

!    OUTPUT PARAMETERS (INTEGER):

!    *KCBOT*       CLOUD BASE LEVEL !    
!    *KCTOP*       CLOUD TOP LEVEL = HEIGHEST HALF LEVEL 
!                                    WITH A NON-ZERO CLOUD UPDRAFT.
!    *KBOTSC*      CLOUD BASE LEVEL OF BL-CLOUDS
!    *KDPL*        DEPARTURE LEVEL

!          EXTERNALS
!          ---------
!          *CUADJTQTL* FOR ADJUSTING T AND Q DUE TO CONDENSATION IN ASCENT

!          MODIFICATIONS
!          -------------
!             02-11-02 : Use fixed last possible departure level and
!                        last updraft computation level for bit-reproducibility
!                              D.Salmond &  J. Hague
!             03-07-03 : Tuning for p690     J. Hague
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!----------------------------------------------------------------------

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

USE YOMCST   , ONLY : RCPD     ,RETV, RD, RG,&
 & RLVTT    ,RLSTT    ,RTT  
USE YOEVDF   , ONLY : RKAP   
USE YOECUMF  , ONLY : LMFDUDV, ENTRPEN, RDEPTHS, NJKT1, NJKT2
USE YOECLDP  , ONLY : RLMIN
USE YOETHF   , ONLY : R2ES     ,R3LES    ,R3IES    ,R4LES    ,&
 & R4IES    ,R5LES    ,R5IES    ,R5ALVCP  ,R5ALSCP  ,&
 & RALVDCP  ,RALSDCP  ,RALFDCP  ,RTWAT    ,RTICE    ,RTICECU  ,RTWAT_RTICE_R,RTWAT_RTICECU_R  

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)    :: PTENH5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQENH5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEOH5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPH5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQHFL5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAHFS5(KLON,KLEV+1) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGEO5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PUEN5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEN5(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) :: PUU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVU5(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWUBASE5(KLON) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KLAB(KLON,KLEV) 
LOGICAL           ,INTENT(INOUT) :: LDCUM(KLON) 
LOGICAL           ,INTENT(OUT)   :: LDSC(KLON) 
INTEGER(KIND=JPIM),INTENT(INOUT) :: KCBOT(KLON) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KBOTSC(KLON) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KCTOP(KLON) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KDPL(KLON) 
INTEGER(KIND=JPIM) ::  ICTOP(KLON),            ICBOT(KLON),&
 & IBOTSC(KLON),           ILAB(KLON,KLEV),&
 & IDPL(KLON)  

!             LOCAL STORAGE
!             ----- -------

LOGICAL ::         LL_LDBASE(KLON),&
 & LLGO_ON(KLON),&
 & LLDEEP(KLON),    LLDCUM(KLON), &
 & LLDSC(KLON),     LLFIRST(KLON)
LOGICAL ::     LLRESET,        LLRESETJL(KLON)  

INTEGER(KIND=JPIM) :: ICALL, IK, IS, JK, JL, JKK, JKT1, JKT2, JKT, JKB ! ,IKB

REAL(KIND=JPRB)    :: ZS5(KLON,KLEV),&
 & ZSENH5(KLON,KLEV+1),&
 & ZQENH5(KLON,KLEV+1),&
 & ZSUH5(KLON,KLEV),&
 & ZWU2H5(KLON,KLEV),&
 & ZBUOH5(KLON,KLEV)  
REAL(KIND=JPRB) ::   ZQOLD5(KLON),ZPH5(KLON)
REAL(KIND=JPRB) :: ZMIX5(KLON)
REAL(KIND=JPRB) :: ZDZ5(KLON),zcbase5(klon)

REAL(KIND=JPRB) ::    ZLU5(KLON,KLEV),   ZQU5(KLON,KLEV),&
 & ZTU5(KLON,KLEV), &
 & ZUU5(KLON,KLEV),   ZVU5(KLON,KLEV)  

REAL(KIND=JPRB) :: ZBUOF5, ZC25, ZEPSADD5 ! ,ZZ5 
REAL(KIND=JPRB) :: ZRHO5     ! DENSITY AT SURFACE (KG/M^3) 
!REAL(KIND=JPRB) :: ZUST5     ! U_STAR (M/S)
REAL(KIND=JPRB) :: ZKHVFL5   ! SURFACE BUOYANCY FLUX (K M/S)
REAL(KIND=JPRB) :: ZWS5      ! SIGMA_W AT LOWEST MODEL HALFLEVEL (M/S)
REAL(KIND=JPRB) :: ZQEXC5    ! HUMIDITY EXCESS AT LOWEST MODEL HALFLEVEL (KG/KG)
REAL(KIND=JPRB) :: ZTEXC5    ! TEMPERATURE EXCESS AT LOWEST MODEL HALFLEVEL (K)
REAL(KIND=JPRB) :: ZEPS5     ! FRACTIONAL ENTRAINMENT RATE   [M^-1]
REAL(KIND=JPRB) :: ZTVENH5   ! ENVIRONMENT VIRTUAL TEMPERATURE AT HALF LEVELS (K)  
REAL(KIND=JPRB) :: ZTVUH5    ! UPDRAFT VIRTUAL TEMPERATURE AT HALF LEVELS     (K)
REAL(KIND=JPRB) :: ZLGLAC5   ! UPDRAFT LIQUID WATER FROZEN IN ONE LAYER
REAL(KIND=JPRB) :: zqsu5, ZCOR5, zdq5, zalfaw5, zfacw5, zfaci5, zfac5,&
 & zesdp5, zdqsdt5, zdtdp5, zdp5,zpdifftop5,zpdiffbot5,ZSF5,ZQF5,&
 & zaw5,zbw5  
REAL(KIND=JPRB) :: ZDTVTRIG5(KLON) ! virtual temperatures
REAL(KIND=JPRB) :: ZWORK15, ZWORK25 ! work arrays for T and w perturbations
REAL(KIND=JPRB) :: ZRCPD5, ZRG5, ZTMP5
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "cuadjtq.intfb.h"
#include "fcttre.h"

!----------------------------------------------------------------------
!     0.           INITIALIZE CONSTANTS AND FIELDS
!                  -------------------------------
!----------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('CUBASENAD',0,ZHOOK_HANDLE)
ZC25    = 0.55_JPRB
ZAW5    = 1.0_JPRB
ZBW5    = 1.0_JPRB
ZEPSADD5= 1.e-4_JPRB

DO JL=KIDIA,KFDIA
  PWUBASE5(JL)=0.0_JPRB
  LLGO_ON(JL)=.TRUE.
  LLFIRST(JL)=.TRUE.
  KDPL(JL)=KLEV
ENDDO

! Set last possible departure level and last updraft computation level
! NOT Bit-reproducible
!DO JK=KLEV+1,2,-1
!  IF((PAPH5(KIDIA,KLEV+1)-PAPH5(KIDIA,JK)) < 350.E2_JPRB ) JKT1=JK
!  IF(PAPH5(KIDIA,JK) > 60.E2_JPRB ) JKT2=JK
!ENDDO

JKT1=NJKT1
JKT2=NJKT2
ZRG5=1.0_JPRB/RG
ZRCPD5=1.0_JPRB/RCPD

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZTU5(JL,JK) = PTU5(JL,JK)
    ZQU5(JL,JK) = PQU5(JL,JK)
    ZLU5(JL,JK) = PLU5(JL,JK)
    ZUU5(JL,JK) = PUU5(JL,JK)
    ZVU5(JL,JK) = PVU5(JL,JK)
    ILAB(JL,JK)= KLAB(JL,JK)
  ENDDO
ENDDO

!       -----------------------------------------------------------
!       1.1  PREPARE FIELDS ON HALF LEVELS BY LINEAR INTERPOLATION
!             OF SPECIFIC HUMIDITY AND STATIC ENERGY
!       -----------------------------------------------------------

DO JK=1,KLEV
  DO JL=KIDIA,KFDIA
    ZWU2H5(JL,JK)=0.0_JPRB
    ZS5   (JL,JK) = RCPD*PTEN5(JL,JK) + PGEO5(JL,JK)
    ZQENH5(JL,JK) = PQENH5(JL,JK)
    ZSENH5(JL,JK) = RCPD*PTENH5(JL,JK)+PGEOH5(JL,JK)
  ENDDO
ENDDO

DO JKK=KLEV,JKT1,-1 ! Big external loop for level testing:
                    ! find first departure level that produces deepest cloud top
                    ! or take surface level for shallow convection and Sc

   !        ---------------------------------------------------------
   !        1.2    INITIALISE FIELDS AT LOWEST HALF MODEL LEVEL
   !        ---------------------------------------------------------

  IS=0
  DO JL=KIDIA,KFDIA
    IF (LLGO_ON(JL)) THEN
      IS=IS+1
      IDPL(JL)    =JKK         ! departure level
      ICBOT  (JL) =JKK         ! cloud base level for convection, (-1 if not found)
      IBOTSC (JL) =KLEV-1      ! sc    base level for sc-clouds , (-1 if not found)
      ICTOP(JL)   =KLEV-1      ! cloud top for convection (-1 if not found)
      LLDCUM  (JL)  =.FALSE.! on exit: true if cloudbase=found
      LLDSC   (JL)  =.FALSE.! on exit: true if cloudbase=found
      LL_LDBASE(JL)    =.FALSE. ! on exit: true if cloudbase=found
      ZDTVTRIG5(JL) =0.0_JPRB   
      ZUU5(JL,JKK) =PUEN5(JL,JKK)*(PAPH5(JL,JKK+1)-PAPH5(JL,JKK))
      ZVU5(JL,JKK) =PVEN5(JL,JKK)*(PAPH5(JL,JKK+1)-PAPH5(JL,JKK))
    ENDIF 
  ENDDO
      
  IF(IS /= 0) THEN

    IF(JKK == KLEV) THEN 
         
      DO JL=KIDIA,KFDIA
        IF (LLGO_ON(JL)) THEN
          ZRHO5  = PAPH5(JL,JKK+1)/(RD*(PTEN5(JL,JKK)*(1.+RETV*PQEN5(JL,JKK))))
          ZKHVFL5= (PAHFS5(JL,JKK+1)/RCPD+RETV*PTEN5(JL,JKK)*PQHFL5(JL,JKK+1))/ZRHO5
         ! ZUST5 = MAX(SQRT(PSSTRU5(JL)**2 + PSSTRV5(JL)**2),ZREPUST)
         ! ZWS5=ZUST5**3._JPRB- 1.5_JPRB*RKAP*ZKHVFL5*PGEOH5(JL,KLEV)/PTEN5(JL,KLEV)
          ZWS5=0.001_JPRB - 1.5_JPRB*RKAP*ZKHVFL5*(PGEOH5(JL,KLEV)-PGEOH5(JL,KLEV+1))/PTEN5(JL,KLEV)
          IF( ZKHVFL5 < 0.0_JPRB ) THEN
            ZWS5=1.2_JPRB*ZWS5**.3333_JPRB
            ILAB(JL,JKK)= 1
            ZTEXC5     = MAX(-1.5_JPRB*PAHFS5(JL,JKK+1)/(ZRHO5*ZWS5*RCPD),0.0_JPRB)
            ZQEXC5     = MAX(-1.5_JPRB*PQHFL5(JL,JKK+1)/(ZRHO5*ZWS5),0.0_JPRB)
            ZQU5 (JL,JKK) = ZQENH5(JL,JKK) + ZQEXC5
            ZSUH5 (JL,JKK) = ZSENH5(JL,JKK) + RCPD*ZTEXC5
            ZTU5 (JL,JKK) = (ZSENH5(JL,JKK)-PGEOH5(JL,JKK))/RCPD + ZTEXC5
            ZLU5 (JL,JKK) = 0.0_JPRB
            ZWU2H5(JL,JKK) = ZWS5**2

        !  determine buoyancy at lowest half level

            ZTVENH5            = (1.0_JPRB+RETV*ZQENH5(JL,JKK)) &
             & *(ZSENH5(JL,JKK)-PGEOH5(JL,JKK))/RCPD  
            ZTVUH5             = (1.0_JPRB+RETV*ZQU5(JL,JKK))*ZTU5(JL,JKK)
            ZBUOH5(JL,JKK) = (ZTVUH5-ZTVENH5)*RG/ZTVENH5
          ELSE
            LLGO_ON(JL)=.FALSE.      ! non-convective point
          ENDIF
        ENDIF
      ENDDO
   
    ELSE

      DO JL=KIDIA,KFDIA
        IF (LLGO_ON(JL)) THEN
          ZRHO5  = PAPH5(JL,JKK+1)/(RD*(PTEN5(JL,JKK)*(1.+RETV*PQEN5(JL,JKK))))
          ILAB(JL,JKK)= 1
          ZTEXC5=.2_JPRB
          ZQEXC5=1.E-4_JPRB
          ZQU5 (JL,JKK) = ZQENH5(JL,JKK) + ZQEXC5
          ZSUH5 (JL,JKK) = ZSENH5(JL,JKK) + RCPD*ZTEXC5
          ZTU5 (JL,JKK) = (ZSENH5(JL,JKK)-PGEOH5(JL,JKK))*ZRCPD5 + ZTEXC5
          ZLU5 (JL,JKK) = 0.0_JPRB
         ! construct mixed layer for parcels emanating in lowest 60 hPa
          IF (PAPH5(JL,KLEV+1)-PAPH5(JL,JKK-1)<60.E2_JPRB) THEN
            ZQU5(JL,JKK) =0.0_JPRB
            ZSUH5(JL,JKK)=0.0_JPRB
            ZWORK15      =0.0_JPRB
            DO JK=JKK+1,JKK-1,-1
              if( ZWORK15 < 50.E2_JPRB ) then
                ZWORK25=PAPH5(JL,JK)-PAPH5(JL,JK-1)
                ZWORK15     =ZWORK15+ZWORK25
                ZQU5(JL,JKK) =ZQU5(JL,JKK) +ZQENH5(JL,JK)*ZWORK25
                ZSUH5(JL,JKK)=ZSUH5(JL,JKK)+ZSENH5(JL,JK)*ZWORK25
              endif
            ENDDO
            ZQU5(JL,JKK) =ZQU5(JL,JKK) /ZWORK15+ZQEXC5
            ZSUH5(JL,JKK)=ZSUH5(JL,JKK)/ZWORK15+RCPD*ZTEXC5
            ZTU5(JL,JKK) =(ZSUH5(JL,JKK)-PGEOH5(JL,JKK))/RCPD+ZTEXC5
          ENDIF
          ZWU2H5(JL,JKK) = 1.0_JPRB

      !  determine buoyancy at lowest half level

          ZTVENH5            = (1.0_JPRB+RETV*ZQENH5(JL,JKK)) &
           & *(ZSENH5(JL,JKK)-PGEOH5(JL,JKK))/RCPD  
          ZTVUH5             = (1.0_JPRB+RETV*ZQU5(JL,JKK))*ZTU5(JL,JKK)
          ZBUOH5(JL,JKK) = (ZTVUH5-ZTVENH5)*RG/ZTVENH5
        ENDIF
      ENDDO
   
    ENDIF

  ENDIF
   
   !                  -------------------------------------
   !     2.0          DO ASCENT IN SUBCLOUD AND LAYER,
   !                  CHECK FOR EXISTENCE OF CONDENSATION LEVEL,
   !                  ADJUST T,Q AND L ACCORDINGLY IN *CUADJTQ*,
   !                  CHECK FOR BUOYANCY AND SET FLAGS
   !                  -------------------------------------
   !       ------------------------------------------------------------
   !        1.2  DO THE VERTICAL ASCENT UNTIL VELOCITY BECOMES NEGATIVE
   !       ------------------------------------------------------------
  DO JK=JKK-1,JKT2,-1
    IS=0

    if(jkk==klev) then ! 1/z mixing for shallow

      DO JL=KIDIA,KFDIA
        IF (LLGO_ON(JL)) THEN
          IS         = IS+1
          ZDZ5(JL)   = (PGEOH5(JL,JK) - PGEOH5(JL,JK+1))*ZRG5
          ZEPS5      = ZC25/((PGEOH5(JL,JK)-PGEOH5(JL,KLEV+1))*ZRG5) + ZEPSADD5
          ZMIX5(JL)       = 0.5_JPRB*ZDZ5(JL)*ZEPS5
          ZQF5 = (PQENH5(JL,JK+1) + PQENH5(JL,JK))*0.5_JPRB
          ZSF5 = (ZSENH5(JL,JK+1) + ZSENH5(JL,JK))*0.5_JPRB
          ZTMP5= 1.0_JPRB/(1.0_JPRB+ZMIX5(JL))
          ZQU5(JL,JK)= (ZQU5(JL,JK+1)*(1.0_JPRB-ZMIX5(JL))&
           & +2.0_JPRB*ZMIX5(jl)*ZQF5) * ZTMP5  
          ZSUH5 (JL,JK)= (ZSUH5(JL,JK+1)*(1.0_JPRB-ZMIX5(JL))&
           & +2.0_JPRB*ZMIX5(jl)*ZSF5) * ZTMP5  
          ZQOLD5(JL)  = ZQU5(JL,JK)
          ZTU5 (JL,JK) = (ZSUH5(JL,JK)-PGEOH5(JL,JK))*ZRCPD5
          ZPH5  (JL)    = PAPH5(JL,JK)
        ENDIF
      ENDDO
     
    else

      DO JL=KIDIA,KFDIA
        IF (LLGO_ON(JL)) THEN
          IS         = IS+1
          ZDZ5(JL)        = (PGEOH5(JL,JK) - PGEOH5(JL,JK+1))*ZRG5
          ZQF5 = (PQENH5(JL,JK+1) + PQENH5(JL,JK))*0.5_JPRB
          ZSF5 = (ZSENH5(JL,JK+1) + ZSENH5(JL,JK))*0.5_JPRB
         !ZMIX5(JL)=ENTRPEN*ZDZ5(JL)
          ZMIX5(JL)=2.0_JPRB*ENTRPEN*ZDZ5(Jl)*(PAPH5(JL,JK)/PAPH5(JL,KLEV+1))**3
          ZQU5(JL,JK)= ZQU5(JL,JK+1)*(1.0_JPRB-ZMIX5(JL))+ ZQF5*ZMIX5(JL)
          ZSUH5(JL,JK)= ZSUH5(JL,JK+1)*(1.0_JPRB-ZMIX5(JL))+ ZSF5*ZMIX5(JL)
          ZQOLD5(JL)  = ZQU5(JL,JK)
          ZTU5 (JL,JK) = (ZSUH5(JL,JK)-PGEOH5(JL,JK))*ZRCPD5
          ZPH5  (JL)    = PAPH5(JL,JK)
        ENDIF
      ENDDO
  
    endif
       
    IF (IS == 0) EXIT
     
    IK=JK
    ICALL=1
   
   !      CALL CUADJTQTL
   !     *   ( KIDIA,    KFDIA,    KLON,     KTDIA,    KLEV
   !     *   , IK
   !     *   , ZPH5,     ZTU5,     ZQU5
   !     *   , ZPH,      ZTU,      ZQU,      LLFLAG,   ICALL)
     
    CALL CUADJTQ &
     & ( KIDIA,    KFDIA,    KLON,    KLEV,      IK,&
     &   ZPH5,     ZTU5,     ZQU5,    LLGO_ON,   ICALL)  
   
   !DIR$ IVDEP
   !OCL NOVREC
   
    DO JL=KIDIA,KFDIA
      IF(LLGO_ON(JL)) THEN
   
   ! add condensation to water
   
        ZDQ5=MAX(ZQOLD5(JL)-ZQU5(JL,JK),0.0_JPRB)
        ZLU5(JL,JK)=ZLU5(jl,jk+1)+ZDQ5
   
   ! freezing
   
   ! note: thermodynamic functions (FOE) need changing when 
   ! this becomes a proper TL
   
        ZLGLAC5=ZDQ5*((1.0_JPRB-FOEALFCU(ZTU5(JL,JK)))-&
         & (1.0_JPRB-FOEALFCU(ZTU5(JL,JK+1))))  
              
   ! pseudo-microphysics
   
        if(jkk==klev) then  ! no precip for shallow
          ZLU5(JL,JK)=MIN(ZLU5(JL,JK),5.E-3_JPRB)
       !* chose a more pseudo-adiabatic formulation as original overestimates
       !* water loading efect and therefore strongly underestimates cloud thickness
        else
          ZLU5(JL,JK)=0.5_JPRB*ZLU5(JL,JK)
        endif
   
   ! update dry static energy after condensation + freezing
   
        ZSUH5(JL,JK)    = RCPD*(ZTU5(jl,jk)+RALFDCP*ZLGLAC5)+PGEOH5(JL,JK)
         
   ! Buoyancy on half and full levels
            
        ZTVUH5           = (1.0_JPRB+RETV*ZQU5(JL,JK)-ZLU5(JL,JK))*ZTU5(JL,JK)&
         & +RALFDCP*ZLGLAC5  
        ZTVENH5          = (1.0_JPRB+RETV*ZQENH5(JL,JK)) &
         & *(ZSENH5(JL,JK)-PGEOH5(JL,JK))/RCPD  
        ZBUOH5(JL,JK)   = (ZTVUH5-ZTVENH5)*RG/ZTVENH5
        ZBUOF5          = (ZBUOH5(JL,JK) + ZBUOH5(JL,JK+1))*0.5_JPRB
   
   ! solve kinetic energy equation
   
        ZWU2H5(JL,JK)   =  ZWU2H5(JL,JK+1)*(1.0_JPRB-2.0_JPRB*zbw5*ZMIX5(jl))/&
         & (1.0_JPRB+2.0_JPRB*ZBW5*ZMIX5(jl))&
         & + 2.0_JPRB*ZAW5*ZBUOF5*ZDZ5(jl)/(1.0_JPRB+2.0_JPRB*ZBW5*ZMIX5(jl))  
   
   ! first layer with liquid water - find exact cloud base
   
   ! note: thermodynamic functions (FOE) need changing when 
   ! this becomes a proper TL
   
        IF(ZLU5(JL,JK) >0.0_JPRB.AND.ILAB(JL,JK+1)==1) THEN
           
          IK=JK+1
          ZQSU5=FOEEWM(ZTU5(JL,IK))/PAPH5(JL,IK)
          ZQSU5=MIN(0.5_JPRB,ZQSU5)
          ZCOR5=1.0_JPRB/(1.0_JPRB-RETV  *ZQSU5)
          ZQSU5=ZQSU5*ZCOR5
          ZDQ5=MIN(0._JPRB,ZQU5(JL,IK)-ZQSU5)
          ZALFAW5=FOEALFA(ZTU5(JL,IK))
          ZFACW5=R5LES/((ZTU5(jl,ik)-R4LES)**2)
          ZFACI5=R5IES/((ZTU5(jl,ik)-R4IES)**2)
          ZFAC5=ZALFAW5*ZFACW5+(1.-ZALFAW5)*ZFACI5
          ZESDP5=FOEEWM(ZTU5(JL,IK))/PAPH5(jl,ik)
          ZCOR5=1.0_JPRB/(1.0_JPRB-RETV*ZESDP5)
          ZDQSDT5=ZFAC5*ZCOR5*ZQSU5
          ZDTDP5=RD*ZTU5(JL,IK)/(RCPD*PAPH5(JL,IK))
          ZDP5=ZDQ5/(ZDQSDT5*ZDTDP5)
          ZCBASE5(JL)=PAPH5(JL,IK)+ZDP5
           
   ! chose nearest half level as cloud base
   
          ZPDIFFTOP5=ZCBASE5(JL)-PAPH5(JL,JK)
          ZPDIFFBOT5=PAPH5(JL,JK+1)-ZCBASE5(jl)
           
          IF(ZPDIFFTOP5 > ZPDIFFBOT5.AND.ZWU2H5(JL,JK+1)>0.0_JPRB) THEN
            JKB=MIN(KLEV-1,JK+1)
            ILAB(JL,JKB)=2
            ILAB(JL,JK)=2
            LL_LDBASE(JL) =.TRUE.
            LLDSC(JL)   =.TRUE.
            IBOTSC(JL) =JKB
            ICBOT(JL)  =JKB
            ZLU5(JL,JK+1) = RLMIN
          ELSEIF(ZPDIFFTOP5 <= ZPDIFFBOT5.AND.ZWU2H5(JL,JK)>0.0_JPRB) THEN
            ILAB(JL,JK)=2
            LL_LDBASE(JL) =.TRUE.
            LLDSC(JL)   =.TRUE.
            IBOTSC(JL) =JK
            ICBOT(JL)  =JK
          ENDIF
          JKB=ICBOT(JL)

        ENDIF
   
   ! decide on presence of convection, cloud base and cloud top based on
   ! kinetic energy
   
        IF (ZWU2H5(JL,JK) < 0.0_JPRB) THEN
          LLGO_ON(JL) = .FALSE.
          IF (ZLU5(JL,JK+1)>0.0_JPRB) THEN
            ICTOP(JL)   = JK
            LLDCUM(JL)   = .TRUE.
          ELSE
            LLDCUM(JL)   = .FALSE.
          ENDIF
        ELSE
          IF (ZLU5(JL,JK)>0.0_JPRB) then
            ILAB(JL,JK) = 2
          ELSE
            ILAB(JL,JK) = 1
          ENDIF
        ENDIF
      ENDIF
    ENDDO
   
    IF(LMFDUDV.AND.JKK==KLEV) THEN
      DO JL=KIDIA,KFDIA
        IF(.NOT.LL_LDBASE(JL).AND.LLGO_ON(JL)) THEN
          ZUU5(JL,JKK)=ZUU5(JL,JKK)+PUEN5(JL,JK)*(PAPH5(JL,JK+1)-PAPH5(JL,JK))
          ZVU5(JL,JKK)=ZVU5(JL,JKK)+PVEN5(JL,JK)*(PAPH5(JL,JK+1)-PAPH5(JL,JK))
        ENDIF
      ENDDO
    ENDIF
   
    IF (IS == 0) EXIT
  ENDDO
   
  IF( JKK==KLEV) THEN
      ! set values for departure level for PBL clouds = first model level
    DO JL=KIDIA,KFDIA
      LDSC(JL)  = LLDSC(JL)
      IF(LDSC(JL)) THEN
        KBOTSC(JL)= IBOTSC(JL)
      ELSE
        KBOTSC(JL)=-1
      ENDIF
   
      LLGO_ON(JL) = .FALSE.
      JKT=ICTOP(JL)
      JKB=ICBOT(JL)
      LLDEEP(JL)=PAPH5(JL,JKB)-PAPH5(JL,JKT)>RDEPTHS
      IF(LLDEEP(JL)) LLDCUM(JL)=.FALSE. ! no deep allowed for KLEV
      lldeep(jl)=.false. ! for deep convection start only at level KLEV-1
                            ! and form mixed layer, so go on
      ! test further for deep convective columns as not yet found
      IF ( LLDEEP(JL) ) LLFIRST(JL)=.FALSE.
      LLGO_ON(JL) = .NOT.LLDEEP(JL)
      IF(LLDCUM(JL)) THEN
        KCBOT(JL)= ICBOT(JL)
        KCTOP(JL)= ICTOP(JL)
        KDPL(JL)  = IDPL(JL)
        LDCUM(JL) = LLDCUM(JL)
        PWUBASE5(JL)=SQRT(MAX(ZWU2H5(JL,JKB),0.0_JPRB))
      ELSE
        KCTOP(JL)=-1
        KCBOT(JL)=-1
        KDPL(JL) =KLEV-1
        LDCUM(JL)=.FALSE.
        PWUBASE5(JL)=0.0_JPRB
      ENDIF
    ENDDO
    DO JK=KLEV,1,-1
      DO JL=KIDIA,KFDIA
        JKT=ICTOP(JL)
        IF ( JK>=JKT ) THEN
          KLAB(JL,JK)=ILAB(JL,JK)
          PTU5(JL,JK)=ZTU5(JL,JK)
          PQU5(JL,JK)=ZQU5(JL,JK)
          PLU5(JL,JK)=ZLU5(JL,JK)
        ENDIF
      ENDDO
    ENDDO
  ! IF(LMFDUDV) THEN
  !   DO JL=KIDIA,KFDIA
  !     IF(LDCUM(JL)) THEN
  !       IKB=KCBOT(JL)
  !       ZZ5=1.0_JPRB/(PAPH5(JL,JKK+1)-PAPH5(JL,IKB))
  !       PUU5(JL,JKK)=ZUU5(JL,JKK)*ZZ5
  !       PVU5(JL,JKK)=ZVU5(JL,JKK)*ZZ5
  !     ENDIF
  !   ENDDO
  ! ENDIF
  ENDIF
   
  IF( JKK < KLEV ) THEN  
    LLRESET=.FALSE.
    DO JL=KIDIA,KFDIA
      IF ( .NOT.LLDEEP(JL) ) THEN
        JKT=ICTOP(JL)
        JKB=ICBOT(JL)
           ! test on cloud thickness and buoyancy
        LLDEEP(JL)=PAPH5(JL,JKB)-PAPH5(JL,JKT)>=RDEPTHS
       ! LLDEEP(JL)=PAPH5(JL,JKB)-PAPH5(JL,JKT)>=RDEPTHS &
       !   &.AND. ZDTVTRIG5(JL)>0._JPRB
      ENDIF
      LLRESETJL(JL)=LLDEEP(JL).AND.LLFIRST(JL)
      LLRESET=LLRESET.OR.LLRESETJL(JL)
    ENDDO


    IF(LLRESET) THEN
      DO JK=KLEV,1,-1
        DO JL=KIDIA,KFDIA
         ! keep first departure level that produces deep cloud
!          IF ( LLDEEP(JL) .AND. LLFIRST(JL) ) THEN 
          IF ( LLRESETJL(JL) ) THEN 
            JKT=ICTOP(JL)
            JKB=IDPL(JL)
            IF ( JK<=JKB .AND. JK>=JKT ) THEN
              KLAB(JL,JK)=ILAB(JL,JK)
              PTU5(JL,JK)=ZTU5(JL,JK)
              PQU5(JL,JK)=ZQU5(JL,JK)
              PLU5(JL,JK)=ZLU5(JL,JK)
            ELSE 
              KLAB(JL,JK)=1
              PTU5(JL,JK)=PTENH5(JL,JK)
              PQU5(JL,JK)=PQENH5(JL,JK)
              PLU5(JL,JK)=0.0_JPRB
            ENDIF
            IF ( JK<JKT ) KLAB(JL,JK)=0
          ENDIF
        ENDDO
      ENDDO
    ENDIF

    DO JL=KIDIA,KFDIA
      IF ( LLDEEP(JL) .AND. LLFIRST(JL) ) THEN
        KDPL(JL)  = IDPL(JL)
        KCTOP(JL) = ICTOP(JL)
        KCBOT(JL) = ICBOT(JL)
        LDCUM(JL) = LLDCUM(JL)
        LDSC(JL)  = .FALSE.
        KBOTSC(JL)= -1
        JKB=KCBOT(JL)
        PWUBASE5(JL)=SQRT(MAX(ZWU2H5(JL,JKB),0.0_JPRB))
!  no initialization of wind for deep here, this is done in
!  CUINI and CUASCN
        LLFIRST(JL)=.FALSE.
      ENDIF
      LLGO_ON(JL) = .NOT.LLDEEP(JL)
    ENDDO
  ENDIF

ENDDO ! end of big loop for search of departure level

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