SUBROUTINE ADVPRC (KIDIA, KFDIA, KLON, KTDIA, KFLEV,&
 & PT, PQ, PQL, PQI, PAUTOL, PAUTOI, &
 & PQR, PQS, PNEB, &
 & PCP, PR, PAPHI, PAPRSF, PDELP,&
 & PFPLSL, PFPLSN, PFPEVPL, PFPEVPN, PFPFPL, PFPFPN )  

! ========================================================

!   THIS ROUTINE PERFORMS THE VERTICAL ADVECTION OF
!   PRECIPITATION PARTICLES.
!   IT ALSO COMPUTES COLLECTION AND EVAPORATION PROCESSES.

! ========================================================

!   Auteur: Philippe Lopez, CNRM/GMME/RECYF

!   Date: 99-10   

!     Modifications.
!     --------------
!        M.Hamrud      01-Oct-2003 CY28 Cleaning

!     2004-01-27, P. Marquet : change sign of the five
!               output fluxes PFHMLTS, PFHEVPP, PFPEVP,
!               PFPFP and PFADVP. Complete the name
!               description of all input/output variables
!     2004-05-27, P. Marquet : TFVR and TFVS from NAMELIST
!     2004-07-01, P. Marquet : a bug / ZESW is not ESW/P !
!     2005-02-01, F. Bouyssel : change in evap & collec vertical repartition
!               correction of latent heat used for snow melting enthalpy
!               missing latent heat terms are added (autoconv & collec)
!               autoconversion is now continuous in a time step 
!               separation of PFPFP in PFPFPL and PFPFPN
!     2005-11-10, F. Bouyssel : Remove PQPR
!     2006-01-25, F. Bouyssel : Complete revision of the flux computation
!     2006-04-04, F. Bouyssel : Replace PQC by PQL,PQI
!     2006-10-30, F. Bouyssel : Introduction of RHEVAP
!     2007-04-06, F. Bouyssel : Change in precipitation evaporation (LLEVAPX)
! ========================================================

! ---------------
! INPUT VARIABLES
! ---------------

! KIDIA, : DEBUT/FIN DES BOUCLES HORIZONTALES (IST,IEND DANS CPG).
! KFDIA  : START/END OF HORIZONTAL LOOP       (IST,IEND IN   CPG).
! KLON   : DIMENSION HORIZONTALE              (NPROMA   DANS CPG).
!        : HORIZONTAL DIMENSION               (NPROMA   IN   CPG).
! KTDIA  : INDICE DE DEPART DES BOUCLES VERTICALES.
!        : START OF THE VERTICAL LOOP IN THE PHYSICS.
! KLEV   : FIN BOUCLE VERTICALES, DIMENSION VERTICALE (NFLEVG DANS CPG).
!        : END OF VERTICAL LOOP, VERTICAL DIMENSION   (NFLEVG IN   CPG).

! PT     : TEMPERATURE.
!        : TEMPERATURE.
! PQ     : HUMIDITE SPECIFIQUE DE LA VAPEUR D'EAU.
!        : SPECIFIC HUMIDITY OF WATER VAPOUR.
! PQL    : QUANTITE SPECIFIQUE D'EAU CONDENSEE LIQUIDE
!        : LIQUID CONDENSED WATER SPECIFIC HUMIDITY
! PQI    : QUANTITE SPECIFIQUE D'EAU CONDENSEE SOLIDE
!        : SOLID CONDENSED WATER SPECIFIC HUMIDITY
! PAUTOL : GENERATION DE PRECIPITATIONS A PARTIR DE L'EAU NUAGEUSE LIQ.
!        : GENERATION OF PRECIPITATION FROM LIQUID CLOUD WATER (ACMICRO). 
! PAUTOI : GENERATION DE PRECIPITATIONS A PARTIR DE L'EAU NUAGEUSE SOLIDE.
!        : GENERATION OF PRECIPITATION FROM SOLID CLOUD WATER (ACMICRO). 
! PQR    : QUANTITE SPECIFIQUE D'EAU PRECIPITANTE LIQUIDE.
!        : LIQUID PRECIPITATING WATER SPECIFIC HUMIDITY.
! PQS    : QUANTITE SPECIFIQUE D'EAU PRECIPITANTE SOLIDE.
!        : SOLID PRECIPITATING WATER SPECIFIC HUMIDITY.
! PNEB   : NEBULOSITE TOTALE
!        : TOTAL CLOUDINESS  
! PCP    : CHALEUR MASSIQUE A PRESSION CONSTANTE DE L'AIR.
!        : SPECIFIC HEAT AT CONSTANT PRESSURE FOR AIR.
! PR     : CONSTANTE DES GAZ POUR L'AIR.
!        : GAS CONSTANT FOR AIR.
! PAPHI  : GEOPOTENTIEL SUR DEMI-NIVEAUX.
!        : GEOPOTENTIAL ON HALF-LEVELS.
! PAPRSF : PRESSION SUR LES NIVEAUX PLEINS.
!        : PRESSURE ON FULL LEVELS.
! PDELP  : EPAISSEUR EN PRESSION DE LA COUCHE.
!        : LAYER THICKNESS IN PRESSURE UNITS.

