!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACPLUIE ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPRS,PDELP,PQ,PQW,PT,&
 ! - OUTPUT 2D .
 & PFASL,PFASN,PFCSQL,PFCSQN,PFESL,PFESN,PFPLSL,PFPLSN,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACPLUIE * - CALCUL DES FLUX DE PRECIPITATION STRATIFORME.

!     Sujet.
!     ------
!     - ROUTINE DE CALCUL ACTIF .
!       CALCUL DES FLUX DE PRECIPITATION STRATIFORME
!              (LIQUIDE ET NEIGE) .
!     - COMPUTATION OF STRATIFORM PRECIPITATION FLUXES
!              (WATER AND SNOW) .

!     - CALCUL DES FLUX D'ENTHALPIE LIES AUX PRECIPITATIONS STRATIFORMES
!              (LIQUIDE ET NEIGE) .
!     - COMPUTATION OF ENTHALPY FLUXES LINKED TO STRATIF. PRECIPITATIONS
!              (WATER AND SNOW) .

!**   Interface.
!     ----------
!        *CALL* *ACPLUIE*

!-----------------------------------------------------------------------
! WARNING: THE ENGLISH VERSION OF VARIABLES' NAMES IS TO BE READ IN THE
!          "APLPAR" CODE.
!-----------------------------------------------------------------------

! -   ARGUMENTS D'ENTREE.
!     -------------------

! - NOM DES PARAMETRES DE DIMENSIONNEMENT DE LA PHYSIQUE.

! 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 (1 EN GENERAL).
! KLEV       : DIMENSION VERTICALE DES TABLEAUX "FULL LEVEL".

! - NOM DES VARIABLES DE LA PHYSIQUE (PAR ORDRE ALPHABETIQUE DANS CHAQUE
!   CATEGORIE).

! - 2D (0:KLEV) .

! PAPRS      : PRESSION AUX DEMI-NIVEAUX.

! - 2D (1:KLEV) .

! PDELP      : EPAISSEUR EN PRESSION DE LA COUCHE.
! PQ         : HUMIDITE SPECIFIQUE DE LA VAPEUR D'EAU.
! PQW        : HUMIDITE SPECIFIQUE DU THERMOMETRE MOUILLE.
! PT         : TEMPERATURE.

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

! -   ARGUMENTS DE SORTIE.
!     --------------------

! - 2D (0:KLEV) .

! PFPLSL     : PRECIPITATIONS STRATIFORMES SOUS FORME LIQUIDE.
! PFPLSN     : PRECIPITATIONS STRATIFORMES SOUS FORME NEIGE.

! PROGNOSTIC PSEUDO FLUXES (WITH RESPECT TO VAPOUR)

! PFASL      : STRATIFORM AUTOCONVERSION (LIQUID)
! PFASN      : STRATIFORM AUTOCONVERSION (SOLID)
! PFCSQL     : STRATIFORM CONDENSATION (LIQUID)
! PFCSQN     : STRATIFORM CONDENSATION (SOLID)
! PFESL      : STRATIFORM EVAPORATION OF RAIN
! PFESN      : STRATIFORM EVAPORATION OF SNOW

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

! -   ARGUMENTS IMPLICITES.
!     ---------------------

! COMMON/YOMPHY /
! COMMON/YOMCST /
! COMMON/YOMPHY0/
! COMMON/YOMPHY2/

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

!     Externes.
!     ---------

!     Methode.
!     --------

!     Auteur.
!     -------
!        89-12, J.F. Geleyn.

!     Modifications.
!     --------------
!        92-04, nouveau flux d'information pour l'enthalpie - E. Bazile.
!        92-04, nuages "glace" pour proprietes physiques - L. Labbe.
!        94-04, Suppression des flux d'enthalpie - E.Bazile.
!        97-08, PZx variables > Zx, introduce CDLOCK - J.M. Piriou.
!        99-07, Introduce reproductibility in physics (NPHYREP). - J.M. Piriou.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        05-03, Introduction de FONICE / fctdoi.h  - F. Bouyssel
!        2006-03-03 R.Brozkova - fix of the computation 
!                                of evaporation/sublimation of precipitations

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

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

