!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACUPU( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
! ----------------------------------------------------------------------
! - INPUT  2D .
                &PUDAL,PUNEBH,PDETFI,&
                &PFCCQL,PFCCQN,PFCSQL,PFCSQN, &
! - OUTPUT  1D .
                &PSIGP, PSIGPC,&
! - INPUT/OUTPUT  2D .
                &PNEBE,&
! - LOCK ARGUMENTS .
                &CDLOCK)
! **** *ACUPU * - UPDATE INTERNAL STATE AFTER UPDRAUGHT
! **   Interface.
!      ----------
! *CALL* *ACUPU*
! ----------------------------------------------------------------------
! - INPUT ARGUMENTS
! -------------------

! - DIMENSIONING PARAMETERS FOR PHYSICS

! KIDIA      : INDICE DE DEPART DES BOUCLES VECTORISEES SUR L'HORIZONT..
! KFDIA      : INDICE DE FIN DES BOUCLES VECTORISEES SUR L'HORIZONTALE.
! KLON       : DIMENSION HORIZONTALE DES TABLEAUX.
! KTDIA      : INDICE DE DEPART DES BOUCLES VERTICALES (NIVEL DU SOMMET
!            : DU NUAGE).
! KLEV       : DIMENSION VERTICALE DES TABLEAUX "FULL LEVEL".


! - PHYSICAL VARIABLES

! - 2D (1:KLEV) .
! PUDAL:  prognostic updraught mesh fraction
! 
! - 2D FLUXES (0:KLEV) .
! PFCCQL
! PFCCQN
! PFCSQL
! PFCSQN

! ----------------------------------------------------------------------
! -   OUTPUT ARGUMENTS (I/O because initialized to zero in aplpar)
!     ----------------
! - 1D
! PSIGP     : PRECIPITATION MESH FRACTION
! PSIGPC    : CONVECTIVE FRACTION OF THE PRECIPITATION FLUX
! - 2D
! ----------------------------------------------------------------------
! -   INPUT/OUTPUT ARGUMENTS (I/O because update here)
!     ----------------------
! - 2D (1:KLEV)
! PUNEBH : pseudo-historic detrainment mesh fraction
! PDETFI : instantaneous detrainment mesh fraction
! PNEBE  : input=strat cloud fraction, output=equiv cloud fraction.
! 
! - 2D FLUXES (0:KLEV)
! ----------------------------------------------------------------------
!     Author.
!     -------
!     01-2007, L. Gerard 

!     Modifications.
!     --------------
!     04-2007, L. Gerard 
! ----------------------------------------------------------------------

USE PARKIND1 , ONLY: JPIM, JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMPHY0  , ONLY : GRRMINA, GCVTAUDE
USE YOMPHY2  , ONLY : TSPHY


IMPLICIT NONE

! ----------------------------------------------------------------------
! SUBROUTINE ARGUMENTS
INTEGER(KIND=JPIM), INTENT(IN) :: KFDIA
INTEGER(KIND=JPIM), INTENT(IN) :: KIDIA
INTEGER(KIND=JPIM), INTENT(IN) :: KLEV
INTEGER(KIND=JPIM), INTENT(IN) :: KLON
INTEGER(KIND=JPIM), INTENT(IN) :: KTDIA

CHARACTER(LEN=5), INTENT(IN)   :: CDLOCK