! ---------------
! OUTPUT VARIABLES
! ---------------

! PFPLSL  : FLUX DE PRECIPITATION LIQUIDE (PLUIE).
!         : RAIN FLUX.
! PFPLSN  : FLUX DE PRECIPITATION SOLIDE  (NEIGE).
!         : ICE PRECIPITATION FLUX.
! PFPEVPL : FLUX ASSOCIE A L'EVAPORATION DES PRECIP.
!         : FLUX ASSOCIATED TO EVAPORATION OF PRECIPITATIONS.
! PFPEVPN : FLUX ASSOCIE A LA SUBLIMATION DES PRECIP.
!         : FLUX ASSOCIATED TO SUBLIMATION OF PRECIPITATIONS.
! PFPFPL  : FLUX DE GENERATION DE PRECIPITATIONS LIQUIDES.
!         : FLUX OF LIQUID PRECIPITATION GENERATION.
! PFPFPN  : FLUX DE GENERATION DE PRECIPITATIONS SOLIDES.
!         : FLUX OF SOLID PRECIPITATION GENERATION.

! ========================================================

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

USE YOMPHY    , ONLY : LEVAPP, LCOLLEC
USE YOMPHY0   , ONLY : RNINTR, RNINTS, RACCEF, RAGGEF, RRIMEF, &
 & TFVR, TFVS, REVASX
USE YOMPHY2   , ONLY : TSPHY
USE YOMCST    , ONLY : RG   , RV   , RTT  , RPI  ,&
 & RCS  , RCW  , RCPV , RLVTT, RLSTT, RETV , RALPW, RALPS,&
 & RALPD, RBETW, RBETS, RBETD, RGAMW, RGAMS, RGAMD

