!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACUPD( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
! ----------------------------------------------------------------------
! - INPUT  2D .
                &PAPRSF,PCP, PLHS, PLHV, PR,&
                &PIPOI, PPOID, PFALLR, PFALLS, &
                &PQU, PTU, PUDAL,&
! - INPUT/OUTPUT  2D .
                &PQV,PT, &
                &PFPLSL, PFPLSN, PFPEVPCL,PFPEVPCN,&
! - LOCK ARGUMENTS .
                &CDLOCK)
! **** *ACUPD * - UPDATE INTERNAL STATE AFTER DOWNDRAUGHT
! **   Interface.
!      ----------
! *CALL* *ACUPD*
! ----------------------------------------------------------------------
! - 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) .
! PAPRSF    : Pressure at full levels
! PCP       : Mean grid box specific heat cp
! PLHS      : Sublimation latent heat
! PLHV      : Vaporization latent heat
! PR        : Mean grid box perfect gas constant
! PIPOI     : g*dt/delta p
! PPOID     : delta p/g*dt
! PFALLR    : Rain fall velocity
! PFALLS    : Snow fall velocity
! PUDAL     : Updraught mesh fraction
! PQU       : Updraught water vapour
! PTU       : Updraught temperature
! 
! - 2D FLUXES (0:KLEV) .

! ----------------------------------------------------------------------
! -   OUTPUT ARGUMENTS (I/O because initialized to zero in aplpar)
!     ----------------
! - 1D
! ----------------------------------------------------------------------
! -   INPUT/OUTPUT ARGUMENTS (I/O because update here)
!     ----------------------
! - 2D (1:KLEV)
! PQV Water vapour specific content
! PT  Temperature
! 
! - 2D FLUXES (0:KLEV)
! PFPLSL Total liquid precipitation
! PFPLSN Total solid precipitation
! PFPEVPCL Liquid precipitation evaporation in DD
! PFPEVPCN Solid precipitation evaporation in DD
! ----------------------------------------------------------------------
!     Author.
!     -------
!     01-2007, L. Gerard 

!     Modifications.
!     --------------
!        2007  J.F. Geleyn, A posteriori Sedimentation
!     04-2007, L. Gerard , revision of LUDEN concept
!        A.Bogatchev : 26-Oct-2007 removing of severe breaks of coding rools 
! ----------------------------------------------------------------------