REAL(KIND=JPRB) ,INTENT(IN) :: PUDAL(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PFCCQL(KLON,0:KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PFCCQN(KLON,0:KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PFCSQL(KLON,0:KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PFCSQN(KLON,0:KLEV)
! - OUTPUT  1D .
REAL(KIND=JPRB) ,INTENT(OUT) :: PSIGP(KLON)
REAL(KIND=JPRB) ,INTENT(OUT) :: PSIGPC(KLON)
! - INPUT/OUTPUT  2D .
REAL(KIND=JPRB) ,INTENT(IN)  :: PUNEBH(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN)  :: PDETFI(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(INOUT) :: PNEBE(KLON,KLEV)

!     LOCAL LOGICAL SCALARS

LOGICAL :: LLNEBINS
! ----------------------------------------------------------------------
! LOCALS
INTEGER (KIND=JPIM) :: JLEV, JLON
REAL (KIND=JPRB) :: ZPX(KLON), ZCC1(KLON), ZCS1(KLON)
REAL(KIND=JPRB)  :: ZEPS0, ZFRCO, ZNEBC,ZNEI,ZNEQ,&
                 &  ZZ,ZZ1,ZZ2, ZCC,ZCS,ZNC,ZNT
 REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ----------------------------------------------------------------------
#include "abor1.intfb.h"
! ----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ACUPU',0,ZHOOK_HANDLE)

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

IF(CDLOCK /= 'ACUPU') THEN
  WRITE(0,*) 'CDLOCK=',CDLOCK
  CALL ABOR1('ACUPU BAD NUMBER OF ARGUMENTS!')
ENDIF

! *
! ------------------------------------------------------------------
!     I - INITIALISATIONS

ZEPS0=1.E-12_JPRB

LLNEBINS=.TRUE.

! ------------------------------------------------------------------
!    II - CALCULATIONS

ZPX=0.0_JPRB
PSIGP(KIDIA:KFDIA)=1.0_JPRB
ZCC1=0.0_JPRB
ZCS1=0.0_JPRB
DO JLEV=KTDIA,KLEV
 DO JLON=KIDIA,KFDIA

! EVALUATION of the Mean Grid Box CONVECTIVE fraction of condensate
!         based on the ratio of *local* CONDENSATION
! ZFRCO = Convective fraction of the condensate at each level

   ZZ=MAX(0.0_JPRB, 1.0_JPRB-PUDAL(JLON,JLEV))
! MIN UD ENVT over vertical
   PSIGP(JLON)=MIN(PSIGP(JLON),ZZ)
! Micro-physical (Current time step)  ZNEBC:

   IF (LLNEBINS) THEN
     ZNEBC=PDETFI(JLON,JLEV)+PUDAL(JLON,JLEV)
   ELSE
     ZNEBC=PUNEBH(JLON,JLEV)+PUDAL(JLON,JLEV)
   ENDIF

   ZCC= PFCCQL(JLON,JLEV)+PFCCQN(JLON,JLEV)
   ZCS= PFCSQL(JLON,JLEV)+PFCSQN(JLON,JLEV)
   ZNC=MAX(0.0_JPRB,ZCC-ZCC1(JLON))
   ZNT=ZNC+MAX(0.0_JPRB,ZCS-ZCS1(JLON))
   ZCC1(JLON)=ZCC
   ZCS1(JLON)=ZCS
   ! The convective fraction is reset to zero 
   ! also if ZNEBC is too small
   ZZ2=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZNT-ZEPS0))&
         & *MAX(0.0_JPRB,SIGN(1.0_JPRB,ZNEBC-GRRMINA))
   ZFRCO=ZZ2*ZNC/(ZNT+(1.0_JPRB-ZZ2))


!    COMPUTE REDUCED CLOUD FRACTIONS 
!    -------------------------------
! such that their sum is the (updated) total cloudiness
!--------------
! nc+ns
      ZZ1=ZNEBC+PNEBE(JLON,JLEV)
! n_tot=nc+ns-nc*ns
      ZZ2=ZZ1-ZNEBC*PNEBE(JLON,JLEV)
! STORE THE MAXIMUM CLOUD and MIN ud envt OVER VERTICAL
      ZPX(JLON)=MAX(ZPX(JLON),ZZ2)

      ZZ=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZZ1-GRRMINA))
! nc'=nc*ntot/(nc+ns)  or zero if (nc+ns)<1E-5
      ZNEBC=ZZ*ZNEBC*ZZ2/(ZZ1+(1.0_JPRB-ZZ))
! ns'=ns*ntot/(nc+ns)  or zero if (nc+ns)<1E-5
      PNEBE(JLON,JLEV)=ZZ*PNEBE(JLON,JLEV)*ZZ2/(ZZ1+(1.0_JPRB-ZZ))

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

! ne: equivalent cloud fraction for microphysics
!                (based on nc', ns' and zfrco)
!          1/ne= (1-ZFRCO)^2/ns' + ZFRCO^2/nc'
! if n's or n'c too small, use the bigger of them
      ZZ1=MAX(0.0_JPRB,SIGN(1.0_JPRB,PNEBE(JLON,JLEV)-GRRMINA))
      ZZ2=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZNEBC-GRRMINA))
! case when ns' or nc' or both are too small: the smaller one or zero
      ZNEQ=ZZ1*(1.0_JPRB-ZZ2)*PNEBE(JLON,JLEV)&
          &+ZZ2*(1.0_JPRB-ZZ1)*ZNEBC
! case when both nc' and ns' are big enough: combine them
      ZZ=(1.0_JPRB-ZFRCO)
! 1/ne is then (if zz1=0=zz2)
      ZNEI= ZZ*ZZ/(PNEBE(JLON,JLEV)+(1.0_JPRB-ZZ1))&
          &+ZFRCO*ZFRCO/(ZNEBC+(1.0_JPRB-ZZ2)) 
!   \--> this must be greater than 1 !
! Put the result ne (equiv cloud fraction) in PNEBE
      PNEBE(JLON,JLEV)=ZNEQ + ZZ1*ZZ2/MAX(0.0_JPRB,ZNEI)
 ENDDO
ENDDO
DO JLON=KIDIA, KFDIA
   ZZ= MAX(0.0_JPRB, PFCCQL(JLON,KLEV)+PFCCQN(JLON,KLEV))
   ZZ1=ZZ+MAX(0.0_JPRB, PFCSQL(JLON,KLEV)+PFCSQN(JLON,KLEV))
   ZZ2=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZZ1-ZEPS0))
   PSIGPC(JLON)=ZZ2*ZZ/(MAX(ZZ1,ZEPS0))
! Precipitation area available for dd:
   PSIGP(JLON)=MIN(PSIGP(JLON), ZPX(JLON))
ENDDO


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