!USE YOMGAMMA , ONLY : GENERALIZED_GAMMA

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA
INTEGER(KIND=JPIM),INTENT(IN)    :: KFLEV 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT     (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ     (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQL    (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQI    (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAUTOL (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAUTOI (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQR    (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS    (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNEB   (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCP    (KLON,KFLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR     (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHI  (KLON,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP  (KLON,KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPLSL (KLON,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPLSN (KLON,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPEVPL(KLON,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPEVPN(KLON,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPFPL (KLON,0:KFLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFPFPN (KLON,0:KFLEV) 

REAL(KIND=JPRB) :: ZEPS,ZFVELR,ZFVELS,ZTMELT,ZRHOW,ZNRHOW &
 & , ZDVISC,ZSQTVIS,ZCDARV,ZRHOREF,ZEXP1,ZEXP4,ZEXP6 &
 & , ZPREF,ZCLEAR,ZKDIFF,ZFACT3,ZFACT4 &
 & , ZESW,ZSSATW,ZCONDT,ZDIFFV,ZCEV,ZES,ZCSU &
 & , ZSSATI,ZRHORAT,ZDZ,ZQR,ZQS &
 & , ZQRNR,ZQSNS,ZACCR,ZAGGR,ZRIMI &
 & , ZCOEFF1,ZCOEFF2,ZCOEFF2b,ZCOEFF3,ZCOEFF4,ZCOEFF5,ZCOEFF6 &
 & , ZNU1,ZNU2,ZTAU1,ZTAU2,ZSIGMA1,ZSIGMA2 &
 & , ZFVENTR1,ZFVENTR2,ZFVENTS1,ZFVENTS2 &
 & , ZLHFUS,ZSUBSA,ZEVAPPL,ZEVAPPN,ZINT1,ZQMLTX &
 & , ZTQEVAPPL,ZTQEVAPPN,ZTCOLLL,ZTCOLLN,ZQFPFPL,ZQFPFPN,ZQMLT &
 & , ZQPRTOT1,ZQPSTOT1,ZQPRTOT2A,ZQPRTOT2B,ZQPSTOT2,ZQPSTOT3 &
 & , FCGENERALIZED_GAMMA

REAL(KIND=JPRB) :: ZRHO(KLON,KFLEV) &
 & , ZALTIH   (KLON,0:KFLEV), ZFROZEN  (KLON,KFLEV) &
 & , ZDPSG    (KLON,KFLEV)  , ZDPSGDT  (KLON,KFLEV) &
 & , ZMELTED  (KLON,KFLEV)  &
 & , ZDELT    (KLON,KFLEV)  , ZEFFA    (KLON,KFLEV) &
 & , ZNS      (KLON,KFLEV)  , ZRHOVI   (KLON,KFLEV) &
 & , ZCEV1    (KLON,KFLEV)  , ZCEV2    (KLON,KFLEV) &
 & , ZCSU1    (KLON,KFLEV)  , ZCSU2    (KLON,KFLEV) &
 & , ZCAGG    (KLON,KFLEV)  , ZCACC    (KLON,KFLEV) &
 & , ZCRIM    (KLON,KFLEV)  , ZFVEL    (KLON,KFLEV) &
 & , ZQL      (KLON,KFLEV)  , ZQI      (KLON,KFLEV) &
 & , ZQPR     (KLON,KFLEV)  , ZQPS     (KLON,KFLEV) &
 & , ZQPROUT  (KLON,KFLEV)  , ZQPSOUT  (KLON,KFLEV) &
 & , ZDZ1     (KLON,KFLEV)  , ZDZ2     (KLON,KFLEV) &
 & , ZQSATW   (KLON,KFLEV)  , ZQSATI   (KLON,KFLEV) &
 & , ZAUTOL   (KLON,KFLEV)  , ZAUTOI   (KLON,KFLEV) &
 & , ZQPRTOT  (KLON)        , ZQPSTOT  (KLON) &
 & , ZZTOP    (KLON)        , ZZBOT    (KLON) &
 & , ZSUM     (KLON)        , ZZMELT   (KLON) &
 & , ZQRAUTO  (KLON)        , ZQSAUTO  (KLON) &
 & , ZCOEF1   (KLON)        , ZCOEF2   (KLON) &
 & , ZCOEF3   (KLON)
 

LOGICAL :: LLMELTS
LOGICAL :: LLEVAPX
INTEGER(KIND=JPIM) :: JLEV, JLON, JK, JTDIA
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcttrm.h"

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

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

IF (LHOOK) CALL DR_HOOK('ADVPRC',0,ZHOOK_HANDLE)

!- - - - - - - - - - - - - - -
IF (TSPHY > 0.0_JPRB) THEN
!- - - - - - - - - - - - - - -
      !
  LLMELTS = .TRUE.
  LLEVAPX = ( REVASX /= 0.0_JPRB )
      !
      ! ----------
      ! Constants      
      ! ----------
      !   
  ZEPS = 1.E-20_JPRB
      !
      ! ----------------------------------------------------------
      ! COEFFICIENTS IN DISTRIBUTIONS OF PARTICLE SPEED AND MASS  
      ! ----------------------------------------------------------
      !
  ZNU1 = 377.8_JPRB
  ZNU2 = 2.0_JPRB/3._JPRB
  ZTAU1 = 21._JPRB
  ZTAU2 = 0.5_JPRB
  ZSIGMA1 = 0.069_JPRB
  ZSIGMA2 = 2.0_JPRB
      !
      ! ------------------------------------------------------
      ! COEFFICIENTS IN VENTILATION FACTOR FOR RAIN AND SNOW
      ! ------------------------------------------------------
      !
  ZFVENTR1 = 0.78_JPRB
  ZFVENTR2 = 0.31_JPRB
  ZFVENTS1 = 0.65_JPRB
  ZFVENTS2 = 0.44_JPRB
      !
      ! ------------
      ! FALL SPEEDS
      ! ------------
      !
  ZFVELR = TFVR
  ZFVELS = TFVS
      !
  ZTMELT = RTT 
  ZRHOW = 1000._JPRB
  ZNRHOW = RNINTR * ZRHOW
  ZDVISC = 1.669E-05_JPRB
  ZSQTVIS = SQRT(ZDVISC)
  ZCDARV = 2.31E-02_JPRB * RV
  ZRHOREF = 1.2_JPRB
  ZEXP1 = 1.0_JPRB/3._JPRB
  ZEXP4 = 2.0_JPRB*ZEXP1
  ZEXP6 = 17._JPRB/24._JPRB
  ZPREF = 1.E+05_JPRB
  ZCOEFF1 = 12.695_JPRB * ZNU1 * FCGENERALIZED_GAMMA(3._JPRB+ZNU2) * RACCEF &
   & / (4._JPRB * ZRHOW)  
!LOP  ZCOEFF2 = 0.0485_JPRB * ZTAU1 * FCGENERALIZED_GAMMA(3._JPRB+ZTAU2) * RRIMEF &
!LOP   & * RPI / (4._JPRB * (2.0_JPRB**(1.0_JPRB+ZTAU2/3._JPRB)) * ZSIGMA1) 
  ZCOEFF2 = 0.0485_JPRB * ZTAU1 * FCGENERALIZED_GAMMA(3._JPRB+ZTAU2) * RRIMEF &
   & * RPI /  4._JPRB &
   & / (FCGENERALIZED_GAMMA(ZSIGMA2+1.0_JPRB)**((3._JPRB+ZTAU2)/(1.0_JPRB+ZSIGMA2))) &
   & / ZSIGMA1   
  ZCOEFF2b = ZCOEFF2 * RAGGEF / RRIMEF
  ZCOEFF3 = 2.0_JPRB * ZFVENTR1 * SQRT(RPI)
  ZCOEFF4 = 2.0_JPRB * RPI**((3._JPRB-ZNU2)/8._JPRB) * ZFVENTR2 * SQRT(ZNU1) &
   & * (ZRHOREF**0.2_JPRB) * FCGENERALIZED_GAMMA((ZNU2+5._JPRB)/2.0_JPRB)   
  ZCOEFF5 = 4._JPRB * ZFVENTS1 / (2.0_JPRB * ZSIGMA1)**ZEXP4 
  ZCOEFF6 = 5.784_JPRB * 4._JPRB * ZFVENTS2 * SQRT(ZTAU1) &
   & * (ZRHOREF**0.2_JPRB) * FCGENERALIZED_GAMMA((ZTAU2+5._JPRB)/2.0_JPRB) &
   & / (2.0_JPRB * ZSIGMA1)**((ZTAU2+5._JPRB)/6._JPRB)   
      !
      ! ---------------
      ! Initializations
      ! ---------------
      !
  ZZMELT(:) = -1.E+20_JPRB
      !
  ZFVEL(:,:) = ZFVELS
  ZMELTED(:,:) = 0.0_JPRB
  ZFROZEN(:,:) = 1.0_JPRB
  ZQPROUT(:,:) = 0.0_JPRB
  ZQPSOUT(:,:) = 0.0_JPRB
      !
  DO JLEV = 0, KFLEV
    DO JLON = KIDIA, KFDIA
      ZALTIH(JLON,JLEV) = PAPHI(JLON,JLEV) / RG 
    ENDDO
  ENDDO
    !
    ! ==========================
    ! COMPUTE DENSITY, THICKNESS
    ! ==========================
    !
  DO JLEV = KTDIA, KFLEV
    DO JLON = KIDIA, KFDIA
      ZDPSG(JLON,JLEV) = PDELP(JLON,JLEV) / RG
      ZDPSGDT(JLON,JLEV) = ZDPSG(JLON,JLEV) * TSPHY
      ZDELT(JLON,JLEV) = PT(JLON,JLEV) - RTT
      ZRHO(JLON,JLEV) = PAPRSF(JLON,JLEV) / PR(JLON,JLEV)&
       & / PT(JLON,JLEV)  
      ZQPR(JLON,JLEV) = PQR(JLON,JLEV)
      ZQPS(JLON,JLEV) = PQS(JLON,JLEV)
      ZAUTOL(JLON,JLEV) = PAUTOL(JLON,JLEV) * ZDPSGDT(JLON,JLEV)
      ZAUTOI(JLON,JLEV) = PAUTOI(JLON,JLEV) * ZDPSGDT(JLON,JLEV)
    ENDDO    
  ENDDO    
    !
    ! ==================
    ! FIND MELTING LEVEL
    ! ==================
    !
  JTDIA = MAX(KTDIA,2)
  DO JLEV = JTDIA, KFLEV
    DO JLON = KIDIA, KFDIA
      IF (PT(JLON,JLEV-1) < ZTMELT .AND. &
         & PT(JLON,JLEV)  >= ZTMELT .AND. &
         & ZMELTED(JLON,JLEV-1) == 0.0_JPRB) THEN  
        ZZMELT(JLON)=ZALTIH(JLON,JLEV-1)
        ZMELTED(JLON,JLEV)=1.0_JPRB
      ELSE
        ZMELTED(JLON,JLEV) = ZMELTED(JLON,JLEV-1)
      ENDIF
    ENDDO
  ENDDO
     !
     ! ======================================
     ! OTHER INITIALIZATIONS FOR MICROPHYSICS
     ! ======================================
     !
  DO JLEV=KTDIA,KFLEV
    DO JLON=KIDIA,KFDIA
       !
      ZFROZEN(JLON,JLEV) = 1.0_JPRB - ZMELTED(JLON,JLEV)
       !
      ZFVEL(JLON,JLEV) = ZFVELS * ZFROZEN(JLON,JLEV) &
       & + ZFVELR * ZMELTED(JLON,JLEV)
       !
      ZRHOVI(JLON,JLEV) = 1.0_JPRB/(ZFVEL(JLON,JLEV)*ZRHO(JLON,JLEV))
       !
       ! -----------------------------------------------------------
       ! Efficiency for ice aggregation as a function of temperature.
       ! -----------------------------------------------------------
      ZEFFA(JLON,JLEV) = EXP(0.025_JPRB * ZDELT(JLON,JLEV))
       !
       ! ---------------------------------------------------------
       ! Intercept parameter for ice as a function of temperature.
       ! ---------------------------------------------------------
      ZNS(JLON,JLEV) = RNINTS * EXP(-0.1222_JPRB * ZDELT(JLON,JLEV))
       !
      ZQL(JLON,JLEV) = MAX(0.0_JPRB,PQL(JLON,JLEV) &
       & -PAUTOL(JLON,JLEV)*TSPHY)
      ZQI(JLON,JLEV) = MAX(0.0_JPRB,PQI(JLON,JLEV) &
       & -PAUTOI(JLON,JLEV)*TSPHY)
       !
      ZCLEAR = 1.0_JPRB - PNEB(JLON,JLEV)
      ZKDIFF = 2.E-5_JPRB * ZPREF / PAPRSF(JLON,JLEV)
      ZFACT3 = (ZSQTVIS * ZKDIFF)**ZEXP1
      ZFACT4 = RV * PT(JLON,JLEV) / ZKDIFF

       ! -----------------------
       ! For evaporation of rain
       ! -----------------------
      ZESW = FOEW(PT(JLON,JLEV),0.0_JPRB)
      ZQSATW(JLON,JLEV) = FOQS(ZESW/PAPRSF(JLON,JLEV))
      ZSSATW = 1.0_JPRB - PQ(JLON,JLEV)/ZQSATW(JLON,JLEV)
       !
      ZCONDT = ( FOLH(PT(JLON,JLEV),0.0_JPRB)/PT(JLON,JLEV) )**2 /ZCDARV
      ZDIFFV = ZFACT4 / ZESW
       !
      ZCEV = ZSSATW * ZCLEAR * RNINTR &
       & / ZRHO(JLON,JLEV) / (ZCONDT + ZDIFFV)  
      ZCEV = MAX(0.0_JPRB,ZCEV)
      ZCEV1(JLON,JLEV) = ZCEV * ZCOEFF3 
      ZCEV2(JLON,JLEV) = ZCEV * ZCOEFF4 / ZFACT3
       !
       ! -----------------------
       ! For sublimation of snow
       ! -----------------------
      ZES = FOEW(PT(JLON,JLEV),1.0_JPRB)
      ZQSATI(JLON,JLEV) = FOQS(ZES/PAPRSF(JLON,JLEV))
      ZSSATI = 1.0_JPRB - PQ(JLON,JLEV)/ZQSATI(JLON,JLEV)
       !
      ZCONDT = ( FOLH(PT(JLON,JLEV),1.0_JPRB)/PT(JLON,JLEV) )**2 /ZCDARV
      ZDIFFV = ZFACT4 / ZES
       !
      ZCSU = ZSSATI * ZCLEAR * ZNS(JLON,JLEV) &
       & / ZRHO(JLON,JLEV) / (ZCONDT + ZDIFFV)  
      ZCSU = MAX(0.0_JPRB,ZCSU)
      ZCSU1(JLON,JLEV) = ZCSU * ZCOEFF5
      ZCSU2(JLON,JLEV) = ZCSU * ZCOEFF6 / ZFACT3
       !
       ! ------------------------
       ! For collection processes
       ! ------------------------
      ZRHORAT = ( ZRHOREF / ZRHO(JLON,JLEV) )**0.4_JPRB
      ZCACC(JLON,JLEV) = ZCOEFF1 * ZRHORAT
      ZCRIM(JLON,JLEV) = ZCOEFF2 * ZRHORAT 
      ZCAGG(JLON,JLEV) = ZCOEFF2b * ZRHORAT * ZEFFA(JLON,JLEV)
       !
    ENDDO
  ENDDO
    !
    ! =============================================
    ! PERFORM LAGRANGIAN ADVECTION OF PRECIPITATION
    ! =============================================
    !
    !-- -- -- -- -- --
  DO JLEV=KTDIA,KFLEV  
    !-- -- -- -- -- --
      ! 
    DO JLON=KIDIA,KFDIA
       !
       ! ------------
       ! TOP OF LAYER
       ! ------------
       !
      IF (ZALTIH(JLON,JLEV-1) < ZZMELT(JLON)) THEN
        ZZTOP(JLON) = ZALTIH(JLON,JLEV-1) + TSPHY * ZFVELR 
        IF (ZZTOP(JLON) >= ZZMELT(JLON)) THEN  
          ZZTOP(JLON) = ZZMELT(JLON) &
           & + (TSPHY - (ZZMELT(JLON)-ZALTIH(JLON,JLEV-1))&
           & / ZFVELR ) * ZFVELS  
        ENDIF
      ELSE
        ZZTOP(JLON) = ZALTIH(JLON,JLEV-1) + TSPHY * ZFVELS
      ENDIF

      ZZTOP(JLON) = MIN(ZALTIH(JLON,KTDIA-1),ZZTOP(JLON))
       !
       ! ---------------
       ! BOTTOM OF LAYER
       ! ---------------
       !
      IF (ZALTIH(JLON,JLEV) < ZZMELT(JLON)) THEN
        ZZBOT(JLON) = ZALTIH(JLON,JLEV) + ZFVELR * TSPHY
        IF (ZZBOT(JLON) >= ZZMELT(JLON)) THEN  
          ZZBOT(JLON) = ZZMELT(JLON) &
           & + (TSPHY-(ZZMELT(JLON)-ZALTIH(JLON,JLEV))&
           & / ZFVELR ) * ZFVELS  
        ENDIF
      ELSE
        ZZBOT(JLON) = ZALTIH(JLON,JLEV) + ZFVELS * TSPHY
      ENDIF
       !
      ZZBOT(JLON) = MIN(ZALTIH(JLON,KTDIA-1),ZZBOT(JLON))
       !
    ENDDO ! JLON=KIDIA,KFDIA
      !
      ! =================================================
      ! COMPUTE PRECIPITATION CONTENT AT THE ORIGIN POINT
      ! AND PRECIPITATION FLUX DOWN TO THE TARGET LAYER.
      ! COMPUTE AVERAGE PRECIPITATION CONTENT FOR USE IN
      ! COLLECTION AND EVAPORATION CALCULATIONS. 
      ! =================================================
      ! 
    ZQPRTOT(:) = 0.0_JPRB
    ZQPSTOT(:) = 0.0_JPRB
    ZSUM   (:) = 0.0_JPRB
      !
    DO JK = KTDIA, JLEV
      DO JLON = KIDIA, KFDIA
         !
        ZINT1 = MIN(ZZTOP(JLON), ZALTIH(JLON,JK-1))
        ZDZ1(JLON,JK) = ZRHO(JLON,JK) &
         & * MAX(0.0_JPRB,ZINT1-MAX(ZZBOT(JLON),ZALTIH(JLON,JK)))
        ZDZ2(JLON,JK) = ZRHO(JLON,JK) &
         & * MAX(0.0_JPRB,ZINT1-ZALTIH(JLON,JK))
        ZSUM(JLON) = ZSUM(JLON) + ZDZ2(JLON,JK) * ZRHOVI(JLON,JK)
         !
      ENDDO
    ENDDO
      !
    DO JLON = KIDIA, KFDIA
       !
      ZQRAUTO(JLON) = ZAUTOL(JLON,JLEV) / ZSUM(JLON)
      ZQSAUTO(JLON) = ZAUTOI(JLON,JLEV) / ZSUM(JLON)
       !
    ENDDO
      !
    DO JK = KTDIA, JLEV
      DO JLON = KIDIA, KFDIA
         !
        ZQPR(JLON,JK) = ZQPR(JLON,JK) + ZQRAUTO(JLON) * ZRHOVI(JLON,JK)
        ZQPS(JLON,JK) = ZQPS(JLON,JK) + ZQSAUTO(JLON) * ZRHOVI(JLON,JK)
        ZQPRTOT(JLON) = ZQPRTOT(JLON) + ZQPR(JLON,JK) * ZDZ2(JLON,JK)
        ZQPSTOT(JLON) = ZQPSTOT(JLON) + ZQPS(JLON,JK) * ZDZ2(JLON,JK)
         !
      ENDDO
    ENDDO
      !
    DO JLON = KIDIA, KFDIA
         !
      ZTQEVAPPL = 0.0_JPRB
      ZTQEVAPPN = 0.0_JPRB
      ZQFPFPL   = 0.0_JPRB
      ZQFPFPN   = 0.0_JPRB
      ZTCOLLL   = 0.0_JPRB
      ZTCOLLN   = 0.0_JPRB
      ZQMLT     = 0.0_JPRB
      ZACCR     = 0.0_JPRB
         !
      ZDZ = ZZTOP(JLON) - ZALTIH(JLON,JLEV)
         !
      ZQPRTOT(JLON) = MAX(0.0_JPRB,ZQPRTOT(JLON))
      ZQPSTOT(JLON) = MAX(0.0_JPRB,ZQPSTOT(JLON))
         !
      ZQR = ZQPRTOT(JLON) / ZDZ
      ZQS = ZQPSTOT(JLON) / ZDZ
         !
      IF (LEVAPP) THEN
           !
           ! ----------------------------------------
           ! Evaporation/Sublimation of precipitation
           ! ----------------------------------------
        ZQRNR =  ZQR / ZNRHOW
        ZQSNS =  ZQS / ZNS(JLON,JLEV)
           !
        ZEVAPPL = ZCEV1(JLON,JLEV)*SQRT(ZQRNR) + ZCEV2(JLON,JLEV)*ZQRNR**ZEXP6
        ZEVAPPN = ZCSU1(JLON,JLEV)*ZQSNS**ZEXP4 + ZCSU2(JLON,JLEV)*ZQSNS
           !
        ZINT1 = 1.0_JPRB / MAX(ZEPS,ZEVAPPL+ZEVAPPN)
           !
        IF (LLEVAPX) THEN
          ZSUBSA = REVASX*ZINT1*(1.0_JPRB-EXP(-1.0_JPRB/(REVASX*ZINT1)))
          ZEVAPPL = ZSUBSA*ZEVAPPL
          ZEVAPPN = ZSUBSA*ZEVAPPN
        ENDIF
           !
        ZSUBSA = ZINT1 * ZEVAPPL * (ZQSATW(JLON,JLEV) - PQ(JLON,JLEV))
        ZTQEVAPPL = MAX(0.0_JPRB, MIN( ZQPRTOT(JLON),  &
         & ZEVAPPL * ZDPSGDT(JLON,JLEV), ZSUBSA * ZDPSG(JLON,JLEV) ))   
           !
        ZSUBSA = ZINT1 * ZEVAPPN * (ZQSATI(JLON,JLEV) - PQ(JLON,JLEV))
        ZTQEVAPPN = MAX(0.0_JPRB, MIN( ZQPSTOT(JLON),  &
         & ZEVAPPN * ZDPSGDT(JLON,JLEV), ZSUBSA * ZDPSG(JLON,JLEV) ))   
           !
      ENDIF
        !
      ZQPRTOT1 = ZQPRTOT(JLON) - ZTQEVAPPL
      ZQPSTOT1 = ZQPSTOT(JLON) - ZTQEVAPPN
        !
      ZQR = ZQPRTOT1 / ZDZ
      ZQS = ZQPSTOT1 / ZDZ
        !
      IF (LCOLLEC) THEN
           !
           ! ----------------------------------------
           ! Collection of cloud liquid water by rain
           ! ----------------------------------------
        ZACCR = ZQL(JLON,JLEV)*(1.0_JPRB-EXP(-ZCACC(JLON,JLEV)*ZQR*TSPHY))
           !
           ! -------------------------------
           ! Collection of cloud ice by snow
           ! -------------------------------
        ZAGGR = ZQI(JLON,JLEV)*(1.0_JPRB-EXP(-ZCAGG(JLON,JLEV)*ZQS*TSPHY))
           !
           ! ----------------------------------------
           ! Collection of cloud liquid water by snow
           ! ----------------------------------------
        ZRIMI = ZQL(JLON,JLEV)*(1.0_JPRB-EXP(-ZCRIM(JLON,JLEV)*ZQS*TSPHY))
           !
           ! ----------------------------
           ! Sum up collection processes
           ! ----------------------------
        ZTCOLLL = MAX(0.0_JPRB, MIN(ZACCR+ZRIMI,ZQL(JLON,JLEV)) ) &
         & * ZDPSG(JLON,JLEV)
        ZTCOLLN = MAX(0.0_JPRB, MIN(ZAGGR      ,ZQI(JLON,JLEV)) ) &
         & * ZDPSG(JLON,JLEV)
           !
      ENDIF
        !
      ZQPRTOT2A = ZQPRTOT1 + ZACCR * ZDPSG(JLON,JLEV)
      ZQPRTOT2B = ZTCOLLL - ZACCR * ZDPSG(JLON,JLEV)
      ZQPSTOT2  = ZQPSTOT1 + ZTCOLLN
        !
      IF (LLMELTS) THEN
           !
           ! ----------------------------
           ! Snow melting
           ! ----------------------------
        ZLHFUS = FOLH(PT(JLON,JLEV),1.0_JPRB) - FOLH(PT(JLON,JLEV),0.0_JPRB)
        ZQMLTX = ZDPSG(JLON,JLEV) * PCP(JLON,JLEV) &
         & * MAX(0.0_JPRB,ZDELT(JLON,JLEV)) / ZLHFUS
           !
        ZQMLT = MIN ( ZQMLTX , ZQPSTOT2 )
           !
      ENDIF
        !
      ZQPSTOT3 = ZQPSTOT2 - ZQMLT
        !
      ZCOEF1(JLON) = ZQPRTOT2A / MAX(ZEPS,ZQPRTOT(JLON))
      ZCOEF2(JLON) = (ZQPRTOT2B + ZQPSTOT2 - ZQPSTOT3) / MAX(ZEPS,ZQPSTOT(JLON))
      ZCOEF3(JLON) = ZQPSTOT3 / MAX(ZEPS,ZQPSTOT(JLON))
        !
      PFPEVPL(JLON,JLEV) = PFPEVPL(JLON,JLEV-1) &
       & + ( ZTQEVAPPL - ZQMLT ) / TSPHY
      PFPEVPN(JLON,JLEV) = PFPEVPN(JLON,JLEV-1) &
       & + ( ZTQEVAPPN + ZQMLT ) / TSPHY
        !
      PFPFPL (JLON,JLEV) = PFPFPL (JLON,JLEV-1) &
       & + ( ZTCOLLL + ZAUTOL(JLON,JLEV) ) / TSPHY
      PFPFPN (JLON,JLEV) = PFPFPN (JLON,JLEV-1) &
       & + ( ZTCOLLN + ZAUTOI(JLON,JLEV) ) / TSPHY
        !
    ENDDO ! JLON = KIDIA, KFDIA
      !
    DO JK = KTDIA, JLEV
      DO JLON = KIDIA, KFDIA
         !
        ZQPR(JLON,JK) = ZQPR(JLON,JK) * ZCOEF1(JLON) &
         & + ZQPS(JLON,JK) * ZCOEF2(JLON)
        ZQPS(JLON,JK) = ZQPS(JLON,JK) * ZCOEF3(JLON)
         !
        ZQPROUT(JLON,JLEV) = ZQPROUT(JLON,JLEV) &
         & + ZQPR(JLON,JK) * ZDZ1(JLON,JK)
        ZQPSOUT(JLON,JLEV) = ZQPSOUT(JLON,JLEV) &
         & + ZQPS(JLON,JK) * ZDZ1(JLON,JK)
         !
      ENDDO
    ENDDO
      !
    DO JLON = KIDIA, KFDIA
      ZQPROUT(JLON,JLEV) = ZQPROUT(JLON,JLEV) / ZDPSG(JLON,JLEV)
      ZQPSOUT(JLON,JLEV) = ZQPSOUT(JLON,JLEV) / ZDPSG(JLON,JLEV)
    ENDDO
    !
    !-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
  ENDDO ! LEV=1,KFLEV : end of lagragian advection 
    !-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
    !
    ! ================================================================
    ! COMPUTE FLUX ASSOCIATED TO FALLING OF PRECIPITATION
    ! ================================================================
    ! 
  DO JLEV = KTDIA, KFLEV
    DO JLON = KIDIA, KFDIA
      ZINT1 = ZDPSG(JLON,JLEV) / TSPHY
        !
      PFPLSL(JLON,JLEV) = PFPLSL(JLON,JLEV-1) - ZINT1 * &
       &   ( ZQPROUT(JLON,JLEV) - PQR    (JLON,JLEV)   ) &
       & + ( PFPFPL (JLON,JLEV) - PFPFPL (JLON,JLEV-1) ) &
       & - ( PFPEVPL(JLON,JLEV) - PFPEVPL(JLON,JLEV-1) )
      PFPLSN(JLON,JLEV) = PFPLSN(JLON,JLEV-1) - ZINT1 * &
       &   ( ZQPSOUT(JLON,JLEV) - PQS    (JLON,JLEV)   ) &  
       & + ( PFPFPN (JLON,JLEV) - PFPFPN (JLON,JLEV-1) ) &
       & - ( PFPEVPN(JLON,JLEV) - PFPEVPN(JLON,JLEV-1) )
        !
    ENDDO
  ENDDO

!- - - - - - - - - - - - - - - - - - - - - - -
ENDIF  ! End of test on TSPHY > 0.0_JPRB
!- - - - - - - - - - - - - - - - - - - - - - -

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