!     ######spl
    SUBROUTINE CONVECTION( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,             &
                           PDTCONV, ODEEP, OSHAL, OREFRESH_ALL, ODOWN, KICE,   &
                           OSETTADJ, PTADJD, PTADJS,                           &
                           KENSM,                                              &
                           PPABS, PZZ, PDXDY,                                  &
                           PT, PRV, PRC, PRI, PU, PV, PW,                      &
                           KCOUNT, PTTEN, PRVTEN, PRCTEN, PRITEN,              &
                           PPRTEN, PPRSTEN,                                    &
                           PUMF, PDMF, PPRLFLX, PPRSFLX, PCAPE, KCLTOP, KCLBAS,& 
                           OCHTRANS, KCH1, PCH1, PCH1TEN                       )
!   ############################################################################
!
!!**** Interface routine to the fast MNH convection code developed for ECMWF/ARPEGE IFS
!!     having a structure typical for operational routines
!!
!!
!!    PURPOSE
!!    -------
!!      The routine interfaces the MNH convection code as developed for operational
!!      forecast models like ECMWF, ARPEGE or HIRLAM with the typical MNH array structure
!!      Calls the deep and/or shallow convection routine
!!
!!
!!**  METHOD
!!    ------
!!     Returns one tendency for shallow+deep convection but each part can
!!     be activated/desactivated separately.
!!     For deep convection one can enable up to 3 additional ensemble members
!!     - this substantially improves the smoothness of the scheme and 
!!       allows for runs with different cloud radii (entrainment rates) and 
!!       reduces the arbitrariness inherent to convective trigger condition
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!    CONVECT_DEEP
!!    CONVECT_SHALLOW
!!    INI_CONVPAR, INI_CONVPAR1
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    11/12/98 
!!      Modif       11/04/O2 allow for ensemble of deep updrafts/downdrafts
!!
!!    REFERENCE
!!    ---------
!!    Bechtold et al., 2001, Quart. J. Roy. Meteor. Soc., Vol 127, pp 869-886: 
!!           A mass flux convection scheme for regional and global models.
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                  INTENT(IN) :: KLON     ! horizontal dimension
INTEGER,                  INTENT(IN) :: KLEV     ! vertical dimension
INTEGER,                  INTENT(IN) :: KIDIA    ! value of the first point in x
INTEGER,                  INTENT(IN) :: KFDIA    ! value of the last point in x
INTEGER,                  INTENT(IN) :: KBDIA    ! vertical  computations start at
!                                                ! KBDIA that is at least 1
INTEGER,                  INTENT(IN) :: KTDIA    ! vertical computations can be
                                                 ! limited to KLEV + 1 - KTDIA
                                                 ! default=1
REAL,                     INTENT(IN) :: PDTCONV  ! Interval of time between two
                                                 ! calls of the deep convection
                                                 ! scheme
LOGICAL,                  INTENT(IN) :: ODEEP    ! switch for deep convection
LOGICAL,                  INTENT(IN) :: OSHAL    ! switch for shallow convection
LOGICAL,                  INTENT(IN) :: OREFRESH_ALL ! refresh or not all 
                                                 ! tendencies  at every call
LOGICAL,                  INTENT(IN) :: ODOWN    ! take or not convective
                                                 ! downdrafts into account
INTEGER,                  INTENT(IN) :: KICE     ! flag for ice ( 1 = yes, 
                                                 !                0 = no ice )
INTEGER,                  INTENT(IN) :: KENSM    ! number of additional deep convection calls
                                                 ! for ensemble (presently limited to 3)
                                                 ! KENSM=0 corresponds to base run with
                                                 ! 1 deep and 1 shallow call
LOGICAL,                  INTENT(IN) :: OSETTADJ ! logical to set convective
                                                 ! adjustment time by user
REAL,                     INTENT(IN) :: PTADJD   ! user defined deep adjustment time (s)
REAL,                     INTENT(IN) :: PTADJS   ! user defined shal. adjustment time (s)
!
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PT     ! grid scale T at time t  (K)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRV    ! grid scale water vapor  (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRC    ! grid scale r_c  (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRI    ! grid scale r_i  (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU     ! grid scale horiz. wind u (m/s) 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV     ! grid scale horiz. wind v (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PW     ! grid scale vertical velocity (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABS  ! grid scale pressure (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ    ! height of model layer (m) 
REAL, DIMENSION(KLON),      INTENT(IN) :: PDXDY  ! grid area (m2)
!   
INTEGER, DIMENSION(KLON), INTENT(INOUT):: KCOUNT   ! convective counter(recompute
                                                   ! tendency or keep it
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN  ! convective temperat. tendency (K/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
REAL, DIMENSION(KLON),      INTENT(INOUT):: PPRTEN ! total surf precipitation tendency (m/s)
REAL, DIMENSION(KLON),      INTENT(INOUT):: PPRSTEN! solid surf precipitation tendency (m/s)
!
! Chemical Tracers:
LOGICAL,                    INTENT(IN)        :: OCHTRANS ! flag to compute convective
                                                          ! transport for chemical tracer
INTEGER,                    INTENT(IN)        :: KCH1     ! number of species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN)   :: PCH1     ! grid scale chemical species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN  ! chemical convective tendency
                                                          ! (1/s)
!					 
! Diagnostic variables:
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF   ! updraft mass flux   (kg/s m2)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF   ! downdraft mass flux (kg/s m2)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PPRLFLX! liquid precip flux  (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PPRSFLX! solid precip flux   (m/s)
REAL, DIMENSION(KLON),   INTENT(INOUT)    :: PCAPE  ! CAPE (J/kg)
INTEGER, DIMENSION(KLON),INTENT(INOUT)    :: KCLTOP ! cloud top level (number of model level)
INTEGER, DIMENSION(KLON),INTENT(INOUT)    :: KCLBAS ! cloud base level(number of model level)
                                                    ! they are given a value of
                                                    ! 0 if no convection
!						 
!*       0.2   Declarations of local variables :
!
INTEGER  :: JI, JK, JN  ! loop index
!
REAL, DIMENSION(KLON)               :: ZTIMEC, ZPRLTEN
!
! special for shallow convection
REAL, DIMENSION(:,:), ALLOCATABLE   :: ZTTENS, ZRVTENS, ZRCTENS, ZRITENS,  &
                                       ZUMFS
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZCH1TENS
INTEGER, DIMENSION(:), ALLOCATABLE  :: ICLBASS, ICLTOPS
!
!*       0.3   Declarations of additional Ensemble fields:
!
INTEGER                             :: KENS     ! number of allowed additional deep convection calls
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTTENE   ! convective temperat. tendency (K/s)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRVTENE  ! convective r_v tendency (1/s)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRCTENE  ! convective r_c tendency (1/s)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZRITENE  ! convective r_i tendency (1/s)
REAL, DIMENSION(:,:),   ALLOCATABLE :: ZPRLTENE ! liquid surf precipitation tendency (m/s)
REAL, DIMENSION(:,:),   ALLOCATABLE :: ZPRSTENE ! solid surf precipitation tendency (m/s)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZUMFE    ! updraft mass flux   (kg/s m2)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDMFE    ! downdraft mass flux (kg/s m2)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRLFLXE ! liquid precip flux  (m/s)
REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZPRSFLXE ! solid precip flux   (m/s)
REAL, DIMENSION(:,:,:,:),ALLOCATABLE:: ZCH1TENE ! chemical convective tendency
INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICLTOPE  ! cloud top level (number of model level)
INTEGER, DIMENSION(:,:),ALLOCATABLE :: ICLBASE  ! cloud base level(number of model level)
REAL, DIMENSION(:),     ALLOCATABLE :: ZEDUMMY  ! field not to be recomputed by ensemble
INTEGER, DIMENSION(:),  ALLOCATABLE :: IEDUMMY  ! field not to be recomputed by ensemble
REAL, DIMENSION(:),     ALLOCATABLE :: ZWEIGHT  ! weighting factor for ensemble members
REAL                                :: ZSUM     ! sum of weighting factors
!
!-------------------------------------------------------------------------------
!
!
!*       0.5  Allocate 2D (horizontal, vertical) arrays and additional ensemble arrays
!             ------------------------------------------------------------------------
!
    ALLOCATE( ZTTENS(KLON,KLEV) ); ALLOCATE( ZRVTENS(KLON,KLEV) ) 
    ALLOCATE( ZRCTENS(KLON,KLEV) ); ALLOCATE( ZRITENS(KLON,KLEV) ) 
    ALLOCATE( ZCH1TENS(KLON,KLEV,KCH1) ) 
    ALLOCATE( ZUMFS(KLON,KLEV) )
    ALLOCATE( ICLBASS(KLON) ); ALLOCATE( ICLTOPS(KLON) )
!
    KCLTOP(:)  = 1 ! set default value when no convection
    KCLBAS(:)  = 1 ! can be changed  depending on user
    ICLTOPS(:) = 1
    ICLBASS(:) = 1
!
KENS = MIN( KENSM, 3 )
IF ( KENS > 0 ) THEN
    ALLOCATE( ZTTENE(KLON,KLEV,KENS) )
    ALLOCATE( ZRVTENE(KLON,KLEV,KENS) )
    ALLOCATE( ZRCTENE(KLON,KLEV,KENS) )
    ALLOCATE( ZRITENE(KLON,KLEV,KENS) )
    ALLOCATE( ZUMFE(KLON,KLEV,KENS) )
    ALLOCATE( ZDMFE(KLON,KLEV,KENS) )
    ALLOCATE( ZCH1TENE(KLON,KLEV,KCH1,KENS) )
    ALLOCATE( ZPRLFLXE(KLON,KLEV,KENS) )
    ALLOCATE( ZPRSFLXE(KLON,KLEV,KENS) )
    ALLOCATE( ZPRLTENE(KLON,KENS) )
    ALLOCATE( ZPRSTENE(KLON,KENS) )
    ALLOCATE( ICLTOPE(KLON,KENS) )
    ALLOCATE( ICLBASE(KLON,KENS) )
    ALLOCATE( ZEDUMMY(KLON) )
    ALLOCATE( IEDUMMY(KLON) )
    ALLOCATE( ZWEIGHT(KENS) )
END IF
!
!*       4.a  Call deep convection routine
!             ----------------------------
!
IF ( ODEEP ) THEN
!
! 1. Base version
!
    CALL INI_CONVPAR
!
    IF ( OSETTADJ ) ZTIMEC(:) = PTADJD

!
    CALL CONVECT_DEEP( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,           &
                          PDTCONV, KICE, OREFRESH_ALL, ODOWN, OSETTADJ,  & 
                          PPABS, PZZ, PDXDY, ZTIMEC,                     &
                          PT, PRV, PRC, PRI, PU, PV, PW,                 &
                          KCOUNT, PTTEN, PRVTEN, PRCTEN, PRITEN,         &
                          ZPRLTEN, PPRSTEN,                              &
                          KCLTOP, KCLBAS, PPRLFLX, PPRSFLX,              & 
                          PUMF, PDMF, PCAPE,                             &
                          OCHTRANS, KCH1, PCH1, PCH1TEN                  )
!
!  2. Additional Ensemble members
!
    IF ( KENS > 0 ) THEN
!
    CALL INI_CONVPAR1
!
!* first member - changes in MODD_CONVPAR (cloud radius of 500 m or so)
!                                          specified in INI_CONVPAR1
!
    CALL CONVECT_DEEP( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,                                   &
                          PDTCONV, KICE, OREFRESH_ALL, ODOWN, OSETTADJ,                          & 
                          PPABS, PZZ, PDXDY, ZTIMEC,                                             &
                          PT, PRV, PRC, PRI, PU, PV, PW,                                         &
                          IEDUMMY, ZTTENE(:,:,1), ZRVTENE(:,:,1), ZRCTENE(:,:,1), ZRITENE(:,:,1),&
                          ZPRLTENE(:,1), ZPRSTENE(:,1),                                          &
                          ICLTOPE(:,1), ICLBASE(:,1), ZPRLFLXE(:,:,1), ZPRSFLXE(:,:,1),          & 
                          ZUMFE(:,:,1), ZDMFE(:,:,1), ZEDUMMY,                                   &
                          OCHTRANS, KCH1, PCH1, ZCH1TENE(:,:,:,1)                                )
    END IF
!
    IF ( KENS > 1 ) THEN
!
    CALL INI_CONVPAR
!
!* second member (positive vertical velocity perturb for Trigger)
!
    CALL CONVECT_DEEP( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,                                   &
                          PDTCONV, KICE, OREFRESH_ALL, ODOWN, OSETTADJ,                          & 
                          PPABS, PZZ, PDXDY, ZTIMEC,                                             &
                          PT, PRV, PRC, PRI, PU, PV, PW*1.5+1.e-4,                               &
                          IEDUMMY, ZTTENE(:,:,2), ZRVTENE(:,:,2), ZRCTENE(:,:,2), ZRITENE(:,:,2),&
                          ZPRLTENE(:,2), ZPRSTENE(:,2),                                          &
                          ICLTOPE(:,2), ICLBASE(:,2), ZPRLFLXE(:,:,2), ZPRSFLXE(:,:,2),          & 
                          ZUMFE(:,:,2), ZDMFE(:,:,2), ZEDUMMY,                                   &
                          OCHTRANS, KCH1, PCH1, ZCH1TENE(:,:,:,2)                                )
    END IF
!
    IF ( KENS > 2 ) THEN
!
!* third member (negative vertical velocity perturb for Trigger)
!
    CALL CONVECT_DEEP( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,                                   &
                          PDTCONV, KICE, OREFRESH_ALL, ODOWN, OSETTADJ,                          & 
                          PPABS, PZZ, PDXDY, ZTIMEC,                                             &
                          PT, PRV, PRC, PRI, PU, PV, PW*.5-1.e-4,                                &
                          IEDUMMY, ZTTENE(:,:,3), ZRVTENE(:,:,3), ZRCTENE(:,:,3), ZRITENE(:,:,3),&
                          ZPRLTENE(:,3), ZPRSTENE(:,3),                                          &
                          ICLTOPE(:,3), ICLBASE(:,3), ZPRLFLXE(:,:,3), ZPRSFLXE(:,:,3),          & 
                          ZUMFE(:,:,3), ZDMFE(:,:,3), ZEDUMMY,                                   &
                          OCHTRANS, KCH1, PCH1, ZCH1TENE(:,:,:,3)                                )
    END IF
!
ENDIF
IF ( .NOT. ODEEP ) THEN
     KCOUNT(:)  =0
     PTTEN(:,:) =0.
     PRVTEN(:,:)=0.
     PRCTEN(:,:)=0.
     PRITEN(:,:)=0.
     PUMF(:,:)  =0.
     PDMF(:,:)  =0.
   ! KCLTOP(:)  =1
   ! KCLBAS(:)  =1
     PCH1TEN(:,:,:)=0.
     ZPRLTEN(:)  =0.
     PPRSTEN(:)  =0.
     PPRLFLX(:,:)=0.
     PPRSFLX(:,:)=0.
     PCAPE(:)    =0.
END IF
!
!*       4.b  Call shallow convection routine
!             -------------------------------
!
IF ( OSHAL ) THEN
!
    IF ( .NOT. ODEEP ) CALL INI_CONVPAR 
    CALL INI_CONVPAR_SHAL
!
    CALL CONVECT_SHALLOW( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,        &
                             PDTCONV, KICE, OSETTADJ, PTADJS,            &
                             PPABS, PZZ,                                 &
                             PT, PRV, PRC, PRI, PW,                      &
                             ZTTENS, ZRVTENS, ZRCTENS, ZRITENS,          &
                             ICLTOPS, ICLBASS, ZUMFS,                    &
                             OCHTRANS, KCH1, PCH1, ZCH1TENS              )
ENDIF
IF ( .NOT. OSHAL ) THEN
     ZTTENS(:,:) =0.
     ZRVTENS(:,:)=0.
     ZRCTENS(:,:)=0.
     ZRITENS(:,:)=0.
     ZUMFS(:,:)  =0
   ! ICLTOPS(:)  =1
   ! ICLBASS(:)  =1
     ZCH1TENS(:,:,:)=0.
END IF
!
!*       5.  Add  - if activated - ensemble average values for deep 
!            and then shallow convective tendencies
!            ---------------------------------------------------------
!
ZSUM = 1.
IF ( KENS > 0 ) THEN
    IF ( KENS == 1 ) ZWEIGHT(:) = .5
    IF ( KENS >  1 ) ZWEIGHT(:) = 1.
    DO JN = 1, KENS
       PTTEN(:,:)  = PTTEN(:,:)  + ZWEIGHT(JN) * ZTTENE(:,:,JN)
       PRVTEN(:,:) = PRVTEN(:,:) + ZWEIGHT(JN) * ZRVTENE(:,:,JN)
       PRCTEN(:,:) = PRCTEN(:,:) + ZWEIGHT(JN) * ZRCTENE(:,:,JN)
       PRITEN(:,:) = PRITEN(:,:) + ZWEIGHT(JN) * ZRITENE(:,:,JN)
       PPRLFLX(:,:)= PPRLFLX(:,:)+ ZWEIGHT(JN) * ZPRLFLXE(:,:,JN)
       PPRSFLX(:,:)= PPRSFLX(:,:)+ ZWEIGHT(JN) * ZPRSFLXE(:,:,JN)
       PUMF(:,:)   = PUMF(:,:)   + ZWEIGHT(JN) * ZUMFE(:,:,JN)
       PDMF(:,:)   = PDMF(:,:)   + ZWEIGHT(JN) * ZDMFE(:,:,JN)
       ZPRLTEN(:)  = ZPRLTEN(:)  + ZWEIGHT(JN) * ZPRLTENE(:,JN)
       PPRSTEN(:)  = PPRSTEN(:)  + ZWEIGHT(JN) * ZPRSTENE(:,JN)
       KCLTOP(:)   = MAX(KCLTOP(:), ICLTOPE(:,JN))
       KCLBAS(:)   = MAX(KCLBAS(:), ICLBASE(:,JN))
       IF ( OCHTRANS )  &
         & PCH1TEN(:,:,:) = PCH1TEN(:,:,:) + ZWEIGHT(JN) * ZCH1TENE(:,:,:,JN)
    END DO
!
    ZSUM = 1. / ( 1. + SUM( ZWEIGHT(:) ) )
END IF
!
       PTTEN(:,:)  = PTTEN(:,:)  * ZSUM + ZTTENS(:,:) 
       PRVTEN(:,:) = PRVTEN(:,:) * ZSUM + ZRVTENS(:,:)
       PRCTEN(:,:) = PRCTEN(:,:) * ZSUM + ZRCTENS(:,:)
       PRITEN(:,:) = PRITEN(:,:) * ZSUM + ZRITENS(:,:)
       PPRLFLX(:,:)= PPRLFLX(:,:)* ZSUM
       PPRSFLX(:,:)= PPRSFLX(:,:)* ZSUM
       PUMF(:,:)   = PUMF(:,:)   * ZSUM + ZUMFS(:,:)
       PDMF(:,:)   = PDMF(:,:)   * ZSUM
       PPRTEN(:)   = ( ZPRLTEN(:) + PPRSTEN(:) ) * ZSUM
       PPRSTEN(:)  = PPRSTEN(:)  * ZSUM
       KCLTOP(:)   = MAX(KCLTOP(:), ICLTOPS(:))
       KCLBAS(:)   = MAX(KCLBAS(:), ICLBASS(:))
    IF ( OCHTRANS ) THEN
          PCH1TEN(:,:,:) = PCH1TEN(:,:,:) * ZSUM + ZCH1TENS(:,:,:)
    END IF
!
!*       6.  Deallocate local arrays
!
       DEALLOCATE( ICLBASS ); DEALLOCATE( ICLTOPS )
       DEALLOCATE( ZUMFS )
       DEALLOCATE( ZCH1TENS ) 
       DEALLOCATE( ZRCTENS ); DEALLOCATE( ZRITENS ) 
       DEALLOCATE( ZTTENS ); DEALLOCATE( ZRVTENS ) 

IF ( KENS > 0 ) THEN
       DEALLOCATE( ZTTENE );   DEALLOCATE( ZRVTENE )
       DEALLOCATE( ZRCTENE );  DEALLOCATE( ZRITENE )
       DEALLOCATE( ZUMFE );    DEALLOCATE( ZDMFE )
       DEALLOCATE( ZCH1TENE )
       DEALLOCATE( ZPRLFLXE ); DEALLOCATE( ZPRSFLXE )
       DEALLOCATE( ZPRLTENE ); DEALLOCATE( ZPRSTENE )
       DEALLOCATE( ZEDUMMY );  DEALLOCATE( IEDUMMY )
       DEALLOCATE( ZWEIGHT )
END IF
!
!
END SUBROUTINE CONVECTION
!     ######spl
      MODULE MODD_CONVPAREXT
!     ######################
!
IMPLICIT NONE
!
INTEGER, SAVE :: JCVEXB ! start vertical computations at
                        ! 1 + JCVEXB = 1 + ( KBDIA - 1 )
INTEGER, SAVE :: JCVEXT ! limit vertical computations to
                        ! KLEV - JCVEXT = KLEV - ( KTDIA - 1 )
!
END MODULE MODD_CONVPAREXT
!     ######spl
      MODULE MODD_CST
!     ###############
!
IMPLICIT NONE
!
REAL, SAVE :: XP00   ! reference pressure
REAL, SAVE :: XPI    ! Pi
REAL, SAVE ::  XG    ! gravity constant
REAL, SAVE :: XMD    ! molecular weight of dry air
REAL, SAVE :: XMV    ! molecular weight of water vapor
REAL, SAVE :: XRD    ! gaz constant for dry air
REAL, SAVE :: XRV    ! gaz constant for water vapor
REAL, SAVE :: XCPD   ! specific heat of dry air
REAL, SAVE :: XCPV   ! specific heat of water vapor
REAL, SAVE :: XRHOLW ! density of liquid water
REAL, SAVE :: XCL    ! specific heat of liquid water
REAL, SAVE :: XCI    ! specific heat of ice
REAL, SAVE :: XTT    ! triple point temperature
REAL, SAVE :: XLVTT  ! latent heat of vaporisation at XTT
REAL, SAVE :: XLSTT  ! latent heat of sublimation at XTT 
REAL, SAVE :: XLMTT  ! latent heat of melting at XTT
REAL, SAVE :: XESTT  ! saturation pressure at XTT
REAL, SAVE :: XALPW  ! constants in saturation pressure over liquid water
REAL, SAVE :: XBETAW 
REAL, SAVE :: XGAMW 
REAL, SAVE :: XALPI  ! constants in saturation pressure over ice
REAL, SAVE :: XBETAI 
REAL, SAVE :: XGAMI 
!
END MODULE MODD_CST
!     ######spl
      MODULE MODD_CONVPAR
!     ###################
!
!!****  *MODD_CONVPAR* - Declaration of convection constants 
!!
!!    PURPOSE
!!    -------
!      The purpose of this declarative module is to declare  the 
!      constants in the deep convection parameterization.    
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!      Book2 of documentation of Meso-NH (MODD_CONVPAR)
!!          
!!    AUTHOR
!!    ------
!!      P. Bechtold   *Laboratoire d'Aerologie*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96                      
!!   Last modified  15/11/96
!-------------------------------------------------------------------------------
!
!*       0.   DECLARATIONS
!             ------------
!
IMPLICIT NONE 
!
REAL, SAVE :: XA25        ! 25 km x 25 km reference grid area
!
REAL, SAVE :: XCRAD       ! cloud radius 
REAL, SAVE :: XCDEPTH     ! minimum necessary cloud depth
REAL, SAVE :: XENTR       ! entrainment constant (m/Pa) = 0.2 (m)  
!
REAL, SAVE :: XZLCL       ! maximum allowed allowed height 
                          ! difference between departure level and surface
REAL, SAVE :: XZPBL       ! minimum mixed layer depth to sustain convection
REAL, SAVE :: XWTRIG      ! constant in vertical velocity trigger
REAL, SAVE :: XDTHPBL     ! temperature perturbation in PBL for trigger
REAL, SAVE :: XDRVPBL     ! moisture perturbation in PBL for trigger
!
!
REAL, SAVE :: XNHGAM      ! accounts for non-hydrost. pressure 
                          ! in buoyancy term of w equation
                          ! = 2 / (1+gamma)
REAL, SAVE :: XTFRZ1      ! begin of freezing interval
REAL, SAVE :: XTFRZ2      ! end of freezing interval
!
REAL, SAVE :: XRHDBC      ! relative humidity below cloud in downdraft
!
REAL, SAVE :: XRCONV      ! constant in precipitation conversion 
REAL, SAVE :: XSTABT      ! factor to assure stability in  fractional time
                          ! integration, routine CONVECT_CLOSURE
REAL, SAVE :: XSTABC      ! factor to assure stability in CAPE adjustment,
                          !  routine CONVECT_CLOSURE
REAL, SAVE :: XUSRDPTH    ! pressure thickness used to compute updraft
                          ! moisture supply rate for downdraft
REAL, SAVE :: XMELDPTH    ! layer (Pa) through which precipitation melt is
                          ! allowed below  melting level
REAL, SAVE :: XUVDP       ! constant for pressure perturb in momentum transport
!
END MODULE MODD_CONVPAR 
!     ######spl
      SUBROUTINE INI_CONVPAR
!     ######################
!
!!****  *INI_CONVPAR * - routine to initialize the constants modules 
!!
!!    PURPOSE
!!    -------
!       The purpose of this routine is to initialize  the constants
!     stored in  modules MODD_CONVPAR, MODD_CST, MODD_CONVPAREXT.
!      
!
!!**  METHOD
!!    ------
!!      The deep convection constants are set to their numerical values 
!!     
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CONVPAR   : contains deep convection constants
!!      Module MODD_CST       : contains physical constants
!!
!!    REFERENCE
!!    ---------
!!      Book2 of the documentation (module MODD_CONVPAR, routine INI_CONVPAR)
!!      
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Last modified  15/04/98 adapted for ARPEGE
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CONVPAR
USE MODD_CST
!
IMPLICIT NONE
!  
!-------------------------------------------------------------------------------
!
!*       1.    Set the thermodynamical and numerical constants for
!              the deep convection parameterization
!              ---------------------------------------------------
!
!
XA25     = 625.E6    ! 25 km x 25 km reference grid area
!
XCRAD    = 1500.     ! cloud radius 
XCDEPTH  = 3.E3      ! minimum necessary cloud depth
XENTR    = 0.03      ! entrainment constant (m/Pa) = 0.2 (m)  
!
XZLCL    = 3.5E3     ! maximum allowed allowed height 
                     ! difference between the surface and the LCL
XZPBL    = 60.E2     ! minimum mixed layer depth to sustain convection
XWTRIG   = 6.00      ! constant in vertical velocity trigger
XDTHPBL  = .3        ! Temp. perturbation in PBL for trigger
XDRVPBL  = 1.e-4     ! moisture  perturbation in PBL for trigger
!
!
XNHGAM   = 1.3333    ! accounts for non-hydrost. pressure 
                     ! in buoyancy term of w equation
                     ! = 2 / (1+gamma)
XTFRZ1   = 273.16    ! begin of freezing interval
XTFRZ2   = 250.16    ! end of freezing interval
!
XRHDBC   = 0.9       ! relative humidity below cloud in downdraft

XRCONV   = 0.015     ! constant in precipitation conversion 
XSTABT   = 0.75      ! factor to assure stability in  fractional time
                     ! integration, routine CONVECT_CLOSURE
XSTABC   = 0.95      ! factor to assure stability in CAPE adjustment,
                     !  routine CONVECT_CLOSURE
XUSRDPTH = 165.E2    ! pressure thickness used to compute updraft
                     ! moisture supply rate for downdraft
XMELDPTH = 200.E2    ! layer (Pa) through which precipitation melt is
                     ! allowed below downdraft
XUVDP    = 0.7       ! constant for pressure perturb in momentum transport
!
!
!*       2.    Set the fundamental thermodynamical constants
!              these have the same values (not names) as in ARPEGE IFS 
!              -------------------------------------------------------
!
!
XP00   = 1.E5        ! reference pressure
XPI    = 3.141592654 ! Pi
 XG    = 9.80665     ! gravity constant
XMD    = 28.9644E-3  ! molecular weight of dry air
XMV    = 18.0153E-3  ! molecular weight of water vapor
XRD    = 287.05967   ! gaz constant for dry air
XRV    = 461.524993  ! gaz constant for water vapor
XCPD   = 1004.708845 ! specific heat of dry air
XCPV   = 1846.1      ! specific heat of water vapor
XRHOLW = 1000.       ! density of liquid water
XCL    = 4218.       ! specific heat of liquid water
XCI    = 2106.       ! specific heat of ice
XTT    = 273.16      ! triple point temperature
XLVTT  = 2.5008E6    ! latent heat of vaporisation at XTT
XLSTT  = 2.8345E6    ! latent heat of sublimation at XTT 
XLMTT  = 0.3337E6    ! latent heat of melting at XTT
XESTT  = 611.14      ! saturation pressure at XTT
XALPW  = 60.22416    ! constants in saturation pressure over liquid water
XBETAW = 6822.459384
XGAMW  = 5.13948
XALPI  = 32.62116    ! constants in saturation pressure over ice
XBETAI = 6295.421
XGAMI  = 0.56313
!
!
END SUBROUTINE INI_CONVPAR 
!     ######spl
      SUBROUTINE INI_CONVPAR1
!     #######################
!
!!****  *INI_CONVPAR * - routine to initialize the convective constants modules 
!!                       with modifications for ensemble run.
!!
!!    PURPOSE
!!    -------
!       The purpose of this routine is to initialize  the constants
!     stored in  modules MODD_CONVPAR, MODD_CST, MODD_CONVPAREXT.
!      
!
!!**  METHOD
!!    ------
!!      The deep convection constants are set to their numerical values 
!!     
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CONVPAR   : contains deep convection constants
!!
!!    REFERENCE
!!    ---------
!!      Book2 of the documentation (module MODD_CONVPAR, routine INI_CONVPAR)
!!      
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Last modified  15/04/98 adapted for ARPEGE
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CONVPAR
!
IMPLICIT NONE
!  
!-------------------------------------------------------------------------------
!
!*       1.    Set the thermodynamical and numerical constants for
!              the deep convection parameterization
!              ---------------------------------------------------
!
!
XA25     = 625.E6    ! 25 km x 25 km reference grid area
!
XCRAD    =  500.     ! cloud radius 
XCDEPTH  = 3.E3      ! minimum necessary cloud depth
XENTR    = 0.03      ! entrainment constant (m/Pa) = 0.2 (m)  
!
XZLCL    = 3.5E3     ! maximum allowed allowed height 
                     ! difference between the surface and the LCL
XZPBL    = 60.E2     ! minimum mixed layer depth to sustain convection
XWTRIG   = 6.00      ! constant in vertical velocity trigger
XDTHPBL  = .3        ! Temp. perturbation in PBL for trigger
XDRVPBL  = 1.e-4     ! moisture  perturbation in PBL for trigger
!
!
XNHGAM   = 1.3333    ! accounts for non-hydrost. pressure 
                     ! in buoyancy term of w equation
                     ! = 2 / (1+gamma)
XTFRZ1   = 273.16    ! begin of freezing interval
XTFRZ2   = 250.16    ! end of freezing interval
!
XRHDBC   = 0.9       ! relative humidity below cloud in downdraft

XRCONV   = 0.015     ! constant in precipitation conversion 
XSTABT   = 0.75      ! factor to assure stability in  fractional time
                     ! integration, routine CONVECT_CLOSURE
XSTABC   = 0.95      ! factor to assure stability in CAPE adjustment,
                     !  routine CONVECT_CLOSURE
XUSRDPTH = 165.E2    ! pressure thickness used to compute updraft
                     ! moisture supply rate for downdraft
XMELDPTH = 200.E2    ! layer (Pa) through which precipitation melt is
                     ! allowed below downdraft
XUVDP    = 0.7       ! constant for pressure perturb in momentum transport
!
!
END SUBROUTINE INI_CONVPAR1 
!     ######spl
    SUBROUTINE CONVECT_DEEP( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,           &
                                PDTCONV, KICE, OREFRESH, ODOWN, OSETTADJ,      &
                                PPABST, PZZ, PDXDY, PTIMEC,                    &
                                PTT, PRVT, PRCT, PRIT, PUT, PVT, PWT,          &
                                KCOUNT, PTTEN, PRVTEN, PRCTEN, PRITEN,         &
                                PPRLTEN, PPRSTEN,                              &
                                KCLTOP, KCLBAS, PPRLFLX, PPRSFLX,              &
                                PUMF, PDMF, PCAPE,                             &
                                OCH1CONV, KCH1, PCH1, PCH1TEN                  )
!   ############################################################################
!
!!**** Monitor routine to compute all convective tendencies by calls
!!     of several subroutines.
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the convective
!!      tendencies. The routine first prepares all necessary grid-scale
!!      variables. The final convective tendencies are then computed by
!!      calls of different subroutines.
!!
!!
!!**  METHOD
!!    ------
!!      We start by selecting convective columns in the model domain through
!!      the call of routine TRIGGER_FUNCT. Then, we allocate memory for the
!!      convection updraft and downdraft variables and gather the grid scale
!!      variables in convective arrays. 
!!      The updraft and downdraft computations are done level by level starting
!!      at the  bottom and top of the domain, respectively.
!!      All computations are done on MNH thermodynamic levels. The depth
!!      of the current model layer k is defined by DP(k)=P(k-1)-P(k)
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!    CONVECT_TRIGGER_FUNCT 
!!    CONVECT_SATMIXRATIO
!!    CONVECT_UPDRAFT
!!        CONVECT_CONDENS
!!        CONVECT_MIXING_FUNCT
!!    CONVECT_TSTEP_PREF
!!    CONVECT_DOWNDRAFT
!!    CONVECT_PRECIP_ADJUST
!!    CONVECT_CLOSURE
!!        CONVECT_CLOSURE_THRVLCL
!!        CONVECT_CLOSURE_ADJUST
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                   ! gravity constant
!!          XPI                  ! number Pi
!!          XP00                 ! reference pressure
!!          XRD, XRV             ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV           ! specific heat for dry air and water vapor
!!          XRHOLW               ! density of liquid water
!!          XALPW, XBETAW, XGAMW ! constants for water saturation pressure
!!          XTT                  ! triple point temperature
!!          XLVTT, XLSTT         ! vaporization, sublimation heat constant
!!          XCL, XCI             ! specific heat for liquid water and ice
!!
!!      Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT       ! extra levels on the vertical boundaries
!!
!!      Module MODD_CONVPAR
!!          XA25                 ! reference grid area
!!          XCRAD                ! cloud radius
!!
!!         
!!    REFERENCE
!!    ---------
!!
!!      Bechtold et al., 2001, Quart. J. Roy. Meteor. Soc. : 
!!           A mass flux convection scheme for regional and global models.
!!      Kain and Fritsch, 1990, J. Atmos. Sci., Vol. 47, 2784-2801.
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol. 24, 165-170.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Peter Bechtold 04/10/97 replace theta_il by enthalpy
!!         "        10/12/98 changes for ARPEGE
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAREXT
USE MODD_CONVPAR
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                    INTENT(IN) :: KLON     ! horizontal dimension
INTEGER,                    INTENT(IN) :: KLEV     ! vertical dimension
INTEGER,                    INTENT(IN) :: KIDIA    ! value of the first point in x
INTEGER,                    INTENT(IN) :: KFDIA    ! value of the last point in x
INTEGER,                    INTENT(IN) :: KBDIA    ! vertical  computations start at
!                                                  ! KBDIA that is at least 1
INTEGER,                    INTENT(IN) :: KTDIA    ! vertical computations can be
                                                   ! limited to KLEV + 1 - KTDIA
                                                   ! default=1
REAL,                       INTENT(IN) :: PDTCONV  ! Interval of time between two
                                                   ! calls of the deep convection
                                                   ! scheme
INTEGER,                    INTENT(IN) :: KICE     ! flag for ice ( 1 = yes, 
                                                   !                0 = no ice )
LOGICAL,                    INTENT(IN) :: OREFRESH ! refresh or not tendencies
						   ! at every call
LOGICAL,                    INTENT(IN) :: ODOWN    ! take or not convective
						   ! downdrafts into account
LOGICAL,                    INTENT(IN) :: OSETTADJ ! logical to set convective
                                                   ! adjustment time by user 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT      ! grid scale temperature at t
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT     ! grid scale water vapor "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT     ! grid scale r_c  "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT     ! grid scale r_i "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUT      ! grid scale horiz. wind u "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PVT      ! grid scale horiz. wind v "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT      ! grid scale vertical 
						   ! velocity (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST   ! grid scale pressure at t
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ      ! height of model layer (m) 
REAL, DIMENSION(KLON),      INTENT(IN) :: PDXDY    ! horizontal grid area (m-a2)
REAL, DIMENSION(KLON),      INTENT(IN) :: PTIMEC   ! value of convective adjustment
                                                   ! time if OSETTADJ=.TRUE.
!   
INTEGER, DIMENSION(KLON),   INTENT(INOUT):: KCOUNT ! convective counter (recompute
                                                   ! tendency or keep it)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN  ! convective temperature
						   ! tendency (K/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
REAL, DIMENSION(KLON),      INTENT(INOUT):: PPRLTEN! liquid surf. precipitation
                                                   ! tendency (m/s)
REAL, DIMENSION(KLON),      INTENT(INOUT):: PPRSTEN! solid surf. precipitation
                                                   ! tendency (m/s)
INTEGER, DIMENSION(KLON),   INTENT(INOUT):: KCLTOP ! cloud top level
INTEGER, DIMENSION(KLON),   INTENT(INOUT):: KCLBAS ! cloud base level
                                                   ! they are given a value of
                                                   ! 0 if no convection
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRLFLX! liquid precip flux (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PPRSFLX! solid  precip flux (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF   ! updraft mass flux (kg/s m2)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF   ! downdraft mass flux (kg/s m2)
REAL, DIMENSION(KLON),      INTENT(INOUT):: PCAPE  ! maximum CAPE (J/kg)
!
LOGICAL,                    INTENT(IN) :: OCH1CONV ! include tracer transport
INTEGER,                    INTENT(IN) :: KCH1     ! number of species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
!
!
!*       0.2   Declarations of local fixed memory variables :
!
INTEGER  :: ITEST, ICONV, ICONV1    ! number of convective columns
INTEGER  :: IIB, IIE                ! horizontal loop bounds
INTEGER  :: IKB, IKE                ! vertical loop bounds
INTEGER  :: IKS                     ! vertical dimension
INTEGER  :: JI, JL                  ! horizontal loop index
INTEGER  :: JN                      ! number of tracers
INTEGER  :: JK, JKP, JKM            ! vertical loop index
INTEGER  :: IFTSTEPS                ! only used for chemical tracers
REAL     :: ZEPS, ZEPSA, ZEPSB      ! R_d / R_v, R_v / R_d, XCPV / XCPD - ZEPSA
REAL     :: ZCPORD, ZRDOCP          ! C_p/R_d,  R_d/C_p
!
LOGICAL, DIMENSION(KLON, KLEV)     :: GTRIG3 ! 3D logical mask for convection 
LOGICAL, DIMENSION(KLON)           :: GTRIG  ! 2D logical mask for trigger test
REAL, DIMENSION(KLON,KLEV)         :: ZTHT, ZSTHV, ZSTHES  ! grid scale theta, 
							   ! theta_v, theta_es
REAL, DIMENSION(KLON)              :: ZTIME  ! convective time period
REAL, DIMENSION(KLON)              :: ZWORK2, ZWORK2B ! work array
!
!
!*       0.2   Declarations of local allocatable  variables :
!
INTEGER, DIMENSION(:),ALLOCATABLE  :: IDPL    ! index for parcel departure level
INTEGER, DIMENSION(:),ALLOCATABLE  :: IPBL    ! index for source layer top
INTEGER, DIMENSION(:),ALLOCATABLE  :: ILCL    ! index for lifting condensation level 
INTEGER, DIMENSION(:),ALLOCATABLE  :: IETL    ! index for zero buoyancy level
INTEGER, DIMENSION(:),ALLOCATABLE  :: ICTL    ! index for cloud top level
INTEGER, DIMENSION(:),ALLOCATABLE  :: ILFS    ! index for level of free sink
INTEGER, DIMENSION(:),ALLOCATABLE  :: IDBL    ! index for downdraft base level  
INTEGER, DIMENSION(:),ALLOCATABLE  :: IML     ! melting level  
!
INTEGER, DIMENSION(:), ALLOCATABLE :: ISDPL   ! index for parcel departure level
INTEGER, DIMENSION(:),ALLOCATABLE  :: ISPBL   ! index for source layer top
INTEGER, DIMENSION(:), ALLOCATABLE :: ISLCL   ! index for lifting condensation level 
REAL, DIMENSION(:), ALLOCATABLE    :: ZSTHLCL ! updraft theta at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSTLCL  ! updraft temp. at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSRVLCL ! updraft rv at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSWLCL  ! updraft w at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSZLCL  ! LCL height
REAL, DIMENSION(:), ALLOCATABLE    :: ZSTHVELCL! envir. theta_v at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSDXDY  ! grid area (m^2)
!
! grid scale variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZZ      ! height of model layer (m) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZPRES   ! grid scale pressure
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDPRES  ! pressure difference between 
                                              ! bottom and top of layer (Pa)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZU      ! grid scale horiz. u component on theta grid
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZV      ! grid scale horiz. v component on theta grid
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZW      ! grid scale vertical velocity on theta grid
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTT     ! temperature
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTH     ! grid scale theta     
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHV    ! grid scale theta_v     
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHL    ! grid scale enthalpy (J/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHES, ZTHEST ! grid scale saturated theta_e
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRW     ! grid scale total water (kg/kg) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRV     ! grid scale water vapor (kg/kg) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRC     ! grid scale cloud water (kg/kg) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRI     ! grid scale cloud ice (kg/kg) 
REAL, DIMENSION(:),   ALLOCATABLE  :: ZDXDY   ! grid area (m^2)
!
! updraft variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUMF    ! updraft mass flux (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUER    ! updraft entrainment (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUDR    ! updraft detrainment (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUPR    ! updraft precipitation in
                                              ! flux units (kg water / s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUTHL   ! updraft enthalpy (J/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUTHV   ! updraft theta_v (K)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURW    ! updraft total water (kg/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURC    ! updraft cloud water (kg/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURI    ! updraft cloud ice   (kg/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURR    ! liquid precipit. (kg/kg)
                                              ! produced in  model layer
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURS    ! solid precipit. (kg/kg)
                                              ! produced in  model layer
REAL, DIMENSION(:),   ALLOCATABLE  :: ZUTPR   ! total updraft precipitation (kg/s)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZMFLCL  ! cloud base unit mass flux(kg/s) 
REAL, DIMENSION(:),   ALLOCATABLE  :: ZCAPE   ! available potent. energy     
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTHLCL  ! updraft theta at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTLCL   ! updraft temp. at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZRVLCL  ! updraft rv at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZWLCL   ! updraft w at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZZLCL   ! LCL height
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTHVELCL! envir. theta_v at LCL
!
! downdraft variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDMF    ! downdraft mass flux (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDER    ! downdraft entrainment (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDDR    ! downdraft detrainment (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDTHL   ! downdraft enthalpy (J/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDRW    ! downdraft total water (kg/kg)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZMIXF   ! mixed fraction at LFS        
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTPR    ! total surf precipitation (kg/s)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZSPR    ! solid surf precipitation (kg/s)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZDTEVR  ! donwndraft evapor. (kg/s)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZPREF   ! precipitation efficiency
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDTEVRF ! donwndraft evapor. (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZPRLFLX ! liquid precip flux
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZPRSFLX ! solid precip flux
!
! closure variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZLMASS  ! mass of model layer (kg)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTIMEA  ! advective time period
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTIMEC, ZTIMED! time during which convection is
                                              ! active at grid point (as ZTIME)
!
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHC    ! conv. adj. grid scale theta
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRVC    ! conv. adj. grid scale r_w 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRCC    ! conv. adj. grid scale r_c 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRIC    ! conv. adj. grid scale r_i 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZWSUB   ! envir. compensating subsidence (Pa/s)
!
LOGICAL, DIMENSION(:),ALLOCATABLE  :: GTRIG1  ! logical mask for convection    
LOGICAL, DIMENSION(:),ALLOCATABLE  :: GWORK   ! logical work array
INTEGER, DIMENSION(:),ALLOCATABLE  :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX!hor.index
REAL, DIMENSION(:),   ALLOCATABLE  :: ZCPH    ! specific heat C_ph 
REAL, DIMENSION(:),   ALLOCATABLE  :: ZLV, ZLS! latent heat of vaporis., sublim.
REAL                               :: ZES     ! saturation vapor mixng ratio
!
! Chemical Tracers:
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1    ! grid scale chemical specy (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C   ! conv. adjust. chemical specy 1
REAL, DIMENSION(:,:),   ALLOCATABLE:: ZWORK3  ! work arrays 
LOGICAL, DIMENSION(:,:,:),ALLOCATABLE::GTRIG4 ! logical mask
!
!-------------------------------------------------------------------------------
!
!
!*       0.3    Compute loop bounds
!               -------------------
!
IIB = KIDIA
IIE = KFDIA
JCVEXB = MAX( 0, KBDIA - 1 )
IKB = 1 + JCVEXB 
IKS = KLEV
JCVEXT = MAX( 0, KTDIA - 1 )
IKE = IKS - JCVEXT 
!
!
!*       0.5    Update convective counter ( where KCOUNT > 0 
!               convection is still active ).
!               ---------------------------------------------
!
KCOUNT(IIB:IIE) = KCOUNT(IIB:IIE) - 1 
!
IF ( OREFRESH ) THEN
KCOUNT(:) = 1
KCOUNT(IIB:IIE) = 0 ! refresh or not at every call
END IF
!
GTRIG(:)  = KCOUNT(:) <= 0
ITEST = COUNT( GTRIG(:) )
IF ( ITEST == 0 ) RETURN  ! if convection is already active at every grid point
                          ! exit CONVECT_DEEP
!
!
!*       0.7    Reset convective tendencies to zero if convective
!               counter becomes negative
!               -------------------------------------------------
!
GTRIG3(:,:) = SPREAD( GTRIG(:), DIM=2, NCOPIES=IKS )
WHERE ( GTRIG3(:,:) ) 
    PTTEN(:,:)  = 0.
    PRVTEN(:,:) = 0.
    PRCTEN(:,:) = 0.
    PRITEN(:,:) = 0.
    PPRLFLX(:,:)= 0.
    PPRSFLX(:,:)= 0.
!   PUTEN(:,:)  = 0.
!   PVTEN(:,:)  = 0.
    PUMF(:,:)   = 0.
    PDMF(:,:)   = 0.
END WHERE
WHERE ( GTRIG(:) ) 
   PPRLTEN(:) = 0.
   PPRSTEN(:) = 0.
!  KCLTOP(:)  = 0 ! already initialized in CONVECTION
!  KCLBAS(:)  = 0
   PCAPE(:)   = 0.
END WHERE
IF ( OCH1CONV ) THEN
   ALLOCATE( GTRIG4(KLON,KLEV,KCH1) )
   GTRIG4(:,:,:) = SPREAD( GTRIG3(:,:), DIM=3, NCOPIES=KCH1 )
   WHERE( GTRIG4(:,:,:) ) PCH1TEN(:,:,:) = 0.
   DEALLOCATE( GTRIG4 )
END IF
!
!
!*       1.     Initialize  local variables
!               ----------------------------
!
ZEPS   = XRD / XRV
ZEPSA  = XRV / XRD 
ZEPSB  = XCPV / XCPD - ZEPSA
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
!
!
!*       1.1    Set up grid scale theta, theta_v, theta_es 
!               ------------------------------------------
!
ZTHT(:,:) = 300.
ZSTHV(:,:)= 300.
ZSTHES(:,:) = 400.
DO JK = IKB, IKE
DO JI = IIB, IIE
   IF ( PPABST(JI,JK) > 40.E2 ) THEN
      ZTHT(JI,JK)  = PTT(JI,JK) * ( XP00 / PPABST(JI,JK) ) ** ZRDOCP
      ZSTHV(JI,JK) = ZTHT(JI,JK) * ( 1. + ZEPSA * PRVT(JI,JK) ) /              &
                     ( 1. + PRVT(JI,JK) + PRCT(JI,JK) + PRIT(JI,JK) )
!
          ! use conservative Bolton (1980) formula for theta_e
          ! it is used to compute CAPE for undilute parcel ascent
          ! For economical reasons we do not use routine CONVECT_SATMIXRATIO here
!
      ZES = EXP( XALPW - XBETAW / PTT(JI,JK) - XGAMW * LOG( PTT(JI,JK) ) )
      ZES = MIN( 1., ZEPS * ZES / ( PPABST(JI,JK) - ZES ) )
      ZSTHES(JI,JK) = PTT(JI,JK) * ( ZTHT(JI,JK) / PTT(JI,JK) ) **             &
                ( 1. - 0.28 * ZES ) * EXP( MIN(500.,                           &
                                           ( 3374.6525 / PTT(JI,JK) - 2.5403 ) &
                                          * ZES * ( 1. + 0.81 * ZES ) ) )
   END IF
END DO
END DO
!
!
!
!*       2.     Test for convective columns and determine properties at the LCL 
!               --------------------------------------------------------------
!
!*       2.1    Allocate arrays depending on number of model columns that need
!               to be tested for convection (i.e. where no convection is present
!               at the moment.
!               --------------------------------------------------------------
!
     ALLOCATE( ZPRES(ITEST,IKS) )
     ALLOCATE( ZZ(ITEST,IKS) )
     ALLOCATE( ZW(ITEST,IKS) )
     ALLOCATE( ZTH(ITEST,IKS) )
     ALLOCATE( ZTHV(ITEST,IKS) )
     ALLOCATE( ZTHEST(ITEST,IKS) )
     ALLOCATE( ZRV(ITEST,IKS) )
     ALLOCATE( ZSTHLCL(ITEST) )
     ALLOCATE( ZSTLCL(ITEST) )
     ALLOCATE( ZSRVLCL(ITEST) )
     ALLOCATE( ZSWLCL(ITEST) )
     ALLOCATE( ZSZLCL(ITEST) )
     ALLOCATE( ZSTHVELCL(ITEST) )
     ALLOCATE( ISDPL(ITEST) )
     ALLOCATE( ISPBL(ITEST) )
     ALLOCATE( ISLCL(ITEST) )
     ALLOCATE( ZSDXDY(ITEST) )
     ALLOCATE( GTRIG1(ITEST) )
     ALLOCATE( ZCAPE(ITEST) )
     ALLOCATE( IINDEX(KLON) )
     ALLOCATE( IJSINDEX(ITEST) )
     DO JI = 1, KLON
        IINDEX(JI) = JI
     END DO
     IJSINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
!
  DO JK = IKB, IKE
  DO JI = 1, ITEST
     JL = IJSINDEX(JI)
     ZPRES(JI,JK)  = PPABST(JL,JK)
     ZZ(JI,JK)     = PZZ(JL,JK)
     ZTH(JI,JK)    = ZTHT(JL,JK)
     ZTHV(JI,JK)   = ZSTHV(JL,JK)
     ZTHEST(JI,JK) = ZSTHES(JL,JK)
     ZRV(JI,JK)    = MAX( 0., PRVT(JL,JK) )
     ZW(JI,JK)     = PWT(JL,JK)
  END DO
  END DO
  DO JI = 1, ITEST
     JL = IJSINDEX(JI)
     ZSDXDY(JI)    = PDXDY(JL)
  END DO
!
!*       2.2    Compute environm. enthalpy and total water = r_v + r_i + r_c 
!               and envir. saturation theta_e
!               ------------------------------------------------------------
!
!
!*       2.3    Test for convective columns and determine properties at the LCL 
!               --------------------------------------------------------------
!
     ISLCL(:) = MAX( IKB, 2 )   ! initialize DPL PBL and LCL 
     ISDPL(:) = IKB
     ISPBL(:) = IKB
!
!
     CALL CONVECT_TRIGGER_FUNCT( ITEST, KLEV,                              &
                                 ZPRES, ZTH, ZTHV, ZTHEST,                 &
                                 ZRV, ZW, ZZ, ZSDXDY,                      &
                                 ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, &
                                 ZSTHVELCL, ISLCL, ISDPL, ISPBL, GTRIG1,   &
                                 ZCAPE )
!
     DO JI = 1, ITEST
        JL = IJSINDEX(JI)
        PCAPE(JL) = ZCAPE(JI)
     END DO
!
     DEALLOCATE( ZPRES )
     DEALLOCATE( ZZ )
     DEALLOCATE( ZTH )
     DEALLOCATE( ZTHV )
     DEALLOCATE( ZTHEST )
     DEALLOCATE( ZRV )
     DEALLOCATE( ZW )
     DEALLOCATE( ZCAPE )
!
!
!*       3.     After the call of TRIGGER_FUNCT we allocate all the dynamic
!               arrays used in the convection scheme using the mask GTRIG, i.e.
!               we do calculus only in convective columns. This corresponds to
!               a GATHER operation.
!               --------------------------------------------------------------
!
     ICONV = COUNT( GTRIG1(:) )
     IF ( ICONV == 0 )  THEN 
         DEALLOCATE( ZSTHLCL )
         DEALLOCATE( ZSTLCL )
         DEALLOCATE( ZSRVLCL )
         DEALLOCATE( ZSWLCL )
         DEALLOCATE( ZSZLCL )
         DEALLOCATE( ZSTHVELCL )
         DEALLOCATE( ZSDXDY )
         DEALLOCATE( ISLCL )
         DEALLOCATE( ISDPL )
         DEALLOCATE( ISPBL )
         DEALLOCATE( GTRIG1 )
         DEALLOCATE( IINDEX )
         DEALLOCATE( IJSINDEX )
         RETURN   ! no convective column has been found, exit CONVECT_DEEP
     ENDIF
!
     ! vertical index variables
!
         ALLOCATE( IDPL(ICONV) )
         ALLOCATE( IPBL(ICONV) )
         ALLOCATE( ILCL(ICONV) )
         ALLOCATE( ICTL(ICONV) )
         ALLOCATE( IETL(ICONV) )
!
	 ! grid scale variables
!
         ALLOCATE( ZZ(ICONV,IKS) )
         ALLOCATE( ZPRES(ICONV,IKS) )
         ALLOCATE( ZDPRES(ICONV,IKS) )
         ALLOCATE( ZU(ICONV,IKS) )
         ALLOCATE( ZV(ICONV,IKS) )
         ALLOCATE( ZTT(ICONV, IKS) )
         ALLOCATE( ZTH(ICONV,IKS) )
         ALLOCATE( ZTHV(ICONV,IKS) )
         ALLOCATE( ZTHL(ICONV,IKS) )
         ALLOCATE( ZTHES(ICONV,IKS) )
         ALLOCATE( ZRV(ICONV,IKS) )
         ALLOCATE( ZRC(ICONV,IKS) )
         ALLOCATE( ZRI(ICONV,IKS) )
         ALLOCATE( ZRW(ICONV,IKS) )
         ALLOCATE( ZDXDY(ICONV) )
!
         ! updraft variables
!
         ALLOCATE( ZUMF(ICONV,IKS) )
         ALLOCATE( ZUER(ICONV,IKS) )
         ALLOCATE( ZUDR(ICONV,IKS) )
         ALLOCATE( ZUPR(ICONV,IKS) )
         ALLOCATE( ZUTHL(ICONV,IKS) )
         ALLOCATE( ZUTHV(ICONV,IKS) )
         ALLOCATE( ZURW(ICONV,IKS) )
         ALLOCATE( ZURC(ICONV,IKS) )
         ALLOCATE( ZURI(ICONV,IKS) )
         ALLOCATE( ZURR(ICONV,IKS) )
         ALLOCATE( ZURS(ICONV,IKS) )
         ALLOCATE( ZUTPR(ICONV) )
         ALLOCATE( ZTHLCL(ICONV) )
         ALLOCATE( ZTLCL(ICONV) )
         ALLOCATE( ZRVLCL(ICONV) )
         ALLOCATE( ZWLCL(ICONV) )
         ALLOCATE( ZMFLCL(ICONV) )
         ALLOCATE( ZZLCL(ICONV) )
         ALLOCATE( ZTHVELCL(ICONV) )
         ALLOCATE( ZCAPE(ICONV) )
!
         ! work variables
!
         ALLOCATE( IJINDEX(ICONV) )
         ALLOCATE( IJPINDEX(ICONV) )
         ALLOCATE( ZCPH(ICONV) )
         ALLOCATE( ZLV(ICONV) )
         ALLOCATE( ZLS(ICONV) )
!
!
!*           3.1    Gather grid scale and updraft base variables in
!                   arrays using mask GTRIG
!                   ---------------------------------------------------
!
         GTRIG(:)      = UNPACK( GTRIG1(:), MASK=GTRIG(:), FIELD=.FALSE. )  
         IJINDEX(:)    = PACK( IINDEX(:), MASK=GTRIG(:) )
!
    DO JK = IKB, IKE
    DO JI = 1, ICONV
         JL = IJINDEX(JI)
         ZZ(JI,JK)     = PZZ(JL,JK)
         ZPRES(JI,JK)  = PPABST(JL,JK)
         ZTT(JI,JK)    = PTT(JL,JK)
         ZTH(JI,JK)    = ZTHT(JL,JK)
         ZTHES(JI,JK)  = ZSTHES(JL,JK)
         ZRV(JI,JK)    = MAX( 0., PRVT(JL,JK) )
         ZRC(JI,JK)    = MAX( 0., PRCT(JL,JK) )
         ZRI(JI,JK)    = MAX( 0., PRIT(JL,JK) )
         ZTHV(JI,JK)   = ZSTHV(JL,JK)
         ZU(JI,JK)     = PUT(JL,JK)
         ZV(JI,JK)     = PVT(JL,JK)
    END DO
    END DO
    IF ( OSETTADJ ) THEN
         ALLOCATE( ZTIMED(ICONV) )
         DO JI = 1, ICONV
            JL = IJINDEX(JI)
            ZTIMED(JI) = PTIMEC(JL)
         END DO
    END IF
!
    DO JI = 1, ITEST
       IJSINDEX(JI) = JI	
    END DO
    IJPINDEX(:) = PACK( IJSINDEX(:), MASK=GTRIG1(:) )
    DO JI = 1, ICONV
         JL = IJPINDEX(JI)
         IDPL(JI)      = ISDPL(JL)
         IPBL(JI)      = ISPBL(JL)
         ILCL(JI)      = ISLCL(JL)
         ZTHLCL(JI)    = ZSTHLCL(JL)
         ZTLCL(JI)     = ZSTLCL(JL)
         ZRVLCL(JI)    = ZSRVLCL(JL)
         ZWLCL(JI)     = ZSWLCL(JL)
         ZZLCL(JI)     = ZSZLCL(JL)
         ZTHVELCL(JI)  = ZSTHVELCL(JL)
         ZDXDY(JI)     = ZSDXDY(JL)
    END DO
         ALLOCATE( GWORK(ICONV) )
         GWORK(:)      = PACK( GTRIG1(:),  MASK=GTRIG1(:) ) 
         DEALLOCATE( GTRIG1 )
         ALLOCATE( GTRIG1(ICONV) )
         GTRIG1(:)     = GWORK(:)
!                 
         DEALLOCATE( GWORK )
         DEALLOCATE( IJPINDEX )
         DEALLOCATE( ISDPL )
         DEALLOCATE( ISPBL )
         DEALLOCATE( ISLCL )
         DEALLOCATE( ZSTHLCL )
         DEALLOCATE( ZSTLCL )
         DEALLOCATE( ZSRVLCL )
         DEALLOCATE( ZSWLCL )
         DEALLOCATE( ZSZLCL )
         DEALLOCATE( ZSTHVELCL )
         DEALLOCATE( ZSDXDY )
!
!
!*           3.2    Compute pressure difference 
!                   ---------------------------------------------------
!
        ZDPRES(:,IKB) = 0.
        DO JK = IKB + 1, IKE
            ZDPRES(:,JK)  = ZPRES(:,JK-1) - ZPRES(:,JK)
        END DO
!
!*           3.3   Compute environm. enthalpy and total water = r_v + r_i + r_c 
!                  ----------------------------------------------------------
!
        DO JK = IKB, IKE, 1
            ZRW(:,JK)  = ZRV(:,JK) + ZRC(:,JK) + ZRI(:,JK)
            ZCPH(:)    = XCPD + XCPV * ZRW(:,JK)
            ZLV(:)     = XLVTT + ( XCPV - XCL ) * ( ZTT(:,JK) - XTT ) ! compute L_v
            ZLS(:)     = XLSTT + ( XCPV - XCI ) * ( ZTT(:,JK) - XTT ) ! compute L_i
            ZTHL(:,JK) = ZCPH(:) * ZTT(:,JK) + ( 1. + ZRW(:,JK) ) * XG * ZZ(:,JK) &
                         - ZLV(:) * ZRC(:,JK) - ZLS(:) * ZRI(:,JK)
        END DO
!
!
!*           4.     Compute updraft properties 
!                   ----------------------------
!
!*           4.1    Set mass flux at LCL ( here a unit mass flux with w = 1 m/s ) 
!                   -------------------------------------------------------------
!
         DO JI = 1, ICONV
               JK = ILCL(JI) - 1
               ZMFLCL(JI) = ZPRES(JI,JK) / ( XRD * ZTT(JI,JK) *                &
                         ( 1. + ZEPS * ZRVLCL(JI) ) ) * XPI * XCRAD * XCRAD 
         END DO
!
         DEALLOCATE( ZCPH )
         DEALLOCATE( ZLV )
         DEALLOCATE( ZLS )
!
!
     CALL CONVECT_UPDRAFT( ICONV, KLEV,                                     &
                           KICE, ZPRES, ZDPRES, ZZ, ZTHL, ZTHV, ZTHES, ZRW, &
                           ZTHLCL, ZTLCL, ZRVLCL, ZWLCL, ZZLCL, ZTHVELCL,   & 
                           ZMFLCL, GTRIG1, ILCL, IDPL, IPBL,                &
                           ZUMF, ZUER, ZUDR, ZUTHL, ZUTHV, ZURW,            &
                           ZURC, ZURI, ZURR, ZURS, ZUPR,                    &
                           ZUTPR, ZCAPE, ICTL, IETL                         )
!
!
!
!*           4.2    In routine UPDRAFT GTRIG1 has been set to false when cloud 
!                   thickness is smaller than 3 km
!                   -----------------------------------------------------------
!
!
     ICONV1 = COUNT(GTRIG1) 
!
     IF ( ICONV1 > 0 )  THEN
!
!*       4.3    Allocate memory for downdraft variables
!               ---------------------------------------
!
! downdraft variables
!
        ALLOCATE( ILFS(ICONV) )
        ALLOCATE( IDBL(ICONV) )
        ALLOCATE( IML(ICONV) )
        ALLOCATE( ZDMF(ICONV,IKS) )
        ALLOCATE( ZDER(ICONV,IKS) )
        ALLOCATE( ZDDR(ICONV,IKS) )
        ALLOCATE( ZDTHL(ICONV,IKS) )
        ALLOCATE( ZDRW(ICONV,IKS) )
        ALLOCATE( ZLMASS(ICONV,IKS) )
        DO JK = IKB, IKE
           ZLMASS(:,JK)  = ZDXDY(:) * ZDPRES(:,JK) / XG  ! mass of model layer
        END DO
	ZLMASS(:,IKB) = ZLMASS(:,IKB+1)
        ALLOCATE( ZMIXF(ICONV) )
        ALLOCATE( ZTPR(ICONV) )
        ALLOCATE( ZSPR(ICONV) )
        ALLOCATE( ZDTEVR(ICONV) )
        ALLOCATE( ZPREF(ICONV) )
        ALLOCATE( ZDTEVRF(ICONV,IKS) )
        ALLOCATE( ZPRLFLX(ICONV,IKS) )
        ALLOCATE( ZPRSFLX(ICONV,IKS) )
!
! closure variables
!
        ALLOCATE( ZTIMEA(ICONV) )
        ALLOCATE( ZTIMEC(ICONV) )
        ALLOCATE( ZTHC(ICONV,IKS) )
        ALLOCATE( ZRVC(ICONV,IKS) )
        ALLOCATE( ZRCC(ICONV,IKS) )
        ALLOCATE( ZRIC(ICONV,IKS) )
        ALLOCATE( ZWSUB(ICONV,IKS) )
!
!
!*           5.     Compute downdraft properties 
!                   ----------------------------
!
!*           5.1    Compute advective time period and precipitation 
!                   efficiency as a function of mean ambient wind (shear) 
!                   --------------------------------------------------------
!
        CALL CONVECT_TSTEP_PREF( ICONV, KLEV,                          &
                                 ZU, ZV, ZPRES, ZZ, ZDXDY, ILCL, ICTL, &
                                 ZTIMEA, ZPREF )
!
          ! exclude convective downdrafts if desired
        IF ( .NOT. ODOWN ) ZPREF(:) = 1.
!
          ! Compute the period during which convection is active
        ZTIMEC(:) = MAX( 1800., MIN( 3600., ZTIMEA(:) ) )
        ZTIMEC(:) = REAL( INT( ZTIMEC(:) / PDTCONV ) ) * PDTCONV
        ZTIMEC(:) = MAX( PDTCONV, ZTIMEC(:) ) ! necessary if PDTCONV > 1800
        IF ( OSETTADJ ) THEN
             ZTIMEC(:) = MAX( PDTCONV, ZTIMED(:) )
        END IF
!
!
!*           5.2    Compute melting level
!                   ----------------------
!
        IML(:) = IKB
        DO JK = IKE, IKB, -1
          WHERE( ZTT(:,JK) <= XTT )  IML(:) = JK
        END DO
!
        CALL CONVECT_DOWNDRAFT( ICONV, KLEV,                               &
                                KICE, ZPRES, ZDPRES, ZZ, ZTH, ZTHES,       & 
                                ZRW, ZRC, ZRI,                             &
                                ZPREF, ILCL, ICTL, IETL,                   &
                                ZUTHL, ZURW, ZURC, ZURI,                   &
                                ZDMF, ZDER, ZDDR, ZDTHL, ZDRW,             &
                                ZMIXF, ZDTEVR, ILFS, IDBL, IML,            &
                                ZDTEVRF                                    )
!
!
!*           6.     Adjust up and downdraft mass flux to be consistent
!                   with precipitation efficiency relation.
!                   --------------------------------------------------- 
!
       CALL CONVECT_PRECIP_ADJUST( ICONV, KLEV,                              &
                                   ZPRES,ZUMF, ZUER, ZUDR, ZUPR, ZUTPR, ZURW,&
                                   ZDMF, ZDER, ZDDR, ZDTHL, ZDRW,            &
                                   ZPREF, ZTPR, ZMIXF, ZDTEVR,               &
                                   ILFS, IDBL, ILCL, ICTL, IETL,             &
                                   ZDTEVRF                                   )
!
!
!*           7.     Determine adjusted environmental values assuming
!                   that all available buoyant energy must be removed
!                   within an advective time step ZTIMEC.
!                   ---------------------------------------------------
!
       CALL CONVECT_CLOSURE( ICONV, KLEV,                                &
                             ZPRES, ZDPRES, ZZ, ZDXDY, ZLMASS,           &
                             ZTHL, ZTH, ZRW, ZRC, ZRI, GTRIG1,           &
                             ZTHC, ZRVC, ZRCC, ZRIC, ZWSUB,              &
                             ILCL, IDPL, IPBL, ILFS, ICTL, IML,          &
                             ZUMF, ZUER, ZUDR, ZUTHL, ZURW,              &
                             ZURC, ZURI, ZUPR,                           &
                             ZDMF, ZDER, ZDDR, ZDTHL, ZDRW,              &
                             ZTPR, ZSPR, ZDTEVR,                         &
                             ZCAPE, ZTIMEC,                              &
                             IFTSTEPS,                                   &
                             ZDTEVRF, ZPRLFLX, ZPRSFLX )
!

 
!
!*           8.     Determine the final grid-scale (environmental) convective 
!                   tendencies and set convective counter
!                   --------------------------------------------------------
!
!
!*           8.1    Grid scale tendencies
!                   ---------------------
!
          ! in order to save memory, the tendencies are temporarily stored
          ! in the tables for the adjusted grid-scale values
!
      DO JK = IKB, IKE
         ZTHC(:,JK) = ( ZTHC(:,JK) - ZTH(:,JK) ) / ZTIMEC(:)             &
           * ( ZPRES(:,JK) / XP00 ) ** ZRDOCP ! change theta in temperature
         ZRVC(:,JK) = ( ZRVC(:,JK) - ZRW(:,JK) + ZRC(:,JK) + ZRI(:,JK) ) &
					         / ZTIMEC(:) 

         ZRCC(:,JK) = ( ZRCC(:,JK) - ZRC(:,JK) ) / ZTIMEC(:)
         ZRIC(:,JK) = ( ZRIC(:,JK) - ZRI(:,JK) ) / ZTIMEC(:) 
!
         ZPRLFLX(:,JK) = ZPRLFLX(:,JK) / ( XRHOLW * ZDXDY(:) )
         ZPRSFLX(:,JK) = ZPRSFLX(:,JK) / ( XRHOLW * ZDXDY(:) )
!
      END DO
!
      ZPRLFLX(:,IKB) = ZPRLFLX(:,IKB+1)
      ZPRSFLX(:,IKB) = ZPRSFLX(:,IKB+1)
!
!
!*           8.2    Apply conservation correction
!                   -----------------------------
!
          ! Compute vertical integrals
!
       JKM = MAXVAL( ICTL(:) )
       ZWORK2(:) = 0.
       ZWORK2B(:) = 0.
       DO JK = JKM, IKB+1, -1
	 JKP = JK + 1
         DO JI = 1, ICONV
           ZWORK2(JI) = ZWORK2(JI) + ( ZRVC(JI,JK) + ZRCC(JI,JK) + ZRIC(JI,JK) ) *   & ! moisture
                                             (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
      !    ZWORK2B(JI) = ZWORK2B(JI) + (                                             & ! energy
      !                                ( XCPD + XCPV * ZRW(JI,JK) )* ZTHC(JI,JK)   - &
      !          ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRCC(JI,JK)   - & 
      !          ( XLSTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRIC(JI,JK) ) * & 
      !                                      (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
         END DO
       END DO
!
          ! Budget error (compare integral to surface precip.)
!
       DO JI = 1, ICONV
         IF ( ZTPR(JI) > 0.) THEN
           JKP = ICTL(JI) + 1
           ZWORK2(JI) = ( ZTPR(JI) / ZDXDY(JI) + ZWORK2(JI) ) * XG /                 &
                                        ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
      !    ZWORK2B(JI) = ( ZTPR(JI) / ZDXDY(JI) *                                    &
      !       ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,IKB) - XTT ) ) - ZWORK2B(JI) )     &
      !                                * XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
         END IF
       END DO
!
          ! Apply uniform correction
!
       DO JK = JKM, IKB+1, -1
         DO JI = 1, ICONV
           IF ( ZTPR(JI) > 0. .AND. JK <= ICTL(JI) ) THEN
                ZRVC(JI,JK) = ZRVC(JI,JK) - ZWORK2(JI)                                ! moisture
       !        ZTHC(JI,JK) = ZTHC(JI,JK) + ZWORK2B(JI) / ( XCPD + XCPV * ZRW(JI,JK) )! energy
           END IF
         END DO
       END DO
!
!

              ! execute a "scatter"= pack command to store the tendencies in
              ! the final 2D tables
!
      DO JK = IKB, IKE
      DO JI = 1, ICONV
         JL = IJINDEX(JI)
         PTTEN(JL,JK)   = ZTHC(JI,JK)
         PRVTEN(JL,JK)  = ZRVC(JI,JK)
         PRCTEN(JL,JK)  = ZRCC(JI,JK)
         PRITEN(JL,JK)  = ZRIC(JI,JK)
!
         PPRLFLX(JL,JK) = ZPRLFLX(JI,JK)
         PPRSFLX(JL,JK) = ZPRSFLX(JI,JK)
      END DO
      END DO
!
!
!
!
!*           8.3    Convective rainfall tendency
!                   ----------------------------
!
	         ! liquid and solid surface rainfall tendency in m/s
       ZTPR(:)   = ZTPR(:) / ( XRHOLW * ZDXDY(:) ) ! total surf precip
       ZSPR(:)   = ZSPR(:) / ( XRHOLW * ZDXDY(:) ) ! solid surf precip
       ZTPR(:)   = ZTPR(:) - ZSPR(:) ! compute liquid part
!
     DO JI = 1, ICONV
        JL = IJINDEX(JI)
        PPRLTEN(JL) = ZTPR(JI)
        PPRSTEN(JL) = ZSPR(JI)
     END DO
!
!
!                   Cloud base and top levels
!                   -------------------------
!
     ILCL(:) = MIN( ILCL(:), ICTL(:) )
     DO JI = 1, ICONV
        JL = IJINDEX(JI)
        KCLTOP(JL) = ICTL(JI)
        KCLBAS(JL) = ILCL(JI)
     END DO
!
!
!*           8.4    Set convective counter
!                   ----------------------
!
	 ! compute convective counter for just activated convective
         ! grid points
         ! If the advective time period is less than specified
         ! minimum for convective period, allow feedback to occur only
         ! during advective time
!
     ZTIME(:) = 1.
     ZWORK2(:) = 0.
     DO JI = 1, ICONV
       JL = IJINDEX(JI)
       ZTIME(JL)  =  ZTIMEC(JI)
       ZWORK2(JL) =  ZTIMEA(JI)
       ZWORK2(JL) =  MIN( ZWORK2(JL), ZTIME(JL) )
       ZWORK2(JL) =  MAX( ZWORK2(JL), PDTCONV )
       IF ( GTRIG(JL) )  KCOUNT(JL) = INT( ZWORK2(JL) / PDTCONV )
       IF ( GTRIG(JL) .AND. PPRLTEN(JL)<1.E-14 ) KCOUNT(JL) = 0
     END DO
!
!
!
!*           8.7    Compute convective tendencies for Tracers
!                   ------------------------------------------
!
  IF ( OCH1CONV ) THEN
!
       ALLOCATE( ZCH1(ICONV,IKS,KCH1) )
       ALLOCATE( ZCH1C(ICONV,IKS,KCH1) )
       ALLOCATE( ZWORK3(ICONV,KCH1) )
!
       DO JK = IKB, IKE
       DO JI = 1, ICONV
          JL = IJINDEX(JI)
          ZCH1(JI,JK,:) = PCH1(JL,JK,:)
       END DO
       END DO
!
      CALL CONVECT_CHEM_TRANSPORT( ICONV, KLEV, KCH1, ZCH1, ZCH1C,      &
                                   IDPL, IPBL, ILCL, ICTL, ILFS, IDBL,  &
                                   ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR,  &
                                   ZTIMEC, ZDXDY, ZMIXF, ZLMASS, ZWSUB, &
				   IFTSTEPS )
!
       DO JK = IKB, IKE
       DO JN = 1, KCH1
          ZCH1C(:,JK,JN) = ( ZCH1C(:,JK,JN)- ZCH1(:,JK,JN) ) / ZTIMEC(:)
       END DO
       END DO
!
!*           8.8    Apply conservation correction
!                   -----------------------------
!
          ! Compute vertical integrals
!
       JKM = MAXVAL( ICTL(:) )
       ZWORK3(:,:) = 0.
       DO JK = JKM, IKB+1, -1
	 JKP = JK + 1
         DO JI = 1, ICONV
           ZWORK3(JI,:) = ZWORK3(JI,:) + ZCH1C(JI,JK,:) *                    &
                              (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
         END DO
       END DO
!
          ! Mass error (integral must be zero)
!
       DO JI = 1, ICONV
         IF ( ZTPR(JI) > 0.) THEN
           JKP = ICTL(JI) + 1
           ZWORK3(JI,:) = ZWORK3(JI,:) *                                     &
                                    XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
         END IF
       END DO
!
          ! Apply uniform correction but assure positive mass at each level
!
       DO JK = JKM, IKB+1, -1
         DO JI = 1, ICONV
           IF ( ZTPR(JI) > 0. .AND. JK <= ICTL(JI) ) THEN
                ZCH1C(JI,JK,:) = ZCH1C(JI,JK,:) - ZWORK3(JI,:)
                ZCH1C(JI,JK,:) = MAX( ZCH1C(JI,JK,:), -ZCH1(JI,JK,:)/ZTIMEC(JI) )
           END IF
         END DO
       END DO
!
       DO JK = IKB, IKE
       DO JI = 1, ICONV
          JL = IJINDEX(JI)
          PCH1TEN(JL,JK,:) = ZCH1C(JI,JK,:)
       END DO
       END DO
  END IF
!
!
!*           9.     Write up- and downdraft mass fluxes
!                   ------------------------------------
!
    DO JK = IKB, IKE
       ZUMF(:,JK)  = ZUMF(:,JK) / ZDXDY(:) ! Mass flux per unit area
       ZDMF(:,JK)  = ZDMF(:,JK) / ZDXDY(:)
    END DO
    ZWORK2(:) = 1.
    WHERE ( PPRLTEN(:)<1.E-14 ) ZWORK2(:) = 0.
    DO JK = IKB, IKE
    DO JI = 1, ICONV
       JL = IJINDEX(JI)
       PUMF(JL,JK) = ZUMF(JI,JK) * ZWORK2(JL)
       PDMF(JL,JK) = ZDMF(JI,JK) * ZWORK2(JL)
    END DO
    END DO
!
!
!*           10.    Deallocate all local arrays
!                   ---------------------------
!
! downdraft variables
!
      DEALLOCATE( ZDMF )
      DEALLOCATE( ZDER )
      DEALLOCATE( ZDDR )
      DEALLOCATE( ZDTHL )
      DEALLOCATE( ZDRW )
      DEALLOCATE( ZLMASS )
      DEALLOCATE( ZMIXF )
      DEALLOCATE( ZTPR )
      DEALLOCATE( ZSPR )
      DEALLOCATE( ZDTEVR )
      DEALLOCATE( ZPREF )
      DEALLOCATE( IML )
      DEALLOCATE( ILFS )
      DEALLOCATE( IDBL )
      DEALLOCATE( ZDTEVRF )
      DEALLOCATE( ZPRLFLX )
      DEALLOCATE( ZPRSFLX )
!
!   closure variables
!
      DEALLOCATE( ZTIMEA )
      DEALLOCATE( ZTIMEC )
      DEALLOCATE( ZTHC )
      DEALLOCATE( ZRVC )
      DEALLOCATE( ZRCC )
      DEALLOCATE( ZRIC )
      DEALLOCATE( ZWSUB )
!
       IF ( OCH1CONV ) THEN
           DEALLOCATE( ZCH1 )
           DEALLOCATE( ZCH1C )
           DEALLOCATE( ZWORK3 )
       END IF
!
    ENDIF
!
!    vertical index
!
    DEALLOCATE( IDPL )
    DEALLOCATE( IPBL )
    DEALLOCATE( ILCL )
    DEALLOCATE( ICTL )
    DEALLOCATE( IETL )
!
! grid scale variables
!
    DEALLOCATE( ZZ )
    DEALLOCATE( ZPRES )
    DEALLOCATE( ZDPRES )
    DEALLOCATE( ZU )
    DEALLOCATE( ZV )
    DEALLOCATE( ZTT )
    DEALLOCATE( ZTH )
    DEALLOCATE( ZTHV )
    DEALLOCATE( ZTHL )
    DEALLOCATE( ZTHES )
    DEALLOCATE( ZRW )
    DEALLOCATE( ZRV )
    DEALLOCATE( ZRC )
    DEALLOCATE( ZRI )
    DEALLOCATE( ZDXDY )
!
! updraft variables
!
    DEALLOCATE( ZUMF )
    DEALLOCATE( ZUER )
    DEALLOCATE( ZUDR )
    DEALLOCATE( ZUTHL )
    DEALLOCATE( ZUTHV )
    DEALLOCATE( ZURW )
    DEALLOCATE( ZURC )
    DEALLOCATE( ZURI )
    DEALLOCATE( ZURR )
    DEALLOCATE( ZURS )
    DEALLOCATE( ZUPR )
    DEALLOCATE( ZUTPR )
    DEALLOCATE( ZTHLCL )
    DEALLOCATE( ZTLCL )
    DEALLOCATE( ZRVLCL )
    DEALLOCATE( ZWLCL )
    DEALLOCATE( ZZLCL )
    DEALLOCATE( ZTHVELCL )
    DEALLOCATE( ZMFLCL )
    DEALLOCATE( ZCAPE )
    IF ( OSETTADJ ) DEALLOCATE( ZTIMED )
!
! work arrays
!
    DEALLOCATE( IINDEX )
    DEALLOCATE( IJINDEX )
    DEALLOCATE( IJSINDEX )
    DEALLOCATE( GTRIG1 )
!
!
END SUBROUTINE CONVECT_DEEP
!     ######spl
      SUBROUTINE CONVECT_TRIGGER_FUNCT( KLON, KLEV,                           &
                                        PPRES, PTH, PTHV, PTHES,              &
                                        PRV, PW, PZ, PDXDY,                   &
                                        PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL,  &
                                        PTHVELCL, KLCL, KDPL, KPBL, OTRIG,    &
                                        PCAPE )
!     ######################################################################
!
!!**** Determine convective columns as well as the cloudy values of theta,
!!     and qv at the lifting condensation level (LCL) 
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine convective columns
!!   
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      What we look for is the undermost unstable level at each grid point.
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     Routine CONVECT_SATMIXRATIO
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XP00               ! Reference pressure
!!          XRD, XRV           ! Gaz  constants for dry air and water vapor
!!          XCPD               ! Cpd (dry air)
!!          XTT                ! triple point temperature
!!          XBETAW, XGAMW      ! constants for vapor saturation pressure
!!
!!      Module MODD_CONVPAR
!!          XA25               ! reference grid area
!!          XZLCL              ! maximum height difference between
!!                             ! the surface and the DPL
!!          XZPBL              ! minimum mixed layer depth to sustain convection
!!          XWTRIG             ! constant in vertical velocity trigger
!!          XCDEPTH            ! minimum necessary cloud depth
!!          XNHGAM             ! coefficient for buoyancy term in w eq.
!!                             ! accounting for nh-pressure
!!
!!      Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    REFERENCE
!!    ---------
!!
!!      Book2 of documentation ( routine TRIGGER_FUNCT)
!!      Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  20/03/97  Select first departure level
!!                            that produces a cloud thicker than XCDEPTH
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER, INTENT(IN)                   :: KLON      ! horizontal loop index
INTEGER, INTENT(IN)                   :: KLEV      ! vertical loop index
REAL, DIMENSION(KLON),     INTENT(IN) :: PDXDY     ! grid area
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES     ! envir. satur. theta_e
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV       ! vapor mixing ratio 
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES     ! pressure
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ        ! height of grid point (m)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW        ! vertical velocity
!
REAL, DIMENSION(KLON),     INTENT(OUT):: PTHLCL    ! theta at LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PTLCL     ! temp. at LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PRVLCL    ! vapor mixing ratio at  LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PWLCL     ! parcel velocity at  LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PZLCL     ! height at LCL (m)
REAL, DIMENSION(KLON),     INTENT(OUT):: PTHVELCL  ! environm. theta_v at LCL (K)
LOGICAL, DIMENSION(KLON),  INTENT(OUT):: OTRIG     ! logical mask for convection 
INTEGER, DIMENSION(KLON),  INTENT(INOUT):: KLCL    ! contains vert. index of LCL
INTEGER, DIMENSION(KLON),  INTENT(INOUT):: KDPL    ! contains vert. index of DPL
INTEGER, DIMENSION(KLON),  INTENT(INOUT):: KPBL    ! contains index of source layer top
REAL, DIMENSION(KLON),     INTENT(OUT):: PCAPE     ! CAPE (J/kg) for diagnostics
!
!*       0.2   Declarations of local variables :
!
INTEGER :: JKK, JK, JKP, JKM, JKDL, JL, JKT, JT! vertical loop index
INTEGER :: JI                                  ! horizontal loop index 
INTEGER :: IIE, IKB, IKE                       ! horizontal + vertical loop bounds
REAL    :: ZEPS, ZEPSA                         ! R_d / R_v, R_v / R_d 
REAL    :: ZCPORD, ZRDOCP                      ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON) :: ZTHLCL, ZTLCL, ZRVLCL, & ! locals for PTHLCL,PTLCL
                               ZWLCL,  ZZLCL, ZTHVELCL  ! PRVLCL, ....
INTEGER, DIMENSION(KLON) :: IDPL, IPBL, ILCL      ! locals for KDPL, ...
REAL, DIMENSION(KLON) :: ZPLCL    ! pressure at LCL
REAL, DIMENSION(KLON) :: ZZDPL    ! height of DPL 
REAL, DIMENSION(KLON) :: ZTHVLCL  ! theta_v at LCL = mixed layer value
REAL, DIMENSION(KLON) :: ZTMIX    ! mixed layer temperature
REAL, DIMENSION(KLON) :: ZEVMIX   ! mixed layer water vapor pressure 
REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
REAL, DIMENSION(KLON) :: ZCAPE    ! convective available energy (m^2/s^2/g)
REAL, DIMENSION(KLON) :: ZTHEUL   ! updraft equiv. pot. temperature (K)
REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
REAL, DIMENSION(KLON) :: ZDP      ! pressure between LCL and model layer
REAL, DIMENSION(KLON) :: ZTOP     ! estimated cloud top (m)
REAL, DIMENSION(KLON,KLEV):: ZCAP ! CAPE at every level for diagnostics
!INTEGER, DIMENSION(KLON) :: ITOP  ! work array to store highest test layer
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3    ! work arrays
LOGICAL, DIMENSION(KLON) :: GTRIG, GTRIG2          ! local arrays for OTRIG
LOGICAL, DIMENSION(KLON) :: GWORK1                 ! work array
!
!
!-------------------------------------------------------------------------------
!
!*       0.3    Compute array bounds
!               --------------------
!
IIE = KLON
IKB = 1 + JCVEXB 
IKE = KLEV - JCVEXT 
!
!
!*       1.     Initialize local variables
!               --------------------------
!
ZEPS       = XRD / XRV
ZEPSA      = XRV / XRD 
ZCPORD     = XCPD / XRD
ZRDOCP     = XRD / XCPD
OTRIG(:)   = .FALSE.
IDPL(:)    = KDPL(:)
IPBL(:)    = KPBL(:)
ILCL(:)    = KLCL(:)
!ITOP(:)    = IKB
PWLCL(:)   = 0.
ZWLCL(:)   = 0.
PTHLCL(:)  = 1.
PTHVELCL(:)= 1.
PTLCL(:)   = 1.
PRVLCL(:)  = 0.
PWLCL(:)   = 0.
PZLCL(:)   = PZ(:,IKB)
ZZDPL(:)   = PZ(:,IKB)
GTRIG2(:)  = .TRUE.
ZCAP(:,:)  = 0.
!
!
!
!       1.     Determine highest necessary loop test layer
!              -------------------------------------------
!
JT = IKE - 2
DO JK = IKB + 1, IKE - 2
 ! DO JI = 1, IIE
 !    IF ( PZ(JI,JK) - PZ(JI,IKB) <= XZLCL ) ITOP(JI) = JK
 ! END DO
   IF ( PZ(1,JK) - PZ(1,IKB) < 12.E3 ) JT = JK 
END DO
!
!
!*       2.     Enter loop for convection test
!               ------------------------------
!
JKP = MINVAL( IDPL(:) ) + 1
!JKT = MAXVAL( ITOP(:) )
JKT = JT
DO JKK = JKP, JKT
!
     GWORK1(:) = ZZDPL(:) - PZ(:,IKB) < XZLCL
          ! we exit the trigger test when the center of the mixed layer is more
          ! than 3500 m  above soil level.
     WHERE ( GWORK1(:) )
        ZDPTHMIX(:) = 0.
        ZPRESMIX(:) = 0.
        ZTHLCL(:)   = 0.
        ZRVLCL(:)   = 0.
        ZZDPL(:)    = PZ(:,JKK)
        IDPL(:)     = JKK
     END WHERE
!
!
!*       3.     Construct a mixed layer of at least 60 hPa (XZPBL)
!               ------------------------------------------
!
     DO JK = JKK, IKE - 1
       JKM = JK + 1
       DO JI = 1, IIE     
         IF ( GWORK1(JI) .AND. ZDPTHMIX(JI) < XZPBL ) THEN
            IPBL(JI)     = JK
            ZWORK1(JI)   = PPRES(JI,JK) - PPRES(JI,JKM)
            ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
            ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
            ZTHLCL(JI)   = ZTHLCL(JI)   + PTH(JI,JK)   * ZWORK1(JI)
            ZRVLCL(JI)   = ZRVLCL(JI)   + PRV(JI,JK)   * ZWORK1(JI)
         END IF
       END DO
        IF ( MINVAL ( ZDPTHMIX(:) ) >= XZPBL ) EXIT
     END DO
!
!
     WHERE ( GWORK1(:) )
!
        ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
      ! ZTHLCL(:)   = ZTHLCL(:)   / ZDPTHMIX(:) 
      ! ZRVLCL(:)   = ZRVLCL(:)   / ZDPTHMIX(:) 
        ZTHLCL(:)   = ZTHLCL(:)   / ZDPTHMIX(:) + XDTHPBL
        ZRVLCL(:)   = ZRVLCL(:)   / ZDPTHMIX(:) + XDRVPBL
        ZTHVLCL(:)  = ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) )                 &
				/ ( 1. + ZRVLCL(:) )
!
!*       4.1    Use an empirical direct solution ( Bolton formula )
!               to determine temperature and pressure at LCL. 
!               Nota: the adiabatic saturation temperature is not
!                     equal to the dewpoint temperature
!               ----------------------------------------------------
!
! 
        ZTMIX(:)  = ZTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP 
        ZEVMIX(:) = ZRVLCL(:) * ZPRESMIX(:) / ( ZRVLCL(:) + ZEPS )
        ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
        ZWORK1(:) = LOG( ZEVMIX(:) / 613.3 )
              ! dewpoint temperature
        ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) ) 
              ! adiabatic saturation temperature
        ZTLCL(:)  = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT )      &
                   - 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
        ZTLCL(:)  = MIN( ZTLCL(:), ZTMIX(:) )
        ZPLCL(:)  = XP00 * ( ZTLCL(:) / ZTHLCL(:) ) ** ZCPORD
!
     END WHERE
!
!
!*       4.2    Correct ZTLCL in order to be completely consistent
!               with MNH saturation formula
!               ---------------------------------------------
!
     CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, ZTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
     WHERE( GWORK1(:) )
        ZWORK2(:) = ZWORK1(:) / ZTLCL(:) * ( XBETAW / ZTLCL(:) - XGAMW ) ! dr_sat/dT
        ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) /                              &
                        ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
        ZTLCL(:)  = ZTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
!
     END WHERE
!
!
!*       4.3    If ZRVLCL = PRVMIX is oversaturated set humidity 
!               and temperature to saturation values. 
!               ---------------------------------------------
!
     CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
     WHERE( GWORK1(:) .AND. ZRVLCL(:) > ZWORK1(:) )
        ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
        ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) /                              &
                       ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) ) 
        ZTLCL(:)  = ZTMIX(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
        ZRVLCL(:) = ZRVLCL(:) - ZWORK2(:)
        ZPLCL(:)  = ZPRESMIX(:)
        ZTHLCL(:) = ZTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
        ZTHVLCL(:)= ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) )                   &
                              / ( 1. + ZRVLCL(:) )
     END WHERE
!
!
!*        5.1   Determine  vertical loop index at the LCL and DPL
!               --------------------------------------------------
!
    DO JK = JKK, IKE - 1
       DO JI = 1, IIE
         IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. GWORK1(JI) ) ILCL(JI) = JK + 1
       END DO
    END DO
!
!
!*        5.2   Estimate height and environm. theta_v at LCL
!               --------------------------------------------------
!
    DO JI = 1, IIE
        JK   = ILCL(JI)
        JKM  = JK - 1
        ZDP(JI)    = LOG( ZPLCL(JI) / PPRES(JI,JKM) ) /                     &
                     LOG( PPRES(JI,JK) / PPRES(JI,JKM) )
        ZWORK1(JI) = PTHV(JI,JKM) + ( PTHV(JI,JK) - PTHV(JI,JKM) ) * ZDP(JI) 
           ! we compute the precise value of the LCL
           ! The precise height is between the levels ILCL and ILCL-1.
        ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
    END DO
    WHERE( GWORK1(:) )
        ZTHVELCL(:) = ZWORK1(:) 
        ZZLCL(:)    = ZWORK2(:)
    END WHERE
!        
!
!*       6.     Check to see if cloud is bouyant 
!               --------------------------------
!
!*      6.1    Compute grid scale vertical velocity perturbation term ZWORK1
!               -------------------------------------------------------------
! 
             !  normalize w grid scale to a 25 km refer. grid
     DO JI = 1, IIE
        JK  = ILCL(JI)
        JKM = JK - 1 
        JKDL = IDPL(JI)
       !ZWORK1(JI) =  ( PW(JI,JKM)  + ( PW(JI,JK) - PW(JI,JKM) ) * ZDP(JI) )  &
        ZWORK1(JI) =  ( PW(JI,JK)  +  PW(JI,JKDL)*ZZLCL(JI)/PZ(JI,JKDL) ) * .5 &  
                           * SQRT( PDXDY(JI) / XA25 )
!                         - 0.02 * ZZLCL(JI) / XZLCL ! avoid spurious convection
     END DO
             ! compute sign of normalized grid scale w
        ZWORK2(:) = SIGN( 1., ZWORK1(:) ) 
        ZWORK1(:) = XWTRIG * ZWORK2(:) * ABS( ZWORK1(:) ) ** 0.333       &
                           * ( XP00 / ZPLCL(:) ) ** ZRDOCP
!
!*       6.2    Compute parcel vertical velocity at LCL
!               ---------------------------------------
!                   
     DO JI = 1, IIE
        JKDL = IDPL(JI)
        ZWORK3(JI) = XG * ZWORK1(JI) * ( ZZLCL(JI) - PZ(JI,JKDL) )       &
                       / ( PTHV(JI,JKDL) + ZTHVELCL(JI) )
     END DO
     WHERE( GWORK1(:) )
       ZWLCL(:)  = 1. + .5 * ZWORK2(:) * SQRT( ABS( ZWORK3(:) ) ) 
       GTRIG(:)  = ZTHVLCL(:) - ZTHVELCL(:) + ZWORK1(:) > 0. .AND.       &
                   ZWLCL(:) > 0. 
     END WHERE
!
!
!*       6.3    Look for parcel that produces sufficient cloud depth.
!               The cloud top is estimated as the level where the CAPE 
!               is smaller  than a given value (based on vertical velocity eq.)
!               --------------------------------------------------------------
!
     ZTHEUL(:) = ZTLCL(:) * ( ZTHLCL(:) / ZTLCL(:) )                       &
                                             ** ( 1. - 0.28 * ZRVLCL(:) )  &
                          * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) *       &
                               ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
!
     ZCAPE(:) = 0.
     ZTOP(:)  = 0.
     ZWORK3(:)= 0.
     JKM = MINVAL( ILCL(:) )
     DO JL = JKM, JT
        JK = JL + 1
        DO JI = 1, IIE
           ZWORK1(JI) = ( 2. * ZTHEUL(JI) /                                &
            ( PTHES(JI,JK) + PTHES(JI,JL) ) - 1. ) * ( PZ(JI,JK) - PZ(JI,JL) )
           IF ( JL < ILCL(JI) ) ZWORK1(JI) = 0.
           ZCAPE(JI)  = ZCAPE(JI) + ZWORK1(JI)
           ZCAP(JI,JKK) = ZCAP(JI,JKK) + XG * MAX( 0., ZWORK1(JI) ) ! actual CAPE
           ZWORK2(JI) = XNHGAM * XG * ZCAPE(JI) + 1.05 * ZWLCL(JI) * ZWLCL(JI)
               ! the factor 1.05 takes entrainment into account
           ZWORK2(JI) = SIGN( 1., ZWORK2(JI) )
           ZWORK3(JI) = ZWORK3(JI) + MIN(0., ZWORK2(JI) )
           ZWORK3(JI) = MAX( -1., ZWORK3(JI) )
               ! Nota, the factors ZWORK2 and ZWORK3 are only used to avoid
               ! if and goto statements, the difficulty is to extract only
               ! the level where the criterium is first fullfilled
           ZTOP(JI)   = PZ(JI,JL) * .5 * ( 1. + ZWORK2(JI) ) * ( 1. + ZWORK3(JI) ) + &
                        ZTOP(JI) * .5 * ( 1. - ZWORK2(JI) )
         END DO
     END DO
!
!
     WHERE( ZTOP(:) - ZZLCL(:) .GE. XCDEPTH  .AND. GTRIG(:) .AND. GTRIG2(:) )
        GTRIG2(:)   = .FALSE.
        OTRIG(:)    = GTRIG(:)     ! we  select the first departure level
        PTHLCL(:)   = ZTHLCL(:)    ! that gives sufficient cloud depth
        PRVLCL(:)   = ZRVLCL(:)
        PTLCL(:)    = ZTLCL(:)
        PWLCL(:)    = ZWLCL(:)
        PZLCL(:)    = ZZLCL(:)
        PTHVELCL(:) = ZTHVELCL(:)
        KDPL(:)     = IDPL(:)
        KPBL(:)     = IPBL(:)
        KLCL(:)     = ILCL(:)
     END WHERE
!
END DO
!
     DO JI = 1, IIE
       PCAPE(JI) = MAXVAL( ZCAP(JI,:) ) ! maximum CAPE for diagnostics
     END DO
!
!
END SUBROUTINE CONVECT_TRIGGER_FUNCT
!     ######spl
      SUBROUTINE CONVECT_UPDRAFT( KLON, KLEV,                                      &
				  KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW, &
                                  PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL,   &
                                  PMFLCL, OTRIG, KLCL, KDPL, KPBL,                 &
                                  PUMF, PUER, PUDR, PUTHL, PUTHV, PURW,            &
                                  PURC, PURI, PURR, PURS, PUPR,                    &
                                  PUTPR, PCAPE, KCTL, KETL )
!     #############################################################################
!
!!**** Compute updraft properties from DPL to CTL. 
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine updraft properties
!!      ( mass flux, thermodynamics, precipitation ) 
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     Routine CONVECT_MIXING_FUNCT
!!     Routine CONVECT_CONDENS
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XP00               ! reference pressure
!!          XRD, XRV           ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV, XCL    ! Cp of dry air, water vapor and liquid water
!!          XTT                ! triple point temperature
!!          XLVTT              ! vaporisation heat at XTT
!!        
!!
!!      Module MODD_CONVPAR
!!          XA25               ! reference grid area
!!          XCRAD              ! cloud radius
!!          XCDEPTH            ! minimum necessary cloud depth
!!          XENTR              ! entrainment constant
!!          XRCONV             ! constant in precipitation conversion 
!!          XNHGAM             ! coefficient for buoyancy term in w eq.
!!                             ! accounting for nh-pressure
!!          XTFRZ1             ! begin of freezing interval
!!          XTFRZ2             ! begin of freezing interval
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_UPDRAFT)
!!      Kain and Fritsch, 1990, J. Atmos. Sci., Vol.
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  10/12/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER, INTENT(IN)                    :: KLON  ! horizontal dimension
INTEGER, INTENT(IN)                    :: KLEV  ! vertical dimension
INTEGER, INTENT(IN)                    :: KICE  ! flag for ice ( 1 = yes,
                                                !                0 = no ice )
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL  ! grid scale enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV  ! grid scale theta_v     
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW   ! grid scale total water  
                                                ! mixing ratio 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between 
                                                ! bottom and top of layer (Pa) 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ    ! height of model layer (m) 
REAL, DIMENSION(KLON),     INTENT(IN) :: PTHLCL ! theta at LCL
REAL, DIMENSION(KLON),     INTENT(IN) :: PTLCL  ! temp. at LCL
REAL, DIMENSION(KLON),     INTENT(IN) :: PRVLCL ! vapor mixing ratio at  LCL
REAL, DIMENSION(KLON),     INTENT(IN) :: PWLCL  ! parcel velocity at LCL (m/s)
REAL, DIMENSION(KLON),     INTENT(IN) :: PMFLCL ! cloud  base unit mass flux
                                                ! (kg/s)
REAL, DIMENSION(KLON),     INTENT(IN) :: PZLCL  ! height at LCL (m)
REAL, DIMENSION(KLON),     INTENT(IN) :: PTHVELCL  ! environm. theta_v at LCL (K)
LOGICAL, DIMENSION(KLON),  INTENT(INOUT):: OTRIG! logical mask for convection 
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KLCL   ! contains vert. index of LCL
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KDPL   ! contains vert. index of DPL 
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KPBL   !  " vert. index of source layertop
!
!
INTEGER, DIMENSION(KLON),  INTENT(OUT):: KCTL   ! contains vert. index of CTL 
INTEGER, DIMENSION(KLON),  INTENT(OUT):: KETL   ! contains vert. index of        &
                                                !equilibrium (zero buoyancy) level 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF  ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER  ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR  ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW  ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC  ! updraft cloud water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI  ! updraft cloud ice   (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURR  ! liquid precipit. (kg/kg)
                                                ! produced in  model layer
REAL, DIMENSION(KLON,KLEV),   INTENT(OUT)::PURS ! solid precipit. (kg/kg)
                                                ! produced in  model layer
REAL, DIMENSION(KLON,KLEV),   INTENT(OUT)::PUPR ! updraft precipitation in
                                                ! flux units (kg water / s)
REAL, DIMENSION(KLON),     INTENT(OUT):: PUTPR  ! total updraft precipitation
                                                ! in flux units (kg water / s)
REAL, DIMENSION(KLON),     INTENT(OUT):: PCAPE  ! available potent. energy
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE  ! horizontal and vertical loop bounds
INTEGER :: JI             ! horizontal loop index
INTEGER :: JK, JKP, JKM, JK1, JK2, JKMIN  ! vertical loop index
REAL    :: ZEPSA, ZCVOCD  ! R_v / R_d, C_pv / C_pd 
REAL    :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON)    :: ZUT             ! updraft temperature (K)
REAL, DIMENSION(KLON)    :: ZUW1, ZUW2      ! square of updraft vert.
                                            ! velocity at levels k and k+1
REAL, DIMENSION(KLON)    :: ZE1,ZE2,ZD1,ZD2 ! fractional entrainm./detrain
                                            ! rates at levels k and k+1
REAL, DIMENSION(KLON)    :: ZMIXF           ! critical mixed fraction  
REAL, DIMENSION(KLON)    :: ZCPH            ! specific heat C_ph 
REAL, DIMENSION(KLON)    :: ZLV, ZLS        ! latent heat of vaporis., sublim.       
REAL, DIMENSION(KLON)    :: ZURV            ! updraft water vapor at level k+1
REAL, DIMENSION(KLON)    :: ZPI             ! Pi=(P0/P)**(Rd/Cpd)  
REAL, DIMENSION(KLON)    :: ZTHEUL          ! theta_e for undilute ascent
REAL, DIMENSION(KLON)    :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5,   &
                            ZWORK6          ! work arrays
INTEGER, DIMENSION(KLON) :: IWORK           ! wok array
LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK2, GWORK4, GWORK5 
                                            ! work arrays
LOGICAL, DIMENSION(KLON,KLEV) :: GWORK6     ! work array
!
!
!-------------------------------------------------------------------------------
!
!        0.3   Set loop bounds
!              ---------------
!
IKB = 1 + JCVEXB 
IKE = KLEV - JCVEXT 
IIE = KLON
!
!
!*       1.     Initialize updraft properties and local variables
!               -------------------------------------------------
!
ZEPSA      = XRV / XRD 
ZCVOCD     = XCPV / XCPD
ZCPORD     = XCPD / XRD
ZRDOCP     = XRD / XCPD
!
PUMF(:,:)  = 0.
PUER(:,:)  = 0.
PUDR(:,:)  = 0.
PUTHL(:,:) = 0.
PUTHV(:,:) = 0.
PURW(:,:)  = 0.
PURC(:,:)  = 0.
PURI(:,:)  = 0.
PUPR(:,:)  = 0.
PURR(:,:)  = 0.
PURS(:,:)  = 0.
PUTPR(:)   = 0.
ZUW1(:)    = PWLCL(:) * PWLCL(:)
ZUW2(:)    = 0.
ZE1(:)     = 1.
ZD1(:)     = 0.
PCAPE(:)   = 0.
KCTL(:)    = IKB
KETL(:)    = KLCL(:)
GWORK2(:)  = .TRUE.
GWORK5(:)  = .TRUE.
ZPI(:)     = 1.
ZWORK3(:)  = 0.
ZWORK4(:)  = 0.
ZWORK5(:)  = 0.
ZWORK6(:)  = 0.
GWORK1(:)  = .FALSE.
GWORK4(:)  = .FALSE.
!
!
!*       1.1    Compute undilute updraft theta_e for CAPE computations
!               Bolton (1980) formula.
!               Define accurate enthalpy for updraft
!               -----------------------------------------------------
!
ZTHEUL(:) = PTLCL(:) * ( PTHLCL(:) / PTLCL(:) ) ** ( 1. - 0.28 * PRVLCL(:) )  &
            * EXP( ( 3374.6525 / PTLCL(:) - 2.5403 ) *                        &
                                   PRVLCL(:) * ( 1. + 0.81 * PRVLCL(:) ) )
!
!
ZWORK1(:) = ( XCPD + PRVLCL(:) * XCPV ) * PTLCL(:)                            &
            + ( 1. + PRVLCL(:) ) * XG * PZLCL(:)
!
!
!*       2.     Set updraft properties between DPL and LCL
!               ------------------------------------------
!
JKP = MAXVAL( KLCL(:) )
JKM = MINVAL( KDPL(:) )
DO JK = JKM, JKP
   DO JI = 1, IIE
    IF ( JK >= KDPL(JI) .AND. JK < KLCL(JI) ) THEN
        PUMF(JI,JK)  = PMFLCL(JI)
        PUTHL(JI,JK) = ZWORK1(JI) 
        PUTHV(JI,JK) = PTHLCL(JI) * ( 1. + ZEPSA * PRVLCL(JI) ) /             &
                                  ( 1. + PRVLCL(JI) )
        PURW(JI,JK)  = PRVLCL(JI) 
   END IF
   END DO
END DO                        
!
!
!*       3.     Enter loop for updraft computations
!               ------------------------------------
!
JKMIN = MINVAL( KLCL(:) - 1 )
DO JK = MAX( IKB + 1, JKMIN ), IKE - 1
  ZWORK6(:) = 1.
  JKP = JK + 1  
!
  GWORK4(:) = JK >= KLCL(:) - 1 
  GWORK1(:) = GWORK4(:) .AND. GWORK2(:) ! this mask is used to confine
                           ! updraft computations between the LCL and the CTL
!                                                         
  WHERE( JK == KLCL(:) - 1 ) ZWORK6(:) = 0. ! factor that is used in buoyancy
                                        ! computation at first level above LCL
!
!
!*       4.     Estimate condensate, L_v L_i, Cph and theta_v at level k+1   
!               ----------------------------------------------------------
!
    ZWORK1(:) = PURC(:,JK) + PURR(:,JK)
    ZWORK2(:) = PURI(:,JK) + PURS(:,JK)
    CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), PUTHL(:,JK), PURW(:,JK),&
                          ZWORK1, ZWORK2, PZ(:,JKP), GWORK1, ZUT, ZURV,     &
                          PURC(:,JKP), PURI(:,JKP), ZLV, ZLS, ZCPH )
!
!
  ZPI(:) = ( XP00 / PPRES(:,JKP) ) ** ZRDOCP   
  WHERE ( GWORK1(:) )
!
    PUTHV(:,JKP) = ZPI(:) * ZUT(:) * ( 1. + ZEPSA * ZURV(:) )           &  
                         / ( 1. + PURW(:,JK) )     
!
!
!*       5.     Compute square of vertical velocity using entrainment   
!               at level k
!               -----------------------------------------------------
!    
    ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) -         &
                     ( 1. - ZWORK6(:) ) * PZLCL(:)          ! level thickness  
    ZWORK4(:) = PTHV(:,JK) * ZWORK6(:) +                   &
                 ( 1. - ZWORK6(:) ) * PTHVELCL(:)
    ZWORK5(:) = 2. * ZUW1(:) * PUER(:,JK) / MAX( .1, PUMF(:,JK) )
    ZUW2(:)   = ZUW1(:) + ZWORK3(:) * XNHGAM * XG *        & 
                  ( ( PUTHV(:,JK) + PUTHV(:,JKP) ) /       &
                  ( ZWORK4(:) + PTHV(:,JKP) ) - 1. )       & ! buoyancy term
                - ZWORK5(:)                                  ! entrainment term
!
!
!*       6.     Update total precipitation: dr_r=(r_c+r_i)*exp(-rate*dz)  
!               --------------------------------------------------------
!
!                    compute level mean vertical velocity
    ZWORK2(:)   = 0.5 *                                                    &
                       ( SQRT( MAX( 1.E-2, ZUW2(:) ) ) +                   &
                         SQRT( MAX( 1.E-2, ZUW1(:) ) ) )          
    PURR(:,JKP) = 0.5 * ( PURC(:,JK) + PURC(:,JKP) + PURI(:,JK) + PURI(:,JKP) )&
                      * ( 1. - EXP( - XRCONV  * ZWORK3(:) / ZWORK2(:) ) )
    PUPR(:,JKP) = PURR(:,JKP) * PUMF(:,JK) ! precipitation rate ( kg water / s)
    PUTPR(:)    = PUTPR(:) + PUPR(:,JKP)   ! total precipitation rate
    ZWORK2(:)   = PURR(:,JKP) / MAX( 1.E-8, PURC(:,JKP) + PURI(:,JKP) )
    PURR(:,JKP) = ZWORK2(:) * PURC(:,JKP)          ! liquid precipitation
    PURS(:,JKP) = ZWORK2(:) * PURI(:,JKP)          ! solid precipitation
!
!
!*       7.     Update r_c, r_i, enthalpy, r_w  for precipitation 
!               -------------------------------------------------------
!
    PURW(:,JKP)  = PURW(:,JK) - PURR(:,JKP) - PURS(:,JKP) 
    PURC(:,JKP)  = PURC(:,JKP) - PURR(:,JKP)
    PURI(:,JKP)  = PURI(:,JKP) - PURS(:,JKP)       
    PUTHL(:,JKP) = ( XCPD + PURW(:,JKP) * XCPV ) * ZUT(:)                     &
                   + ( 1. + PURW(:,JKP) ) * XG * PZ(:,JKP)                    &
                   - ZLV(:) * PURC(:,JKP) - ZLS(:) * PURI(:,JKP)             
!    
    ZUW1(:)      = ZUW2(:)       
!
  END WHERE
!
!
!*       8.     Compute entrainment and detrainment using conservative
!               variables adjusted for precipitation ( not for entrainment)
!               -----------------------------------------------------------
!
!*       8.1    Compute critical mixed fraction by estimating unknown  
!               T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
!               We determine the zero crossing of the linear curve
!               evaluating the derivative using ZMIXF=0.1.
!               -----------------------------------------------------
!    
    ZMIXF(:)  = 0.1   ! starting value for critical mixed fraction
    ZWORK1(:) = ZMIXF(:) * PTHL(:,JKP)                                     &
                     + ( 1. - ZMIXF(:) ) * PUTHL(:,JKP) ! mixed enthalpy
    ZWORK2(:) = ZMIXF(:) * PRW(:,JKP)                                      &
                     + ( 1. - ZMIXF(:) ) * PURW(:,JKP)  ! mixed r_w
!
    CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), ZWORK1, ZWORK2,        &
                          PURC(:,JKP), PURI(:,JKP), PZ(:,JKP), GWORK1, ZUT,&
                          ZWORK3, ZWORK4, ZWORK5, ZLV, ZLS, ZCPH )
!        put in enthalpy and r_w and get T r_c, r_i (ZUT, ZWORK4-5)
!        
     ! compute theta_v of mixture
    ZWORK3(:) = ZUT(:) * ZPI(:) * ( 1. + ZEPSA * (                         &
                ZWORK2(:) - ZWORK4(:) - ZWORK5(:) ) ) / ( 1. + ZWORK2(:) )
     ! compute final value of critical mixed fraction using theta_v
     ! of mixture, grid-scale and updraft
    ZMIXF(:) = MAX( 0., PUTHV(:,JKP) - PTHV(:,JKP) ) * ZMIXF(:) /          &
                              ( PUTHV(:,JKP) - ZWORK3(:) + 1.E-10 )
    ZMIXF(:) = MAX( 0., MIN( 1., ZMIXF(:) ) )
!    
!
!*       8.2     Compute final midlevel values for entr. and detrainment    
!                after call of distribution function
!                -------------------------------------------------------
!    
!
    CALL CONVECT_MIXING_FUNCT ( KLON, ZMIXF, 1, ZE2, ZD2 )
!       Note: routine MIXING_FUNCT returns fractional entrainm/detrainm. rates
!
! ZWORK1(:) = XENTR * PMFLCL(:) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
!*MOD
  zwork1(:) = xentr * xg / xcrad * pumf(:,jk) * ( pz(:,jkp) - pz(:,jk) )
! ZWORK1(:) = XENTR * pumf(:,jk) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
!*MOD
  ZWORK2(:) = 0.
  WHERE ( GWORK1(:) ) ZWORK2(:) = 1.
  WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) )
    ze2=.5; zd2=.5  ! modif entrainment=detrainment, this avoids
		    ! too large mass flux values at upper levels
    PUER(:,JKP) = 0.5 * ZWORK1(:) * ( ZE1(:) + ZE2(:) ) * ZWORK2(:)
    PUDR(:,JKP) = 0.5 * ZWORK1(:) * ( ZD1(:) + ZD2(:) ) * ZWORK2(:)
  ELSEWHERE
    PUER(:,JKP) = 0.
    PUDR(:,JKP) = ZWORK1(:) * ZWORK2(:)
  END WHERE
!
!*       8.3     Determine equilibrium temperature level
!                --------------------------------------
!
   WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) .AND. JK > KLCL(:) + 1 &   
           .AND. GWORK1(:) )
         KETL(:) = JKP            ! equilibrium temperature level 
   END WHERE
!
!*       8.4     If the calculated detrained mass flux is greater than    
!                the total updraft mass flux, or vertical velocity is
!                negative, all cloud mass detrains at previous model level,
!                exit updraft calculations - CTL is attained
!                -------------------------------------------------------
!
  WHERE( GWORK1(:) )                                                   &
        GWORK2(:) = PUMF(:,JK) - PUDR(:,JKP) > 10. .AND. ZUW2(:) > 0.        
  WHERE ( GWORK2(:) ) KCTL(:) = JKP   ! cloud top level
  GWORK1(:) = GWORK2(:) .AND. GWORK4(:)
!
  IF ( COUNT( GWORK2(:) ) == 0 ) EXIT           
!
!
!*       9.   Compute CAPE for undilute ascent using theta_e and 
!             theta_es instead of theta_v. This estimation produces 
!             a significantly larger value for CAPE than the actual one.
!             ----------------------------------------------------------
!
  WHERE ( GWORK1(:) )
!
    ZWORK3(:)   = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) -                      &
                  ( 1. - ZWORK6(:) ) *  PZLCL(:)              ! level thickness
    ZWORK2(:)   = PTHES(:,JK) + ( 1. - ZWORK6(:) ) *                      &
     ( PTHES(:,JKP) - PTHES(:,JK) ) / ( PZ(:,JKP) - PZ(:,JK) ) *          &
     ( PZLCL(:) - PZ(:,JK) ) ! linear interpolation for theta_es at LCL
                            ! ( this is only done for model level just above LCL
!
    ZWORK1(:) = ( 2. * ZTHEUL(:) ) / ( ZWORK2(:) + PTHES(:,JKP) ) - 1.   
    PCAPE(:)  = PCAPE(:) + XG * ZWORK3(:) * MAX( 0., ZWORK1(:) )
!
!
!*       10.   Compute final values of updraft mass flux, enthalpy, r_w 
!              at level k+1    
!              --------------------------------------------------------
!    
    PUMF(:,JKP)  = PUMF(:,JK) - PUDR(:,JKP) + PUER(:,JKP) 
    PUMF(:,JKP)  = MAX( PUMF(:,JKP), 0.1 )
    PUTHL(:,JKP) = ( PUMF(:,JK) * PUTHL(:,JK) +                              &
                     PUER(:,JKP) * PTHL(:,JK) - PUDR(:,JKP) * PUTHL(:,JK) )  &
                    / PUMF(:,JKP) + PUTHL(:,JKP) - PUTHL(:,JK)
    PURW(:,JKP)  = ( PUMF(:,JK) * PURW(:,JK) +                               &
                     PUER(:,JKP) * PRW(:,JK) - PUDR(:,JKP) * PURW(:,JK) )    &
                    / PUMF(:,JKP) - PURR(:,JKP) - PURS(:,JKP)
!    
    ZE1(:) = ZE2(:) ! update fractional entrainment/detrainment
    ZD1(:) = ZD2(:)
!
  END WHERE
!
END DO
!
!*       12.1    Set OTRIG to False if cloud thickness < XCDEPTH
!                or CAPE < 1
!                ------------------------------------------------
!
    DO JI = 1, IIE
          JK  = KCTL(JI)
          OTRIG(JI) = PZ(JI,JK) - PZLCL(JI) >= XCDEPTH               &
                     .AND. PCAPE(JI) > 1. 
    END DO
    WHERE( .NOT. OTRIG(:) )
          KCTL(:) = IKB 
    END WHERE
KETL(:) = MAX( KETL(:), KLCL(:) + 2 )
KETL(:) = MIN( KETL(:), KCTL(:) )
!
!
!*       12.2    If the ETL and CTL are the same detrain updraft mass   
!                flux at this level
!                ------------------------------------------------------- 
!
ZWORK1(:) = 0.
WHERE ( KETL(:) == KCTL(:) ) ZWORK1(:) = 1.
!
DO JI = 1, IIE
    JK = KETL(JI) 
    PUDR(JI,JK)   = PUDR(JI,JK) +                                    &
                          ( PUMF(JI,JK) - PUER(JI,JK) )  * ZWORK1(JI)  
    PUER(JI,JK)   = PUER(JI,JK) * ( 1. - ZWORK1(JI) )
    PUMF(JI,JK)   = PUMF(JI,JK) * ( 1. - ZWORK1(JI) )
    JKP = KCTL(JI) + 1
    PUER(JI,JKP)  = 0. ! entrainm/detr rates have been already computed
    PUDR(JI,JKP)  = 0. ! at level KCTL+1, set them to zero
END DO
!    
!*       12.3    Adjust mass flux profiles, detrainment rates, and   
!                precipitation fallout rates to reflect linear decrease
!                in mass flux between the ETL and CTL
!                -------------------------------------------------------        
! 
ZWORK1(:) = 0.
JK1 = MINVAL( KETL(:) )
JK2 = MAXVAL( KCTL(:) )
DO JK = JK1, JK2
    DO JI = 1, IIE
    IF( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
        ZWORK1(JI) = ZWORK1(JI) + PDPRES(JI,JK)
    END IF
    END DO
END DO
!
DO JI = 1, IIE
    JK = KETL(JI) 
    ZWORK1(JI) = PUMF(JI,JK) / MAX( 1., ZWORK1(JI) )
END DO
!
DO JK = JK1 + 1, JK2
    JKP = JK - 1
    DO JI = 1, IIE
    IF ( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
      ! PUTPR(JI)    = PUTPR(JI) - ( PURR(JI,JK) + PURS(JI,JK) ) * PUMF(JI,JKP)      
        PUTPR(JI)    = PUTPR(JI) - PUPR(JI,JK)
        PUDR(JI,JK)  = PDPRES(JI,JK) * ZWORK1(JI)
        PUMF(JI,JK)  = PUMF(JI,JKP) - PUDR(JI,JK)
        PUPR(JI,JK)  = PUMF(JI,JKP) * ( PURR(JI,JK) + PURS(JI,JK) )
        PUTPR(JI)    = PUTPR(JI) + PUPR(JI,JK)
    END IF
    END DO
END DO
!
!         12.4   Set mass flux and entrainment in the source layer.
!                Linear increase throughout the source layer.
!                -------------------------------------------------------
!
!IWORK(:) = MIN( KPBL(:), KLCL(:) - 1 )
IWORK(:) = KPBL(:)
DO JI = 1, IIE
     JK  = KDPL(JI)
     JKP = IWORK(JI)
!          mixed layer depth
     ZWORK2(JI) = PPRES(JI,JK) - PPRES(JI,JKP) + PDPRES(JI,JK)
END DO
!
JKP = MAXVAL( IWORK(:) )
DO JK = JKM, JKP
   DO JI = 1, IIE
   IF ( JK >= KDPL(JI)  .AND. JK <= IWORK(JI) ) THEN
       PUER(JI,JK) = PUER(JI,JK) + PMFLCL(JI) * PDPRES(JI,JK) / ( ZWORK2(JI) + 0.1 )
       PUMF(JI,JK) = PUMF(JI,JK-1) + PUER(JI,JK)
   END IF
   END DO
END DO
!
!
!*       13.   If cloud thickness is smaller than  3 km, no
!              convection is allowed
!              Nota: For technical reasons, we stop the convection
!                    computations in this case and do not go back to
!                    TRIGGER_FUNCT to look for the next unstable LCL
!                    which could produce a thicker cloud.
!              ---------------------------------------------------
!
GWORK6(:,:) = SPREAD( OTRIG(:), DIM=2, NCOPIES=KLEV )
WHERE ( .NOT. OTRIG(:) ) PUTPR(:) = 0.
WHERE ( .NOT. GWORK6(:,:) )
    PUMF(:,:)  = 0.
    PUDR(:,:)  = 0.
    PUER(:,:)  = 0.
    PUTHL(:,:) = PTHL(:,:)
    PURW(:,:)  = PRW(:,:)
    PUPR(:,:)  = 0.
    PURC(:,:)  = 0.
    PURI(:,:)  = 0.
    PURR(:,:)  = 0.
    PURS(:,:)  = 0.
END WHERE
!
END SUBROUTINE CONVECT_UPDRAFT
!     ######spl
      SUBROUTINE CONVECT_CONDENS( KLON,                                           &
                                  KICE, PPRES, PTHL, PRW, PRCO, PRIO, PZ, OWORK1, &
                                  PT, PEW, PRC, PRI, PLV, PLS, PCPH   )
!     ###########################################################################
!
!!**** Compute temperature cloud and ice water content from enthalpy and r_w 
!!
!!
!!    PURPOSE
!!    -------
!!     The purpose of this routine is to determine cloud condensate
!!     and to return values for L_v, L_s and C_ph
!!
!!
!!**  METHOD
!!    ------
!!     Condensate is extracted iteratively 
!!     
!!
!!    EXTERNAL
!!    --------
!!     None
!!     
!!
!!    IMPLICIT ARGUMENTS     
!!    ------------------
!!
!!      Module MODD_CST
!!          XG                   ! gravity constant
!!          XALPW, XBETAW, XGAMW ! constants for water saturation pressure
!!          XALPI, XBETAI, XGAMI ! constants for ice saturation pressure
!!          XP00                 ! reference pressure
!!          XRD, XRV             ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV           ! specific heat for dry air and water vapor
!!          XCL, XCI             ! specific heat for liquid water and ice
!!          XTT                  ! triple point temperature
!!          XLVTT, XLSTT         ! vaporization, sublimation heat constant
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CONVPAR
!!          XTFRZ1               ! begin of freezing interval
!!          XTFRZ2               ! end of freezing interval
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_CONDENS)
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  04/10/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER, INTENT(IN)                :: KLON    ! horizontal loop index
INTEGER, INTENT(IN)                :: KICE    ! flag for ice ( 1 = yes,
                                              !                0 = no ice )
REAL, DIMENSION(KLON),   INTENT(IN) :: PPRES  ! pressure
REAL, DIMENSION(KLON),   INTENT(IN) :: PTHL   ! enthalpy (J/kg)
REAL, DIMENSION(KLON),   INTENT(IN) :: PRW    ! total water mixing ratio  
REAL, DIMENSION(KLON),   INTENT(IN) :: PRCO   ! cloud water estimate (kg/kg)
REAL, DIMENSION(KLON),   INTENT(IN) :: PRIO   ! cloud ice   estimate (kg/kg)
REAL, DIMENSION(KLON),   INTENT(IN) :: PZ     ! level height (m)
LOGICAL, DIMENSION(KLON),INTENT(IN) :: OWORK1 ! logical mask         
!
!
REAL, DIMENSION(KLON),   INTENT(OUT):: PT     ! temperature   
REAL, DIMENSION(KLON),   INTENT(OUT):: PRC    ! cloud water mixing ratio(kg/kg)
REAL, DIMENSION(KLON),   INTENT(OUT):: PRI    ! cloud ice mixing ratio  (kg/kg)
REAL, DIMENSION(KLON),   INTENT(OUT):: PLV    ! latent heat L_v    
REAL, DIMENSION(KLON),   INTENT(OUT):: PLS    ! latent heat L_s  
REAL, DIMENSION(KLON),   INTENT(OUT):: PCPH   ! specific heat C_ph   
REAL, DIMENSION(KLON),   INTENT(OUT):: PEW    ! water saturation mixing ratio  
!
!*       0.2   Declarations of local variables KLON
!
INTEGER :: JITER          ! iteration index
REAL    :: ZEPS, ZEPSA    ! R_d / R_v, 1 / ZEPS
REAL    :: ZCVOCD         ! XCPV / XCPD
REAL    :: ZRDOCP         ! R_d / C_pd
!
REAL, DIMENSION(KLON)    :: ZEI           ! ice saturation mixing ratio
REAL, DIMENSION(KLON)    :: ZWORK1, ZWORK2, ZWORK3, ZT ! work arrays
!
!
!-------------------------------------------------------------------------------
!
!*       1.     Initialize temperature and Exner function
!               -----------------------------------------
!
ZRDOCP      = XRD / XCPD  
ZEPS        = XRD / XRV
ZEPSA       = 1. / ZEPS
ZCVOCD      = XCPV / XCPD
!
!
    ! Make a first temperature estimate, based e.g. on values of
    !  r_c and r_i at lower level
!
      !! Note that the definition of ZCPH is not the same as used in
      !! routine CONVECT_SATMIXRATIO
     PCPH(:)   = XCPD + XCPV * PRW(:)
     ZWORK1(:) = ( 1. + PRW(:) ) * XG * PZ(:)
     PT(:)     = ( PTHL(:) + PRCO(:) * XLVTT + PRIO(:) * XLSTT - ZWORK1(:) )   &
                 / PCPH(:)
     PT(:)     = MAX(180., MIN( 330., PT(:) ) ) ! set overflow bounds in
                                                    ! case that PTHL=0     
!
!
!*       2.     Enter the iteration loop
!               ------------------------
!    
DO JITER = 1,6
     PEW(:) = EXP( XALPW - XBETAW / PT(:) - XGAMW * LOG( PT(:) ) )
     ZEI(:) = EXP( XALPI - XBETAI / PT(:) - XGAMI * LOG( PT(:) ) )
     PEW(:) = ZEPS * PEW(:) / ( PPRES(:) - PEW(:) )
     ZEI(:) = ZEPS * ZEI(:) / ( PPRES(:) - ZEI(:) )    
!
     PLV(:)    = XLVTT + ( XCPV - XCL ) * ( PT(:) - XTT ) ! compute L_v
     PLS(:)    = XLSTT + ( XCPV - XCI ) * ( PT(:) - XTT ) ! compute L_i
!    
     ZWORK2(:) = ( PT(:) - XTFRZ2 ) / ( XTFRZ1 - XTFRZ2 ) ! freezing interval
     ZWORK2(:) = MAX( 0., MIN(1., ZWORK2(:) ) ) 
     ZWORK2(:) = ZWORK2(:) * ZWORK2(:)
     IF ( KICE == 0 ) ZWORK2(:) = 1.
     ZWORK3(:) = ( 1. - ZWORK2(:) ) * ZEI(:) + ZWORK2(:) * PEW(:)
     PRC(:)    = MAX( 0., ZWORK2(:) * ( PRW(:) - ZWORK3(:) ) )
     PRI(:)    = MAX( 0., ( 1. - ZWORK2(:) ) * ( PRW(:) - ZWORK3(:) ) )
     ZT(:)     = ( PTHL(:) + PRC(:) * PLV(:) + PRI(:) * PLS(:) - ZWORK1(:) )   &
                 / PCPH(:)
     PT(:) = PT(:) + ( ZT(:) - PT(:) ) * 0.4  ! force convergence
     PT(:) = MAX( 175., MIN( 330., PT(:) ) )
END DO
!
!
END SUBROUTINE CONVECT_CONDENS
!     ######spl
      SUBROUTINE CONVECT_SATMIXRATIO( KLON,                          &
                                      PPRES, PT, PEW, PLV, PLS, PCPH )      
!     ################################################################
!
!!**** Compute vapor saturation mixing ratio over liquid water
!!
!!
!!    PDRPOSE
!!    -------
!!     The purpose of this routine is to determine saturation mixing ratio
!!     and to return values for L_v L_s and C_ph
!!
!!
!!**  METHOD
!!    ------
!!
!!
!!    EXTERNAL
!!    --------
!!     None
!!
!!
!!    IMPLICIT ARGUMENTS    
!!    ------------------
!!      Module MODD_CST
!!          XALPW, XBETAW, XGAMW ! constants for water saturation pressure
!!          XRD, XRV             ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV           ! specific heat for dry air and water vapor
!!          XCL, XCI             ! specific heat for liquid water and ice
!!          XTT                  ! triple point temperature
!!          XLVTT, XLSTT         ! vaporization, sublimation heat constant
!!
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_SATMIXRATIO)
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  04/10/97
!------------------------- ------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                INTENT(IN) :: KLON    ! horizontal loop index
REAL, DIMENSION(KLON),  INTENT(IN) :: PPRES   ! pressure
REAL, DIMENSION(KLON),  INTENT(IN) :: PT      ! temperature   
!
REAL, DIMENSION(KLON),  INTENT(OUT):: PEW     ! vapor saturation mixing ratio
REAL, DIMENSION(KLON),  INTENT(OUT):: PLV     ! latent heat L_v    
REAL, DIMENSION(KLON),  INTENT(OUT):: PLS     ! latent heat L_s  
REAL, DIMENSION(KLON),  INTENT(OUT):: PCPH    ! specific heat C_ph   
!
!*       0.2   Declarations of local variables :
!
REAL, DIMENSION(KLON)              :: ZT      ! temperature   
REAL    :: ZEPS           ! R_d / R_v
!
!
!-------------------------------------------------------------------------------
!
    ZEPS      = XRD / XRV
!
    ZT(:)     = MIN( 400., MAX( PT(:), 10. ) ) ! overflow bound
    PEW(:)    = EXP( XALPW - XBETAW / ZT(:) - XGAMW * LOG( ZT(:) ) )
    PEW(:)    = ZEPS * PEW(:) / ( PPRES(:) - PEW(:) )
!
    PLV(:)    = XLVTT + ( XCPV - XCL ) * ( ZT(:) - XTT ) ! compute L_v
    PLS(:)    = XLSTT + ( XCPV - XCI ) * ( ZT(:) - XTT ) ! compute L_i
!    
    PCPH(:)   = XCPD + XCPV * PEW(:)                     ! compute C_ph 
!
END SUBROUTINE CONVECT_SATMIXRATIO
!     ######spl
      SUBROUTINE CONVECT_MIXING_FUNCT( KLON,                &
                                       PMIXC, KMF, PER, PDR ) 
!     #######################################################
!
!!**** Determine the area under the distribution function
!!     KMF = 1 : gaussian  KMF = 2 : triangular distribution function
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the entrainment and
!!      detrainment rate by evaluating the are under the distribution 
!!      function. The integration interval is limited by the critical
!!      mixed fraction PMIXC
!!   
!!
!!
!!**  METHOD
!!    ------
!!      Use handbook of mathemat. functions by Abramowitz and Stegun, 1968
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!      None
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      None
!!
!!
!!    REFERENCE
!!    ---------
!!
!!      Book2 of documentation ( routine MIXING_FUNCT)
!!      Abramovitz and Stegun (1968), handbook of math. functions 
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  04/10/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER,               INTENT(IN) :: KLON   ! horizontal dimension
INTEGER,               INTENT(IN) :: KMF    ! switch for dist. function
REAL, DIMENSION(KLON), INTENT(IN) :: PMIXC  ! critical mixed fraction
!
REAL, DIMENSION(KLON), INTENT(OUT):: PER    ! normalized entrainment rate
REAL, DIMENSION(KLON), INTENT(OUT):: PDR    ! normalized detrainment rate
!
!*       0.2   Declarations of local variables :
!
REAL    :: ZSIGMA = 0.166666667                   ! standard deviation 
REAL    :: ZFE    = 4.931813949                   ! integral normalization 
REAL    :: ZSQRTP = 2.506628,  ZP  = 0.33267      ! constants
REAL    :: ZA1    = 0.4361836, ZA2 =-0.1201676    ! constants
REAL    :: ZA3    = 0.9372980, ZT1 = 0.500498     ! constants
REAL    :: ZE45   = 0.01111                       ! constant
!
REAL, DIMENSION(KLON) :: ZX, ZY, ZW1, ZW2         ! work variables
REAL    :: ZW11
!
!
!-------------------------------------------------------------------------------
!
!       1.     Use gaussian function for KMF=1
!              -------------------------------
!
IF( KMF == 1 ) THEN 
    ! ZX(:)  = ( PMIXC(:) - 0.5 ) / ZSIGMA
      ZX(:)  = 6. * PMIXC(:) - 3.
      ZW1(:) = 1. / ( 1.+ ZP * ABS ( ZX(:) ) )
      ZY(:)  = EXP( -0.5 * ZX(:) * ZX(:) )
      ZW2(:) = ZA1 * ZW1(:) + ZA2 * ZW1(:) * ZW1(:) +                   &
               ZA3 * ZW1(:) * ZW1(:) * ZW1(:)
      ZW11   = ZA1 * ZT1 + ZA2 * ZT1 * ZT1 + ZA3 * ZT1 * ZT1 * ZT1
ENDIF 
!
WHERE ( KMF == 1 .AND. ZX(:) >= 0. )
	PER(:) = ZSIGMA * ( 0.5 * ( ZSQRTP - ZE45 * ZW11                 &
		 - ZY(:) * ZW2(:) ) + ZSIGMA * ( ZE45 - ZY(:) ) )        &
		 - 0.5 * ZE45 * PMIXC(:) * PMIXC(:)
	PDR(:) = ZSIGMA*( 0.5 * ( ZY(:) * ZW2(:) - ZE45 * ZW11   )       &
		 + ZSIGMA * ( ZE45 - ZY(:) ) )                           &
		 - ZE45 * ( 0.5 + 0.5 * PMIXC(:) * PMIXC(:) - PMIXC(:) )
END WHERE
WHERE ( KMF == 1 .AND. ZX(:) < 0. ) 
	PER(:) = ZSIGMA*( 0.5 * ( ZY(:) * ZW2(:) - ZE45 * ZW11   )       &
		 + ZSIGMA * ( ZE45 - ZY(:) ) )                           &
		 - 0.5 * ZE45 * PMIXC(:) * PMIXC(:)
	PDR(:) = ZSIGMA * ( 0.5 * ( ZSQRTP - ZE45 * ZW11 - ZY(:)         &
		 * ZW2(:) ) + ZSIGMA * ( ZE45 - ZY(:) ) )                &
		 - ZE45 * ( 0.5 + 0.5 * PMIXC(:) * PMIXC(:) - PMIXC(:) )
END WHERE
!
      PER(:) = PER(:) * ZFE
      PDR(:) = PDR(:) * ZFE
!
!
!       2.     Use triangular function KMF=2
!              -------------------------------
!
!     not yet released
!
!
END SUBROUTINE CONVECT_MIXING_FUNCT
!     ######spl
      SUBROUTINE CONVECT_TSTEP_PREF( KLON, KLEV,                           &
				     PU, PV, PPRES, PZ, PDXDY, KLCL, KCTL, &
                                     PTIMEA, PPREF )
!     ######################################################################
!
!!**** Routine to compute convective advection time step and precipitation 
!!     efficiency 
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the convective
!!      advection time step PTIMEC as a function of the mean ambient 
!!      wind as well as the precipitation efficiency as a function
!!      of wind shear and cloud base height.
!!
!!
!!**  METHOD
!!    ------
!!     
!!
!!    EXTERNAL
!!    --------
!!     None
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation 
!!      Fritsch and Chappell, 1980, J. Atmos. Sci.
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  04/10/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER, INTENT(IN)                    :: KLON   ! horizontal dimension
INTEGER, INTENT(IN)                    :: KLEV   ! vertical dimension
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES  ! pressure (Pa) 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PU     ! grid scale horiz. wind u 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PV     ! grid scale horiz. wind v
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ     ! height of model layer (m) 
REAL, DIMENSION(KLON),      INTENT(IN) :: PDXDY  ! grid area (m^2)
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KLCL   ! lifting condensation level index
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KCTL   ! cloud top level index
!
REAL, DIMENSION(KLON),      INTENT(OUT):: PTIMEA ! advective time period
REAL, DIMENSION(KLON),      INTENT(OUT):: PPREF  ! precipitation efficiency 
!
!
!*       0.2   Declarations of local variables KLON
!
INTEGER :: IIE, IKB, IKE                      ! horizontal + vertical loop bounds
INTEGER :: JI                                 ! horizontal loop index
INTEGER :: JK, JKLC, JKP5, JKCT               ! vertical loop index
!
INTEGER, DIMENSION(KLON)  :: IP500       ! index of 500 hPa levels
REAL, DIMENSION(KLON)     :: ZCBH        ! cloud base height 
REAL, DIMENSION(KLON)     :: ZWORK1, ZWORK2, ZWORK3  ! work arrays
!
!
!-------------------------------------------------------------------------------
!
!        0.3   Set loop bounds
!              ---------------
!
IIE = KLON
IKB = 1 + JCVEXB 
IKE = KLEV - JCVEXT 
!
!
!*       1.     Determine vertical index for 500 hPa levels 
!               ------------------------------------------
!
!
IP500(:) = IKB
DO JK = IKB, IKE
    WHERE ( PPRES(:,JK) >= 500.E2 ) IP500(:) = JK
END DO
!
!
!*       2.     Compute convective time step 
!               ----------------------------
!
	    ! compute wind speed at LCL, 500 hPa, CTL

DO JI = 1, IIE
   JKLC = KLCL(JI)
   JKP5 = IP500(JI)
   JKCT = KCTL(JI)
   ZWORK1(JI) = SQRT( PU(JI,JKLC) * PU(JI,JKLC) +           &
		      PV(JI,JKLC) * PV(JI,JKLC)  ) 
   ZWORK2(JI) = SQRT( PU(JI,JKP5) * PU(JI,JKP5) +           &
		      PV(JI,JKP5) * PV(JI,JKP5)  ) 
   ZWORK3(JI) = SQRT( PU(JI,JKCT) * PU(JI,JKCT) +           &
		      PV(JI,JKCT) * PV(JI,JKCT)  ) 
END DO
!
ZWORK2(:) = MAX( 0.1, 0.5 * ( ZWORK1(:) + ZWORK2(:) ) )
!
PTIMEA(:) = SQRT( PDXDY(:) ) / ZWORK2(:) 
!
!
!*       3.     Compute precipitation efficiency 
!               -----------------------------------
!
!*       3.1    Precipitation efficiency as a function of wind shear
!               ----------------------------------------------------
!
ZWORK2(:) = SIGN( 1., ZWORK3(:) - ZWORK1(:) )
DO JI = 1, IIE
    JKLC = KLCL(JI)
    JKCT = KCTL(JI)
    ZWORK1(JI) = ( PU(JI,JKCT) - PU(JI,JKLC) )  *          &
                 ( PU(JI,JKCT) - PU(JI,JKLC) )  +          &
                 ( PV(JI,JKCT) - PV(JI,JKLC) )  *          &
                 ( PV(JI,JKCT) - PV(JI,JKLC) )  
    ZWORK1(JI) = 1.E3 * ZWORK2(JI) * SQRT( ZWORK1(JI) ) /  &
	         MAX( 1.E-2, PZ(JI,JKCT) - PZ(JI,JKLC) )
END DO
!
PPREF(:)  = 1.591 + ZWORK1(:) * ( -.639 + ZWORK1(:) * (        &
				9.53E-2 - ZWORK1(:) * 4.96E-3 ) ) 
PPREF(:)  = MAX( .4, MIN( PPREF(:), .92 ) )
!
!*       3.2    Precipitation efficiency as a function of cloud base height 
!               ----------------------------------------------------------
!
DO JI = 1, IIE
   JKLC = KLCL(JI)
   ZCBH(JI)   = MAX( 3., ( PZ(JI,JKLC) - PZ(JI,IKB) ) * 3.281E-3 ) 
END DO
ZWORK1(:) = .9673 + ZCBH(:) * ( -.7003 + ZCBH(:) * ( .1622 + &
	      ZCBH(:) *  ( -1.2570E-2 + ZCBH(:) * ( 4.2772E-4 -  &
              ZCBH(:) * 5.44E-6 ) ) ) )
ZWORK1(:) = MAX( .4, MIN( .92, 1./ ( 1. + ZWORK1(:) ) ) )
!
!*       3.3    Mean precipitation efficiency is used to compute rainfall 
!               ----------------------------------------------------------
!
PPREF(:) = 0.5 * ( PPREF(:) + ZWORK1(:) )
!
!
END SUBROUTINE CONVECT_TSTEP_PREF
!     ######spl
     SUBROUTINE CONVECT_DOWNDRAFT( KLON, KLEV,                                &
                                   KICE, PPRES, PDPRES, PZ, PTH, PTHES,       &
                                   PRW, PRC, PRI,                             &
                                   PPREF, KLCL, KCTL, KETL,                   &
                                   PUTHL, PURW, PURC, PURI,                   &
                                   PDMF, PDER, PDDR, PDTHL, PDRW,             &
                                   PMIXF, PDTEVR, KLFS, KDBL, KML,            &
                                   PDTEVRF )
!    ########################################################################
!
!!**** Compute downdraft properties from LFS to DBL. 
!!
!!
!!    PDRPOSE                                                       
!!    -------
!!      The purpose of this routine is to determine downdraft properties
!!      ( mass flux, thermodynamics ) 
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from top.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     Routine CONVECT_SATMIXRATIO        
!!                
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XPI                ! Pi
!!          XP00               ! reference pressure
!!          XRD, XRV           ! gaz  constants for dry air and water vapor
!!          XCPD               ! Cpd (dry air)
!!          XCPV, XCL, XCI     ! Cp of water vapor, liquid water and ice
!!          XTT                ! triple point temperature
!!          XLVTT, XLSTT       ! vaporisation/sublimation heat at XTT
!!
!!      Module MODD_CONVPAR
!!          XCRAD              ! cloud radius
!!          XZPBL              ! thickness of downdraft detrainment layer
!!          XENTR              ! entrainment constant in pressure coordinates
!!          XRHDBC             ! relative humidity in downdraft below cloud
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_DOWNDRAFT)
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  04/10/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                    INTENT(IN) :: KLON  ! horizontal dimension
INTEGER,                    INTENT(IN) :: KLEV  ! vertical dimension
INTEGER,                    INTENT(IN) :: KICE  ! flag for ice ( 1 = yes,
                                                !                0 = no ice )
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH   ! grid scale theta        
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW   ! grid scale total water  
                                                ! mixing ratio 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRC   ! grid scale r_c (cloud water) 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRI   ! grid scale r_i (cloud ice) 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between 
						! bottom and top of layer (Pa) 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ    ! level height (m)
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KLCL  ! contains vert. index of LCL
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KCTL  ! contains vert. index of CTL 
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KETL  ! contains vert. index of 
						! equilibrium (zero buoyancy) level 
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KML   ! " vert. index of melting level
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUTHL ! updraft enthalpy (J/kg)      
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW  ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURC  ! updraft r_c (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURI  ! updraft r_i (kg/kg)
REAL, DIMENSION(KLON),      INTENT(IN) :: PPREF ! precipitation efficiency
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDMF   ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDER   ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDDR   ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTHL  ! downdraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDRW   ! downdraft total water (kg/kg)
REAL, DIMENSION(KLON),      INTENT(OUT):: PMIXF  ! mixed fraction at LFS
REAL, DIMENSION(KLON),      INTENT(OUT):: PDTEVR ! total downdraft evaporation
                                                 ! rate at LFS (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PDTEVRF! downdraft evaporation rate
INTEGER, DIMENSION(KLON),  INTENT(OUT):: KLFS    ! contains vert. index of LFS 
INTEGER, DIMENSION(KLON),  INTENT(OUT):: KDBL    ! contains vert. index of DBL   
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE     ! horizontal + vertical loop bounds
INTEGER :: JK, JKP, JKM, JKT ! vertical loop index
INTEGER :: JI, JL            ! horizontal loop index
INTEGER :: JITER          ! iteration loop index
REAL    :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
REAL    :: ZEPS           ! R_d / R_v
REAL    :: ZEPSA, ZCVOCD  ! R_v / R_d, C_pv / C_pd
!
INTEGER, DIMENSION(KLON) :: IDDT      ! top level of detrainm. layer
REAL, DIMENSION(KLON)    :: ZTHE      ! environm. theta_e (K)
REAL, DIMENSION(KLON)    :: ZDT, ZDTP ! downdraft temperature (K)
REAL, DIMENSION(KLON)    :: ZCPH      ! specific heat C_ph 
REAL, DIMENSION(KLON)    :: ZLV, ZLS  ! latent heat of vaporis., sublim.       
REAL, DIMENSION(KLON)    :: ZDDT      ! thickness (hPa) of detrainm. layer
REAL, DIMENSION(KLON)    :: ZPI       ! Pi=(P0/P)**(Rd/Cpd)  
REAL, DIMENSION(KLON)    :: ZWORK1, ZWORK2, ZWORK3, ZWORK4,  &
                                   ZWORK5                  ! work arrays 
LOGICAL, DIMENSION(KLON) :: GWORK1                         ! work array
!
!
!-------------------------------------------------------------------------------
!
!        0.3    Set loop bounds
!               ---------------
!
IIE = KLON
IKB = 1 + JCVEXB 
IKE = KLEV - JCVEXT 
!
!
!*       1.     Initialize downdraft properties
!               -------------------------------
!
ZCPORD     = XCPD / XRD
ZRDOCP     = XRD / XCPD
ZEPS       = XRD / XRV
ZEPSA      = XRV / XRD
ZCVOCD     = XCPV / XCPD
PDMF(:,:)  = 0.
PDER(:,:)  = 0.
PDDR(:,:)  = 0.
PDRW(:,:)  = 0.
PDTHL(:,:) = 0.
PDTEVR(:)  = 0.
PMIXF(:)   = 0.
ZTHE(:)    = 0.
ZDDT(:)    = PDPRES(:,IKB+2)
KDBL(:)    = IKB + 1
KLFS(:)    = IKB + 1
IDDT(:)    = KDBL(:) + 1
!  
!
!*       2.     Determine the LFS by looking for minimum of environmental 
!               saturated theta_e 
!               ----------------------------------------------------------
!
ZWORK1(:) = 900.   ! starting value for search of minimum envir. theta_e
DO JK = MINVAL( KLCL(:) ) + 2, MAXVAL( KETL(:) )
   DO JI = 1, IIE
      GWORK1(JI) = JK >= KLCL(JI) + 2 .AND. JK < KETL(JI)  
      IF ( GWORK1(JI) .AND. ZWORK1(JI) > PTHES(JI,JK) ) THEN
         KLFS(JI)   = JK
         ZWORK1(JI) = MIN( ZWORK1(JI), PTHES(JI,JK) )
      END IF
   END DO
END DO      
!
!
!*       3.     Determine the mixed fraction using environmental and updraft
!               values of theta_e at LFS
!               ---------------------------------------------------------   
!
DO JI = 1, IIE
    JK = KLFS(JI)
    ZPI(JI)    = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
      ! compute updraft theta_e
    ZWORK3(JI) = PURW(JI,JK) - PURC(JI,JK) - PURI(JI,JK)
    ZDT(JI)    = PTH(JI,JK) / ZPI(JI) 
    ZLV(JI)    = XLVTT + ( XCPV - XCL ) * ( ZDT(JI) - XTT )                   
    ZLS(JI)    = XLSTT + ( XCPV - XCI ) * ( ZDT(JI) - XTT )                   
    ZCPH(JI)   = XCPD + XCPV * PURW(JI,JK)
    ZDT(JI)    = ( PUTHL(JI,JK) - ( 1. + PURW(JI,JK) ) * XG * PZ(JI,JK)       &
                 + ZLV(JI) * PURC(JI,JK) + ZLS(JI) * PURI(JI,JK) ) / ZCPH(JI)           
    ZWORK1(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) )              &
                                  * EXP( ( 3374.6525 / ZDT(JI) - 2.5403 )     &
                                  * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
      ! compute environmental theta_e
    ZDT(JI)    = PTH(JI,JK) / ZPI(JI)
    ZLV(JI)    = XLVTT + ( XCPV - XCL ) * ( ZDT(JI) - XTT )                   
    ZLS(JI)    = XLSTT + ( XCPV - XCI ) * ( ZDT(JI) - XTT )                   
    ZWORK3(JI) = PRW(JI,JK) - PRC(JI,JK) - PRI(JI,JK)
    ZCPH(JI)   = XCPD + XCPV * PRW(JI,JK)
    ZWORK2(JI) = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) )              &
                                  * EXP( ( 3374.6525 / ZDT(JI) - 2.5403 )     &
                                  * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
      ! compute mixed fraction
    PMIXF(JI)  = MAX( 0., ( ZWORK1(JI) - PTHES(JI,JK) ) )                   &
                  / ( ZWORK1(JI) - ZWORK2(JI) + 1.E-10 )
    PMIXF(JI)  = MAX(0., MIN( 1., PMIXF(JI) ) )
    ZWORK4(JI) = PPRES(JI,JK)
END DO
!
!
!*       4.     Estimate the effect of melting on the downdraft  
!               ---------------------------------------------
!
ZWORK1(:) = 0.
      ! use total solid precipitation
!DO JK = IKB + 1, IKE
!    ZWORK1(:) = ZWORK1(:) + PURS(:,JK) ! total snow/hail content
!END DO
!
DO JI = 1, IIE
     JK  = KLCL(JI)
     JKP = KCTL(JI)
     ZWORK1(JI) = 0.5 * ( PURW(JI,JK) - PURW(JI,JKP) )
END DO
!
      ! temperature perturbation due to melting at LFS
ZWORK3(:) = 0.
WHERE( KML(:) > IKB + 2 )
	  ZWORK3(:) = ZWORK1(:) * ( ZLS(:) - ZLV(:) ) / ZCPH(:)
	  ZDT(:)    = ZDT(:) - ZWORK3(:) * REAL(KICE)
END WHERE
!
!
!*       5.     Initialize humidity at LFS as a saturated mixture of
!               updraft and environmental air
!               -----------------------------------------------------    
!
DO JI = 1, IIE
     JK = KLFS(JI)
     PDRW(JI,JK)  = PMIXF(JI) * PRW(JI,JK) + ( 1. - PMIXF(JI) ) * PURW(JI,JK)
     ZWORK2(JI)   = PDRW(JI,JK) - ( 1. - PMIXF(JI) )                          &
                                     * ( PURC(JI,JK) + PURI(JI,JK) )
END DO
!
!
!*       6.1    Determine the DBL by looking for level where the envir.
!               theta_es at the LFS corrected by melting effects  becomes
!               larger than envir. value
!               ---------------------------------------------------------
!
      ! compute satur. mixing ratio for melting corrected temperature
CALL CONVECT_SATMIXRATIO( KLON, ZWORK4, ZDT, ZWORK3, ZLV, ZLS, ZCPH )  
!
      ! compute envir. saturated theta_e for melting corrected temperature
    ZWORK1(:) = MIN( ZWORK2(:), ZWORK3(:) )
    ZWORK3(:) = ZWORK3(:) * ZWORK4(:) / ( ZWORK3(:) + ZEPS ) ! sat. pressure
    ZWORK3(:) = LOG( ZWORK3(:) / 613.3 )
              ! dewp point temperature
    ZWORK3(:) = ( 4780.8 - 32.19 * ZWORK3(:) ) / ( 17.502 - ZWORK3(:) )
              ! adiabatic saturation temperature
    ZWORK3(:) = ZWORK3(:) - ( .212 + 1.571E-3 * ( ZWORK3(:) - XTT )          &
                  - 4.36E-4 * ( ZDT(:) - XTT ) ) * ( ZDT(:) - ZWORK3(:) )
    ZWORK4(:) = SIGN(0.5, ZWORK2(:) - ZWORK3(:) )
    ZDT(:)    = ZDT(:) * ( .5 + ZWORK4(:) ) + ( .5 - ZWORK4(:) ) * ZWORK3(:) 
    ZWORK2(:) = ZDT(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK2(:) )                 &
                                  * EXP( ( 3374.6525 / ZDT(:) - 2.5403 )     &
                                  * ZWORK1(:) * ( 1. + 0.81 * ZWORK1(:) ) )
!
GWORK1(:) = .TRUE.
JKM = MAXVAL( KLFS(:) )
DO JK = JKM - 1, IKB + 1, -1
  DO JI = 1, IIE
     IF ( JK < KLFS(JI) .AND. ZWORK2(JI) > PTHES(JI,JK) .AND. GWORK1(JI) ) THEN
	  KDBL(JI) = JK
          GWORK1(JI) = .FALSE.
     END IF
  END DO
END DO
!
!
!*       7.     Define mass flux and entr/detr. rates at LFS
!               -------------------------------------------
!
DO JI = 1, IIE
     JK = KLFS(JI)
     ZWORK1(JI)  = PPRES(JI,JK) /                                            &
                   ( XRD * ZDT(JI) * ( 1. + ZEPS * ZWORK1(JI) ) ) ! density
     PDMF(JI,JK) = - ( 1. - PPREF(JI) ) * ZWORK1(JI) * XPI * XCRAD * XCRAD
     PDTHL(JI,JK)= ZWORK2(JI)   ! theta_l is here actually theta_e
     ZWORK2(JI)  = PDMF(JI,JK)
     PDDR(JI,JK) = 0.
     PDER(JI,JK) = - PMIXF(JI) * PDMF(JI,JK)
END DO
!
!
!         7.1   Downdraft detrainment is assumed to occur in a layer
!               of 60 hPa, determine top level IDDT of this layer
!               ---------------------------------------------------------
!
ZWORK1(:) = 0.
DO JK = IKB + 2, JKM
      ZWORK1(:) = ZWORK1(:) + PDPRES(:,JK)
      WHERE ( JK > KDBL(:) .AND. ZWORK1(:) <= XZPBL )
           ZDDT(:) = ZWORK1(:) 
           IDDT(:) = JK
      END WHERE
END DO
!
!
!*       8.     Enter loop for downdraft computations. Make a first guess
!               of initial downdraft mass flux. 
!               In the downdraft computations we use theta_es instead of 
!               enthalpy as it allows to better take into account evaporation
!               effects. As the downdraft detrainment rate is zero apart 
!               from the detrainment layer, we just compute enthalpy 
!               downdraft from theta_es in this layer.
!               ----------------------------------------------------------
!
!
ZWORK5(:) = 0.
!
DO JK =  JKM - 1, IKB + 1, -1
  JKP = JK + 1
  DO JI = 1, IIE
    IF ( JK < KLFS(JI) .AND. JK >= IDDT(JI) )  THEN
      PDER(JI,JK)  = - ZWORK2(JI) * XENTR * PDPRES(JI,JKP) / XCRAD 
                                               ! DER and DPRES are positive
      PDMF(JI,JK)  = PDMF(JI,JKP) - PDER(JI,JK) 
      ZPI(JI)      = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
      ZDT(JI)      = PTH(JI,JK) / ZPI(JI)
      ZWORK1(JI)   = PRW(JI,JK) - PRC(JI,JK) - PRI(JI,JK)
      ZTHE(JI)     = ZDT(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK1(JI) )           &
                               * EXP( ( 3374.6525 / ZDT(JI) - 2.5403 )         &
                               * ZWORK1(JI) * ( 1. + 0.81 * ZWORK1(JI) ) )
         ! PDTHL is here theta_es, later on in this routine this table is
         ! reskipped to enthalpy 
      PDTHL(JI,JK) = ( PDTHL(JI,JKP) * PDMF(JI,JKP) - ZTHE(JI) * PDER(JI,JK)    &
                    ) / ( PDMF(JI,JK) - 1.E-7 )      
      PDRW(JI,JK)  = ( PDRW(JI,JKP) * PDMF(JI,JKP) - PRW(JI,JK) * PDER(JI,JK)   &
                    ) / ( PDMF(JI,JK) - 1.E-7 )       
    END IF
    IF ( JK < IDDT(JI) .AND. JK >= KDBL(JI) )   THEN
      JL = IDDT(JI)
      PDDR(JI,JK)  = - PDMF(JI,JL) * PDPRES(JI,JKP) / ZDDT(JI) 
      PDMF(JI,JK)  = PDMF(JI,JKP) + PDDR(JI,JK) 
      PDTHL(JI,JK) = PDTHL(JI,JKP)
      PDRW(JI,JK)  = PDRW(JI,JKP)
    END IF
  END DO
END DO
!
!
!*       9.     Calculate total downdraft evaporation 
!               rate for given mass flux (between DBL and IDDT)
!               -----------------------------------------------
!
PDTEVRF(:,:) = 0.
!
JKT = MAXVAL( IDDT(:) )
DO JK = IKB + 1, JKT
!
       ZPI(:) = ( XP00 / PPRES(:,JK) ) ** ZRDOCP
       ZDT(:) = PTH(:,JK) / ZPI(:)
!
!*       9.1    Determine wet bulb temperature at DBL from theta_e.
!               The iteration algoritm is similar to that used in
!               routine CONVECT_CONDENS
!               --------------------------------------------------
!
   DO JITER = 1, 4
       CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZDT, ZWORK1, ZLV, ZLS, ZCPH )  
       ZDTP(:) = PDTHL(:,JK) / ( ZPI(:) ** ( 1. - 0.28 * ZWORK1(:) )         &
                      * EXP( ( 3374.6525 / ZDT(:) - 2.5403 )                 &
                             * ZWORK1(:) * ( 1. + 0.81 * ZWORK1(:) ) ) )
       ZDT(:)  = 0.4 * ZDTP(:) + 0.6 * ZDT(:) ! force convergence
   END DO
!
!
!*       9.2    Sum total downdraft evaporation rate. No evaporation
!               if actual humidity is larger than specified one.
!               -----------------------------------------------------
!
   ZWORK2(:) = ZWORK1(:) / ZDT(:) * ( XBETAW / ZDT(:) - XGAMW ) ! dr_sat/dT
   ZWORK2(:) = ZLV(:) / ZCPH(:) * ZWORK1(:) * ( 1. - XRHDBC ) /              &
                    ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) ) ! temperature perturb                                                           ! due to evaporation
   ZDT(:)    = ZDT(:) + ZWORK2(:)
!
   CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZDT, ZWORK3, ZLV, ZLS, ZCPH )
!
   ZWORK3(:)    = ZWORK3(:) * XRHDBC
   ZWORK1(:)    = MAX( 0., ZWORK3(:) - PDRW(:,JK) ) 
   PDTEVR(:)    = PDTEVR(:) + ZWORK1(:) * PDDR(:,JK) 
   PDTEVRF(:,JK)= PDTEVRF(:,JK) + ZWORK1(:) * PDDR(:,JK) 
      ! compute enthalpie and humidity in the detrainment layer
   PDRW(:,JK)   = MAX( PDRW(:,JK), ZWORK3(:) ) 
   PDTHL(:,JK)  = ( ( XCPD + PDRW(:,JK) * XCPV ) * ZDT(:)                    &
                    + ( 1. + PDRW(:,JK) ) * XG * PZ(:,JK) ) 
!
END DO
!
!
!*      12.     If downdraft does not evaporate any water for specified 
!               relative humidity, no downdraft is allowed
!               ---------------------------------------------------------
!
ZWORK2(:) = 1.
WHERE ( PDTEVR(:) < 1. .OR. KLFS(:) == IKB + 1 ) ZWORK2(:) = 0.
DO JK = IKB, JKM
      KDBL(:)     = KDBL(:) * INT( ZWORK2(:) ) + ( 1 - INT( ZWORK2(:) ) ) * IKB
      KLFS(:)     = KLFS(:) * INT( ZWORK2(:) ) + ( 1 - INT( ZWORK2(:) ) ) * IKB
      PDMF(:,JK)  = PDMF(:,JK)  * ZWORK2(:)
      PDER(:,JK)  = PDER(:,JK)  * ZWORK2(:) 
      PDDR(:,JK)  = PDDR(:,JK)  * ZWORK2(:) 
      ZWORK1(:)   = REAL( KLFS(:) - JK )         ! use this to reset thl_d
      ZWORK1(:)   = MAX( 0.,MIN(1.,ZWORK1(:) ) ) ! and rv_d to zero above LFS
      PDTHL(:,JK) = PDTHL(:,JK) * ZWORK2(:) * ZWORK1(:)
      PDRW(:,JK)  = PDRW(:,JK)  * ZWORK2(:) * ZWORK1(:)
      PDTEVR(:)   = PDTEVR(:)   * ZWORK2(:)
      PDTEVRF(:,JK)= PDTEVRF(:,JK) * ZWORK2(:)
END DO
!
END SUBROUTINE CONVECT_DOWNDRAFT
!     ######spl
      SUBROUTINE CONVECT_PRECIP_ADJUST( KLON, KLEV,                        &
                                        PPRES, PUMF, PUER, PUDR,           &
                                        PUPR, PUTPR, PURW,                 &
                                        PDMF, PDER, PDDR, PDTHL, PDRW,     &
                                        PPREF, PTPR, PMIXF, PDTEVR,        &
                                        KLFS, KDBL, KLCL, KCTL, KETL,      &
                                        PDTEVRF )
!     ######################################################################
!
!!**** Adjust up- and downdraft mass fluxes to be consistent with the
!!     mass transport at the LFS given by the precipitation efficiency
!!     relation. 
!!
!!
!!    PURPOSE                                                       
!!    -------
!!      The purpose of this routine is to adjust up- and downdraft mass
!!      fluxes below the LFS to be consistent with the precipitation
!!      efficiency relation
!!
!!
!!
!!**  METHOD
!!    ------
!!      
!!
!!    EXTERNAL
!!    --------
!!     None
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!     Module MODD_CONVPAR
!!        XUSRDPTH             ! pressure depth to compute updraft humidity
!!                             ! supply rate for downdraft
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_PRECIP_ADJUST)
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  04/10/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CONVPAREXT
USE MODD_CONVPAR
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                    INTENT(IN) :: KLON  ! horizontal dimension
INTEGER,                    INTENT(IN) :: KLEV  ! vertical dimension
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PURW  ! updraft total water (kg/kg) 
REAL, DIMENSION(KLON),      INTENT(IN) :: PUTPR ! updraft  total precipit. (kg/s
REAL, DIMENSION(KLON),      INTENT(IN) :: PPREF ! precipitation efficiency
REAL, DIMENSION(KLON),      INTENT(IN) :: PMIXF ! critical mixed fraction at LCL
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KLCL  ! contains vert. index of LCL
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KCTL  ! contains vert. index of CTL
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KETL  ! contains vert. index of equilibrium 
						! (zero buoyancy) level 
INTEGER, DIMENSION(KLON),  INTENT(INOUT) :: KLFS ! contains vert. index of LFS
INTEGER, DIMENSION(KLON),  INTENT(INOUT) :: KDBL ! contains vert. index of DBL
!
REAL, DIMENSION(KLON),      INTENT(INOUT) :: PDTEVR ! total downdraft evaporation
                                                    ! rate at LFS   
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTEVRF! downdraft evaporation rate
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF   ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER   ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR   ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUPR   ! updraft  precipit. (kg/s)     
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF   ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER   ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR   ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDTHL  ! downdraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDRW   ! downdraft total water (kg/kg)
!
REAL, DIMENSION(KLON),     INTENT(OUT)   :: PTPR    ! total precipitation (kg/s) 
                                                 ! = downdraft precipitation
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE        ! horizontal + vertical loop bounds
INTEGER :: JK, JKT1, JKT2, JKT3 ! vertical loop index
INTEGER :: JI                   ! horizontal loop index
!
INTEGER, DIMENSION(KLON) :: IPRL
REAL, DIMENSION(KLON)    :: ZWORK1, ZWORK2, ZWORK3,     &
				    ZWORK4, ZWORK5, ZWORK6 ! work arrays
!
!
!-------------------------------------------------------------------------------
!
!        0.3   Set loop bounds
!              ---------------
!
IKB  = 1 + JCVEXB 
IKE  = KLEV - JCVEXT 
IIE  = KLON
JKT1 = MAXVAL( KLFS(:) )
JKT2 = MAXVAL( KCTL(:) )
JKT3 = MINVAL( KLCL(:) )
!
!
!        1.    Set some output variables for columns where no downdraft 
!              exists. Exit if there is no downdraft at all.
!              --------------------------------------------------------
!
IPRL(:) = IKB
PTPR(:) = 0.
!
WHERE ( PDTEVR(:) == 0. )
     PTPR(:)    = PUTPR(:)  ! no downdraft evaporation => no downdraft, all
			    ! precipitation occurs in updraft
END WHERE
IF ( COUNT( PDTEVR(:) > 0. ) == 0 ) RETURN ! exit routine if no downdraft exists
!
!*       2.     The total mass transported from the updraft to the down-  
!               draft at the LFS must be consistent with the three water
!               budget terms :
!               ---------------------------------------------------------
!
!*       2.1    Downdraft evaporation rate at the DBL. The evaporation
!               rate in downdraft must be consistent with precipitation
!               efficiency relation.
!               --------------------------------------------------------
!
!
DO JI = 1, IIE
     JK = KLFS(JI)
     ZWORK1(JI) = PDTEVR(JI) / MIN( -1.E-1, PDMF(JI,JK) )
     ZWORK6(JI) = PDMF(JI,JK)
END DO
!
!*       2.2    Some preliminar computations for downdraft = total 
!               precipitation rate. The precipitation is evaluated in 
!               a layer thickness DP=XUSRDPTH=165 hPa above the LCL.
!               The difference between updraft precipitation and downdraft
!               precipitation (updraft supply rate) is used to drive the
!               downdraft through evaporational cooling.
!               --------------------------------------------------------
!
DO JI = 1, IIE
     JK = KLCL(JI)
     ZWORK5(JI) = PPRES(JI,JK)
END DO
!
PTPR(:) = 0.
DO JK = JKT3, JKT2
    WHERE ( JK >= KLCL(:) .AND. PPRES(:,JK) >= ZWORK5(:) - XUSRDPTH )
	PTPR(:) = PTPR(:) + PUPR(:,JK)
	IPRL(:) = JK
    END WHERE
END DO
IPRL(:) = MIN( KETL(:), IPRL(:) )
!
DO JI = 1, IIE
     JK = IPRL(JI)
     PTPR(JI) = PUMF(JI,JK+1) * PURW(JI,JK+1) + PTPR(JI) 
END DO
!
PTPR(:) = PPREF(:) * MIN( PUTPR(:), PTPR(:) )
ZWORK4(:) = PUTPR(:) - PTPR(:) 
!
!
!*       2.3    Total amount of precipitation that falls out of the up-
!               draft between the LCL and the LFS.
!               Condensate transfer from up to downdraft at LFS
!               ---------------------------------------------------------
!
ZWORK5(:) = 0.
DO JK = JKT3, JKT1
     WHERE ( JK >= KLCL(:) .AND. JK <= KLFS(:) )
	   ZWORK5(:) = ZWORK5(:) +  PUPR(:,JK)
     END WHERE
END DO
!
DO JI = 1, IIE
     JK = KLFS(JI)
     ZWORK2(JI) = ( 1. - PPREF(JI) ) * ZWORK5(JI) *                     &
                  ( 1. - PMIXF(JI) ) / MAX( 1.E-1, PUMF(JI,JK) )
END DO
!
!
!*       2.4    Increase the first guess downdraft mass flux to satisfy
!               precipitation efficiency relation.
!               If downdraft does not evaporate any water at the DBL for  
!               the specified relative humidity, or if the corrected mass 
!               flux at the LFS is positive no downdraft is allowed
!               ---------------------------------------------------------
!    
!
ZWORK1(:) = ZWORK4(:) / ( ZWORK1(:) + ZWORK2(:) + 1.E-8 ) 
ZWORK2(:) = ZWORK1(:) / MIN( -1.E-1, ZWORK6(:) ) ! ratio of budget consistent to actual DMF
!
ZWORK3(:) = 1.
ZWORK6(:) = 1.
WHERE ( ZWORK1(:) > 0. .OR. PDTEVR(:) < 1. ) 
   KDBL(:)   = IKB
   KLFS(:)   = IKB
   PDTEVR(:) = 0. 
   ZWORK2(:) = 0.
   ZWORK3(:) = 0.
   ZWORK6(:) = 0.
END WHERE
!
DO JK = IKB, JKT1   
     PDMF(:,JK)  = PDMF(:,JK)  * ZWORK2(:)
     PDER(:,JK)  = PDER(:,JK)  * ZWORK2(:)  
     PDDR(:,JK)  = PDDR(:,JK)  * ZWORK2(:)  
   PDTEVRF(:,JK) = PDTEVRF(:,JK)* ZWORK2(:)  
     PDRW(:,JK)  = PDRW(:,JK)  * ZWORK3(:)  
     PDTHL(:,JK) = PDTHL(:,JK) * ZWORK3(:)  
END DO     
ZWORK4(:) = ZWORK2(:)
!
!
!*       3.     Increase updraft mass flux, mass detrainment rate, and water  
!               substance detrainment rates to be consistent with the transfer
!               of the estimated mass from the up- to the downdraft at the LFS
!               --------------------------------------------------------------
!
DO JI = 1, IIE
    JK = KLFS(JI)
    ZWORK2(JI) = ( 1. - ZWORK6(JI) ) + ZWORK6(JI) *                   &
		  ( PUMF(JI,JK) - ( 1. - PMIXF(JI) ) * ZWORK1(JI) ) / &
		  MAX( 1.E-1, PUMF(JI,JK) )
END DO
!
!
JKT1  = MAXVAL( KLFS(:) )  ! value of KLFS might have been reset to IKB above
DO JK = IKB, JKT1
    DO JI = 1, IIE
      IF ( JK <= KLFS(JI) ) THEN
	PUMF(JI,JK)  = PUMF(JI,JK)  * ZWORK2(JI) 
	PUER(JI,JK)  = PUER(JI,JK)  * ZWORK2(JI)
	PUDR(JI,JK)  = PUDR(JI,JK)  * ZWORK2(JI)
	PUPR(JI,JK)  = PUPR(JI,JK)  * ZWORK2(JI)
      END IF
    END DO
END DO
!
!
!*       4.     Increase total = downdraft precipitation and evaporation rate
!               -------------------------------------------------------------
!
WHERE ( PDTEVR(:) > 0. )
    PDTEVR(:)  = PDTEVR(:) * ZWORK4(:)
    PTPR(:)    = PTPR(:) + PPREF(:) * ZWORK5(:) * ( ZWORK2(:) - 1. )
ELSEWHERE
    PTPR(:)    = PUTPR(:)
END WHERE
!
!
END SUBROUTINE CONVECT_PRECIP_ADJUST
!     ######spl
     SUBROUTINE CONVECT_CLOSURE( KLON, KLEV,                                 &
                                 PPRES, PDPRES, PZ, PDXDY, PLMASS,           &
                                 PTHL, PTH, PRW, PRC, PRI, OTRIG1,           &
                                 PTHC, PRWC, PRCC, PRIC, PWSUB,              &
                                 KLCL, KDPL, KPBL, KLFS, KCTL, KML,          &
                                 PUMF, PUER, PUDR, PUTHL, PURW,              &
                                 PURC, PURI, PUPR,                           &
                                 PDMF, PDER, PDDR, PDTHL, PDRW,              &
                                 PTPR, PSPR, PDTEVR,                         &
                                 PCAPE, PTIMEC,                              &
                                 KFTSTEPS,                                   &
                                 PDTEVRF, PPRLFLX, PPRSFLX                   )
!    #######################################################################
!
!!**** Uses modified Fritsch-Chappell closure
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the final adjusted
!!     (over a time step PTIMEC) environmental values of THETA_l, R_w, R_c, R_i
!!      The final convective tendencies can then be evaluated in the main
!!      routine DEEP_CONVECT by (PTHC-PTH)/PTIMEC
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     
!!    CONVECT_CLOSURE_THRVLCL
!!    CONVECT_CLOSURE_ADJUST
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XP00               ! reference pressure
!!          XRD, XRV           ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV         ! specific heat for dry air and water vapor
!!          XCL, XCI           ! specific heat for liquid water and ice
!!          XTT                ! triple point temperature
!!          XLVTT, XLSTT       ! vaporization, sublimation heat constant
!!
!!      Module MODD_CONVPAR
!!          XA25               ! reference grid area
!!          XSTABT             ! stability factor in time integration 
!!          XSTABC             ! stability factor in CAPE adjustment
!!          XMELDPTH           ! allow melting over specific pressure depth
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_CLOSURE)
!!      Fritsch and Chappell, 1980, J. Atmos. Sci.
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Peter Bechtold 04/10/97 change for enthalpie, r_c + r_i tendencies
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER,                   INTENT(IN) :: KLON   ! horizontal dimension
INTEGER,                   INTENT(IN) :: KLEV   ! vertical dimension
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KLFS   ! index for level of free sink
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KLCL   ! index lifting condens. level
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KCTL   ! index for cloud top level
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KDPL   ! index for departure level 
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KPBL   ! index for top of source layer
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KML    ! index for melting level
REAL, DIMENSION(KLON),  INTENT(INOUT) :: PTIMEC ! convection time step 
REAL, DIMENSION(KLON),     INTENT(IN) :: PDXDY  ! grid area (m^2)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL   ! grid scale enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH    ! grid scale theta        
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW    ! grid scale total water  
			                        ! mixing ratio 
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC    ! grid scale r_c 
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI    ! grid scale r_i 
LOGICAL, DIMENSION(KLON),  INTENT(IN) :: OTRIG1 ! logical to keep trace of 
                                                ! convective arrays modified in UPDRAFT
!   
!
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES  ! pressure (P)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between 
                                                 ! bottom and top of layer (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ     ! height of model layer (m) 
REAL, DIMENSION(KLON),     INTENT(IN)  :: PCAPE  ! available potent. energy
INTEGER,                INTENT(OUT)   :: KFTSTEPS! maximum of fract time steps
                                                 ! only used for chemical tracers
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF  ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER  ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR  ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUPR  ! updraft precipitation in
                                                  ! flux units (kg water / s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PUTHL  ! updraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PURW   ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PURC   ! updraft cloud water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PURI   ! updraft cloud ice   (kg/kg)
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDMF  ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDER  ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDDR  ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)   :: PDTHL ! downdraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)   :: PDRW  ! downdraft total water (kg/kg)
REAL, DIMENSION(KLON),      INTENT(INOUT):: PTPR  ! total surf precipitation (kg/s)
REAL, DIMENSION(KLON),      INTENT(OUT)  :: PSPR  ! solid surf precipitation (kg/s)
REAL, DIMENSION(KLON),      INTENT(INOUT):: PDTEVR! donwndraft evapor. (kg/s)
!
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PTHC  ! conv. adj. grid scale theta
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PRWC  ! conv. adj. grid scale r_w 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PRCC  ! conv. adj. grid scale r_c 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PRIC  ! conv. adj. grid scale r_i 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PWSUB ! envir. compensating subsidence(Pa/s)
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PDTEVRF! downdraft evaporation rate
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PPRLFLX! liquid precip flux
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PPRSFLX! solid  precip flux
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE  ! horizontal + vertical loop bounds
INTEGER :: IKS            ! vertical dimension
INTEGER :: JK, JKP, JKMAX ! vertical loop index
INTEGER :: JI             ! horizontal loop index
INTEGER :: JITER          ! iteration loop index
INTEGER :: JSTEP          ! fractional time loop index
REAL    :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
REAL    :: ZCVOCD, ZEPSA  ! C_pv / C_pd, R_v / R_d
!
REAL, DIMENSION(KLON,KLEV) :: ZTHLC       ! convectively adjusted 
                                          ! grid scale enthalpy
REAL, DIMENSION(KLON,KLEV) :: ZOMG        ! conv. environm. subsidence (Pa/s)
REAL, DIMENSION(KLON,KLEV) :: ZUMF        ! non-adjusted updraft mass flux
REAL, DIMENSION(KLON,KLEV) :: ZUER        !   "     updraft  entrainm. rate
REAL, DIMENSION(KLON,KLEV) :: ZUDR        !   "     updraft  detrainm. rate
REAL, DIMENSION(KLON,KLEV) :: ZDMF        !   "   downdraft mass flux
REAL, DIMENSION(KLON,KLEV) :: ZDER        !   "   downdraft  entrainm. rate
REAL, DIMENSION(KLON,KLEV) :: ZDDR        !   "   downdraft  detrainm. rate
REAL, DIMENSION(KLON)     :: ZTPR         !   "   total precipitation
REAL, DIMENSION(KLON)     :: ZDTEVR       !   "   total downdraft evapor. 
REAL, DIMENSION(KLON,KLEV):: ZPRLFLX      !   "   liquid precip flux
REAL, DIMENSION(KLON,KLEV):: ZPRSFLX      !   "   solid  precip flux
REAL, DIMENSION(KLON)     :: ZPRMELT      ! melting of precipitation
REAL, DIMENSION(KLON)     :: ZPRMELTO     ! non-adjusted  "
REAL, DIMENSION(KLON)     :: ZADJ         ! mass adjustment factor
REAL, DIMENSION(KLON)     :: ZADJMAX      ! limit value for ZADJ
REAL, DIMENSION(KLON)     :: ZCAPE        ! new CAPE after adjustment
REAL, DIMENSION(KLON)     :: ZTIMEC       ! fractional convective time step
REAL, DIMENSION(KLON,KLEV):: ZTIMC        ! 2D work array for ZTIMEC
!
REAL, DIMENSION(KLON)     :: ZTHLCL       ! new  theta at LCL
REAL, DIMENSION(KLON)     :: ZRVLCL       ! new  r_v at LCL
REAL, DIMENSION(KLON)     :: ZZLCL        ! height of LCL
REAL, DIMENSION(KLON)     :: ZTLCL        ! temperature at LCL
REAL, DIMENSION(KLON)     :: ZTELCL       ! envir. temper. at LCL
REAL, DIMENSION(KLON)     :: ZTHEUL       ! theta_e for undilute ascent
REAL, DIMENSION(KLON)     :: ZTHES1, ZTHES2! saturation environm. theta_e
REAL, DIMENSION(KLON,KLEV) :: ZTHMFIN, ZTHMFOUT, ZRWMFIN, ZRWMFOUT
REAL, DIMENSION(KLON,KLEV) :: ZRCMFIN, ZRCMFOUT, ZRIMFIN, ZRIMFOUT
                                    ! work arrays for environm. compensat. mass flux
REAL, DIMENSION(KLON)     :: ZPI          ! (P/P00)**R_d/C_pd 
REAL, DIMENSION(KLON)     :: ZLV          ! latent heat of vaporisation
REAL, DIMENSION(KLON)     :: ZLS          ! latent heat of sublimation 
REAL, DIMENSION(KLON)     :: ZLM          ! latent heat of melting
REAL, DIMENSION(KLON)     :: ZCPH         ! specific heat C_ph
REAL, DIMENSION(KLON)     :: ZMELDPTH     ! actual depth of melting layer 
INTEGER, DIMENSION(KLON)  :: ITSTEP       ! fractional convective time step
INTEGER, DIMENSION(KLON)  :: ICOUNT       ! timestep counter 
INTEGER, DIMENSION(KLON)  :: ILCL         ! index lifting condens. level
INTEGER, DIMENSION(KLON)  :: IWORK1       ! work array
REAL, DIMENSION(KLON)     :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
REAL, DIMENSION(KLON,KLEV):: ZWORK6
LOGICAL, DIMENSION(KLON)  :: GWORK1, GWORK3! work arrays
LOGICAL, DIMENSION(KLON,KLEV) :: GWORK4    ! work array
!
!
!-------------------------------------------------------------------------------
!
!*       0.2    Initialize  local variables
!               ----------------------------
!
!
PSPR(:)   = 0.
ZTIMC(:,:) = 0.
ZTHES2(:) = 0.
ZWORK1(:) = 0. 
ZWORK2(:) = 0. 
ZWORK3(:) = 0. 
ZWORK4(:) = 0. 
ZWORK5(:) = 0. 
GWORK1(:) = .FALSE.
GWORK3(:) = .FALSE.  
GWORK4(:,:) = .FALSE.  
ILCL(:)   = KLCL(:)
!
ZCPORD    = XCPD / XRD
ZRDOCP    = XRD / XCPD
ZCVOCD    = XCPV / XCPD 
ZEPSA     = XRV / XRD
!
ZADJ(:)   = 1.
ZWORK5(:) = 1.
WHERE( .NOT. OTRIG1(:) ) ZWORK5(:) = 0. 
!
!
!*       0.3   Compute loop bounds
!              ------------------- 
!
IIE    = KLON
IKB    = 1 + JCVEXB 
IKS    = KLEV
IKE    = KLEV - JCVEXT 
JKMAX  = MAXVAL( KCTL(:) )
!
!
!*       2.     Save initial mass flux values to be used in adjustment procedure
!               ---------------------------------------------------------------
!
ZUMF(:,:)  = PUMF(:,:)
ZUER(:,:)  = PUER(:,:)
ZUDR(:,:)  = PUDR(:,:)
ZDMF(:,:)  = PDMF(:,:)
ZDER(:,:)  = PDER(:,:)
ZDDR(:,:)  = PDDR(:,:)
ZTPR(:)    = PTPR(:)
ZDTEVR(:)  = PDTEVR(:)
ZOMG(:,:)  = 0.
PWSUB(:,:) = 0. 
ZPRMELT(:) = 0.
PPRLFLX(:,:) = 0.
ZPRLFLX(:,:) = 0.
PPRSFLX(:,:) = 0.
ZPRSFLX(:,:) = 0.
!
!
!*       2.1    Some preliminar computations for melting of precipitation
!               used later in section 9 and computation of precip fluxes
!               Precipitation fluxes are updated for melting and evaporation
!               ---------------------------------------------------------
!
!
ZWORK1(:) = 0.
ZMELDPTH(:) = 0.
ZWORK6(:,:) = 0.
DO JK = JKMAX + 1, IKB + 1, -1
   ! Nota: PUPR is total precipitation flux, but the solid, liquid
   !       precipitation is stored in units kg/kg; therefore we compute here
   !       the solid fraction of the total precipitation flux.
  DO JI = 1, IIE
     ZWORK2(JI)    = PUPR(JI,JK) / ( PURC(JI,JK) + PURI(JI,JK) + 1.E-8 )
     ZPRMELT(JI)   = ZPRMELT(JI) + PURI(JI,JK) * ZWORK2(JI)
     ZWORK1(JI)    = ZWORK1(JI) + PURC(JI,JK) * ZWORK2(JI) - PDTEVRF(JI,JK)
     ZPRLFLX(JI,JK)= MAX( 0., ZWORK1(JI) )
     ZPRMELT(JI)   = ZPRMELT(JI) + MIN( 0., ZWORK1(JI) )
     ZPRSFLX(JI,JK)= ZPRMELT(JI) 
     IF ( KML(JI) >= JK .AND. ZMELDPTH(JI) <= XMELDPTH ) THEN                 
          ZPI(JI)    = ( PPRES(JI,JK) / XP00 ) ** ZRDOCP 
          ZWORK3(JI) = PTH(JI,JK) * ZPI(JI)            ! temperature estimate
          ZLM(JI)    = XLSTT + ( XCPV - XCI ) * ( ZWORK3(JI) - XTT ) -       &
               ( XLVTT + ( XCPV - XCL ) * ( ZWORK3(JI) - XTT ) ) ! L_s - L_v
          ZCPH(JI)   = XCPD + XCPV * PRW(JI,JK)
          ZMELDPTH(JI) = ZMELDPTH(JI) + PDPRES(JI,JK)
          ZWORK6(JI,JK)= ZLM(JI) * PTIMEC(JI) / PLMASS(JI,JK) * PDPRES(JI,JK)
          ZOMG(JI,JK)= 1. ! at this place only used as work variable
     END IF
  END DO
!
END DO
!
ZWORK2(:) = 0.
DO JK = JKMAX, IKB + 1, -1
    ZWORK1(:) = ZPRMELT(:) * PDPRES(:,JK) / MAX( XMELDPTH, ZMELDPTH(:) )
    ZWORK2(:) = ZWORK2(:) + ZWORK1(:) * ZOMG(:,JK)
    ZPRLFLX(:,JK) = ZPRLFLX(:,JK) + ZWORK2(:) 
    ZPRSFLX(:,JK) = ZPRSFLX(:,JK) - ZWORK2(:)
END DO 
WHERE( ZPRSFLX(:,:) < 1. ) ZPRSFLX(:,:)=0.
ZPRMELTO(:) = ZPRMELT(:)
!
!
!*       3.     Compute limits on the closure adjustment factor so that the
!               inflow in convective drafts from a given layer can't be larger 
!               than the mass contained in this layer initially.
!               ---------------------------------------------------------------
!
ZADJMAX(:) = 1000.
IWORK1(:) = MAX( ILCL(:), KLFS(:) )
JKP = MINVAL( KDPL(:) )
DO JK = JKP, IKE
  DO JI = 1, IIE
    IF( JK > KDPL(JI) .AND. JK <= IWORK1(JI) ) THEN
        ZWORK1(JI)  = PLMASS(JI,JK) /                                      &
                  ( ( PUER(JI,JK) + PDER(JI,JK) + 1.E-5 ) * PTIMEC(JI) )
        ZADJMAX(JI) = MIN( ZADJMAX(JI), ZWORK1(JI) )
    END IF
  END DO
END DO
!
!
GWORK1(:) = OTRIG1(:)  ! logical array to limit adjustment to not definitively
                       ! adjusted columns
!
DO JK = IKB, IKE
  ZTHLC(:,:) = PTHL(:,:) ! initialize adjusted envir. values 
  PRWC(:,:)  = PRW(:,:)
  PRCC(:,:)  = PRC(:,:)
  PRIC(:,:)  = PRI(:,:)
  PTHC(:,:)  = PTH(:,:)
END DO
!
!
!
DO JITER = 1, 7  ! Enter adjustment loop to assure that all CAPE is
                 ! removed within the advective time interval TIMEC
!
     ZTIMEC(:) = PTIMEC(:)
     GWORK4(:,:)   = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKS )
     WHERE( GWORK4(:,:) ) PWSUB(:,:) = 0.
     ZOMG(:,:)=0.
!
     DO JK = IKB + 1, JKMAX
           JKP = MAX( IKB + 1, JK - 1 )
           WHERE ( GWORK1(:) .AND. JK <= KCTL(:) )
!
!
!*       4.     Determine vertical velocity at top and bottom of each layer
!               to satisfy mass continuity.
!               ---------------------------------------------------------------
              ! we compute here Domega/Dp = - g rho Dw/Dz = 1/Dt
!
             ZWORK1(:)   = - ( PUER(:,JKP) + PDER(:,JKP) -                   &
                           PUDR(:,JKP) - PDDR(:,JKP) ) / PLMASS(:,JKP)
!    
             PWSUB(:,JK) = PWSUB(:,JKP) - PDPRES(:,JK-1) * ZWORK1(:)
              ! we use PDPRES(JK-1) and not JKP in order to have zero subsidence
              ! at the first layer
!
!   
!*       5.     Compute fractional time step. For stability or 
!               mass conservation reasons one must split full time step PTIMEC)
!               ---------------------------------------------------------------
!
             ZWORK1(:) = XSTABT * PDPRES(:,JKP) / ( ABS( PWSUB(:,JK) ) + 1.E-10 )
              ! the factor XSTABT is used for stability reasons
             ZTIMEC(:) = MIN( ZTIMEC(:), ZWORK1(:) ) 
!
              ! transform vertical velocity in mass flux units
             ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG 
         END WHERE
     END DO
!
!
     WHERE( GWORK4(:,:) )
           ZTHLC(:,:) = PTHL(:,:) ! reinitialize adjusted envir. values 
           PRWC(:,:)  = PRW(:,:)  ! when iteration criterium not attained
           PRCC(:,:)  = PRC(:,:)
           PRIC(:,:)  = PRI(:,:)
           PTHC(:,:)  = PTH(:,:)
     END WHERE
!
! 
!        6. Check for mass conservation, i.e. ZWORK1 > 1.E-2
!           If mass is not conserved, the convective tendencies
!           automatically become zero.
!           ----------------------------------------------------
!
    DO JI = 1, IIE
       JK=KCTL(JI)
       ZWORK1(JI) = PUDR(JI,JK) * PDPRES(JI,JK) / ( PLMASS(JI,JK) + .1 )    &
                                                            - PWSUB(JI,JK)
    END DO
    WHERE( GWORK1(:) .AND. ABS( ZWORK1(:) ) - .01 > 0. )
        GWORK1(:) = .FALSE.
        PTIMEC(:) = 1.E-1
        ZTPR(:)   = 0.
        ZWORK5(:) = 0.
    END WHERE
    DO JK = IKB, IKE
        PWSUB(:,JK) = PWSUB(:,JK) * ZWORK5(:)
        ZPRLFLX(:,JK) = ZPRLFLX(:,JK) * ZWORK5(:)
        ZPRSFLX(:,JK) = ZPRSFLX(:,JK) * ZWORK5(:)
    END DO
    GWORK4(:,1:IKB) = .FALSE.
    GWORK4(:,IKS)   = .FALSE.
!
    ITSTEP(:) = INT( PTIMEC(:) / ZTIMEC(:) ) + 1 
    ZTIMEC(:) = PTIMEC(:) / REAL( ITSTEP(:) ) ! adjust  fractional time step
                                           ! to be an integer multiple of PTIMEC
    ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
    ICOUNT(:) = 0
!
!
!
    KFTSTEPS = MAXVAL( ITSTEP(:) )
    DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop here
!
     	 ICOUNT(:) = ICOUNT(:) + 1
!
	     GWORK3(:) =  ITSTEP(:) >= ICOUNT(:) .AND. GWORK1(:) 
!
!
!*       7.     Assign enthalpy and r_w values at the top and bottom of each
!               layer based on the sign of w
!               ------------------------------------------------------------
!
             ZTHMFIN(:,:)   = 0.
             ZRWMFIN(:,:)   = 0.
             ZRCMFIN(:,:)   = 0.
             ZRIMFIN(:,:)   = 0.
             ZTHMFOUT(:,:)  = 0.
             ZRWMFOUT(:,:)  = 0.
             ZRCMFOUT(:,:)  = 0.
             ZRIMFOUT(:,:)  = 0.
!
         DO JK = IKB + 1, JKMAX
         GWORK4(:,JK) = GWORK3(:) .AND. JK <= KCTL(:)
         JKP = MAX( IKB + 1, JK - 1 )
           DO JI = 1, IIE
           IF ( GWORK3(JI) ) THEN
!
               ZWORK1(JI)       = SIGN( 1., ZOMG(JI,JK) )
               ZWORK2(JI)       = 0.5 * ( 1. + ZWORK1(JI) )
               ZWORK1(JI)       = 0.5 * ( 1. - ZWORK1(JI) )
               ZTHMFIN(JI,JK)   = - ZOMG(JI,JK) * ZTHLC(JI,JKP) * ZWORK1(JI)
               ZTHMFOUT(JI,JK)  =   ZOMG(JI,JK) * ZTHLC(JI,JK)  * ZWORK2(JI)
               ZTHMFIN(JI,JKP)  = ZTHMFIN(JI,JKP)  + ZTHMFOUT(JI,JK) * ZWORK2(JI)
               ZTHMFOUT(JI,JKP) = ZTHMFOUT(JI,JKP) + ZTHMFIN(JI,JK)  * ZWORK1(JI)
               ZRWMFIN(JI,JK)   = - ZOMG(JI,JK) * PRWC(JI,JKP) * ZWORK1(JI)
               ZRWMFOUT(JI,JK)  =   ZOMG(JI,JK) * PRWC(JI,JK)  * ZWORK2(JI)
               ZRWMFIN(JI,JKP)  = ZRWMFIN(JI,JKP)  + ZRWMFOUT(JI,JK) * ZWORK2(JI)
               ZRWMFOUT(JI,JKP) = ZRWMFOUT(JI,JKP) + ZRWMFIN(JI,JK)  * ZWORK1(JI)
               ZRCMFIN(JI,JK)   = - ZOMG(JI,JK) * PRCC(JI,JKP) * ZWORK1(JI)
               ZRCMFOUT(JI,JK)  =   ZOMG(JI,JK) * PRCC(JI,JK)  * ZWORK2(JI)
               ZRCMFIN(JI,JKP)  = ZRCMFIN(JI,JKP)  + ZRCMFOUT(JI,JK) * ZWORK2(JI)
               ZRCMFOUT(JI,JKP) = ZRCMFOUT(JI,JKP) + ZRCMFIN(JI,JK)  * ZWORK1(JI)
               ZRIMFIN(JI,JK)   = - ZOMG(JI,JK) * PRIC(JI,JKP) * ZWORK1(JI)
               ZRIMFOUT(JI,JK)  =   ZOMG(JI,JK) * PRIC(JI,JK)  * ZWORK2(JI)
               ZRIMFIN(JI,JKP)  = ZRIMFIN(JI,JKP)  + ZRIMFOUT(JI,JK) * ZWORK2(JI)
               ZRIMFOUT(JI,JKP) = ZRIMFOUT(JI,JKP) + ZRIMFIN(JI,JK)  * ZWORK1(JI)
!
           END IF
           END DO
         END DO
!
         WHERE ( GWORK4(:,:) )
!
!******************************************************************************
!
!*       8.     Update the environmental values of enthalpy and r_w at each level
!               NOTA: These are the MAIN EQUATIONS of the scheme
!               -----------------------------------------------------------------
!
!
           ZTHLC(:,:) = ZTHLC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * (      &
                          ZTHMFIN(:,:) + PUDR(:,:) * PUTHL(:,:)  +     &
                          PDDR(:,:) * PDTHL(:,:) - ZTHMFOUT(:,:) -     &
                        ( PUER(:,:) + PDER(:,:) ) * PTHL(:,:)   )
           PRWC(:,:)  = PRWC(:,:) + ZTIMC(:,:) / PLMASS(:,:) *  (      &
                         ZRWMFIN(:,:) + PUDR(:,:) * PURW(:,:)  +       &
                         PDDR(:,:) * PDRW(:,:) - ZRWMFOUT(:,:) -       &
                        ( PUER(:,:) + PDER(:,:) ) * PRW(:,:)    )    
           PRCC(:,:)  = PRCC(:,:) + ZTIMC(:,:) / PLMASS(:,:) *  (      &
               ZRCMFIN(:,:) + PUDR(:,:) * PURC(:,:) - ZRCMFOUT(:,:) -  &
                        ( PUER(:,:) + PDER(:,:) ) * PRC(:,:)    )    
           PRIC(:,:)  = PRIC(:,:) + ZTIMC(:,:) / PLMASS(:,:) *  (      &
               ZRIMFIN(:,:) + PUDR(:,:) * PURI(:,:) - ZRIMFOUT(:,:) -  & 
                        ( PUER(:,:) + PDER(:,:) ) * PRI(:,:)    )    
!
!
!******************************************************************************
!
         END WHERE
!
    END DO ! Exit the fractional time step loop
!
! 
!*           9.    Allow frozen precipitation to melt over a 200 mb deep layer
!                  -----------------------------------------------------------
!
      DO JK = JKMAX, IKB + 1, -1
            ZTHLC(:,JK) = ZTHLC(:,JK) -                                &
               ZPRMELT(:) * ZWORK6(:,JK) / MAX( XMELDPTH, ZMELDPTH(:) )
      END DO
!
!
!*          10.    Compute final linearized value of theta envir.
!                  ----------------------------------------------
!
      DO JK = IKB + 1, JKMAX
         DO JI = 1, IIE
         IF( GWORK1(JI) .AND. JK <= KCTL(JI) ) THEN
           ZPI(JI)    = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
           ZCPH(JI)   = XCPD + PRWC(JI,JK) * XCPV
           ZWORK2(JI) = PTH(JI,JK) / ZPI(JI)  ! first temperature estimate
           ZLV(JI)    = XLVTT + ( XCPV - XCL ) * ( ZWORK2(JI) - XTT )
           ZLS(JI)    = XLVTT + ( XCPV - XCI ) * ( ZWORK2(JI) - XTT )
             ! final linearized temperature
           ZWORK2(JI) = ( ZTHLC(JI,JK) + ZLV(JI) * PRCC(JI,JK) + ZLS(JI) * PRIC(JI,JK) &
                       - (1. + PRWC(JI,JK) ) * XG * PZ(JI,JK) ) / ZCPH(JI)
           ZWORK2(JI) = MAX( 180., MIN( 340., ZWORK2(JI) ) )
           PTHC(JI,JK)= ZWORK2(JI) * ZPI(JI) ! final adjusted envir. theta
         END IF
         END DO
      END DO
!
!
!*         11.     Compute new cloud ( properties at new LCL )
!                     NOTA: The computations are very close to
!                           that in routine TRIGGER_FUNCT
!                  ---------------------------------------------
!
      CALL CONVECT_CLOSURE_THRVLCL(  KLON, KLEV,                           &
                                     PPRES, PTHC, PRWC, PZ, GWORK1,        &
                                     ZTHLCL, ZRVLCL, ZZLCL, ZTLCL, ZTELCL, &
                                     ILCL, KDPL, KPBL )
!
!
       ZTLCL(:)  = MAX( 230., MIN( 335., ZTLCL(:) ) )  ! set some overflow bounds
       ZTELCL(:) = MAX( 230., MIN( 335., ZTELCL(:) ) )
       ZTHLCL(:) = MAX( 230., MIN( 345., ZTHLCL(:) ) )
       ZRVLCL(:) = MAX(   0., MIN(   1., ZRVLCL(:) ) )
!
!
!*         12.    Compute adjusted CAPE
!                 ---------------------
!
       ZCAPE(:)  = 0.
       ZPI(:)    = ZTHLCL(:) / ZTLCL(:)
       ZPI(:)    = MAX( 0.95, MIN( 1.5, ZPI(:) ) )
       ZWORK1(:) = XP00 / ZPI(:) ** ZCPORD ! pressure at LCL
!
       CALL CONVECT_SATMIXRATIO( KLON, ZWORK1, ZTELCL, ZWORK3, ZLV, ZLS, ZCPH )
       ZWORK3(:) = MIN(   .1, MAX(   0., ZWORK3(:) ) )
!
	        ! compute theta_e updraft undilute
       ZTHEUL(:) = ZTLCL(:) * ZPI(:) ** ( 1. - 0.28 * ZRVLCL(:) )            &
                                  * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 )   &
                                  * ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
!
	        ! compute theta_e saturated environment at LCL
       ZTHES1(:) = ZTELCL(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK3(:) )           &
                                  * EXP( ( 3374.6525 / ZTELCL(:) - 2.5403 )  &
                                  * ZWORK3(:) * ( 1. + 0.81 * ZWORK3(:) ) )
!
      DO JK = MINVAL( ILCL(:) ), JKMAX
        JKP = JK - 1
        DO JI = 1, IIE
          ZWORK4(JI) = 1.
          IF ( JK == ILCL(JI) ) ZWORK4(JI) = 0.
!
           ! compute theta_e saturated environment and adjusted values
           ! of theta
!
          GWORK3(JI)  = JK >= ILCL(JI) .AND. JK <= KCTL(JI) .AND. GWORK1(JI) 
!
          ZPI(JI)     = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
          ZWORK2(JI)  = PTHC(JI,JK) / ZPI(JI)
        END DO
!
        CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZWORK2, ZWORK3, ZLV, ZLS, ZCPH )
!
!
        DO JI = 1, IIE
          IF ( GWORK3(JI) ) THEN
              ZTHES2(JI)  = ZWORK2(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) )   &
                                   * EXP( ( 3374.6525 / ZWORK2(JI) - 2.5403 ) &
                                   * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
!
              ZWORK3(JI)  = PZ(JI,JK) - PZ(JI,JKP) * ZWORK4(JI) -                &
                           ( 1. - ZWORK4(JI) ) * ZZLCL(JI)    ! level thickness
              ZWORK1(JI)  = ( 2. * ZTHEUL(JI) ) / ( ZTHES1(JI) + ZTHES2(JI) ) - 1.
              ZCAPE(JI)   = ZCAPE(JI) + XG * ZWORK3(JI) * MAX( 0., ZWORK1(JI) )
              ZTHES1(JI)  = ZTHES2(JI)
          END IF
        END DO
      END DO
!
!                                                          
!*         13.     Determine mass adjustment factor knowing how much
!                  CAPE has been removed.
!                  -------------------------------------------------
!
       WHERE ( GWORK1(:) )
           ZWORK1(:) = MAX( PCAPE(:) - ZCAPE(:), 0.1 * PCAPE(:) )
           ZWORK2(:) = ZCAPE(:) / ( PCAPE(:) + 1.E-8 )
!       
           GWORK1(:) = ZWORK2(:) > 0.1 .OR. ZCAPE(:) == 0. ! mask for adjustment
       END WHERE
!
       WHERE ( ZCAPE(:) == 0. .AND. GWORK1(:) )  ZADJ(:) = ZADJ(:) * 0.5
       WHERE ( ZCAPE(:) /= 0. .AND. GWORK1(:) )                              &
               ZADJ(:) = ZADJ(:) * XSTABC * PCAPE(:) / ( ZWORK1(:) + 1.E-8 )
       ZADJ(:) = MIN( ZADJ(:), ZADJMAX(:) )  
!
!
!*         13.     Adjust mass flux by the factor ZADJ to converge to
!                  specified degree of stabilization
!                 ----------------------------------------------------
!
       CALL CONVECT_CLOSURE_ADJUST( KLON, KLEV, ZADJ,                     &
                                    PUMF, ZUMF, PUER, ZUER, PUDR, ZUDR,   &
                                    PDMF, ZDMF, PDER, ZDER, PDDR, ZDDR,   &
                                    ZPRMELT, ZPRMELTO, PDTEVR, ZDTEVR,    &
                                    PTPR, ZTPR,                           &
                                    PPRLFLX, ZPRLFLX, PPRSFLX, ZPRSFLX    )
!
!
      IF ( COUNT( GWORK1(:) ) == 0 ) EXIT ! exit big adjustment iteration loop
                                          ! when all columns have reached 
                                          ! desired degree of stabilization.
!
END DO  ! end of big adjustment iteration loop
!
!
        ! skip adj. total water array  to water vapor
DO JK = IKB, IKE
  PRWC(:,JK) = MAX( 0., PRWC(:,JK) - PRCC(:,JK) - PRIC(:,JK) )
END DO
!
        ! compute surface solid (ice) precipitation 
PSPR(:) = ZPRMELT(:) * ( 1. - ZMELDPTH(:) / XMELDPTH )
PSPR(:) = MAX( 0., PSPR(:) )
!
!
END SUBROUTINE CONVECT_CLOSURE
!     ######spl
     SUBROUTINE CONVECT_CLOSURE_ADJUST( KLON, KLEV, PADJ,                      &
                                        PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR, &
                                        PDMF, PZDMF, PDER, PZDER, PDDR, PZDDR, &
                                        PPRMELT, PZPRMELT, PDTEVR, PZDTEVR,    &
                                        PTPR, PZTPR,                           &
                                        PPRLFLX, PZPRLFL, PPRSFLX, PZPRSFL     )

!    #########################################################################
!
!!**** Uses closure adjustment factor to adjust mass flux and to modify
!!     precipitation efficiency  when necessary. The computations are
!!     similar to routine CONVECT_PRECIP_ADJUST.
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to adjust the mass flux using the
!!      factor PADJ computed in CONVECT_CLOSURE
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      
!!
!!    EXTERNAL
!!    --------
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!     
!!    None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    None
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_CLOSURE_ADJUST)
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Last modified  04/10/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CONVPAREXT
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                    INTENT(IN) :: KLON     ! horizontal dimension
INTEGER,                    INTENT(IN) :: KLEV     ! vertical dimension
REAL, DIMENSION(KLON),      INTENT(IN) :: PADJ     ! mass adjustment factor
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF  ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of  "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER  ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of  "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR  ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of  "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDMF  ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDMF ! initial value of  "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDER  ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDER ! initial value of  "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PDDR  ! downdraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZDDR ! initial value of  "
REAL, DIMENSION(KLON),   INTENT(INOUT):: PTPR     ! total precipitation (kg/s)
REAL, DIMENSION(KLON),   INTENT(INOUT):: PZTPR    ! initial value of "
REAL, DIMENSION(KLON),   INTENT(INOUT):: PDTEVR   ! donwndraft evapor. (kg/s)
REAL, DIMENSION(KLON),   INTENT(INOUT):: PZDTEVR  ! initial value of " 
REAL, DIMENSION(KLON),   INTENT(INOUT):: PPRMELT  ! melting of precipitation
REAL, DIMENSION(KLON),   INTENT(INOUT):: PZPRMELT ! initial value of " 
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT)  :: PPRLFLX! liquid precip flux
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT)  :: PZPRLFL! initial value "
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT)  :: PPRSFLX! solid  precip flux
REAL, DIMENSION(KLON,KLEV),INTENT(INOUT)  :: PZPRSFL! initial value "
!
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE                 ! horiz. + vert. loop bounds
INTEGER :: JK                            ! vertical loop index
!
!
!-------------------------------------------------------------------------------
!
!*       0.3   Compute loop bounds
!              -------------------
!
IIE  = KLON
IKB  = 1 + JCVEXB 
IKE  = KLEV - JCVEXT 
!
!
!*       1.     Adjust mass flux by the factor PADJ to converge to
!               specified degree of stabilization
!               ----------------------------------------------------
!
          PPRMELT(:)  = PZPRMELT(:)   * PADJ(:)
          PDTEVR(:)   = PZDTEVR(:)    * PADJ(:)
          PTPR(:)     = PZTPR(:)      * PADJ(:)
!
     DO JK = IKB + 1, IKE
	  PUMF(:,JK)  = PZUMF(:,JK)   * PADJ(:)
          PUER(:,JK)  = PZUER(:,JK)   * PADJ(:)
          PUDR(:,JK)  = PZUDR(:,JK)   * PADJ(:)
          PDMF(:,JK)  = PZDMF(:,JK)   * PADJ(:)
          PDER(:,JK)  = PZDER(:,JK)   * PADJ(:)
          PDDR(:,JK)  = PZDDR(:,JK)   * PADJ(:)
          PPRLFLX(:,JK) = PZPRLFL(:,JK) * PADJ(:)
          PPRSFLX(:,JK) = PZPRSFL(:,JK) * PADJ(:)
     END DO
!
END SUBROUTINE CONVECT_CLOSURE_ADJUST
!     ######spl
      SUBROUTINE CONVECT_CLOSURE_THRVLCL( KLON, KLEV,                         &
                                          PPRES, PTH, PRV, PZ, OWORK1,        &
                                         PTHLCL, PRVLCL, PZLCL, PTLCL, PTELCL,&
                                          KLCL, KDPL, KPBL )
!     ######################################################################
!
!!**** Determine thermodynamic properties at new LCL
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the thermodynamic
!!      properties at the new lifting condensation level LCL
!!   
!!
!!
!!**  METHOD
!!    ------
!!    see CONVECT_TRIGGER_FUNCT
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     Routine CONVECT_SATMIXRATIO
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XP00               ! Reference pressure
!!          XRD, XRV           ! Gaz  constants for dry air and water vapor
!!          XCPD               ! Cpd (dry air)
!!          XTT                ! triple point temperature
!!          XBETAW, XGAMW      ! constants for vapor saturation pressure
!!
!!      Module MODD_CONVPAR
!!          XA25               ! reference grid area
!!          XZLCL              ! lowest allowed pressure difference between
!!                             ! surface and LCL
!!          XZPBL              ! minimum mixed layer depth to sustain convection
!!          XWTRIG             ! constant in vertical velocity trigger
!!
!!      Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    REFERENCE
!!    ---------
!!
!!      Book2 of documentation ( routine TRIGGER_FUNCT)
!!      Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  04/10/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER,                    INTENT(IN) :: KLON  ! horizontal dimension
INTEGER,                    INTENT(IN) :: KLEV  ! vertical dimension
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTH   ! theta
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRV   ! vapor mixing ratio 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ    ! height of grid point (m)
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KDPL  ! contains vert. index of DPL
INTEGER, DIMENSION(KLON),   INTENT(IN) :: KPBL  ! " vert. index of source layer top
LOGICAL, DIMENSION(KLON),   INTENT(IN) :: OWORK1! logical mask 
!
REAL, DIMENSION(KLON),     INTENT(OUT):: PTHLCL ! theta at LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PRVLCL ! vapor mixing ratio at  LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PZLCL  ! height at LCL (m)
REAL, DIMENSION(KLON),     INTENT(OUT):: PTLCL  ! temperature at LCL (m)
REAL, DIMENSION(KLON),     INTENT(OUT):: PTELCL ! environm. temp. at LCL (K)
INTEGER, DIMENSION(KLON),  INTENT(OUT):: KLCL   ! contains vert. index of LCL
!
!*       0.2   Declarations of local variables :
!
INTEGER :: JK, JKM, JKMIN, JKMAX      ! vertical loop index
INTEGER :: JI                         ! horizontal loop index 
INTEGER :: IIE, IKB, IKE              ! horizontal + vertical loop bounds
REAL    :: ZEPS, ZEPSA    ! R_d / R_v, R_v / R_d 
REAL    :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON) :: ZPLCL    ! pressure at LCL
REAL, DIMENSION(KLON) :: ZTMIX    ! mixed layer temperature
REAL, DIMENSION(KLON) :: ZEVMIX   ! mixed layer water vapor pressure 
REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
REAL, DIMENSION(KLON) :: ZDP      ! pressure between LCL and model layer
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2     ! work arrays
!
!
!-------------------------------------------------------------------------------
!
!*       0.3    Compute array bounds
!               --------------------
!
IIE = KLON
IKB = 1 + JCVEXB 
IKE = KLEV - JCVEXT 
!
!
!*       1.     Initialize local variables
!               --------------------------
!
ZEPS      = XRD / XRV
ZEPSA     = XRV / XRD 
ZCPORD    = XCPD / XRD
ZRDOCP    = XRD / XCPD
!
ZDPTHMIX(:) = 0.
ZPRESMIX(:) = 0.
PTHLCL(:)   = 300.
PTLCL(:)    = 300.
PTELCL(:)   = 300.
PRVLCL(:)   = 0.
PZLCL(:)    = PZ(:,IKB)
ZTMIX(:)    = 230.
ZPLCL(:)    = 1.E4 
KLCL(:)     = IKB + 1
!
!
!*       2.     Construct a mixed layer as in TRIGGER_FUNCT
!               -------------------------------------------
!
     JKMAX = MAXVAL( KPBL(:) )
     JKMIN = MINVAL( KDPL(:) )
     DO JK = IKB + 1, JKMAX
        JKM = JK + 1
        DO JI = 1, IIE
        IF ( JK >= KDPL(JI) .AND. JK <= KPBL(JI) ) THEN
!           
            ZWORK1(JI)   = PPRES(JI,JK) - PPRES(JI,JKM)
            ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
            ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
            PTHLCL(JI)   = PTHLCL(JI)   + PTH(JI,JK)   * ZWORK1(JI)
            PRVLCL(JI)   = PRVLCL(JI)   + PRV(JI,JK)   * ZWORK1(JI)
!
        END IF
        END DO
     END DO
!
!
WHERE ( OWORK1(:) )
!
        ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
        PTHLCL(:)   = PTHLCL(:)   / ZDPTHMIX(:)
        PRVLCL(:)   = PRVLCL(:)   / ZDPTHMIX(:)
!
!*       3.1    Use an empirical direct solution ( Bolton formula )
!               to determine temperature and pressure at LCL.
!               Nota: the adiabatic saturation temperature is not
!                     equal to the dewpoint temperature
!               --------------------------------------------------
!
!
        ZTMIX(:)  = PTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP
        ZEVMIX(:) = PRVLCL(:) * ZPRESMIX(:) / ( PRVLCL(:) + ZEPS )
        ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
        ZWORK1(:) = LOG( ZEVMIX(:) / 613.3 )
              ! dewpoint temperature
        ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) ) 
              ! adiabatic saturation temperature
        PTLCL(:)  = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT )      &
                  - 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
        PTLCL(:)  = MIN( PTLCL(:), ZTMIX(:) )
        ZPLCL(:)  = XP00 * ( PTLCL(:) / PTHLCL(:) ) ** ZCPORD
!
END WHERE
!
     ZPLCL(:) = MIN( 2.E5, MAX( 10., ZPLCL(:) ) ) ! bound to avoid overflow
!
!
!*       3.2    Correct PTLCL in order to be completely consistent
!               with MNH saturation formula
!               --------------------------------------------------
!
     CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, PTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
     WHERE( OWORK1(:) )
        ZWORK2(:) = ZWORK1(:) / PTLCL(:) * ( XBETAW / PTLCL(:) - XGAMW ) ! dr_sat/dT
        ZWORK2(:) = ( ZWORK1(:) - PRVLCL(:) ) /                              &
                        ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) ) 
        PTLCL(:)  = PTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
!
     END WHERE
!
!
!*       3.3    If PRVLCL is oversaturated set humidity and temperature
!               to saturation values.
!               -------------------------------------------------------
!
    CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
     WHERE( OWORK1(:) .AND. PRVLCL(:) > ZWORK1(:) )
        ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
        ZWORK2(:) = ( ZWORK1(:) - PRVLCL(:) ) /                              &
                        ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) )
        PTLCL(:)  = ZTMIX(:) + ZLV(:) / ZCPH(:) * ZWORK2(:)
        PRVLCL(:) = PRVLCL(:) - ZWORK2(:)
        ZPLCL(:)  = ZPRESMIX(:)
        PTHLCL(:) = PTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
     END WHERE
!
!
!*        4.1   Determine  vertical loop index at the LCL 
!               -----------------------------------------
!
     DO JK = JKMIN, IKE - 1
        DO JI = 1, IIE
        IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. OWORK1(JI) ) THEN
            KLCL(JI)  = JK + 1
            PZLCL(JI) = PZ(JI,JK+1)
        END IF
        END DO
     END DO
!
!
!*        4.2   Estimate height and environmental temperature at LCL
!               ----------------------------------------------------
!
    DO JI = 1, IIE
        JK   = KLCL(JI)
        JKM  = JK - 1
        ZDP(JI)     = LOG( ZPLCL(JI) / PPRES(JI,JKM) ) /                     &
                      LOG( PPRES(JI,JK) / PPRES(JI,JKM) )
        ZWORK1(JI)  = PTH(JI,JK)  * ( PPRES(JI,JK) / XP00 ) ** ZRDOCP
        ZWORK2(JI)  = PTH(JI,JKM) * ( PPRES(JI,JKM) / XP00 ) ** ZRDOCP
        ZWORK1(JI)  = ZWORK2(JI) + ( ZWORK1(JI) - ZWORK2(JI) ) * ZDP(JI) 
           ! we compute the precise value of the LCL
           ! The precise height is between the levels KLCL and KLCL-1.
        ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
    END DO
    WHERE( OWORK1(:) )
       PTELCL(:) = ZWORK1(:)
       PZLCL(:)  = ZWORK2(:)
    END WHERE
!        
!
!
END SUBROUTINE CONVECT_CLOSURE_THRVLCL
!     ######spl
      SUBROUTINE CONVECT_CHEM_TRANSPORT( KLON, KLEV, KCH, PCH1, PCH1C,       &
                                         KDPL, KPBL, KLCL, KCTL, KLFS, KDBL, &
                                         PUMF, PUER, PUDR, PDMF, PDER, PDDR, &
                                         PTIMEC, PDXDY, PMIXF, PLMASS, PWSUB,&
                                         KFTSTEPS )
!    #######################################################################
!
!!**** Compute  modified chemical tracer values due to convective event
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the final adjusted
!!      environmental values of the chemical tracers
!!      The final convective tendencies can then be evaluated in the main
!!      routine DEEP_CONVECT by (PCH1C-PCH1)/PTIMEC
!!
!!
!!**  METHOD
!!    ------
!!      Identical to the computation of the conservative variables in the
!!      main deep convection code
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      Original    11/12/97
!!
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAREXT
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER,                INTENT(IN) :: KLON     ! horizontal dimension
INTEGER,                INTENT(IN) :: KLEV     ! vertical dimension
INTEGER,                INTENT(IN) :: KCH      ! number of passive tracers
!
REAL,DIMENSION(KLON,KLEV,KCH),INTENT(IN) :: PCH1 ! grid scale tracer concentr.
REAL,DIMENSION(KLON,KLEV,KCH),INTENT(OUT):: PCH1C! conv adjusted tracer concntr.
!
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDPL   ! index for departure level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KPBL   ! index for top of source layer
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLCL   ! index lifting condens. level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KCTL   ! index for cloud top level
INTEGER, DIMENSION(KLON), INTENT(IN) :: KLFS   ! index for level of free sink
INTEGER, DIMENSION(KLON), INTENT(IN) :: KDBL   ! index for downdraft base level
!
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUMF ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUER ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PUDR ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDMF ! downdraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDER ! downdraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDDR ! downdraft detrainment (kg/s)
!
REAL, DIMENSION(KLON),     INTENT(IN) :: PTIMEC! convection time step
REAL, DIMENSION(KLON),     INTENT(IN) :: PDXDY ! grid area (m^2)
REAL, DIMENSION(KLON),     INTENT(IN) :: PMIXF ! mixed fraction at LFS
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PLMASS! mass of model layer (kg)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PWSUB ! envir. compensating subsidence(Pa/s)
INTEGER,                INTENT(IN) :: KFTSTEPS  ! maximum fractional time steps
!
!
!*       0.2   Declarations of local variables :
!
INTEGER :: INCH1          ! number of chemical tracers
INTEGER :: IIE, IKB, IKE  ! horizontal + vertical loop bounds
INTEGER :: IKS            ! vertical dimension
INTEGER :: JI             ! horizontal loop index
INTEGER :: JK, JKP        ! vertical loop index
INTEGER :: JN             ! chemical tracer loop index
INTEGER :: JSTEP          ! fractional time loop index
INTEGER :: JKLC, JKLD, JKLP, JKMAX ! loop index for levels
!
REAL, DIMENSION(KLON,KLEV)     :: ZOMG ! compensat. subsidence (Pa/s)
REAL, DIMENSION(KLON,KLEV,KCH) :: ZUCH1, ZDCH1 ! updraft/downdraft values
REAL, DIMENSION(KLON)          :: ZTIMEC  ! fractional convective time step
REAL, DIMENSION(KLON,KLEV)     :: ZTIMC! 2D work array for ZTIMEC
REAL, DIMENSION(KLON,KLEV,KCH) :: ZCH1MFIN, ZCH1MFOUT
                                   ! work arrays for environm. compensat. mass
REAL, DIMENSION(KLON,KCH)      :: ZWORK1, ZWORK2, ZWORK3
!
!-------------------------------------------------------------------------------
!
!*       0.3   Compute loop bounds
!              -------------------
!
INCH1  = KCH
IIE    = KLON
IKB    = 1 + JCVEXB 
IKS    = KLEV
IKE    = KLEV - JCVEXT 
JKMAX  = MAXVAL( KCTL(:) )
!
!
!*      2.      Updraft computations
!               --------------------
!
ZUCH1(:,:,:) = 0.
!
!*      2.1     Initialization  at LCL
!               ----------------------------------
!
DO JI = 1, IIE
    JKLC = KLCL(JI)
    JKLD = KDPL(JI)
    JKLP = KPBL(JI)
    ZWORK1(JI,:) = .5 * ( PCH1(JI,JKLD,:) + PCH1(JI,JKLP,:) )
END DO
!
!*      2.2     Final updraft loop
!               ------------------
!
DO JK = MINVAL( KDPL(:) ), JKMAX
JKP = JK + 1
!
    DO JN = 1, INCH1
     DO JI = 1, IIE
       IF ( KDPL(JI) <= JK .AND. KLCL(JI) > JK )                             &
            ZUCH1(JI,JK,JN) = ZWORK1(JI,JN)
!
       IF ( KLCL(JI) - 1 <= JK .AND. KCTL(JI) > JK ) THEN
                            !if you have reactive i.e. non-passive tracers
                            !add the corresponding sink term in the following equation
           ZUCH1(JI,JKP,JN) = ( PUMF(JI,JK) * ZUCH1(JI,JK,JN) +              &
                                PUER(JI,JKP) * PCH1(JI,JK,JN) )  /           & 
                              ( PUMF(JI,JKP) + PUDR(JI,JKP) + 1.E-7 )
       END IF
     END DO
   END DO
!
END DO
!
!*      3.      Downdraft computations
!               ----------------------
!
ZDCH1(:,:,:) = 0.
!
!*      3.1     Initialization at the LFS
!               -------------------------
!
ZWORK1(:,:) = SPREAD( PMIXF(:), DIM=2, NCOPIES=INCH1 )
DO JI = 1, IIE
     JK = KLFS(JI)
     ZDCH1(JI,JK,:) = ZWORK1(JI,:) * PCH1(JI,JK,:) +                          &
                                       ( 1. - ZWORK1(JI,:) ) * ZUCH1(JI,JK,:)
END DO
!
!*      3.2     Final downdraft loop
!               --------------------
!
DO JK = MAXVAL( KLFS(:) ), IKB + 1, -1
JKP = JK - 1
    DO JN = 1, INCH1
    DO JI = 1, IIE
      IF ( JK <= KLFS(JI) .AND. JKP >= KDBL(JI) ) THEN
       ZDCH1(JI,JKP,JN) = ( ZDCH1(JI,JK,JN) * PDMF(JI,JK) -              &
                            PCH1(JI,JK,JN) *  PDER(JI,JKP) ) /           &
                          ( PDMF(JI,JKP) - PDDR(JI,JKP) - 1.E-7 ) 
      END IF
    END DO
    END DO
END DO
!
!							   
!*      4.      Final closure (environmental) computations
!               ------------------------------------------
!
PCH1C(:,IKB:IKE,:) = PCH1(:,IKB:IKE,:) ! initialize adjusted envir. values
!
DO JK = IKB, IKE
   ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG ! environmental subsidence
END DO
!
ZTIMEC(:) = PTIMEC(:) / REAL( KFTSTEPS ) ! adjust  fractional time step
                                         ! to be an integer multiple of PTIMEC
WHERE ( PTIMEC(:) < 1. ) ZTIMEC(:) = 0.
ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
!
ZCH1MFIN(:,:,:)   = 0.
ZCH1MFOUT(:,:,:)  = 0.
!
DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop
!
      DO JK = IKB + 1, JKMAX
          JKP = MAX( IKB + 1, JK - 1 )
	  ZWORK3(:,:) = SPREAD( ZOMG(:,JK), DIM=2, NCOPIES=INCH1 )
          ZWORK1(:,:) = SIGN( 1., ZWORK3(:,:) )
          ZWORK2(:,:) = 0.5 * ( 1. + ZWORK1(:,:) )
          ZWORK1(:,:) = 0.5 * ( 1. - ZWORK1(:,:) )
          ZCH1MFIN(:,JK,:)  = - ZWORK3(:,:) * PCH1C(:,JKP,:) * ZWORK1(:,:)
          ZCH1MFOUT(:,JK,:) =   ZWORK3(:,:) * PCH1C(:,JK,:)  * ZWORK2(:,:)
         ZCH1MFIN(:,JKP,:) = ZCH1MFIN(:,JKP,:) + ZCH1MFOUT(:,JK,:) * ZWORK2(:,:)
         ZCH1MFOUT(:,JKP,:)= ZCH1MFOUT(:,JKP,:) + ZCH1MFIN(:,JK,:) * ZWORK1(:,:)
      END DO
!
      DO JN = 1, INCH1
       DO JK = IKB + 1, JKMAX
         PCH1C(:,JK,JN) = PCH1C(:,JK,JN) + ZTIMC(:,JK) / PLMASS(:,JK) *  (    &
                      ZCH1MFIN(:,JK,JN) + PUDR(:,JK) * ZUCH1(:,JK,JN) +       &
                      PDDR(:,JK) * ZDCH1(:,JK,JN) - ZCH1MFOUT(:,JK,JN) -      &
                      ( PUER(:,JK) + PDER(:,JK) ) * PCH1(:,JK,JN)    )
         PCH1C(:,JK,JN) = MAX( 0., PCH1C(:,JK,JN) )
       END DO
      END DO
!
END DO ! Exit the fractional time step loop
!
!
END SUBROUTINE CONVECT_CHEM_TRANSPORT
!     ######spl
      MODULE MODD_CONVPAR_SHAL
!     ########################
!
!!****  *MODD_CONVPAR_SHAL* - Declaration of convection constants 
!!
!!    PURPOSE
!!    -------
!!      The purpose of this declarative module is to declare  the 
!!      constants in the deep convection parameterization.    
!!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!      Book2 of documentation of Meso-NH (MODD_CONVPAR_SHAL)
!!          
!!    AUTHOR
!!    ------
!!      P. Bechtold   *Laboratoire d'Aerologie*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96                      
!!   Last modified  04/10/98
!-------------------------------------------------------------------------------
!
!*       0.   DECLARATIONS
!             ------------
!
IMPLICIT NONE 
!
REAL, SAVE :: XA25        ! 25 km x 25 km reference grid area
!
REAL, SAVE :: XCRAD       ! cloud radius 
REAL, SAVE :: XCTIME_SHAL ! convective adjustment time
REAL, SAVE :: XCDEPTH     ! minimum necessary cloud depth
REAL, SAVE :: XCDEPTH_D   ! maximum allowed cloud thickness
REAL, SAVE :: XDTPERT     ! add small Temp perturb. at LCL
REAL, SAVE :: XENTR       ! entrainment constant (m/Pa) = 0.2 (m)  
!
REAL, SAVE :: XZLCL       ! maximum allowed allowed height 
                          ! difference between departure level and surface
REAL, SAVE :: XZPBL       ! minimum mixed layer depth to sustain convection
REAL, SAVE :: XWTRIG      ! constant in vertical velocity trigger
!
!
REAL, SAVE :: XNHGAM      ! accounts for non-hydrost. pressure 
			  ! in buoyancy term of w equation
                          ! = 2 / (1+gamma)
REAL, SAVE :: XTFRZ1      ! begin of freezing interval
REAL, SAVE :: XTFRZ2      ! end of freezing interval
!
!
REAL, SAVE :: XSTABT      ! factor to assure stability in  fractional time
                          ! integration, routine CONVECT_CLOSURE
REAL, SAVE :: XSTABC      ! factor to assure stability in CAPE adjustment,
                          !  routine CONVECT_CLOSURE
!
END MODULE MODD_CONVPAR_SHAL 
!     ######spl
      SUBROUTINE INI_CONVPAR_SHAL
!     ###########################
!
!!****  *INI_CONVPAR * - routine to initialize the constants modules 
!!
!!    PURPOSE
!!    -------
!!       The purpose of this routine is to initialize  the constants
!!     stored in  modules MODD_CONVPAR_SHAL
!!      
!!
!!**  METHOD
!!    ------
!!      The shallow convection constants are set to their numerical values 
!!     
!!
!!    EXTERNAL
!!    --------
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CONVPAR_SHAL   : contains deep convection constants
!!
!!    REFERENCE
!!    ---------
!!      Book2 of the documentation (module MODD_CONVPAR_SHAL, routine INI_CONVPAR)
!!      
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Last modified  15/04/98 adapted for ARPEGE
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CONVPAR_SHAL
!
IMPLICIT NONE
!  
!-------------------------------------------------------------------------------
!
!*       1.    Set the thermodynamical and numerical constants for
!              the deep convection parameterization
!              ---------------------------------------------------
!
!
XA25     = 625.E6    ! 25 km x 25 km reference grid area
!
XCRAD       =  50.   ! cloud radius 
XCTIME_SHAL = 10800. ! convective adjustment time
XCDEPTH     = 0.5E3  ! minimum necessary shallow cloud depth
XCDEPTH_D   = 3.0E3  ! maximum allowed shallow cloud depth
XDTPERT     = .2     ! add small Temp perturbation at LCL
!
XENTR    = 0.02      ! entrainment constant (m/Pa) = 0.2 (m)  
!
XZLCL    = 1.5E3     ! maximum allowed allowed height 
                     ! difference between the DPL and the LCL
XZPBL    = 50.E2     ! minimum mixed layer depth to sustain convection
!
!
XNHGAM   = 1.3333    ! accounts for non-hydrost. pressure 
                     ! in buoyancy term of w equation
                     ! = 2 / (1+gamma)
XTFRZ1   = 268.16    ! begin of freezing interval
XTFRZ2   = 248.16    ! end of freezing interval
!

XSTABT   = 0.75      ! factor to assure stability in  fractional time
                     ! integration, routine CONVECT_CLOSURE
XSTABC   = 0.95      ! factor to assure stability in CAPE adjustment,
                     !  routine CONVECT_CLOSURE
!
!
END SUBROUTINE INI_CONVPAR_SHAL 
!     ######spl
    SUBROUTINE CONVECT_SHALLOW( KLON, KLEV, KIDIA, KFDIA, KBDIA, KTDIA,        &
                                   PDTCONV, KICE, OSETTADJ, PTADJS,               &
                                   PPABST, PZZ,                                   &
                                   PTT, PRVT, PRCT, PRIT, PWT,                    &
                                   PTTEN, PRVTEN, PRCTEN, PRITEN,                 &
                                   KCLTOP, KCLBAS, PUMF,                          &
                                   OCH1CONV, KCH1, PCH1, PCH1TEN                  )
!   ############################################################################
!
!!**** Monitor routine to compute all convective tendencies by calls
!!     of several subroutines.
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the convective
!!      tendencies. The routine first prepares all necessary grid-scale
!!      variables. The final convective tendencies are then computed by
!!      calls of different subroutines.
!!
!!
!!**  METHOD
!!    ------
!!      We start by selecting convective columns in the model domain through
!!      the call of routine TRIGGER_FUNCT. Then, we allocate memory for the
!!      convection updraft and downdraft variables and gather the grid scale
!!      variables in convective arrays. 
!!      The updraft and downdraft computations are done level by level starting
!!      at the  bottom and top of the domain, respectively.
!!      All computations are done on MNH thermodynamic levels. The depth
!!      of the current model layer k is defined by DP(k)=P(k-1)-P(k)
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!    CONVECT_TRIGGER_SHAL
!!    CONVECT_SATMIXRATIO
!!    CONVECT_UPDRAFT_SHAL
!!        CONVECT_CONDENS
!!        CONVECT_MIXING_FUNCT
!!    CONVECT_CLOSURE_SHAL
!!        CONVECT_CLOSURE_THRVLCL
!!        CONVECT_CLOSURE_ADJUST_SHAL
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                   ! gravity constant
!!          XPI                  ! number Pi
!!          XP00                 ! reference pressure
!!          XRD, XRV             ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV           ! specific heat for dry air and water vapor
!!          XRHOLW               ! density of liquid water
!!          XALPW, XBETAW, XGAMW ! constants for water saturation pressure
!!          XTT                  ! triple point temperature
!!          XLVTT, XLSTT         ! vaporization, sublimation heat constant
!!          XCL, XCI             ! specific heat for liquid water and ice
!!
!!      Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT       ! extra levels on the vertical boundaries
!!
!!      Module MODD_CONVPAR
!!          XA25                 ! reference grid area
!!          XCRAD                ! cloud radius
!!
!!         
!!    REFERENCE
!!    ---------
!!
!!      Bechtold, 1997 : Meso-NH scientific  documentation (31 pp)
!!      Fritsch and Chappell, 1980, J. Atmos. Sci., Vol. 37, 1722-1761.
!!      Kain and Fritsch, 1990, J. Atmos. Sci., Vol. 47, 2784-2801.
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol. 24, 165-170.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Peter Bechtold 15/11/96 replace theta_il by enthalpy
!!         "        10/12/98 changes for ARPEGE
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAREXT
USE MODD_CONVPAR_SHAL
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                    INTENT(IN) :: KLON     ! horizontal dimension
INTEGER,                    INTENT(IN) :: KLEV     ! vertical dimension
INTEGER,                    INTENT(IN) :: KIDIA    ! value of the first point in x
INTEGER,                    INTENT(IN) :: KFDIA    ! value of the last point in x
INTEGER,                    INTENT(IN) :: KBDIA    ! vertical  computations start at
!                                                  ! KBDIA that is at least 1
INTEGER,                    INTENT(IN) :: KTDIA    ! vertical computations can be
						   ! limited to KLEV + 1 - KTDIA
                                                   ! default=1
REAL,                       INTENT(IN) :: PDTCONV  ! Interval of time between two
                                                   ! calls of the deep convection
                                                   ! scheme
INTEGER,                    INTENT(IN) :: KICE     ! flag for ice ( 1 = yes, 
                                                   !                0 = no ice )
LOGICAL,                    INTENT(IN) :: OSETTADJ ! logical to set convective
						   ! adjustment time by user
REAL,                       INTENT(IN) :: PTADJS   ! user defined adjustment time
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTT      ! grid scale temperature at t
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRVT     ! grid scale water vapor "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRCT     ! grid scale r_c  "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRIT     ! grid scale r_i "
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PWT      ! grid scale vertical 
						   ! velocity (m/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPABST   ! grid scale pressure at t
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZZ      ! height of model layer (m) 
!   
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PTTEN  ! convective temperature 
						   ! tendency (K/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRVTEN ! convective r_v tendency (1/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRCTEN ! convective r_c tendency (1/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PRITEN ! convective r_i tendency (1/s)
INTEGER, DIMENSION(KLON),   INTENT(INOUT):: KCLTOP ! cloud top level
INTEGER, DIMENSION(KLON),   INTENT(INOUT):: KCLBAS ! cloud base level
                                                   ! they are given a value of
                                                   ! 0 if no convection
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF   ! updraft mass flux (kg/s m2)
!
LOGICAL,                    INTENT(IN) :: OCH1CONV ! include tracer transport
INTEGER,                    INTENT(IN) :: KCH1     ! number of species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(IN) :: PCH1! grid scale chemical species
REAL, DIMENSION(KLON,KLEV,KCH1), INTENT(INOUT):: PCH1TEN! species conv. tendency (1/s)
!
!
!*       0.2   Declarations of local fixed memory variables :
!
INTEGER  :: ITEST, ICONV, ICONV1    ! number of convective columns
INTEGER  :: IIB, IIE                ! horizontal loop bounds
INTEGER  :: IKB, IKE                ! vertical loop bounds
INTEGER  :: IKS                     ! vertical dimension
INTEGER  :: JI, JL                  ! horizontal loop index
INTEGER  :: JN                      ! number of tracers
INTEGER  :: JK, JKP, JKM            ! vertical loop index
INTEGER  :: IFTSTEPS                ! only used for chemical tracers
REAL     :: ZEPS, ZEPSA, ZEPSB      ! R_d / R_v, R_v / R_d, XCPV / XCPD - ZEPSA
REAL     :: ZCPORD, ZRDOCP          ! C_p/R_d,  R_d/C_p
!
LOGICAL, DIMENSION(KLON, KLEV)     :: GTRIG3 ! 3D logical mask for convection 
LOGICAL, DIMENSION(KLON)           :: GTRIG  ! 2D logical mask for trigger test
REAL, DIMENSION(KLON,KLEV)         :: ZTHT, ZSTHV, ZSTHES  ! grid scale theta, theta_v
REAL, DIMENSION(KLON)              :: ZTIME  ! convective time period
REAL, DIMENSION(KLON)              :: ZWORK2, ZWORK2B ! work array 
!
!
!*       0.2   Declarations of local allocatable  variables :
!
INTEGER, DIMENSION(:),ALLOCATABLE  :: IDPL    ! index for parcel departure level
INTEGER, DIMENSION(:),ALLOCATABLE  :: IPBL    ! index for source layer top
INTEGER, DIMENSION(:),ALLOCATABLE  :: ILCL    ! index for lifting condensation level 
INTEGER, DIMENSION(:),ALLOCATABLE  :: IETL    ! index for zero buoyancy level
INTEGER, DIMENSION(:),ALLOCATABLE  :: ICTL    ! index for cloud top level
INTEGER, DIMENSION(:),ALLOCATABLE  :: ILFS    ! index for level of free sink
!
INTEGER, DIMENSION(:), ALLOCATABLE :: ISDPL   ! index for parcel departure level
INTEGER, DIMENSION(:),ALLOCATABLE  :: ISPBL   ! index for source layer top
INTEGER, DIMENSION(:), ALLOCATABLE :: ISLCL   ! index for lifting condensation level 
REAL, DIMENSION(:), ALLOCATABLE    :: ZSTHLCL ! updraft theta at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSTLCL  ! updraft temp. at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSRVLCL ! updraft rv at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSWLCL  ! updraft w at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSZLCL  ! LCL height
REAL, DIMENSION(:), ALLOCATABLE    :: ZSTHVELCL! envir. theta_v at LCL
REAL, DIMENSION(:), ALLOCATABLE    :: ZSDXDY  ! grid area (m^2)
!
! grid scale variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZZ      ! height of model layer (m) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZPRES   ! grid scale pressure
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDPRES  ! pressure difference between 
                                              ! bottom and top of layer (Pa)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZW      ! grid scale vertical velocity on theta grid
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTT     ! temperature
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTH     ! grid scale theta     
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHV    ! grid scale theta_v     
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHL    ! grid scale enthalpy (J/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHES, ZTHEST ! grid scale saturated theta_e
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRW     ! grid scale total water (kg/kg) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRV     ! grid scale water vapor (kg/kg) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRC     ! grid scale cloud water (kg/kg) 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRI     ! grid scale cloud ice (kg/kg) 
REAL, DIMENSION(:),   ALLOCATABLE  :: ZDXDY   ! grid area (m^2)
!
! updraft variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUMF    ! updraft mass flux (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUER    ! updraft entrainment (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUDR    ! updraft detrainment (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUTHL   ! updraft enthalpy (J/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZUTHV   ! updraft theta_v (K)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURW    ! updraft total water (kg/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURC    ! updraft cloud water (kg/kg)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZURI    ! updraft cloud ice   (kg/kg)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZMFLCL  ! cloud base unit mass flux(kg/s) 
REAL, DIMENSION(:),   ALLOCATABLE  :: ZCAPE   ! available potent. energy     
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTHLCL  ! updraft theta at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTLCL   ! updraft temp. at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZRVLCL  ! updraft rv at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZWLCL   ! updraft w at LCL
REAL, DIMENSION(:),   ALLOCATABLE  :: ZZLCL   ! LCL height
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTHVELCL! envir. theta_v at LCL
!
! downdraft variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDMF    ! downdraft mass flux (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDER    ! downdraft entrainment (kg/s)
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZDDR    ! downdraft detrainment (kg/s)
!
! closure variables
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZLMASS  ! mass of model layer (kg)
REAL, DIMENSION(:),   ALLOCATABLE  :: ZTIMEC  ! advective time period
!
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZTHC    ! conv. adj. grid scale theta
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRVC    ! conv. adj. grid scale r_w 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRCC    ! conv. adj. grid scale r_c 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZRIC    ! conv. adj. grid scale r_i 
REAL, DIMENSION(:,:), ALLOCATABLE  :: ZWSUB   ! envir. compensating subsidence (Pa/s)
!
LOGICAL, DIMENSION(:),ALLOCATABLE  :: GTRIG1  ! logical mask for convection    
LOGICAL, DIMENSION(:),ALLOCATABLE  :: GWORK   ! logical work array
INTEGER, DIMENSION(:),ALLOCATABLE  :: IINDEX, IJINDEX, IJSINDEX, IJPINDEX!hor.index
REAL, DIMENSION(:),   ALLOCATABLE  :: ZCPH    ! specific heat C_ph 
REAL, DIMENSION(:),   ALLOCATABLE  :: ZLV, ZLS! latent heat of vaporis., sublim.
REAL                               :: ZES     ! saturation vapor mixng ratio
REAl                               :: ZW1     ! work variable
!
! Chemical Tracers:
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1    ! grid scale chemical specy (kg/kg)
REAL, DIMENSION(:,:,:), ALLOCATABLE:: ZCH1C   ! conv. adjust. chemical specy 1
REAL, DIMENSION(:,:),   ALLOCATABLE:: ZWORK3  ! conv. adjust. chemical specy 1
LOGICAL, DIMENSION(:,:,:),ALLOCATABLE::GTRIG4 ! logical mask
!
!-------------------------------------------------------------------------------
!
!
!*       0.3    Compute loop bounds
!               -------------------
!
IIB = KIDIA
IIE = KFDIA
JCVEXB = MAX( 0, KBDIA - 1 )
IKB = 1 + JCVEXB 
IKS = KLEV
JCVEXT = MAX( 0, KTDIA - 1)
IKE = IKS - JCVEXT 
!
!
!*       0.5    Update convective counter ( where KCOUNT > 0 
!               convection is still active ).
!               ---------------------------------------------
!
GTRIG(:) = .FALSE.
GTRIG(IIB:IIE) = .TRUE.
ITEST = COUNT( GTRIG(:) )
IF ( ITEST == 0 ) RETURN 
                        
!
!
!*       0.7    Reset convective tendencies to zero if convective
!               counter becomes negative
!               -------------------------------------------------
!
GTRIG3(:,:) = SPREAD( GTRIG(:), DIM=2, NCOPIES=IKS )
WHERE ( GTRIG3(:,:) ) 
    PTTEN(:,:)  = 0.
    PRVTEN(:,:) = 0.
    PRCTEN(:,:) = 0.
    PRITEN(:,:) = 0.
!   PUTEN(:,:)  = 0.
!   PVTEN(:,:)  = 0.
    PUMF(:,:)   = 0.
END WHERE
WHERE ( GTRIG(:) ) 
 ! KCLTOP(:)  = 0 ! already initialized in CONVECTION
 ! KCLBAS(:)  = 0
END WHERE
IF ( OCH1CONV ) THEN
    ALLOCATE( GTRIG4(KLON,KLEV,KCH1) )
    GTRIG4(:,:,:) = SPREAD( GTRIG3(:,:), DIM=3, NCOPIES=KCH1 )
    WHERE( GTRIG4(:,:,:) ) PCH1TEN(:,:,:) = 0.
    DEALLOCATE( GTRIG4 )
END IF
!
!
!*       1.     Initialize  local variables
!               ----------------------------
!
ZEPS   = XRD / XRV
ZEPSA  = XRV / XRD 
ZEPSB  = XCPV / XCPD - ZEPSA
ZCPORD = XCPD / XRD
ZRDOCP = XRD / XCPD
!
!
!*       1.1    Set up grid scale theta, theta_v, theta_es 
!               ------------------------------------------
!
ZTHT(:,:) = 300.
ZSTHV(:,:)= 300.
ZSTHES(:,:) = 400.
DO JK = IKB, IKE
DO JI = IIB, IIE
   IF ( PPABST(JI,JK) > 40.E2 ) THEN
      ZTHT(JI,JK)  = PTT(JI,JK) * ( XP00 / PPABST(JI,JK) ) ** ZRDOCP
      ZSTHV(JI,JK) = ZTHT(JI,JK) * ( 1. + ZEPSA * PRVT(JI,JK) ) /              &
                     ( 1. + PRVT(JI,JK) + PRCT(JI,JK) + PRIT(JI,JK) )
!
          ! use conservative Bolton (1980) formula for theta_e
          ! it is used to compute CAPE for undilute parcel ascent
          ! For economical reasons we do not use routine CONVECT_SATMIXRATIO here
!
      ZES = EXP( XALPW - XBETAW / PTT(JI,JK) - XGAMW * LOG( PTT(JI,JK) ) )
      ZES = MIN( 1., ZEPS * ZES / ( PPABST(JI,JK) - ZES ) )
      ZSTHES(JI,JK) = PTT(JI,JK) * ( ZTHT(JI,JK) / PTT(JI,JK) ) **             &
                ( 1. - 0.28 * ZES ) * EXP( MIN(500.,                           &
                                           ( 3374.6525 / PTT(JI,JK) - 2.5403 ) &
                                          * ZES * ( 1. + 0.81 * ZES ) ) )
   END IF
END DO
END DO
!
!
!
!*       2.     Test for convective columns and determine properties at the LCL
!               --------------------------------------------------------------
!
!*       2.1    Allocate arrays depending on number of model columns that need
!               to be tested for convection (i.e. where no convection is present
!               at the moment.
!               --------------------------------------------------------------
!
     ALLOCATE( ZPRES(ITEST,IKS) )
     ALLOCATE( ZZ(ITEST,IKS) )
     ALLOCATE( ZW(ITEST,IKS) )
     ALLOCATE( ZTH(ITEST,IKS) )
     ALLOCATE( ZTHV(ITEST,IKS) )
     ALLOCATE( ZTHEST(ITEST,IKS) )
     ALLOCATE( ZRV(ITEST,IKS) )
     ALLOCATE( ZSTHLCL(ITEST) )
     ALLOCATE( ZSTLCL(ITEST) )
     ALLOCATE( ZSRVLCL(ITEST) )
     ALLOCATE( ZSWLCL(ITEST) )
     ALLOCATE( ZSZLCL(ITEST) )
     ALLOCATE( ZSTHVELCL(ITEST) )
     ALLOCATE( ISDPL(ITEST) )
     ALLOCATE( ISPBL(ITEST) )
     ALLOCATE( ISLCL(ITEST) )
     ALLOCATE( ZSDXDY(ITEST) )
     ALLOCATE( GTRIG1(ITEST) )
     ALLOCATE( IINDEX(KLON) )
     ALLOCATE( IJSINDEX(ITEST) )
     DO JI = 1, KLON
        IINDEX(JI) = JI
     END DO
     IJSINDEX(:) = PACK( IINDEX(:), MASK=GTRIG(:) )
!
  DO JK = IKB, IKE
  DO JI = 1, ITEST
     JL = IJSINDEX(JI)
     ZPRES(JI,JK)  = PPABST(JL,JK)
     ZZ(JI,JK)     = PZZ(JL,JK)
     ZTH(JI,JK)    = ZTHT(JL,JK)
     ZTHV(JI,JK)   = ZSTHV(JL,JK)
     ZTHEST(JI,JK) = ZSTHES(JL,JK)
     ZRV(JI,JK)    = MAX( 0., PRVT(JL,JK) )
     ZW(JI,JK)     = PWT(JL,JK)
  END DO
  END DO
  DO JI = 1, ITEST
     JL = IJSINDEX(JI)
     ZSDXDY(JI)    = XA25
  END DO
!
!*       2.2    Compute environm. enthalpy and total water = r_v + r_i + r_c 
!               and envir. saturation theta_e
!               ------------------------------------------------------------
!
!
!*       2.3    Test for convective columns and determine properties at the LCL
!               --------------------------------------------------------------
!
     ISLCL(:) = MAX( IKB, 2 )   ! initialize DPL PBL and LCL 
     ISDPL(:) = IKB
     ISPBL(:) = IKB
!
     CALL CONVECT_TRIGGER_SHAL(  ITEST, KLEV,                              &
                                 ZPRES, ZTH, ZTHV, ZTHEST,                 &
                                 ZRV, ZW, ZZ, ZSDXDY,                      &
                                 ZSTHLCL, ZSTLCL, ZSRVLCL, ZSWLCL, ZSZLCL, &
                                 ZSTHVELCL, ISLCL, ISDPL, ISPBL, GTRIG1    )
!
     DEALLOCATE( ZPRES )
     DEALLOCATE( ZZ )
     DEALLOCATE( ZTH )
     DEALLOCATE( ZTHV )
     DEALLOCATE( ZTHEST )
     DEALLOCATE( ZRV )
     DEALLOCATE( ZW )
!
!
!*       3.     After the call of TRIGGER_FUNCT we allocate all the dynamic
!               arrays used in the convection scheme using the mask GTRIG, i.e.
!               we do calculus only in convective columns. This corresponds to
!               a GATHER operation.
!               --------------------------------------------------------------
!
     ICONV = COUNT( GTRIG1(:) )
     IF ( ICONV == 0 )  THEN 
         DEALLOCATE( ZSTHLCL )
         DEALLOCATE( ZSTLCL )
         DEALLOCATE( ZSRVLCL )
         DEALLOCATE( ZSWLCL )
         DEALLOCATE( ZSZLCL )
         DEALLOCATE( ZSTHVELCL )
         DEALLOCATE( ZSDXDY )
         DEALLOCATE( ISLCL )
         DEALLOCATE( ISDPL )
         DEALLOCATE( ISPBL )
         DEALLOCATE( GTRIG1 )
         DEALLOCATE( IINDEX )
         DEALLOCATE( IJSINDEX )
         RETURN   ! no convective column has been found, exit CONVECT_SHALLOW 
     ENDIF
!
     ! vertical index variables
!
         ALLOCATE( IDPL(ICONV) )
         ALLOCATE( IPBL(ICONV) )
         ALLOCATE( ILCL(ICONV) )
         ALLOCATE( ICTL(ICONV) )
         ALLOCATE( IETL(ICONV) )
!
	 ! grid scale variables
!
         ALLOCATE( ZZ(ICONV,IKS) )
         ALLOCATE( ZPRES(ICONV,IKS) )
         ALLOCATE( ZDPRES(ICONV,IKS) )
         ALLOCATE( ZTT(ICONV, IKS) )
         ALLOCATE( ZTH(ICONV,IKS) )
         ALLOCATE( ZTHV(ICONV,IKS) )
         ALLOCATE( ZTHL(ICONV,IKS) )
         ALLOCATE( ZTHES(ICONV,IKS) )
         ALLOCATE( ZRV(ICONV,IKS) )
         ALLOCATE( ZRC(ICONV,IKS) )
         ALLOCATE( ZRI(ICONV,IKS) )
         ALLOCATE( ZRW(ICONV,IKS) )
         ALLOCATE( ZDXDY(ICONV) )
!
         ! updraft variables
!
         ALLOCATE( ZUMF(ICONV,IKS) )
         ALLOCATE( ZUER(ICONV,IKS) )
         ALLOCATE( ZUDR(ICONV,IKS) )
         ALLOCATE( ZUTHL(ICONV,IKS) )
         ALLOCATE( ZUTHV(ICONV,IKS) )
         ALLOCATE( ZURW(ICONV,IKS) )
         ALLOCATE( ZURC(ICONV,IKS) )
         ALLOCATE( ZURI(ICONV,IKS) )
         ALLOCATE( ZTHLCL(ICONV) )
         ALLOCATE( ZTLCL(ICONV) )
         ALLOCATE( ZRVLCL(ICONV) )
         ALLOCATE( ZWLCL(ICONV) )
         ALLOCATE( ZMFLCL(ICONV) )
         ALLOCATE( ZZLCL(ICONV) )
         ALLOCATE( ZTHVELCL(ICONV) )
         ALLOCATE( ZCAPE(ICONV) )
!
         ! work variables
!
         ALLOCATE( IJINDEX(ICONV) )
         ALLOCATE( IJPINDEX(ICONV) )
         ALLOCATE( ZCPH(ICONV) )
         ALLOCATE( ZLV(ICONV) )
         ALLOCATE( ZLS(ICONV) )
!
!
!*           3.1    Gather grid scale and updraft base variables in
!                   arrays using mask GTRIG
!                   ---------------------------------------------------
!
         GTRIG(:)      = UNPACK( GTRIG1(:), MASK=GTRIG(:), FIELD=.FALSE. )  
         IJINDEX(:)    = PACK( IINDEX(:), MASK=GTRIG(:) )
!
    DO JK = IKB, IKE
    DO JI = 1, ICONV
         JL = IJINDEX(JI)
         ZZ(JI,JK)     = PZZ(JL,JK)
         ZPRES(JI,JK)  = PPABST(JL,JK)
         ZTT(JI,JK)    = PTT(JL,JK)
         ZTH(JI,JK)    = ZTHT(JL,JK)
         ZTHES(JI,JK)  = ZSTHES(JL,JK)
         ZRV(JI,JK)    = MAX( 0., PRVT(JL,JK) )
         ZRC(JI,JK)    = MAX( 0., PRCT(JL,JK) )
         ZRI(JI,JK)    = MAX( 0., PRIT(JL,JK) )
         ZTHV(JI,JK)   = ZSTHV(JL,JK)
    END DO
    END DO
!
    DO JI = 1, ITEST
       IJSINDEX(JI) = JI	
    END DO
    IJPINDEX(:) = PACK( IJSINDEX(:), MASK=GTRIG1(:) )
    DO JI = 1, ICONV
         JL = IJPINDEX(JI)
         IDPL(JI)      = ISDPL(JL)
         IPBL(JI)      = ISPBL(JL)
         ILCL(JI)      = ISLCL(JL)
         ZTHLCL(JI)    = ZSTHLCL(JL)
         ZTLCL(JI)     = ZSTLCL(JL)
         ZRVLCL(JI)    = ZSRVLCL(JL)
         ZWLCL(JI)     = ZSWLCL(JL)
         ZZLCL(JI)     = ZSZLCL(JL)
         ZTHVELCL(JI)  = ZSTHVELCL(JL)
         ZDXDY(JI)     = ZSDXDY(JL)
    END DO
         ALLOCATE( GWORK(ICONV) )
         GWORK(:)      = PACK( GTRIG1(:),  MASK=GTRIG1(:) ) 
         DEALLOCATE( GTRIG1 )
         ALLOCATE( GTRIG1(ICONV) )
         GTRIG1(:)     = GWORK(:)
!                 
         DEALLOCATE( GWORK )
         DEALLOCATE( IJPINDEX )
         DEALLOCATE( ISDPL )
         DEALLOCATE( ISPBL )
         DEALLOCATE( ISLCL )
         DEALLOCATE( ZSTHLCL )
         DEALLOCATE( ZSTLCL )
         DEALLOCATE( ZSRVLCL )
         DEALLOCATE( ZSWLCL )
         DEALLOCATE( ZSZLCL )
         DEALLOCATE( ZSTHVELCL )
         DEALLOCATE( ZSDXDY )
!
!
!*           3.2    Compute pressure difference 
!                   ---------------------------------------------------
!
        ZDPRES(:,IKB) = 0.
        DO JK = IKB + 1, IKE
            ZDPRES(:,JK)  = ZPRES(:,JK-1) - ZPRES(:,JK)
        END DO
!
!*           3.3   Compute environm. enthalpy and total water = r_v + r_i + r_c
!                  ----------------------------------------------------------
!
        DO JK = IKB, IKE, 1
            ZRW(:,JK)  = ZRV(:,JK) + ZRC(:,JK) + ZRI(:,JK)
            ZCPH(:)    = XCPD + XCPV * ZRW(:,JK)
            ZLV(:)     = XLVTT + ( XCPV - XCL ) * ( ZTT(:,JK) - XTT ) ! compute L_v
            ZLS(:)     = XLSTT + ( XCPV - XCI ) * ( ZTT(:,JK) - XTT ) ! compute L_i
            ZTHL(:,JK) = ZCPH(:) * ZTT(:,JK) + ( 1. + ZRW(:,JK) ) * XG * ZZ(:,JK) &
                         - ZLV(:) * ZRC(:,JK) - ZLS(:) * ZRI(:,JK)
        END DO
!
        DEALLOCATE( ZCPH )
        DEALLOCATE( ZLV )
        DEALLOCATE( ZLS )
!
!
!*           4.     Compute updraft properties 
!                   ----------------------------
!
!*           4.1    Set mass flux at LCL ( here a unit mass flux with w = 1 m/s ) 
!                   -------------------------------------------------------------
!
         ZDXDY(:)  = XA25
         ZMFLCL(:) = XA25 * 1.e-3
!
!
     CALL CONVECT_UPDRAFT_SHAL( ICONV, KLEV,                                     &
                                KICE, ZPRES, ZDPRES, ZZ, ZTHL, ZTHV, ZTHES, ZRW, &
                                ZTHLCL, ZTLCL, ZRVLCL, ZWLCL, ZZLCL, ZTHVELCL,   & 
                                ZMFLCL, GTRIG1, ILCL, IDPL, IPBL,                &
                                ZUMF, ZUER, ZUDR, ZUTHL, ZUTHV, ZURW,            &
                                ZURC, ZURI, ZCAPE, ICTL, IETL                    )
!
!
!
!*           4.2    In routine UPDRAFT GTRIG1 has been set to false when cloud 
!                   thickness is smaller than 3 km
!                   -----------------------------------------------------------
!
!
     ICONV1 = COUNT(GTRIG1) 
!
     IF ( ICONV1 > 0 )  THEN
!
!*       4.3    Allocate memory for downdraft variables
!               ---------------------------------------
!
! downdraft variables
!
        ALLOCATE( ZDMF(ICONV,IKS) )
        ALLOCATE( ZDER(ICONV,IKS) )
        ALLOCATE( ZDDR(ICONV,IKS) )
        ALLOCATE( ILFS(ICONV) )
        ALLOCATE( ZLMASS(ICONV,IKS) )
        ZDMF(:,:) = 0.
        ZDER(:,:) = 0.
        ZDDR(:,:) = 0.
        ILFS(:)   = IKB
        DO JK = IKB, IKE
           ZLMASS(:,JK)  = ZDXDY(:) * ZDPRES(:,JK) / XG  ! mass of model layer
        END DO
	ZLMASS(:,IKB) = ZLMASS(:,IKB+1)
!
! closure variables
!
        ALLOCATE( ZTIMEC(ICONV) )
        ALLOCATE( ZTHC(ICONV,IKS) )
        ALLOCATE( ZRVC(ICONV,IKS) )
        ALLOCATE( ZRCC(ICONV,IKS) )
        ALLOCATE( ZRIC(ICONV,IKS) )
        ALLOCATE( ZWSUB(ICONV,IKS) )
!
!
!*           5.     Compute downdraft properties 
!                   ----------------------------
!
        ZTIMEC(:) = XCTIME_SHAL
        IF ( OSETTADJ ) ZTIMEC(:) = PTADJS
!
!*           7.     Determine adjusted environmental values assuming
!                   that all available buoyant energy must be removed
!                   within an advective time step ZTIMEC.
!                   ---------------------------------------------------
!
       CALL CONVECT_CLOSURE_SHAL( ICONV, KLEV,                         &
                                  ZPRES, ZDPRES, ZZ, ZDXDY, ZLMASS,    &
                                  ZTHL, ZTH, ZRW, ZRC, ZRI, GTRIG1,    &
                                  ZTHC, ZRVC, ZRCC, ZRIC, ZWSUB,       &
                                  ILCL, IDPL, IPBL, ICTL,              &
                                  ZUMF, ZUER, ZUDR, ZUTHL, ZURW,       &
                                  ZURC, ZURI, ZCAPE, ZTIMEC, IFTSTEPS  )

!
!
!
!*           8.     Determine the final grid-scale (environmental) convective 
!                   tendencies and set convective counter
!                   --------------------------------------------------------
!
!
!*           8.1    Grid scale tendencies
!                   ---------------------
!
          ! in order to save memory, the tendencies are temporarily stored
          ! in the tables for the adjusted grid-scale values
!
      DO JK = IKB, IKE
         ZTHC(:,JK) = ( ZTHC(:,JK) - ZTH(:,JK) ) / ZTIMEC(:)             &
           * ( ZPRES(:,JK) / XP00 ) ** ZRDOCP ! change theta in temperature
         ZRVC(:,JK) = ( ZRVC(:,JK) - ZRW(:,JK) + ZRC(:,JK) + ZRI(:,JK) ) &
                                                  / ZTIMEC(:)

         ZRCC(:,JK) = ( ZRCC(:,JK) - ZRC(:,JK) ) / ZTIMEC(:)
         ZRIC(:,JK) = ( ZRIC(:,JK) - ZRI(:,JK) ) / ZTIMEC(:)
!
      END DO
!
!
!*           8.2    Apply conservation correction
!                   -----------------------------
!
          ! Compute vertical integrals
!
       JKM = MAXVAL( ICTL(:) )
       ZWORK2(:) = 0.
       ZWORK2B(:) = 0.
       DO JK = JKM, IKB+1, -1
	 JKP = JK + 1
         DO JI = 1, ICONV
           ZW1 =  ZRVC(JI,JK) + ZRCC(JI,JK) + ZRIC(JI,JK)
           ZWORK2(JI) = ZWORK2(JI) +  ZW1 *          & ! moisture
                                             (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
           ZW1 = ( XCPD + XCPV * ZRW(JI,JK) )* ZTHC(JI,JK)   - &
                 ( XLVTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRCC(JI,JK) - &
                 ( XLSTT + ( XCPV - XCL ) * ( ZTT(JI,JK) - XTT ) ) * ZRIC(JI,JK) 
           ZWORK2B(JI) = ZWORK2B(JI) + ZW1 *         & ! energy
                                             (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
         END DO
       END DO
!
          ! Budget error (integral must be zero)
!
       DO JI = 1, ICONV
         IF ( ICTL(JI) > 2 ) THEN
           JKP = ICTL(JI) + 1
           ZWORK2(JI) =  ZWORK2(JI) * XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
           ZWORK2B(JI) = ZWORK2B(JI) * XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
         END IF
       END DO
!
          ! Apply uniform correction
!
       DO JK = JKM, IKB+1, -1
         DO JI = 1, ICONV
           IF ( ICTL(JI) > 2 .AND. JK <= ICTL(JI) ) THEN
                 ZRVC(JI,JK) = ZRVC(JI,JK) - ZWORK2(JI)                                ! moisture
                 ZTHC(JI,JK) = ZTHC(JI,JK) - ZWORK2B(JI) / ( XCPD + XCPV * ZRW(JI,JK) )! energy
           END IF
         END DO
       END DO
!
	      ! execute a "scatter"= pack command to store the tendencies in
	      ! the final 2D tables
!
      DO JK = IKB, IKE
      DO JI = 1, ICONV
         JL = IJINDEX(JI)
         PTTEN(JL,JK)   = ZTHC(JI,JK)
         PRVTEN(JL,JK)  = ZRVC(JI,JK)
         PRCTEN(JL,JK)  = ZRCC(JI,JK)
         PRITEN(JL,JK)  = ZRIC(JI,JK)
      END DO
      END DO
!
!
!                   Cloud base and top levels
!                   -------------------------
!
     ILCL(:) = MIN( ILCL(:), ICTL(:) )
     DO JI = 1, ICONV
        JL = IJINDEX(JI)
        KCLTOP(JL) = ICTL(JI)
        KCLBAS(JL) = ILCL(JI)
     END DO
!
!
!*           8.7    Compute convective tendencies for Tracers
!                   ------------------------------------------
!
  IF ( OCH1CONV ) THEN
!
       ALLOCATE( ZCH1(ICONV,IKS,KCH1) )
       ALLOCATE( ZCH1C(ICONV,IKS,KCH1) )
       ALLOCATE( ZWORK3(ICONV,KCH1) )
!
       DO JK = IKB, IKE
       DO JI = 1, ICONV
          JL = IJINDEX(JI)
          ZCH1(JI,JK,:) = PCH1(JL,JK,:)
       END DO
       END DO
!
      CALL CONVECT_CHEM_TRANSPORT( ICONV, KLEV, KCH1, ZCH1, ZCH1C,          &
                                   IDPL, IPBL, ILCL, ICTL, ILFS, ILFS,      &
                                   ZUMF, ZUER, ZUDR, ZDMF, ZDER, ZDDR,      &
                                   ZTIMEC, ZDXDY, ZDMF(:,1), ZLMASS, ZWSUB, &
                                   IFTSTEPS )
!
       DO JK = IKB, IKE
       DO JN = 1, KCH1
          ZCH1C(:,JK,JN) = ( ZCH1C(:,JK,JN)- ZCH1(:,JK,JN) ) / ZTIMEC(:)
       END DO
       END DO
!
!
!*           8.8    Apply conservation correction
!                   -----------------------------
!
          ! Compute vertical integrals
!
       JKM = MAXVAL( ICTL(:) )
       ZWORK3(:,:) = 0.
       DO JK = JKM, IKB+1, -1
	 JKP = JK + 1
         DO JI = 1, ICONV
           ZWORK3(JI,:) = ZWORK3(JI,:) + ZCH1C(JI,JK,:) *                    &
                              (ZPRES(JI,JK) - ZPRES(JI,JKP)) / XG
         END DO
       END DO
!
          ! Mass error (integral must be zero)
!
       DO JI = 1, ICONV
           JKP = ICTL(JI) + 1
           ZWORK3(JI,:) = ZWORK3(JI,:) *                                     &
                                    XG / ( ZPRES(JI,IKB+1) - ZPRES(JI,JKP) )
       END DO
!
          ! Apply uniform correction but assure positive mass at each level
!
       DO JK = JKM, IKB+1, -1
         DO JI = 1, ICONV
           IF ( JK <= ICTL(JI) ) THEN
                ZCH1C(JI,JK,:) = ZCH1C(JI,JK,:) - ZWORK3(JI,:)
       !        ZCH1C(JI,JK,:) = MAX( ZCH1C(JI,JK,:), -ZCH1(JI,JK,:)/ZTIMEC(JI) )
           END IF
         END DO
       END DO
!
       DO JK = IKB, IKE
       DO JI = 1, ICONV
          JL = IJINDEX(JI)
          PCH1TEN(JL,JK,:) = ZCH1C(JI,JK,:)
       END DO
       END DO
  END IF
!
!
!*           9.     Write up- and downdraft mass fluxes
!                   ------------------------------------
!
    DO JK = IKB, IKE
       ZUMF(:,JK)  = ZUMF(:,JK) / ZDXDY(:) ! Mass flux per unit area
    END DO
    ZWORK2(:) = 1.
    DO JK = IKB, IKE
    DO JI = 1, ICONV
       JL = IJINDEX(JI)
       PUMF(JL,JK) = ZUMF(JI,JK) * ZWORK2(JL)
    END DO
    END DO
!
!
!*           10.    Deallocate all local arrays
!                   ---------------------------
!
! downdraft variables
!
      DEALLOCATE( ZDMF )
      DEALLOCATE( ZDER )
      DEALLOCATE( ZDDR )
      DEALLOCATE( ILFS )
      DEALLOCATE( ZLMASS )
!
!   closure variables
!
      DEALLOCATE( ZTIMEC )
      DEALLOCATE( ZTHC )
      DEALLOCATE( ZRVC )
      DEALLOCATE( ZRCC )
      DEALLOCATE( ZRIC )
      DEALLOCATE( ZWSUB )
!
       IF ( OCH1CONV ) THEN
           DEALLOCATE( ZCH1 )
           DEALLOCATE( ZCH1C )
           DEALLOCATE( ZWORK3 )
       END IF
!
    ENDIF
!
!    vertical index
!
    DEALLOCATE( IDPL )
    DEALLOCATE( IPBL )
    DEALLOCATE( ILCL )
    DEALLOCATE( ICTL )
    DEALLOCATE( IETL )
!
! grid scale variables
!
    DEALLOCATE( ZZ )
    DEALLOCATE( ZPRES )
    DEALLOCATE( ZDPRES )
    DEALLOCATE( ZTT )
    DEALLOCATE( ZTH )
    DEALLOCATE( ZTHV )
    DEALLOCATE( ZTHL )
    DEALLOCATE( ZTHES )
    DEALLOCATE( ZRW )
    DEALLOCATE( ZRV )
    DEALLOCATE( ZRC )
    DEALLOCATE( ZRI )
    DEALLOCATE( ZDXDY )
!
! updraft variables
!
    DEALLOCATE( ZUMF )
    DEALLOCATE( ZUER )
    DEALLOCATE( ZUDR )
    DEALLOCATE( ZUTHL )
    DEALLOCATE( ZUTHV )
    DEALLOCATE( ZURW )
    DEALLOCATE( ZURC )
    DEALLOCATE( ZURI )
    DEALLOCATE( ZTHLCL )
    DEALLOCATE( ZTLCL )
    DEALLOCATE( ZRVLCL )
    DEALLOCATE( ZWLCL )
    DEALLOCATE( ZZLCL )
    DEALLOCATE( ZTHVELCL )
    DEALLOCATE( ZMFLCL )
    DEALLOCATE( ZCAPE )
!
! work arrays
!
    DEALLOCATE( IINDEX )
    DEALLOCATE( IJINDEX )
    DEALLOCATE( IJSINDEX )
    DEALLOCATE( GTRIG1 )
!
!
END SUBROUTINE CONVECT_SHALLOW
!     ######spl
      SUBROUTINE CONVECT_TRIGGER_SHAL(  KLON, KLEV,                           &
                                        PPRES, PTH, PTHV, PTHES,              &
                                        PRV, PW, PZ, PDXDY,                   &
                                        PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL,  &
                                        PTHVELCL, KLCL, KDPL, KPBL, OTRIG     )
!     ######################################################################
!
!!**** Determine convective columns as well as the cloudy values of theta,
!!     and qv at the lifting condensation level (LCL) 
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine convective columns
!!   
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      What we look for is the undermost unstable level at each grid point.
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     Routine CONVECT_SATMIXRATIO
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XP00               ! Reference pressure
!!          XRD, XRV           ! Gaz  constants for dry air and water vapor
!!          XCPD               ! Cpd (dry air)
!!          XTT                ! triple point temperature
!!          XBETAW, XGAMW      ! constants for vapor saturation pressure
!!
!!      Module MODD_CONVPAR
!!          XA25               ! reference grid area
!!          XZLCL              ! maximum height difference between
!!                             ! the surface and the DPL
!!          XZPBL              ! minimum mixed layer depth to sustain convection
!!          XCDEPTH            ! minimum necessary cloud depth
!!          XCDEPTH_D          ! maximum allowed cloud depth
!!          XDTPERT            ! add small Temp peturbation
!!          XNHGAM             ! coefficient for buoyancy term in w eq.
!!                             ! accounting for nh-pressure
!!
!!      Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    REFERENCE
!!    ---------
!!
!!      Book2 of documentation ( routine TRIGGER_FUNCT)
!!      Fritsch and Chappell (1980), J. Atm. Sci., Vol. 37, 1722-1761.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  20/03/97  Select first departure level
!!                            that produces a cloud thicker than XCDEPTH
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR_SHAL
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER, INTENT(IN)                   :: KLON      ! horizontal loop index
INTEGER, INTENT(IN)                   :: KLEV      ! vertical loop index
REAL, DIMENSION(KLON),     INTENT(IN) :: PDXDY     ! grid area
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH, PTHV ! theta, theta_v
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHES     ! envir. satur. theta_e
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRV       ! vapor mixing ratio 
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PPRES     ! pressure
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PZ        ! height of grid point (m)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PW        ! vertical velocity
!
REAL, DIMENSION(KLON),     INTENT(OUT):: PTHLCL    ! theta at LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PTLCL     ! temp. at LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PRVLCL    ! vapor mixing ratio at  LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PWLCL     ! parcel velocity at  LCL
REAL, DIMENSION(KLON),     INTENT(OUT):: PZLCL     ! height at LCL (m)
REAL, DIMENSION(KLON),     INTENT(OUT):: PTHVELCL  ! environm. theta_v at LCL (K)
LOGICAL, DIMENSION(KLON),  INTENT(OUT):: OTRIG     ! logical mask for convection 
INTEGER, DIMENSION(KLON),  INTENT(INOUT):: KLCL    ! contains vert. index of LCL
INTEGER, DIMENSION(KLON),  INTENT(INOUT):: KDPL    ! contains vert. index of DPL
INTEGER, DIMENSION(KLON),  INTENT(INOUT):: KPBL    ! contains index of source layer top
!
!*       0.2   Declarations of local variables :
!
INTEGER :: JKK, JK, JKP, JKM, JL, JKT, JT      ! vertical loop index
INTEGER :: JI                                  ! horizontal loop index 
INTEGER :: IIE, IKB, IKE                       ! horizontal + vertical loop bounds
REAL    :: ZEPS, ZEPSA                         ! R_d / R_v, R_v / R_d 
REAL    :: ZCPORD, ZRDOCP                      ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON) :: ZTHLCL, ZTLCL, ZRVLCL, & ! locals for PTHLCL,PTLCL
                               ZWLCL,  ZZLCL, ZTHVELCL  ! PRVLCL, ....
INTEGER, DIMENSION(KLON) :: IDPL, IPBL, ILCL      ! locals for KDPL, ...
REAL, DIMENSION(KLON) :: ZPLCL    ! pressure at LCL
REAL, DIMENSION(KLON) :: ZZDPL    ! height of DPL 
REAL, DIMENSION(KLON) :: ZTHVLCL  ! theta_v at LCL = mixed layer value
REAL, DIMENSION(KLON) :: ZTMIX    ! mixed layer temperature
REAL, DIMENSION(KLON) :: ZEVMIX   ! mixed layer water vapor pressure 
REAL, DIMENSION(KLON) :: ZDPTHMIX, ZPRESMIX ! mixed layer depth and pressure
REAL, DIMENSION(KLON) :: ZCAPE    ! convective available energy (m^2/s^2/g)
REAL, DIMENSION(KLON) :: ZTHEUL   ! updraft equiv. pot. temperature (K)
REAL, DIMENSION(KLON) :: ZLV, ZCPH! specific heats of vaporisation, dry air
REAL, DIMENSION(KLON) :: ZDP      ! pressure between LCL and model layer
REAL, DIMENSION(KLON) :: ZTOP     ! estimated cloud top (m)
!INTEGER, DIMENSION(KLON) :: ITOP  ! work array to store highest test layer
REAL, DIMENSION(KLON) :: ZWORK1, ZWORK2, ZWORK3    ! work arrays
LOGICAL, DIMENSION(KLON) :: GTRIG, GTRIG2          ! local arrays for OTRIG
LOGICAL, DIMENSION(KLON) :: GWORK1                 ! work array
!
!
!-------------------------------------------------------------------------------
!
!*       0.3    Compute array bounds
!               --------------------
!
IIE = KLON
IKB = 1 + JCVEXB 
IKE = KLEV - JCVEXT 
!
!
!*       1.     Initialize local variables
!               --------------------------
!
ZEPS       = XRD / XRV
ZEPSA      = XRV / XRD 
ZCPORD     = XCPD / XRD
ZRDOCP     = XRD / XCPD
OTRIG(:)   = .FALSE.
IDPL(:)    = KDPL(:)
IPBL(:)    = KPBL(:)
ILCL(:)    = KLCL(:)
!ITOP(:)    = IKB
PWLCL(:)   = 0.
ZWLCL(:)   = 0.
PTHLCL(:)  = 1.
PTHVELCL(:)= 1.
PTLCL(:)   = 1.
PRVLCL(:)  = 0.
PWLCL(:)   = 0.
PZLCL(:)   = PZ(:,IKB)
ZZDPL(:)   = PZ(:,IKB)
GTRIG2(:)  = .TRUE.
!
!
!
!       1.     Determine highest necessary loop test layer
!              -------------------------------------------
!
JT = IKE - 2
DO JK = IKB + 1, IKE - 2
 ! DO JI = 1, IIE
 !    IF ( PZ(JI,JK) - PZ(JI,IKB) <= XZLCL ) ITOP(JI) = JK
 ! END DO
   IF ( PZ(1,JK) - PZ(1,IKB) < 5.E3 ) JT = JK 
END DO
!
!
!*       2.     Enter loop for convection test
!               ------------------------------
!
JKP = MINVAL( IDPL(:) ) + 1
!JKT = MAXVAL( ITOP(:) )
JKT = JT
DO JKK = JKP, JKT
!
     GWORK1(:) = ZZDPL(:) - PZ(:,IKB) < XZLCL
          ! we exit the trigger test when the center of the mixed layer is more
          ! than 1500 m  above soil level.
     WHERE ( GWORK1(:) )
        ZDPTHMIX(:) = 0.
        ZPRESMIX(:) = 0.
        ZTHLCL(:)   = 0.
        ZRVLCL(:)   = 0.
        ZZDPL(:)    = PZ(:,JKK)
        IDPL(:)     = JKK
     END WHERE
!
!
!*       3.     Construct a mixed layer of at least 50 hPa (XZPBL)
!               ------------------------------------------
!
     DO JK = JKK, IKE - 1
       JKM = JK + 1
       DO JI = 1, IIE     
         IF ( GWORK1(JI) .AND. ZDPTHMIX(JI) < XZPBL ) THEN
            IPBL(JI)     = JK
            ZWORK1(JI)   = PPRES(JI,JK) - PPRES(JI,JKM)
            ZDPTHMIX(JI) = ZDPTHMIX(JI) + ZWORK1(JI)
            ZPRESMIX(JI) = ZPRESMIX(JI) + PPRES(JI,JK) * ZWORK1(JI)
            ZTHLCL(JI)   = ZTHLCL(JI)   + PTH(JI,JK)   * ZWORK1(JI)
            ZRVLCL(JI)   = ZRVLCL(JI)   + PRV(JI,JK)   * ZWORK1(JI)
         END IF
       END DO
        IF ( MINVAL ( ZDPTHMIX(:) ) >= XZPBL ) EXIT
     END DO
!
!
     WHERE ( GWORK1(:) )
!
        ZPRESMIX(:) = ZPRESMIX(:) / ZDPTHMIX(:)
        ZTHLCL(:)   = ZTHLCL(:)   / ZDPTHMIX(:) + XDTPERT ! add small Temp Perturb.
        ZRVLCL(:)   = ZRVLCL(:)   / ZDPTHMIX(:)
        ZTHVLCL(:)  = ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) )                 &
				/ ( 1. + ZRVLCL(:) )
!
!*       4.1    Use an empirical direct solution ( Bolton formula )
!               to determine temperature and pressure at LCL. 
!               Nota: the adiabatic saturation temperature is not
!                     equal to the dewpoint temperature
!               ----------------------------------------------------
!
! 
        ZTMIX(:)  = ZTHLCL(:) * ( ZPRESMIX(:) / XP00 ) ** ZRDOCP 
        ZEVMIX(:) = ZRVLCL(:) * ZPRESMIX(:) / ( ZRVLCL(:) + ZEPS )
        ZEVMIX(:) = MAX( 1.E-8, ZEVMIX(:) )
        ZWORK1(:) = LOG( ZEVMIX(:) / 613.3 )
              ! dewpoint temperature
        ZWORK1(:) = ( 4780.8 - 32.19 * ZWORK1(:) ) / ( 17.502 - ZWORK1(:) ) 
              ! adiabatic saturation temperature
        ZTLCL(:)  = ZWORK1(:) - ( .212 + 1.571E-3 * ( ZWORK1(:) - XTT )      &
                   - 4.36E-4 * ( ZTMIX(:) - XTT ) ) * ( ZTMIX(:) - ZWORK1(:) )
        ZTLCL(:)  = MIN( ZTLCL(:), ZTMIX(:) )
        ZPLCL(:)  = XP00 * ( ZTLCL(:) / ZTHLCL(:) ) ** ZCPORD
!
     END WHERE
!
!
!*       4.2    Correct ZTLCL in order to be completely consistent
!               with MNH saturation formula
!               ---------------------------------------------
!
     CALL CONVECT_SATMIXRATIO( KLON, ZPLCL, ZTLCL, ZWORK1, ZLV, ZWORK2, ZCPH )
     WHERE( GWORK1(:) )
        ZWORK2(:) = ZWORK1(:) / ZTLCL(:) * ( XBETAW / ZTLCL(:) - XGAMW ) ! dr_sat/dT
        ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) /                              &
                        ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) ) 
        ZTLCL(:)  = ZTLCL(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
!
     END WHERE
!
!
!*       4.3    If ZRVLCL = PRVMIX is oversaturated set humidity 
!               and temperature to saturation values. 
!               ---------------------------------------------
!
     CALL CONVECT_SATMIXRATIO( KLON, ZPRESMIX, ZTMIX, ZWORK1, ZLV, ZWORK2, ZCPH )
     WHERE( GWORK1(:) .AND. ZRVLCL(:) > ZWORK1(:) )
        ZWORK2(:) = ZWORK1(:) / ZTMIX(:) * ( XBETAW / ZTMIX(:) - XGAMW ) ! dr_sat/dT
        ZWORK2(:) = ( ZWORK1(:) - ZRVLCL(:) ) /                              &
                       ( 1. + ZLV(:) / ZCPH(:) * ZWORK2(:) ) 
        ZTLCL(:)  = ZTMIX(:) - ZLV(:) / ZCPH(:) * ZWORK2(:)
        ZRVLCL(:) = ZRVLCL(:) - ZWORK2(:)
        ZPLCL(:)  = ZPRESMIX(:)
        ZTHLCL(:) = ZTLCL(:) * ( XP00 / ZPLCL(:) ) ** ZRDOCP
        ZTHVLCL(:)= ZTHLCL(:) * ( 1. + ZEPSA * ZRVLCL(:) )                   &
                              / ( 1. + ZRVLCL(:) )
     END WHERE
!
!
!*        5.1   Determine  vertical loop index at the LCL and DPL
!               --------------------------------------------------
!
    DO JK = JKK, IKE - 1
       DO JI = 1, IIE
         IF ( ZPLCL(JI) <= PPRES(JI,JK) .AND. GWORK1(JI) ) ILCL(JI) = JK + 1
       END DO
    END DO
!
!
!*        5.2   Estimate height and environm. theta_v at LCL
!               --------------------------------------------------
!
    DO JI = 1, IIE
        JK   = ILCL(JI)
        JKM  = JK - 1
        ZDP(JI)    = LOG( ZPLCL(JI) / PPRES(JI,JKM) ) /                     &
                     LOG( PPRES(JI,JK) / PPRES(JI,JKM) )
        ZWORK1(JI) = PTHV(JI,JKM) + ( PTHV(JI,JK) - PTHV(JI,JKM) ) * ZDP(JI) 
           ! we compute the precise value of the LCL
           ! The precise height is between the levels ILCL and ILCL-1.
        ZWORK2(JI) = PZ(JI,JKM) + ( PZ(JI,JK) - PZ(JI,JKM) ) * ZDP(JI)
    END DO
    WHERE( GWORK1(:) )
        ZTHVELCL(:) = ZWORK1(:) 
        ZZLCL(:)    = ZWORK2(:)
    END WHERE
!        
!
!*       6.     Check to see if cloud is bouyant 
!               --------------------------------
!
!*      6.1    Compute grid scale vertical velocity perturbation term ZWORK1
!               -------------------------------------------------------------
! 
!            !  normalize w grid scale to a 25 km refer. grid
!    DO JI = 1, IIE
!       JK  = ILCL(JI)
!       JKM = JK - 1 
!       ZWORK1(JI) =  ( PW(JI,JKM)  + ( PW(JI,JK) - PW(JI,JKM) ) * ZDP(JI) )  &
!                          * SQRT( PDXDY(JI) / XA25 )
!                         - 0.02 * ZZLCL(JI) / XZLCL ! avoid spurious convection
!    END DO
!            ! compute sign of normalized grid scale w
!       ZWORK2(:) = SIGN( 1., ZWORK1(:) ) 
!       ZWORK1(:) = XWTRIG * ZWORK2(:) * ABS( ZWORK1(:) ) ** 0.333       &
!                          * ( XP00 / ZPLCL(:) ) ** ZRDOCP
!
!*       6.2    Compute parcel vertical velocity at LCL
!               ---------------------------------------
!                   
!    DO JI = 1, IIE
!       JKDL = IDPL(JI)
!       ZWORK3(JI) = XG * ZWORK1(JI) * ( ZZLCL(JI) - PZ(JI,JKDL) )       &
!                      / ( PTHV(JI,JKDL) + ZTHVELCL(JI) )
!    END DO
!    WHERE( GWORK1(:) )
!      ZWLCL(:)  = 1. + .5 * ZWORK2(:) * SQRT( ABS( ZWORK3(:) ) ) 
!      GTRIG(:)  = ZTHVLCL(:) - ZTHVELCL(:) + ZWORK1(:) > 0. .AND.       &
!                  ZWLCL(:) > 0. 
!    END WHERE
     ZWLCL(:) = 1.
!
!
!*       6.3    Look for parcel that produces sufficient cloud depth.
!               The cloud top is estimated as the level where the CAPE 
!               is smaller  than a given value (based on vertical velocity eq.)
!               --------------------------------------------------------------
!
     ZTHEUL(:) = ZTLCL(:) * ( ZTHLCL(:) / ZTLCL(:) )                       &
                                             ** ( 1. - 0.28 * ZRVLCL(:) )  &
                          * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 ) *       &
                               ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
!
     ZCAPE(:) = 0.
     ZTOP(:)  = 0.
     ZWORK3(:)= 0.
     JKM = MINVAL( ILCL(:) )
     DO JL = JKM, JT
        JK = JL + 1
        DO JI = 1, IIE
           ZWORK1(JI) = ( 2. * ZTHEUL(JI) /                                &
            ( PTHES(JI,JK) + PTHES(JI,JL) ) - 1. ) * ( PZ(JI,JK) - PZ(JI,JL) )
           IF ( JL < ILCL(JI) ) ZWORK1(JI) = 0.
           ZCAPE(JI)  = ZCAPE(JI) + ZWORK1(JI)
           ZWORK2(JI) = XNHGAM * XG * ZCAPE(JI) + 1.05 * ZWLCL(JI) * ZWLCL(JI)
               ! the factor 1.05 takes entrainment into account
           ZWORK2(JI) = SIGN( 1., ZWORK2(JI) )
           ZWORK3(JI) = ZWORK3(JI) + MIN(0., ZWORK2(JI) )
           ZWORK3(JI) = MAX( -1., ZWORK3(JI) )
               ! Nota, the factors ZWORK2 and ZWORK3 are only used to avoid
               ! if and goto statements, the difficulty is to extract only
               ! the level where the criterium is first fullfilled
           ZTOP(JI)   = PZ(JI,JL) * .5 * ( 1. + ZWORK2(JI) ) * ( 1. + ZWORK3(JI) ) + &
                        ZTOP(JI) * .5 * ( 1. - ZWORK2(JI) )
         END DO
     END DO
!
!
     ZWORK2(:) = ZTOP(:) - ZZLCL(:)
     WHERE( ZWORK2(:)  .GE. XCDEPTH  .AND. ZWORK2(:) < XCDEPTH_D .AND. GTRIG2(:) )
        GTRIG2(:)   = .FALSE.
        OTRIG(:)    = .TRUE.
      ! OTRIG(:)    = GTRIG(:)     ! we  select the first departure level
        PTHLCL(:)   = ZTHLCL(:)    ! that gives sufficient cloud depth
        PRVLCL(:)   = ZRVLCL(:)
        PTLCL(:)    = ZTLCL(:)
        PWLCL(:)    = ZWLCL(:)
        PZLCL(:)    = ZZLCL(:)
        PTHVELCL(:) = ZTHVELCL(:)
        KDPL(:)     = IDPL(:)
        KPBL(:)     = IPBL(:)
        KLCL(:)     = ILCL(:)
     END WHERE
!
END DO
!
!
END SUBROUTINE CONVECT_TRIGGER_SHAL
!     ######spl
    SUBROUTINE CONVECT_UPDRAFT_SHAL( KLON, KLEV,                                     &
     		                     KICE, PPRES, PDPRES, PZ, PTHL, PTHV, PTHES, PRW,&
                                     PTHLCL, PTLCL, PRVLCL, PWLCL, PZLCL, PTHVELCL,  &
                                     PMFLCL, OTRIG, KLCL, KDPL, KPBL,                &
                                     PUMF, PUER, PUDR, PUTHL, PUTHV, PURW,           &
                                     PURC, PURI, PCAPE, KCTL, KETL )
!    ###############################################################################
!
!!**** Compute updraft properties from DPL to CTL. 
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine updraft properties
!!      ( mass flux, thermodynamics, precipitation ) 
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     Routine CONVECT_MIXING_FUNCT
!!     Routine CONVECT_CONDENS
!!     
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XP00               ! reference pressure
!!          XRD, XRV           ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV, XCL    ! Cp of dry air, water vapor and liquid water
!!          XTT                ! triple point temperature
!!          XLVTT              ! vaporisation heat at XTT
!!        
!!
!!      Module MODD_CONVPAR_SHAL
!!          XA25               ! reference grid area
!!          XCRAD              ! cloud radius
!!          XCDEPTH            ! minimum necessary cloud depth
!!          XENTR              ! entrainment constant
!!          XNHGAM             ! coefficient for buoyancy term in w eq.
!!                             ! accounting for nh-pressure
!!          XTFRZ1             ! begin of freezing interval
!!          XTFRZ2             ! begin of freezing interval
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_UPDRAFT)
!!      Kain and Fritsch, 1990, J. Atmos. Sci., Vol.
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    07/11/95 
!!   Last modified  10/12/97
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR_SHAL
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER, INTENT(IN)                    :: KLON  ! horizontal dimension
INTEGER, INTENT(IN)                    :: KLEV  ! vertical dimension
INTEGER, INTENT(IN)                    :: KICE  ! flag for ice ( 1 = yes,
                                                !                0 = no ice )
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHL  ! grid scale enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHV  ! grid scale theta_v     
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PTHES ! grid scale saturated theta_e 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PRW   ! grid scale total water  
                                                ! mixing ratio 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES ! pressure (P)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES! pressure difference between 
                                                ! bottom and top of layer (Pa) 
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ    ! height of model layer (m) 
REAL, DIMENSION(KLON),     INTENT(IN) :: PTHLCL ! theta at LCL
REAL, DIMENSION(KLON),     INTENT(IN) :: PTLCL  ! temp. at LCL
REAL, DIMENSION(KLON),     INTENT(IN) :: PRVLCL ! vapor mixing ratio at  LCL
REAL, DIMENSION(KLON),     INTENT(IN) :: PWLCL  ! parcel velocity at LCL (m/s)
REAL, DIMENSION(KLON),     INTENT(IN) :: PMFLCL ! cloud  base unit mass flux
                                                ! (kg/s)
REAL, DIMENSION(KLON),     INTENT(IN) :: PZLCL  ! height at LCL (m)
REAL, DIMENSION(KLON),     INTENT(IN) :: PTHVELCL  ! environm. theta_v at LCL (K)
LOGICAL, DIMENSION(KLON),  INTENT(INOUT):: OTRIG! logical mask for convection 
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KLCL   ! contains vert. index of LCL
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KDPL   ! contains vert. index of DPL 
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KPBL   !  " vert. index of source layertop
!
!
INTEGER, DIMENSION(KLON),  INTENT(OUT):: KCTL   ! contains vert. index of CTL 
INTEGER, DIMENSION(KLON),  INTENT(OUT):: KETL   ! contains vert. index of        &
						!equilibrium (zero buoyancy) level 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUMF  ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUER  ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUDR  ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHL ! updraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PUTHV ! updraft theta_v (K)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURW  ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURC  ! updraft cloud water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(OUT):: PURI  ! updraft cloud ice   (kg/kg)
REAL, DIMENSION(KLON),     INTENT(OUT):: PCAPE  ! available potent. energy
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE  ! horizontal and vertical loop bounds
INTEGER :: JI             ! horizontal loop index
INTEGER :: JK, JKP, JKM, JK1, JK2, JKMIN   ! vertical loop index
REAL    :: ZEPSA, ZCVOCD  ! R_v / R_d, C_pv / C_pd 
REAL    :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
!
REAL, DIMENSION(KLON)    :: ZUT             ! updraft temperature (K)
REAL, DIMENSION(KLON)    :: ZUW1, ZUW2      ! square of updraft vert.
                                            ! velocity at levels k and k+1
REAL, DIMENSION(KLON)    :: ZE1,ZE2,ZD1,ZD2 ! fractional entrainm./detrain
                                            ! rates at levels k and k+1
REAL, DIMENSION(KLON)    :: ZMIXF           ! critical mixed fraction  
REAL, DIMENSION(KLON)    :: ZCPH            ! specific heat C_ph 
REAL, DIMENSION(KLON)    :: ZLV, ZLS        ! latent heat of vaporis., sublim.       
REAL, DIMENSION(KLON)    :: ZURV            ! updraft water vapor at level k+1
REAL, DIMENSION(KLON)    :: ZPI             ! Pi=(P0/P)**(Rd/Cpd)  
REAL, DIMENSION(KLON)    :: ZTHEUL          ! theta_e for undilute ascent
REAL, DIMENSION(KLON)    :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5,   &
                            ZWORK6          ! work arrays
INTEGER, DIMENSION(KLON) :: IWORK           ! wok array
LOGICAL, DIMENSION(KLON) :: GWORK1, GWORK2, GWORK4, GWORK5 
                                            ! work arrays
LOGICAL, DIMENSION(KLON,KLEV) :: GWORK6     ! work array
!
!
!-------------------------------------------------------------------------------
!
!        0.3   Set loop bounds
!              ---------------
!
IKB = 1 + JCVEXB 
IKE = KLEV - JCVEXT 
IIE = KLON
!
!
!*       1.     Initialize updraft properties and local variables
!               -------------------------------------------------
!
ZEPSA      = XRV / XRD 
ZCVOCD     = XCPV / XCPD
ZCPORD     = XCPD / XRD
ZRDOCP     = XRD / XCPD
!
PUMF(:,:)  = 0.
PUER(:,:)  = 0.
PUDR(:,:)  = 0.
PUTHL(:,:) = 0.
PUTHV(:,:) = 0.
PURW(:,:)  = 0.
PURC(:,:)  = 0.
PURI(:,:)  = 0.
ZUW1(:)    = PWLCL(:) * PWLCL(:)
ZUW2(:)    = 0.
ZE1(:)     = 0.
ZD1(:)     = 0.
PCAPE(:)   = 0.
KCTL(:)    = IKB
KETL(:)    = KLCL(:)
GWORK2(:)  = .TRUE.
GWORK5(:)  = .TRUE.
ZPI(:)     = 1.
ZWORK3(:)  = 0.
ZWORK4(:)  = 0.
ZWORK5(:)  = 0.
ZWORK6(:)  = 0.
GWORK1(:)  = .FALSE.
GWORK4(:)  = .FALSE.
!
!
!*       1.1    Compute undilute updraft theta_e for CAPE computations
!               Bolton (1980) formula.
!               Define accurate enthalpy for updraft
!               -----------------------------------------------------
!
ZTHEUL(:) = PTLCL(:) * ( PTHLCL(:) / PTLCL(:) ) ** ( 1. - 0.28 * PRVLCL(:) )  &
            * EXP( ( 3374.6525 / PTLCL(:) - 2.5403 ) *                        &
                                   PRVLCL(:) * ( 1. + 0.81 * PRVLCL(:) ) )
!
!
ZWORK1(:) = ( XCPD + PRVLCL(:) * XCPV ) * PTLCL(:)                            &
            + ( 1. + PRVLCL(:) ) * XG * PZLCL(:)
!
!
!*       2.     Set updraft properties between DPL and LCL
!               ------------------------------------------
!
JKP = MAXVAL( KLCL(:) )
JKM = MINVAL( KDPL(:) )
DO JK = JKM, JKP
   DO JI = 1, IIE
   IF ( JK >= KDPL(JI) .AND. JK < KLCL(JI) ) THEN
	PUMF(JI,JK)  = PMFLCL(JI)
	PUTHL(JI,JK) = ZWORK1(JI) 
	PUTHV(JI,JK) = PTHLCL(JI) * ( 1. + ZEPSA * PRVLCL(JI) ) /             &
                                  ( 1. + PRVLCL(JI) )
        PURW(JI,JK)  = PRVLCL(JI) 
   END IF
   END DO
END DO                        
!
!
!*       3.     Enter loop for updraft computations
!               ------------------------------------
!
JKMIN = MINVAL( KLCL(:) - 1 ) 
DO JK = MAX( IKB + 1, JKMIN ), IKE - 1
  ZWORK6(:) = 1.
  JKP = JK + 1  
!
  GWORK4(:) = JK >= KLCL(:) - 1 
  GWORK1(:) = GWORK4(:) .AND. GWORK2(:) ! this mask is used to confine
                           ! updraft computations between the LCL and the CTL
!                                                         
  WHERE( JK == KLCL(:) - 1 ) ZWORK6(:) = 0. ! factor that is used in buoyancy
                                        ! computation at first level above LCL
!
!
!*       4.     Estimate condensate, L_v L_i, Cph and theta_v at level k+1   
!               ----------------------------------------------------------
!
    ZWORK1(:) = PURC(:,JK) 
    ZWORK2(:) = PURI(:,JK) 
    CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), PUTHL(:,JK), PURW(:,JK),&
                          ZWORK1, ZWORK2, PZ(:,JKP), GWORK1, ZUT, ZURV,     &
                          PURC(:,JKP), PURI(:,JKP), ZLV, ZLS, ZCPH )
!
!
  ZPI(:) = ( XP00 / PPRES(:,JKP) ) ** ZRDOCP   
  WHERE ( GWORK1(:) )
!
    PUTHV(:,JKP) = ZPI(:) * ZUT(:) * ( 1. + ZEPSA * ZURV(:) )           &  
                         / ( 1. + PURW(:,JK) )     
!
!
!*       5.     Compute square of vertical velocity using entrainment   
!               at level k
!               -----------------------------------------------------
!    
    ZWORK3(:) = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) -         &
                     ( 1. - ZWORK6(:) ) * PZLCL(:)          ! level thickness  
    ZWORK4(:) = PTHV(:,JK) * ZWORK6(:) +                   &
                 ( 1. - ZWORK6(:) ) * PTHVELCL(:)
    ZWORK5(:) = 2. * ZUW1(:) * PUER(:,JK) / MAX( .1, PUMF(:,JK) )
    ZUW2(:)   = ZUW1(:) + ZWORK3(:) * XNHGAM * XG *        & 
                  ( ( PUTHV(:,JK) + PUTHV(:,JKP) ) /       &
                  ( ZWORK4(:) + PTHV(:,JKP) ) - 1. )       & ! buoyancy term
                - ZWORK5(:)                                  ! entrainment term
!
!
!*       6.     Update total precipitation: dr_r=(r_c+r_i)*exp(-rate*dz)  
!               --------------------------------------------------------
!
!                    compute level mean vertical velocity  
    ZWORK2(:)   = 0.5 *                                                    &
                       ( SQRT( MAX( 1.E-2, ZUW2(:) ) ) +                   &
                         SQRT( MAX( 1.E-2, ZUW1(:) ) ) )          
!
!
!*       7.     Update r_c, r_i, enthalpy, r_w  for precipitation 
!               -------------------------------------------------------
!
    PURW(:,JKP)  = PURW(:,JK) 
    PURC(:,JKP)  = PURC(:,JKP)
    PURI(:,JKP)  = PURI(:,JKP)
    PUTHL(:,JKP) = PUTHL(:,JK)
!    
    ZUW1(:)      = ZUW2(:)       
!
  END WHERE
!
!
!*       8.     Compute entrainment and detrainment using conservative
!               variables adjusted for precipitation ( not for entrainment)
!               -----------------------------------------------------------
!
!*       8.1    Compute critical mixed fraction by estimating unknown  
!               T^mix r_c^mix and r_i^mix from enthalpy^mix and r_w^mix
!               We determine the zero crossing of the linear curve
!               evaluating the derivative using ZMIXF=0.1.
!               -----------------------------------------------------
!    
    ZMIXF(:)  = 0.1   ! starting value for critical mixed fraction
    ZWORK1(:) = ZMIXF(:) * PTHL(:,JKP)                                     &
                     + ( 1. - ZMIXF(:) ) * PUTHL(:,JKP) ! mixed enthalpy
    ZWORK2(:) = ZMIXF(:) * PRW(:,JKP)                                      &
                     + ( 1. - ZMIXF(:) ) * PURW(:,JKP)  ! mixed r_w
!
    CALL CONVECT_CONDENS( KLON, KICE, PPRES(:,JKP), ZWORK1, ZWORK2,        &
                          PURC(:,JKP), PURI(:,JKP), PZ(:,JKP), GWORK1, ZUT,&
                          ZWORK3, ZWORK4, ZWORK5, ZLV, ZLS, ZCPH )
!        put in enthalpy and r_w and get T r_c, r_i (ZUT, ZWORK4-5)
!        
     ! compute theta_v of mixture
    ZWORK3(:) = ZUT(:) * ZPI(:) * ( 1. + ZEPSA * (                         &
                ZWORK2(:) - ZWORK4(:) - ZWORK5(:) ) ) / ( 1. + ZWORK2(:) )
     ! compute final value of critical mixed fraction using theta_v
     ! of mixture, grid-scale and updraft
    ZMIXF(:) = MAX( 0., PUTHV(:,JKP) - PTHV(:,JKP) ) * ZMIXF(:) /          &
                              ( PUTHV(:,JKP) - ZWORK3(:) + 1.E-10 )
    ZMIXF(:) = MAX( 0., MIN( 1., ZMIXF(:) ) )
!    
!
!*       8.2     Compute final midlevel values for entr. and detrainment    
!                after call of distribution function
!                -------------------------------------------------------
!    
!
    CALL CONVECT_MIXING_FUNCT ( KLON, ZMIXF, 1, ZE2, ZD2 )
!       Note: routine MIXING_FUNCT returns fractional entrainm/detrainm. rates
!
! ZWORK1(:) = XENTR * PMFLCL(:) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
!*MOD
  zwork1(:) = xentr * xg / xcrad * pumf(:,jk) * ( pz(:,jkp) - pz(:,jk) )
! ZWORK1(:) = XENTR * pumf(:,jk) * PDPRES(:,JKP) / XCRAD ! rate of env. inflow
!*MOD
  ZWORK2(:) = 0.
  WHERE ( GWORK1(:) ) ZWORK2(:) = 1.
  WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) )
    PUER(:,JKP) = 0.5 * ZWORK1(:) * ( ZE1(:) + ZE2(:) ) * ZWORK2(:)
    PUDR(:,JKP) = 0.5 * ZWORK1(:) * ( ZD1(:) + ZD2(:) ) * ZWORK2(:)
  ELSEWHERE
    PUER(:,JKP) = 0.
    PUDR(:,JKP) = ZWORK1(:) * ZWORK2(:)
  END WHERE
!
!*       8.3     Determine equilibrium temperature level
!                --------------------------------------
!
   WHERE ( PUTHV(:,JKP) > PTHV(:,JKP) .AND. JK > KLCL(:) + 1 &   
           .AND. GWORK1(:) )
         KETL(:) = JKP            ! equilibrium temperature level 
   END WHERE
!
!*       8.4     If the calculated detrained mass flux is greater than    
!                the total updraft mass flux, or vertical velocity is
!                negative, all cloud mass detrains at previous model level,
!                exit updraft calculations - CTL is attained
!                -------------------------------------------------------
!
  WHERE( GWORK1(:) )                                                   &
        GWORK2(:) = PUMF(:,JK) - PUDR(:,JKP) > 10. .AND. ZUW2(:) > 0.        
  WHERE ( GWORK2(:) ) KCTL(:) = JKP   ! cloud top level
  GWORK1(:) = GWORK2(:) .AND. GWORK4(:)
!
  IF ( COUNT( GWORK2(:) ) == 0 ) EXIT           
!
!
!*       9.   Compute CAPE for undilute ascent using theta_e and 
!             theta_es instead of theta_v. This estimation produces 
!             a significantly larger value for CAPE than the actual one.
!             ----------------------------------------------------------
!
  WHERE ( GWORK1(:) )
!
    ZWORK3(:)   = PZ(:,JKP) - PZ(:,JK) * ZWORK6(:) -                      &
                  ( 1. - ZWORK6(:) ) *  PZLCL(:)              ! level thickness
    ZWORK2(:)   = PTHES(:,JK) + ( 1. - ZWORK6(:) ) *                      &
     ( PTHES(:,JKP) - PTHES(:,JK) ) / ( PZ(:,JKP) - PZ(:,JK) ) *          &
     ( PZLCL(:) - PZ(:,JK) ) ! linear interpolation for theta_es at LCL
                            ! ( this is only done for model level just above LCL
!
    ZWORK1(:) = ( 2. * ZTHEUL(:) ) / ( ZWORK2(:) + PTHES(:,JKP) ) - 1.   
    PCAPE(:)  = PCAPE(:) + XG * ZWORK3(:) * MAX( 0., ZWORK1(:) )
!
!
!*       10.   Compute final values of updraft mass flux, enthalpy, r_w 
!              at level k+1    
!              --------------------------------------------------------
!    
    PUMF(:,JKP)  = PUMF(:,JK) - PUDR(:,JKP) + PUER(:,JKP) 
    PUMF(:,JKP)  = MAX( PUMF(:,JKP), 0.1 )
    PUTHL(:,JKP) = ( PUMF(:,JK) * PUTHL(:,JK) +                              &
                     PUER(:,JKP) * PTHL(:,JK) - PUDR(:,JKP) * PUTHL(:,JK) )  &
                    / PUMF(:,JKP) 
    PURW(:,JKP)  = ( PUMF(:,JK) * PURW(:,JK) +                               &
                     PUER(:,JKP) * PRW(:,JK) - PUDR(:,JKP) * PURW(:,JK) )    &
                    / PUMF(:,JKP) 
!    
!
    ZE1(:) = ZE2(:) ! update fractional entrainment/detrainment
    ZD1(:) = ZD2(:)
!
  END WHERE
!
END DO
!
!*       12.1    Set OTRIG to False if cloud thickness < 0.5km
!                or > 3km (deep convection) or CAPE < 1
!                ------------------------------------------------
!
    DO JI = 1, IIE
          JK  = KCTL(JI)
          ZWORK1(JI) = PZ(JI,JK) - PZLCL(JI)
          OTRIG(JI) = ZWORK1(JI) >= XCDEPTH  .AND. ZWORK1(JI) < 3.E3        &
                     .AND. PCAPE(JI) > 1. 
    END DO
    WHERE( .NOT. OTRIG(:) )
          KCTL(:) = IKB 
    END WHERE
KETL(:) = MAX( KETL(:), KLCL(:) + 2 )
KETL(:) = MIN( KETL(:), KCTL(:) )
!
!
!*       12.2    If the ETL and CTL are the same detrain updraft mass   
!                flux at this level
!                ------------------------------------------------------- 
!
ZWORK1(:) = 0.
WHERE ( KETL(:) == KCTL(:) ) ZWORK1(:) = 1.
!
DO JI = 1, IIE
    JK = KETL(JI) 
    PUDR(JI,JK)   = PUDR(JI,JK) +                                    &
                          ( PUMF(JI,JK) - PUER(JI,JK) )  * ZWORK1(JI)  
    PUER(JI,JK)   = PUER(JI,JK) * ( 1. - ZWORK1(JI) )
    PUMF(JI,JK)   = PUMF(JI,JK) * ( 1. - ZWORK1(JI) )
    JKP = KCTL(JI) + 1
    PUER(JI,JKP)  = 0. ! entrainm/detr rates have been already computed
    PUDR(JI,JKP)  = 0. ! at level KCTL+1, set them to zero
END DO
!    
!*       12.3    Adjust mass flux profiles, detrainment rates, and   
!                precipitation fallout rates to reflect linear decrease
!                in mass flux between the ETL and CTL
!                -------------------------------------------------------        
! 
ZWORK1(:) = 0.
JK1 = MINVAL( KETL(:) )
JK2 = MAXVAL( KCTL(:) )

DO JK = JK1, JK2
    DO JI = 1, IIE
    IF( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
        ZWORK1(JI) = ZWORK1(JI) + PDPRES(JI,JK)
    END IF
    END DO
END DO
!
DO JI = 1, IIE
    JK = KETL(JI) 
    ZWORK1(JI) = PUMF(JI,JK) / MAX( 1., ZWORK1(JI) )
END DO
!
DO JK = JK1 + 1, JK2
    JKP = JK - 1
    DO JI = 1, IIE
    IF ( JK > KETL(JI) .AND. JK <= KCTL(JI) ) THEN
        PUDR(JI,JK)  = PDPRES(JI,JK) * ZWORK1(JI)
        PUMF(JI,JK)  = PUMF(JI,JKP) - PUDR(JI,JK)
    END IF
    END DO
END DO
!
!         12.4   Set mass flux and entrainment in the source layer.
!                Linear increase throughout the source layer.
!                -------------------------------------------------------
!
!IWORK(:) = MIN( KPBL(:), KLCL(:) - 1 )
IWORK(:) = KPBL(:)
DO JI = 1, IIE
     JK  = KDPL(JI)
     JKP = IWORK(JI)
!          mixed layer depth
     ZWORK2(JI) = PPRES(JI,JK) - PPRES(JI,JKP) + PDPRES(JI,JK)
END DO
!
JKP = MAXVAL( IWORK(:) )
DO JK = JKM, JKP
   DO JI = 1, IIE
   IF ( JK >= KDPL(JI)  .AND. JK <= IWORK(JI) ) THEN
       PUER(JI,JK) = PUER(JI,JK) + PMFLCL(JI) * PDPRES(JI,JK) / ( ZWORK2(JI) + 0.1 )
       PUMF(JI,JK) = PUMF(JI,JK-1) + PUER(JI,JK)
   END IF
   END DO
END DO
!
!
!*       13.   If cloud thickness is smaller than  .5 km or > 3 km
!              no shallow convection is allowed
!              Nota: For technical reasons, we stop the convection
!                    computations in this case and do not go back to
!                    TRIGGER_FUNCT to look for the next unstable LCL
!                    which could produce a thicker cloud.
!              ---------------------------------------------------
!
GWORK6(:,:) = SPREAD( OTRIG(:), DIM=2, NCOPIES=KLEV )
WHERE ( .NOT. GWORK6(:,:) )
    PUMF(:,:)  = 0.
    PUDR(:,:)  = 0.
    PUER(:,:)  = 0.
    PUTHL(:,:) = PTHL(:,:)
    PURW(:,:)  = PRW(:,:)
    PURC(:,:)  = 0.
    PURI(:,:)  = 0.
END WHERE
!
END SUBROUTINE CONVECT_UPDRAFT_SHAL
!     ######spl
     SUBROUTINE CONVECT_CLOSURE_SHAL( KLON, KLEV,                                 &
                                      PPRES, PDPRES, PZ, PDXDY, PLMASS,           &
                                      PTHL, PTH, PRW, PRC, PRI, OTRIG1,           &
                                      PTHC, PRWC, PRCC, PRIC, PWSUB,              &
                                      KLCL, KDPL, KPBL, KCTL,                     &
                                      PUMF, PUER, PUDR, PUTHL, PURW,              &
                                      PURC, PURI, PCAPE, PTIMEC, KFTSTEPS         )
!    #######################################################################
!
!!**** Uses modified Fritsch-Chappell closure
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to determine the final adjusted 
!!     (over a time step PTIMEC) environmental values of THETA_l, R_w, R_c, R_i
!!      The final convective tendencies can then be evaluated in the main
!!      routine DEEP_CONVECT by (PTHC-PTH)/PTIMEC
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      
!!     
!!
!!    EXTERNAL
!!    --------
!!     
!!    CONVECT_CLOSURE_THRVLCL
!!    CONVECT_CLOSURE_ADJUST_SHAL
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!      Module MODD_CST
!!          XG                 ! gravity constant
!!          XP00               ! reference pressure
!!          XRD, XRV           ! gaz  constants for dry air and water vapor
!!          XCPD, XCPV         ! specific heat for dry air and water vapor
!!          XCL, XCI           ! specific heat for liquid water and ice
!!          XTT                ! triple point temperature
!!          XLVTT, XLSTT       ! vaporization, sublimation heat constant
!!
!!      Module MODD_CONVPAR_SHAL
!!          XA25               ! reference grid area
!!          XSTABT             ! stability factor in time integration 
!!          XSTABC             ! stability factor in CAPE adjustment
!!
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_CLOSURE)
!!      Fritsch and Chappell, 1980, J. Atmos. Sci.
!!      Kain and Fritsch, 1993, Meteor. Monographs, Vol.
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Peter Bechtold 15/11/96 change for enthalpie, r_c + r_i tendencies
!!      Tony Dore   14/10/96 Initialise local variables
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CST
USE MODD_CONVPAR_SHAL
USE MODD_CONVPAREXT
!
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
INTEGER,                   INTENT(IN) :: KLON   ! horizontal dimension
INTEGER,                   INTENT(IN) :: KLEV   ! vertical dimension
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KLCL   ! index lifting condens. level
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KCTL   ! index for cloud top level
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KDPL   ! index for departure level 
INTEGER, DIMENSION(KLON),  INTENT(IN) :: KPBL   ! index for top of source layer
REAL, DIMENSION(KLON),  INTENT(INOUT) :: PTIMEC ! convection time step 
REAL, DIMENSION(KLON),     INTENT(IN) :: PDXDY  ! grid area (m^2)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTHL   ! grid scale enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PTH    ! grid scale theta        
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRW    ! grid scale total water  
			                        ! mixing ratio 
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRC    ! grid scale r_c 
REAL, DIMENSION(KLON,KLEV),INTENT(IN) :: PRI    ! grid scale r_i 
LOGICAL, DIMENSION(KLON),  INTENT(IN) :: OTRIG1 ! logical to keep trace of 
                                                ! convective arrays modified in UPDRAFT
!   
!
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PPRES  ! pressure (P)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PDPRES ! pressure difference between 
                                                 ! bottom and top of layer (Pa)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PLMASS ! mass of model layer (kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN) :: PZ     ! height of model layer (m) 
REAL, DIMENSION(KLON),     INTENT(IN)  :: PCAPE  ! available potent. energy
INTEGER,                INTENT(OUT)   :: KFTSTEPS! maximum of fract time steps
                                                 ! only used for chemical tracers
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUMF  ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUER  ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT):: PUDR  ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PUTHL  ! updraft enthalpy (J/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PURW   ! updraft total water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PURC   ! updraft cloud water (kg/kg)
REAL, DIMENSION(KLON,KLEV), INTENT(IN)  :: PURI   ! updraft cloud ice   (kg/kg)
!
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PTHC  ! conv. adj. grid scale theta
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PRWC  ! conv. adj. grid scale r_w 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PRCC  ! conv. adj. grid scale r_c 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PRIC  ! conv. adj. grid scale r_i 
REAL, DIMENSION(KLON,KLEV), INTENT(OUT)  :: PWSUB ! envir. compensating subsidence(Pa/s)
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE  ! horizontal + vertical loop bounds
INTEGER :: IKS            ! vertical dimension
INTEGER :: JK, JKP, JKMAX ! vertical loop index
INTEGER :: JI             ! horizontal loop index
INTEGER :: JITER          ! iteration loop index
INTEGER :: JSTEP          ! fractional time loop index
REAL    :: ZCPORD, ZRDOCP ! C_pd / R_d, R_d / C_pd
REAL    :: ZCVOCD, ZEPSA  ! C_pv / C_pd, R_v / R_d
!
REAL, DIMENSION(KLON,KLEV) :: ZTHLC       ! convectively adjusted 
                                          ! grid scale enthalpy
REAL, DIMENSION(KLON,KLEV) :: ZOMG        ! conv. environm. subsidence (Pa/s)
REAL, DIMENSION(KLON,KLEV) :: ZUMF        ! non-adjusted updraft mass flux
REAL, DIMENSION(KLON,KLEV) :: ZUER        !   "     updraft  entrainm. rate
REAL, DIMENSION(KLON,KLEV) :: ZUDR        !   "     updraft  detrainm. rate
REAL, DIMENSION(KLON)     :: ZADJ         ! mass adjustment factor
REAL, DIMENSION(KLON)     :: ZADJMAX      ! limit value for ZADJ
REAL, DIMENSION(KLON)     :: ZCAPE        ! new CAPE after adjustment
REAL, DIMENSION(KLON)     :: ZTIMEC       ! fractional convective time step
REAL, DIMENSION(KLON,KLEV):: ZTIMC        ! 2D work array for ZTIMEC
!
REAL, DIMENSION(KLON)     :: ZTHLCL       ! new  theta at LCL
REAL, DIMENSION(KLON)     :: ZRVLCL       ! new  r_v at LCL
REAL, DIMENSION(KLON)     :: ZZLCL        ! height of LCL
REAL, DIMENSION(KLON)     :: ZTLCL        ! temperature at LCL
REAL, DIMENSION(KLON)     :: ZTELCL       ! envir. temper. at LCL
REAL, DIMENSION(KLON)     :: ZTHEUL       ! theta_e for undilute ascent
REAL, DIMENSION(KLON)     :: ZTHES1, ZTHES2! saturation environm. theta_e
REAL, DIMENSION(KLON,KLEV) :: ZTHMFIN, ZTHMFOUT, ZRWMFIN, ZRWMFOUT
REAL, DIMENSION(KLON,KLEV) :: ZRCMFIN, ZRCMFOUT, ZRIMFIN, ZRIMFOUT
                                    ! work arrays for environm. compensat. mass flux
REAL, DIMENSION(KLON)     :: ZPI          ! (P/P00)**R_d/C_pd 
REAL, DIMENSION(KLON)     :: ZLV          ! latent heat of vaporisation
REAL, DIMENSION(KLON)     :: ZLS          ! latent heat of sublimation 
REAL, DIMENSION(KLON)     :: ZCPH         ! specific heat C_ph
INTEGER, DIMENSION(KLON)  :: ITSTEP       ! fractional convective time step
INTEGER, DIMENSION(KLON)  :: ICOUNT       ! timestep counter 
INTEGER, DIMENSION(KLON)  :: ILCL         ! index lifting condens. level
INTEGER, DIMENSION(KLON)  :: IWORK1       ! work array
REAL, DIMENSION(KLON)     :: ZWORK1, ZWORK2, ZWORK3, ZWORK4, ZWORK5
LOGICAL, DIMENSION(KLON)  :: GWORK1, GWORK3! work arrays
LOGICAL, DIMENSION(KLON,KLEV) :: GWORK4    ! work array
!
!
!-------------------------------------------------------------------------------
!
!*       0.2    Initialize  local variables
!               ----------------------------
!
!
ZTIMC(:,:) = 0.
ZTHES2(:) = 0.
ZWORK1(:) = 0. 
ZWORK2(:) = 0. 
ZWORK3(:) = 0. 
ZWORK4(:) = 0. 
ZWORK5(:) = 0. 
GWORK1(:) = .FALSE.
GWORK3(:) = .FALSE.  
GWORK4(:,:) = .FALSE.  
ILCL(:)   = KLCL(:)
!
ZCPORD    = XCPD / XRD
ZRDOCP    = XRD / XCPD
ZCVOCD    = XCPV / XCPD 
ZEPSA     = XRV / XRD
!
ZADJ(:)   = 1.
ZWORK5(:) = 1.
WHERE( .NOT. OTRIG1(:) ) ZWORK5(:) = 0. 
!
!
!*       0.3   Compute loop bounds
!              ------------------- 
!
IIE    = KLON
IKB    = 1 + JCVEXB 
IKS    = KLEV
IKE    = KLEV - JCVEXT 
JKMAX  = MAXVAL( KCTL(:) )
!
!
!*       2.     Save initial mass flux values to be used in adjustment procedure
!               ---------------------------------------------------------------
!
ZUMF(:,:)  = PUMF(:,:)
ZUER(:,:)  = PUER(:,:)
ZUDR(:,:)  = PUDR(:,:)
ZOMG(:,:)  = 0.
PWSUB(:,:) = 0. 
!
!
!*       3.     Compute limits on the closure adjustment factor so that the
!               inflow in convective drafts from a given layer can't be larger 
!               than the mass contained in this layer initially.
!               ---------------------------------------------------------------
!
ZADJMAX(:) = 1000.
IWORK1(:) = ILCL(:)
JKP = MINVAL( KDPL(:) )
DO JK = JKP, IKE
  DO JI = 1, IIE
    IF( JK > KDPL(JI) .AND. JK <= IWORK1(JI) ) THEN
        ZWORK1(JI)  = PLMASS(JI,JK) / ( ( PUER(JI,JK) + 1.E-5 ) * PTIMEC(JI) )
        ZADJMAX(JI) = MIN( ZADJMAX(JI), ZWORK1(JI) )
    END IF
  END DO
END DO
!
!
GWORK1(:) = OTRIG1(:)  ! logical array to limit adjustment to not definitively
                       ! adjusted columns
!
DO JK = IKB, IKE
  ZTHLC(:,JK) = PTHL(:,JK) ! initialize adjusted envir. values 
  PRWC(:,JK)  = PRW(:,JK)
  PRCC(:,JK)  = PRC(:,JK)
  PRIC(:,JK)  = PRI(:,JK)
  PTHC(:,JK)  = PTH(:,JK)
END DO
!
!
!
DO JITER = 1, 7  ! Enter adjustment loop to assure that all CAPE is
                 ! removed within the advective time interval TIMEC
!
     ZTIMEC(:) = PTIMEC(:)
     GWORK4(:,:)   = SPREAD( GWORK1(:), DIM=2, NCOPIES=IKS )
     WHERE( GWORK4(:,:) ) PWSUB(:,:) = 0.
     ZOMG(:,:)=0.
!
     DO JK = IKB + 1, JKMAX 
           JKP = MAX( IKB + 1, JK - 1 )
           WHERE ( GWORK1(:) .AND. JK <= KCTL(:) )
!
!
!*       4.     Determine vertical velocity at top and bottom of each layer
!               to satisfy mass continuity.
!               ---------------------------------------------------------------
              ! we compute here Domega/Dp = - g rho Dw/Dz = 1/Dt
!
             ZWORK1(:)   = - ( PUER(:,JKP) - PUDR(:,JKP) ) / PLMASS(:,JKP)
!    
             PWSUB(:,JK) = PWSUB(:,JKP) - PDPRES(:,JK-1) * ZWORK1(:)
              ! we use PDPRES(JK-1) and not JKP in order to have zero subsidence
              ! at the first layer
!
!   
!*       5.     Compute fractional time step. For stability or 
!               mass conservation reasons one must split full time step PTIMEC)
!               ---------------------------------------------------------------
!
             ZWORK1(:) = XSTABT * PDPRES(:,JKP) / ( ABS( PWSUB(:,JK) ) + 1.E-10 )
              ! the factor XSTABT is used for stability reasons
             ZTIMEC(:) = MIN( ZTIMEC(:), ZWORK1(:) ) 
!
              ! transform vertical velocity in mass flux units
             ZOMG(:,JK) = PWSUB(:,JK) * PDXDY(:) / XG 
         END WHERE
     END DO
!
!
     WHERE( GWORK4(:,:) )
           ZTHLC(:,:) = PTHL(:,:) ! reinitialize adjusted envir. values 
           PRWC(:,:)  = PRW(:,:)  ! when iteration criterium not attained
           PRCC(:,:)  = PRC(:,:)
           PRIC(:,:)  = PRI(:,:)
           PTHC(:,:)  = PTH(:,:)
     END WHERE
!
! 
!        6. Check for mass conservation, i.e. ZWORK1 > 1.E-2
!           If mass is not conserved, the convective tendencies
!           automatically become zero.
!           ----------------------------------------------------
!
    DO JI = 1, IIE
       JK=KCTL(JI)
       ZWORK1(JI) = PUDR(JI,JK) * PDPRES(JI,JK) / ( PLMASS(JI,JK) + .1 )    &
                                                            - PWSUB(JI,JK)
    END DO
    WHERE( GWORK1(:) .AND. ABS( ZWORK1(:) ) - .01 > 0. )
        GWORK1(:) = .FALSE.
        PTIMEC(:) = 1.E-1
        ZWORK5(:) = 0.
    END WHERE
    DO JK = IKB, IKE
        PWSUB(:,JK) = PWSUB(:,JK) * ZWORK5(:)
    END DO
    GWORK4(:,1:IKB) = .FALSE.
    GWORK4(:,IKS)   = .FALSE.
!
    ITSTEP(:) = INT( PTIMEC(:) / ZTIMEC(:) ) + 1 
    ZTIMEC(:) = PTIMEC(:) / REAL( ITSTEP(:) ) ! adjust  fractional time step
                                           ! to be an integer multiple of PTIMEC
    ZTIMC(:,:)= SPREAD( ZTIMEC(:), DIM=2, NCOPIES=IKS )
    ICOUNT(:) = 0
!
!
!
    KFTSTEPS = MAXVAL( ITSTEP(:) )
    DO JSTEP = 1, KFTSTEPS ! Enter the fractional time step loop here
!
     	 ICOUNT(:) = ICOUNT(:) + 1
!
	     GWORK3(:) =  ITSTEP(:) >= ICOUNT(:) .AND. GWORK1(:) 
!
!
!*       7.     Assign enthalpy and r_w values at the top and bottom of each
!               layer based on the sign of w
!               ------------------------------------------------------------
!
             ZTHMFIN(:,:)   = 0.
             ZRWMFIN(:,:)   = 0.
             ZRCMFIN(:,:)   = 0.
             ZRIMFIN(:,:)   = 0.
             ZTHMFOUT(:,:)  = 0.
             ZRWMFOUT(:,:)  = 0.
             ZRCMFOUT(:,:)  = 0.
             ZRIMFOUT(:,:)  = 0.
!
         DO JK = IKB + 1, JKMAX
         GWORK4(:,JK) = GWORK3(:) .AND. JK <= KCTL(:)
         JKP = MAX( IKB + 1, JK - 1 )
           DO JI = 1, IIE
           IF ( GWORK3(JI) ) THEN
!
               ZWORK1(JI)       = SIGN( 1., ZOMG(JI,JK) )
               ZWORK2(JI)       = 0.5 * ( 1. + ZWORK1(JI) )
               ZWORK1(JI)       = 0.5 * ( 1. - ZWORK1(JI) )
               ZTHMFIN(JI,JK)   = - ZOMG(JI,JK) * ZTHLC(JI,JKP) * ZWORK1(JI)
               ZTHMFOUT(JI,JK)  =   ZOMG(JI,JK) * ZTHLC(JI,JK)  * ZWORK2(JI)
               ZTHMFIN(JI,JKP)  = ZTHMFIN(JI,JKP)  + ZTHMFOUT(JI,JK) * ZWORK2(JI)
               ZTHMFOUT(JI,JKP) = ZTHMFOUT(JI,JKP) + ZTHMFIN(JI,JK)  * ZWORK1(JI)
               ZRWMFIN(JI,JK)   = - ZOMG(JI,JK) * PRWC(JI,JKP) * ZWORK1(JI)
               ZRWMFOUT(JI,JK)  =   ZOMG(JI,JK) * PRWC(JI,JK)  * ZWORK2(JI)
               ZRWMFIN(JI,JKP)  = ZRWMFIN(JI,JKP)  + ZRWMFOUT(JI,JK) * ZWORK2(JI)
               ZRWMFOUT(JI,JKP) = ZRWMFOUT(JI,JKP) + ZRWMFIN(JI,JK)  * ZWORK1(JI)
               ZRCMFIN(JI,JK)   = - ZOMG(JI,JK) * PRCC(JI,JKP) * ZWORK1(JI)
               ZRCMFOUT(JI,JK)  =   ZOMG(JI,JK) * PRCC(JI,JK)  * ZWORK2(JI)
               ZRCMFIN(JI,JKP)  = ZRCMFIN(JI,JKP)  + ZRCMFOUT(JI,JK) * ZWORK2(JI)
               ZRCMFOUT(JI,JKP) = ZRCMFOUT(JI,JKP) + ZRCMFIN(JI,JK)  * ZWORK1(JI)
               ZRIMFIN(JI,JK)   = - ZOMG(JI,JK) * PRIC(JI,JKP) * ZWORK1(JI)
               ZRIMFOUT(JI,JK)  =   ZOMG(JI,JK) * PRIC(JI,JK)  * ZWORK2(JI)
               ZRIMFIN(JI,JKP)  = ZRIMFIN(JI,JKP)  + ZRIMFOUT(JI,JK) * ZWORK2(JI)
               ZRIMFOUT(JI,JKP) = ZRIMFOUT(JI,JKP) + ZRIMFIN(JI,JK)  * ZWORK1(JI)
!
           END IF
           END DO
         END DO
!
         WHERE ( GWORK4(:,:) )
!
!******************************************************************************
!
!*       8.     Update the environmental values of enthalpy and r_w at each level
!               NOTA: These are the MAIN EQUATIONS of the scheme
!               -----------------------------------------------------------------
!
!
           ZTHLC(:,:) = ZTHLC(:,:) + ZTIMC(:,:) / PLMASS(:,:) * (      &
                          ZTHMFIN(:,:) + PUDR(:,:) * PUTHL(:,:)        &
                      - ZTHMFOUT(:,:) - PUER(:,:) * PTHL(:,:)   )
           PRWC(:,:)  = PRWC(:,:) + ZTIMC(:,:) / PLMASS(:,:) *  (      &
                          ZRWMFIN(:,:) + PUDR(:,:) * PURW(:,:)          &
                      - ZRWMFOUT(:,:) - PUER(:,:) * PRW(:,:)    )    
           PRCC(:,:)  = PRCC(:,:) + ZTIMC(:,:) / PLMASS(:,:) *  (      &
               ZRCMFIN(:,:) + PUDR(:,:) * PURC(:,:) - ZRCMFOUT(:,:) -  &
                         PUER(:,:) * PRC(:,:)    )    
           PRIC(:,:)  = PRIC(:,:) + ZTIMC(:,:) / PLMASS(:,:) *  (      &
               ZRIMFIN(:,:) + PUDR(:,:) * PURI(:,:) - ZRIMFOUT(:,:) -  & 
                         PUER(:,:) * PRI(:,:)    )    
!
!
!******************************************************************************
!
         END WHERE
!
    END DO ! Exit the fractional time step loop
!
! 
!*          10.    Compute final linearized value of theta envir.
!                  ----------------------------------------------
!
      DO JK = IKB + 1, JKMAX
         DO JI = 1, IIE
         IF( GWORK1(JI) .AND. JK <= KCTL(JI) ) THEN
           ZPI(JI)    = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
           ZCPH(JI)   = XCPD + PRWC(JI,JK) * XCPV
           ZWORK2(JI) = PTH(JI,JK) / ZPI(JI)  ! first temperature estimate
           ZLV(JI)    = XLVTT + ( XCPV - XCL ) * ( ZWORK2(JI) - XTT )
           ZLS(JI)    = XLVTT + ( XCPV - XCI ) * ( ZWORK2(JI) - XTT )
             ! final linearized temperature
           ZWORK2(JI) = ( ZTHLC(JI,JK) + ZLV(JI) * PRCC(JI,JK) + ZLS(JI) * PRIC(JI,JK) &
                       - (1. + PRWC(JI,JK) ) * XG * PZ(JI,JK) ) / ZCPH(JI)
           ZWORK2(JI) = MAX( 180., MIN( 340., ZWORK2(JI) ) )
           PTHC(JI,JK)= ZWORK2(JI) * ZPI(JI) ! final adjusted envir. theta
         END IF
         END DO
      END DO
!
!
!*         11.     Compute new cloud ( properties at new LCL )
!                     NOTA: The computations are very close to
!                           that in routine TRIGGER_FUNCT
!                  ---------------------------------------------
!
      CALL CONVECT_CLOSURE_THRVLCL(  KLON, KLEV,                           &
                                     PPRES, PTHC, PRWC, PZ, GWORK1,        &
                                     ZTHLCL, ZRVLCL, ZZLCL, ZTLCL, ZTELCL, &
                                     ILCL, KDPL, KPBL )
!
!
       ZTLCL(:)  = MAX( 230., MIN( 335., ZTLCL(:) ) )  ! set some overflow bounds
       ZTELCL(:) = MAX( 230., MIN( 335., ZTELCL(:) ) )
       ZTHLCL(:) = MAX( 230., MIN( 345., ZTHLCL(:) ) )
       ZRVLCL(:) = MAX(   0., MIN(   1., ZRVLCL(:) ) )
!
!
!*         12.    Compute adjusted CAPE
!                 ---------------------
!
       ZCAPE(:)  = 0.
       ZPI(:)    = ZTHLCL(:) / ZTLCL(:)
       ZPI(:)    = MAX( 0.95, MIN( 1.5, ZPI(:) ) )
       ZWORK1(:) = XP00 / ZPI(:) ** ZCPORD ! pressure at LCL
!
       CALL CONVECT_SATMIXRATIO( KLON, ZWORK1, ZTELCL, ZWORK3, ZLV, ZLS, ZCPH )
       ZWORK3(:) = MIN(   .1, MAX(   0., ZWORK3(:) ) )
!
	        ! compute theta_e updraft undilute
       ZTHEUL(:) = ZTLCL(:) * ZPI(:) ** ( 1. - 0.28 * ZRVLCL(:) )            &
                                  * EXP( ( 3374.6525 / ZTLCL(:) - 2.5403 )   &
                                  * ZRVLCL(:) * ( 1. + 0.81 * ZRVLCL(:) ) )
!
	        ! compute theta_e saturated environment at LCL
       ZTHES1(:) = ZTELCL(:) * ZPI(:) ** ( 1. - 0.28 * ZWORK3(:) )           &
                                  * EXP( ( 3374.6525 / ZTELCL(:) - 2.5403 )  &
                                  * ZWORK3(:) * ( 1. + 0.81 * ZWORK3(:) ) )
!
      DO JK = MINVAL( ILCL(:) ), JKMAX
        JKP = JK - 1
        DO JI = 1, IIE
          ZWORK4(JI) = 1.
          IF ( JK == ILCL(JI) ) ZWORK4(JI) = 0.
!
           ! compute theta_e saturated environment and adjusted values
           ! of theta
!
          GWORK3(JI)  = JK >= ILCL(JI) .AND. JK <= KCTL(JI) .AND. GWORK1(JI) 
!
          ZPI(JI)     = ( XP00 / PPRES(JI,JK) ) ** ZRDOCP
          ZWORK2(JI)  = PTHC(JI,JK) / ZPI(JI)
        END DO
!
        CALL CONVECT_SATMIXRATIO( KLON, PPRES(:,JK), ZWORK2, ZWORK3, ZLV, ZLS, ZCPH )
!
!
        DO JI = 1, IIE
          IF ( GWORK3(JI) ) THEN
              ZTHES2(JI)  = ZWORK2(JI) * ZPI(JI) ** ( 1. - 0.28 * ZWORK3(JI) )   &
                                   * EXP( ( 3374.6525 / ZWORK2(JI) - 2.5403 ) &
                                   * ZWORK3(JI) * ( 1. + 0.81 * ZWORK3(JI) ) )
!
              ZWORK3(JI)  = PZ(JI,JK) - PZ(JI,JKP) * ZWORK4(JI) -                &
                           ( 1. - ZWORK4(JI) ) * ZZLCL(JI)    ! level thickness
              ZWORK1(JI)  = ( 2. * ZTHEUL(JI) ) / ( ZTHES1(JI) + ZTHES2(JI) ) - 1.
              ZCAPE(JI)   = ZCAPE(JI) + XG * ZWORK3(JI) * MAX( 0., ZWORK1(JI) )
              ZTHES1(JI)  = ZTHES2(JI)
          END IF
        END DO
      END DO
!
!                                                          
!*         13.     Determine mass adjustment factor knowing how much
!                  CAPE has been removed.
!                  -------------------------------------------------
!
       WHERE ( GWORK1(:) )
           ZWORK1(:) = MAX( PCAPE(:) - ZCAPE(:), 0.1 * PCAPE(:) )
           ZWORK2(:) = ZCAPE(:) / ( PCAPE(:) + 1.E-8 )
!       
           GWORK1(:) = ZWORK2(:) > 0.1 .OR. ZCAPE(:) == 0. ! mask for adjustment
       END WHERE
!
       WHERE ( ZCAPE(:) == 0. .AND. GWORK1(:) )  ZADJ(:) = ZADJ(:) * 0.5
       WHERE ( ZCAPE(:) /= 0. .AND. GWORK1(:) )                              &
               ZADJ(:) = ZADJ(:) * XSTABC * PCAPE(:) / ( ZWORK1(:) + 1.E-8 )
       ZADJ(:) = MIN( ZADJ(:), ZADJMAX(:) )  
!
!
!*         13.     Adjust mass flux by the factor ZADJ to converge to
!                  specified degree of stabilization
!                 ----------------------------------------------------
!
       CALL CONVECT_CLOSURE_ADJUST_SHAL( KLON, KLEV, ZADJ,                     &
                                         PUMF, ZUMF, PUER, ZUER, PUDR, ZUDR    )
!
!
      IF ( COUNT( GWORK1(:) ) == 0 ) EXIT ! exit big adjustment iteration loop
                                          ! when all columns have reached 
                                          ! desired degree of stabilization.
!
END DO  ! end of big adjustment iteration loop
!
!
        ! skip adj. total water array  to water vapor
DO JK = IKB, IKE
   PRWC(:,JK) = MAX( 0., PRWC(:,JK) - PRCC(:,JK) - PRIC(:,JK) )
END DO
!
!
END SUBROUTINE CONVECT_CLOSURE_SHAL
!     ######spl
     SUBROUTINE CONVECT_CLOSURE_ADJUST_SHAL( KLON, KLEV, PADJ,                      &
                                             PUMF, PZUMF, PUER, PZUER, PUDR, PZUDR  )
!    #########################################################################
!
!!**** Uses closure adjustment factor to adjust mass flux and to modify
!!     precipitation efficiency  when necessary. The computations are
!!     similar to routine CONVECT_PRECIP_ADJUST.
!!
!!
!!    PURPOSE
!!    -------
!!      The purpose of this routine is to adjust the mass flux using the
!!      factor PADJ computed in CONVECT_CLOSURE
!!
!!
!!**  METHOD
!!    ------
!!      Computations are done at every model level starting from bottom.
!!      The use of masks allows to optimise the inner loops (horizontal loops).
!!      
!!
!!    EXTERNAL
!!    --------
!!     Module MODD_CONVPAREXT
!!          JCVEXB, JCVEXT     ! extra levels on the vertical boundaries
!!     
!!    None
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    None
!!
!!    REFERENCE
!!    ---------
!!
!!      Book1,2 of documentation ( routine CONVECT_CLOSURE_ADJUST)
!!
!!    AUTHOR
!!    ------
!!      P. BECHTOLD       * Laboratoire d'Aerologie *
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    26/03/96 
!!   Last modified  15/11/96
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
USE MODD_CONVPAREXT
!
IMPLICIT NONE
!
!*       0.1   Declarations of dummy arguments :
!
!
INTEGER,                    INTENT(IN) :: KLON     ! horizontal dimension
INTEGER,                    INTENT(IN) :: KLEV     ! vertical dimension
REAL, DIMENSION(KLON),      INTENT(IN) :: PADJ     ! mass adjustment factor
!
!
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUMF  ! updraft mass flux (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUMF ! initial value of  "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUER  ! updraft entrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUER ! initial value of  "
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PUDR  ! updraft detrainment (kg/s)
REAL, DIMENSION(KLON,KLEV), INTENT(INOUT) :: PZUDR ! initial value of  "
!
!
!*       0.2   Declarations of local variables :
!
INTEGER :: IIE, IKB, IKE                 ! horiz. + vert. loop bounds
INTEGER :: JK                            ! vertical loop index
!
!
!-------------------------------------------------------------------------------
!
!*       0.3   Compute loop bounds
!              -------------------
!
IIE  = KLON
IKB  = 1 + JCVEXB 
IKE  = KLEV - JCVEXT
!
!
!*       1.     Adjust mass flux by the factor PADJ to converge to
!               specified degree of stabilization
!               ----------------------------------------------------
!
     DO JK = IKB + 1, IKE
	  PUMF(:,JK)  = PZUMF(:,JK)   * PADJ(:)
          PUER(:,JK)  = PZUER(:,JK)   * PADJ(:)
          PUDR(:,JK)  = PZUDR(:,JK)   * PADJ(:)
     END DO
!
END SUBROUTINE CONVECT_CLOSURE_ADJUST_SHAL