USE YOMPHY   , ONLY : LNEIGE, NPHYREP
USE YOMCST   , ONLY : RG       ,RTT      ,RDT
USE YOMPHY0  , ONLY : EVAP     ,FONT     ,REVGSL   ,RDTFAC
USE YOMPHY2  , ONLY : TSPHY

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQW(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFASL(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFASN(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCSQL(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCSQN(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFESL(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFESN(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPLSL(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPLSN(KLON,0:KLEV) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZPOID(KLON,KLEV),ZDQ(KLON),ZFPTB(KLON),ZFPTH(KLON)&
 & ,ZIPB(KLON),ZIPH(KLON),ZRME(KLON),ZRMI(KLON)  

INTEGER(KIND=JPIM) :: JLEV, JLON

REAL(KIND=JPRB) :: ZDELTA, ZEPS1, ZEPS2, ZEVA, ZFON, &
 & ZGDTI, ZPLS, ZRMIE, ZRMIT, ZRPTB, ZRPTH, &
 & ZSIGMA  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "fctdoi.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

IF (LHOOK) CALL DR_HOOK('ACPLUIE',0,ZHOOK_HANDLE)
IF(CDLOCK /= 'ACPLUIE') CALL ABOR1('BAD NUMBER OF ARGUMENTS!')

!*
!     ------------------------------------------------------------------
!     I - CALCUL DE PARAMETRES DERIVES ET CONSTANTES DE SECURITE (POUR
!     LES FLUX DE PRECIPITATION ET LEURS RACINES CARREES).

!         COMPUTATION OF DERIVED PARAMETERS AND SECURITY CONSTANTS (FOR
!     THE PRECIPITATION FLUXES AND THEIR SQUARE ROOTS).

ZGDTI=1.0_JPRB/(RG*TSPHY)

ZEPS1=1.E-10_JPRB
ZEPS2=1.E-05_JPRB

!*
!     ------------------------------------------------------------------
!     II - CALCULS PRELIMINAIRES DE L'EPAISSEUR EN PRESSION DES COUCHES
!     DIVISEE PAR G*DT POUR CHAQUE NIVEAU.

!          PRELIMINARY COMPUTATIONS OF THE LAYER'S PRESSURE THICKNESS
!     DIVIDED BY G*DT FOR ALL LEVELS.

! - TEMPORAIRE(S) 2D (1:KLEV) .

! ZPOID     : DP/(RG*DT) POUR UNE COUCHE ET UN PAS DE TEMPS DONNES.
!            : DP/(RG*DT) FOR A GIVEN LEVEL AND A GIVEN TIME STEP.

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZPOID(JLON,JLEV)=PDELP(JLON,JLEV)*ZGDTI
  ENDDO
ENDDO

!*
!     ------------------------------------------------------------------
!     III - CONDITION A LA LIMITE SUPERIEURE. DANS TOUTE LA ROUTINE
!     ZSIGMA SERVIRA A EVITER DES CALCULS CHERS D'EVAPORATION ET FONTE
!     TANT QU'IL N'Y AURA PAS EU AU MOINS UNE FOIS CONDENSATION A UN
!     NIVEAU LE LONG DU VECTEUR "JLON". IL Y AURA ROTATION A LA FIN DE
!     LA BOUCLE VERTICALE POUR LES CHAMPS TEMPORAIRES 1D "H" (HAUT) ET
!     "B" (BAS). LES PROPORTIONS NEIGEUSES DU FLUX DE PRECIPITATION DANS
!     LE CAS DE L'OPTION NEIGE RESTENT 0 PAR DEFINITION TANT QUE LE FLUX
!     TOTAL EST NUL.

!           UPPER BOUNDARY CONDITION. IN THE WHOLE ROUTINE ZSIGMA WILL
!     BE USED TO AVOID EXPENSIVE EVAPORATION AND MELTING CALCULATIONS AS
!     LONG AS THERE HAS NOT BEEN AT LEAST ONE TIME CONDENSATION AT ONE
!     LEVEL ALONG THE "JLON" VECTOR. THERE WILL BE A SWAP AT THE END OF
!     THE VERTICAL LOOP FOR THE TEMPORARY 1D FIELDS "H" (TOP) AND "B"
!     (BOTTOM). THE SNOW PROPORTIONS OF THE PRECIPITATION FLUX IN THE
!     CASE OF THE SNOW OPTION REMAIN 0 PER DEFINITION AS LONG AS THE
!     TOTAL FLUX IS ZERO.

! - TEMPORAIRE(S) 1D .

! ZFPTH     : FLUX TOTAL DE PRECIPITATIONS AU SOMMET DE LA COUCHE.
!            : TOTAL PRECIPITATION FLUX AT THE TOP OF THE LAYER.
! ZFPTB     : FLUX TOTAL DE PRECIPITATIONS A LA BASE DE LA COUCHE.
!            : TOTAL PRECIPITATION FLUX AT THE BOTTOM OF THE LAYER.
! ZRME      : PROPORTION DU FLUX DE PRECIP. SOUS FORME PHYSIQUE NEIGE.
!            : PHYSICAL-SNOW-TYPE PROPORTION OF THE PRECIPITATION FLUX.
! ZRMI      : PROPORTION DU FLUX DE PRECIP. SOUS FORME THERMOD. NEIGE.
!            : THERMOD.-SNOW-TYPE PROPORTION OF THE PRECIPITATION FLUX.

DO JLON=KIDIA,KFDIA
  PFPLSL(JLON,KTDIA-1)=0.0_JPRB
  PFPLSN(JLON,KTDIA-1)=0.0_JPRB
  ZFPTH(JLON)=0.0_JPRB
  ZRME(JLON)=0.0_JPRB
  ZRMI(JLON)=0.0_JPRB
ENDDO

ZSIGMA=0.0_JPRB

!*
!     ------------------------------------------------------------------
!     IV - CALCULS PROPREMENTS DITS DANS UNE BOUCLE VERTICALE OU
!     L'INFORMATION SE TRANSMET DE COUCHE A COUCHE.

!          EFFECTIVE CALCULATIONS IN A VERTICAL LOOP WHERE THE
!     INFORMATION IS PASSED FROM LAYER TO LAYER.

DO JLEV=KTDIA,KLEV

!     CALCULS PRELIMINAIRES (CORRECTION "THERMOMETRE MOUILLE" POUR Q ET
!     INVERSE DE LA PRESSION AUX BORNES) ET FLUX PROVISOIRE A LA BASE EN
!     CAS DE MISE A L'EQUILIBRE DE SATURATION.
!     PRELIMINARY COMPUTATIONS ("WET BULB" CORRECTION FOR Q AND INVERSE
!     OF THE PRESSURE AT BOUNDARIES) AND PROVISIONAL FLUX AT THE BOTTOM
!     FOR THE CASE OF RETURN TO EXACT SATURATION.

! - TEMPORAIRE(S) 1D .

! ZIPB      : INVERSE DE LA PRESSION A LA BASE DE LA COUCHE.
!            : INVERSE PRESSURE AT THE BOTTOM OF THE LAYER.
! ZIPH      : INVERSE DE LA PRESSION AU SOMMET DE LA COUCHE.
!            : INVERSE PRESSURE AT THE TOP OF THE LAYER.
! ZDQ       : CORRECTION DE Q POUR PASSER A L'EQUILIBRE SATURE.
!            : CORRECTION OF Q TO REACH THE SATURATION BALANCE.

  DO JLON=KIDIA,KFDIA
    ZIPB(JLON)=1.0_JPRB/PAPRS(JLON,JLEV)
    ZDQ(JLON)=PQW(JLON,JLEV)-PQ(JLON,JLEV)
    ZFPTB(JLON)=MAX(0.0_JPRB,ZFPTH(JLON)-ZPOID(JLON,JLEV)*ZDQ(JLON))
  ENDDO

!     CALCULS COMPLETS D'EVAPORATION ET FONTE/(GEL) SI ZSIGMA >0,
!     RECALCUL DE ZSIGMA ET INITIALISATION EVENTUELLE DES PROPORTIONS
!     NEIGEUSES DU FLUX DANS LE CAS CONTRAIRE.
!     COMPLETE COMPUTATIONS OF EVAPORATION AND MELTING/(FREEZING) IF
!     ZSIGMA >0, RECOMPUTATION OF ZSIGMA AND POTENTIAL INITIALIZATION
!     OF THE SNOW PROPORTIONS OF THE FLUX IN THE OPPOSITE CASE.

  IF (ZSIGMA > 0.0_JPRB) THEN
    DO JLON=KIDIA,KFDIA
      ZEVA=EVAP*SQRT(1.0_JPRB-ZRME(JLON)*(1.0_JPRB-REVGSL))
      ZFON=FONT*SQRT(1.0_JPRB-ZRME(JLON)*(1.0_JPRB-REVGSL))
      ZRPTH=SQRT(MAX(ZFPTH(JLON),ZFPTB(JLON)))
      ZRPTB=MAX(0.0_JPRB,ZRPTH-ZEVA*MAX(0.0_JPRB,ZDQ(JLON))*(ZIPH(JLON)&
       & -ZIPB(JLON)))  
      ZFPTB(JLON)=MAX(ZFPTB(JLON),ZRPTB**2)

!     CALCULS DE CHANGEMENT DES PROPORTIONS NEIGEUSES (NOUVELLES
!     PRECIPITATIONS GENEREES ET FONTE/(GEL)) DANS L'OPTION "NEIGE".
!     CALCULATIONS OF THE CHANGE IN THE SNOW PROPORTIONS (NEWLY
!     GENERATED PRECIPITATIONS AND MELTING/(FREEZING)) IN THE SNOW
!     OPTION "NEIGE".

      IF (LNEIGE) THEN
        ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PT(JLON,JLEV)))
        ZPLS=FONICE(PT(JLON,JLEV))
        ZRMIE=ZPLS+(ZRME(JLON)-ZPLS)*ZFPTH(JLON)/MAX(ZEPS1 &
         & +ZFPTH(JLON),ZFPTB(JLON))  
        ZRMIT=ZDELTA+(ZRMI(JLON)-ZDELTA)*ZFPTH(JLON)/MAX(ZEPS1 &
         & +ZFPTH(JLON),ZFPTB(JLON))  
        ZRME(JLON)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZRMIE+ZFON*(RTT-PT(JLON,JLEV))&
         & *(ZIPH(JLON)-ZIPB(JLON))/MAX(ZEPS2,0.5_JPRB &
         & *(ZRPTH+ZRPTB))))  
        ZRMI(JLON)=MAX(0.0_JPRB,MIN(1.0_JPRB,ZRMIT+ZFON*(RTT-PT(JLON,JLEV))&
         & *(ZIPH(JLON)-ZIPB(JLON))/MAX(ZEPS2,0.5_JPRB &
         & *(ZRPTH+ZRPTB))))  
      ELSE
        ZRME(JLON)=0.0_JPRB
        ZRMI(JLON)=0.0_JPRB
      ENDIF

    ENDDO
  ELSE

!     CALCUL, PAR SOMMATION EXPLICITE, DE ZSIGMA.
!     COMPUTATION, BY EXPLICIT SUMMATION, OF ZSIGMA.

    ZSIGMA=0.0_JPRB
    DO JLON=KIDIA,KFDIA
      ZSIGMA=ZSIGMA+ZFPTB(JLON)
    ENDDO

    IF(NPHYREP /= 0 .AND. NPHYREP /= -3) ZSIGMA=1.0_JPRB

    DO JLON=KIDIA,KFDIA

!     DANS LE CAS "NEIGE" ET ZSIGMA >0 INITIALISATION DES PROPORTIONS
!     NEIGEUSES.
!     IN THE SNOW "NEIGE" CASE AND IF ZSIGMA >0 INITIALIZATION OF THE
!     SNOW PROPORTIONS.

      IF (LNEIGE.AND.(ZSIGMA > 0.0_JPRB)) THEN
        ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PT(JLON,JLEV)))
        ZPLS=FONICE(PT(JLON,JLEV))
        ZRME(JLON)=ZPLS
        ZRMI(JLON)=ZDELTA
      ELSE
        ZRME(JLON)=0.0_JPRB
        ZRMI(JLON)=0.0_JPRB
      ENDIF

    ENDDO
  ENDIF

!     ROTATION A LA FIN DU CALCUL DE COUCHE ET VALEURS DES FLUX.
!     SWAP AT THE END OF THE LAYER'S COMPUTATIONS AND FLUX VALUES.

  DO JLON=KIDIA,KFDIA
    ZIPH(JLON)=ZIPB(JLON)
    ZFPTH(JLON)=ZFPTB(JLON)
    PFPLSL(JLON,JLEV)=ZFPTB(JLON)*(1.0_JPRB-ZRMI(JLON))
    PFPLSN(JLON,JLEV)=ZFPTB(JLON)*ZRMI(JLON)
    PFCSQL(JLON,JLEV)=PFPLSL(JLON,JLEV)
    PFCSQN(JLON,JLEV)=PFPLSN(JLON,JLEV)
    PFASL(JLON,JLEV)=PFPLSL(JLON,JLEV)
    PFASN(JLON,JLEV)=PFPLSN(JLON,JLEV)
  ENDDO
ENDDO

PFESL(:,:)=0._JPRB
PFESN(:,:)=0._JPRB

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