USE PARKIND1 , ONLY: JPIM, JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
USE YOMPHY   , ONLY : LUDEN
USE YOMPHY0  , ONLY : GCVALMX
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) :: PAPRSF(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PCP(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PLHS(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PLHV(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PR(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PIPOI(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PPOID(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PFALLR(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PFALLS(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PQU(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PTU(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(IN) :: PUDAL(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(INOUT) :: PQV(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(INOUT) :: PT(KLON,KLEV)
REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLSL(KLON,0:KLEV)
REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPLSN(KLON,0:KLEV)
REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPCL(KLON,0:KLEV)
REAL(KIND=JPRB) ,INTENT(INOUT) :: PFPEVPCN(KLON,0:KLEV)

! ----------------------------------------------------------------------
! LOCALS
INTEGER (KIND=JPIM) :: JLEV, JLON
REAL(KIND=JPRB) :: ZEPS1, ZRHOAIR, ZSTAL0, ZSTAL1, ZSTAL2,&
                &  ZSTAN0, ZSTAN1, ZSTAN2, &
                &  ZUDAL, ZZ, ZZSLS, ZZSNS
REAL(KIND=JPRB) :: ZFPLSL(KLON,0:KLEV), ZFPLSN(KLON,0:KLEV), &
                &  ZSTAL3(KLON), ZSTAN3(KLON)
LOGICAL :: LLSTASED, LLLAGSED
REAL(KIND=JPRB) :: ZHOOK_HANDLE
! ----------------------------------------------------------------------
#include "abor1.intfb.h"
! ----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ACUPD',0,ZHOOK_HANDLE)

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

LLSTASED=.TRUE.
LLLAGSED=.FALSE.
ZEPS1=1.E-10_JPRB

! ------------------------------------------------------------------
!    II - CALCULATIONS
IF (LUDEN) THEN
 DO JLEV=KTDIA,KLEV
 DO JLON=KIDIA,KFDIA
    ZUDAL=MIN(PUDAL(JLON,JLEV),GCVALMX)
    ZZ=1.0_JPRB-ZUDAL
    PQV(JLON,JLEV)=ZUDAL*PQU(JLON,JLEV)+ZZ*PQV(JLON,JLEV)
    PT(JLON,JLEV)=ZUDAL*PTU(JLON,JLEV)+ZZ*PT(JLON,JLEV)
 ENDDO
 ENDDO
ENDIF

! SEDIMENTATION A POSTERIORI CORRECTION FOR DOWNDRAFTS.

DO JLEV=KTDIA-1,KLEV
  DO JLON=KIDIA,KFDIA
    ZFPLSL(JLON,JLEV)=PFPLSL(JLON,JLEV)
    ZFPLSN(JLON,JLEV)=PFPLSN(JLON,JLEV)
  ENDDO
ENDDO

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA

    ZRHOAIR=PAPRSF(JLON,JLEV)/(PR(JLON,JLEV)*PT(JLON,JLEV))
    ZZSLS=MAX(ZEPS1,(PPOID(JLON,JLEV)/ZRHOAIR)/PFALLR(JLON,JLEV))
    ZZSNS=MAX(ZEPS1,(PPOID(JLON,JLEV)/ZRHOAIR)/PFALLS(JLON,JLEV))

    IF (LLSTASED) THEN
      ZSTAL0=EXP(-ZZSLS)
      ZSTAL1=(1.0_JPRB-ZSTAL0)/ZZSLS
      ZSTAL2=ZSTAL0/(1._JPRB+ZZSLS+0.5_JPRB*(SQRT((1._JPRB+ZZSLS)&
       &**2+4._JPRB*ZZSLS)-(1._JPRB+ZZSLS)))
      ZSTAL3(JLON)=0.5_JPRB*(ZSTAL1+ZSTAL2)
      ZSTAN0=EXP(-ZZSNS)
      ZSTAN1=(1.0_JPRB-ZSTAN0)/ZZSNS
      ZSTAN2=ZSTAN0/(1._JPRB+ZZSNS+0.5_JPRB*(SQRT((1._JPRB+ZZSNS)&
       &**2+4._JPRB*ZZSNS)-(1._JPRB+ZZSNS)))
      ZSTAN3(JLON)=0.5_JPRB*(ZSTAN1+ZSTAN2)
    ENDIF
    
    IF (LLLAGSED) THEN
      ZSTAL0=MAX(0.0_JPRB,SIGN(1.0_JPRB,1.0_JPRB-ZZSLS))
      ZSTAL1=MIN(1.0_JPRB,1.0_JPRB/ZZSLS)
      ZSTAL2=MAX(0.0_JPRB,1.0_JPRB-ZZSLS)
      ZSTAL3(JLON)=0.5_JPRB*(ZSTAL1+ZSTAL2)
      ZSTAN0=MAX(0.0_JPRB,SIGN(1.0_JPRB,1.0_JPRB-ZZSNS))
      ZSTAN1=MIN(1.0_JPRB,1.0_JPRB/ZZSNS)
      ZSTAN2=MAX(0.0_JPRB,1.0_JPRB-ZZSNS)
      ZSTAN3(JLON)=0.5_JPRB*(ZSTAN1+ZSTAN2)
    ENDIF

    PFPLSL(JLON,JLEV)=PFPLSL(JLON,JLEV-1)&
     &+(ZFPLSL(JLON,JLEV)-ZFPLSL(JLON,JLEV-1))&
     &+(1.0_JPRB-ZSTAL3(JLON))*(PFPEVPCL(JLON,JLEV)-PFPEVPCL(JLON,JLEV-1))
    PFPLSN(JLON,JLEV)=PFPLSN(JLON,JLEV-1)&
     &+(ZFPLSN(JLON,JLEV)-ZFPLSN(JLON,JLEV-1))&
     &+(1.0_JPRB-ZSTAN3(JLON))*(PFPEVPCN(JLON,JLEV)-PFPEVPCN(JLON,JLEV-1))

  ENDDO
ENDDO


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