! -----------------------------------------------------------------------
SUBROUTINE ACCVIMPDGY( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 ! -----------------------------------------------------------------------
 ! - INPUT  2D .
 & KNCDN,KNLAB,&
 & PALPH,PAPHIF,PAPRS,PAPRSF,&
 & PDELP,PLH,PLNPR,PQ,PQLIC,PQLIS,&
 & PQSAT,PQW,PR,PT,PTW,&
 & PU,PV,&
 ! - OUTPUT 2D .
 & PBET,PDELA,PFORM,PQDN,&
 & PQN2,PSDN,PUM,PVM,&
 ! - OUTPUT 1D .
 & KNLABD,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACCVIMPDGY * - SCHEMA DE COURANTS DESCENDANTS A FLUX DE MASSE.

! Sujet.
! ------
!     - CALCUL DES FLUX DE CONDENSATION ET DE TRANSPORT CONVECTIFS
!       DESCENDANTS PAR UN SCHEMA A FLUX DE MASSE.

!     - MASS-FLUX DOWNDRAFT SCHEME, COMPUTING CONVECTIVE
!       CONDENSATION AND TRANSPORT FLUXES.

! **   Interface.
! ----------
! *CALL* *ACCVIMPDGY*

! -----------------------------------------------------------------------
! 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 (NIVEL DU SOMMET
!            : DU NUAGE).
! KLEV       : DIMENSION VERTICALE DES TABLEAUX "FULL LEVEL".

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

! KNCDN      : NIVEAU DU POINT DE CONDENSATION.
! KNLAB      : INDICE D'ACTIVITE CONVECTIVE (NUAGE SI EGAL A UN).

! - 2D (0:KLEV) .

! PAPRS      : PRESSION AUX DEMI-NIVEAUX.

! - 2D (1:KLEV) .

! PALPH      : LOG(PAPRS(JLEV)/PAPRSF(JLEV)) (POUR L'HYDROSTATIQUE).
! PAPHIF     : GEOPOTENTIEL AUX NIVEAUX DES COUCHES.
! PAPRSF     : PRESSION AUX NIVEAUX DES COUCHES.
! PDELP      : EPAISSEUR EN PRESSION DE LA COUCHE.
! PLH        : CHALEUR LATENTE A LA TEMPERATURE DE L'AIR.
! PLNPR      : LOG(PAPRS(JLEV)/PAPRS(JLEV-1)) (POUR L'HYDROSTATIQUE).
! PQ         : HUMIDITE SPECIFIQUE DE LA VAPEUR D'EAU.
! PQLIC      : EAU LIQUIDE OU SOLIDE CONVECTIVE.
! PQLIS      : EAU LIQUIDE OU SOLIDE STRATIFORME.
! PQSAT      : HUMIDITE SPECIFIQUE DE SATURATION.
! PQW        : HUMIDITE SPECIFIQUE DU THERMOMETRE MOUILLE.
! PR         : CONSTANTE DES GAZ POUR L'AIR.
! PT         : TEMPERATURE.
! PTW        : TEMPERATURE DU THERMOMETRE MOUILLE.
! PU         : COMPOSANTE EN X DU VENT.
! PV         : COMPOSANTE EN Y DU VENT.

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

! -   ARGUMENTS EN SORTIE.
! ---------------------------

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

! - 2D (0:KLEV) .

! PFORM      : PROFIL DE FLUX DE MASSE.

! - 2D (1:KLEV) .

! PBET       : COEFFICIENT BETA DE LA VITESSE HORIZONTALE.
! PDELA      : COEFFICIENT DE DETRAINEMENT.
! PQDN       : HUMIDITE DE DETRAINEMENT DU COURANT DESCENDANT.
! PQN2       : HUMIDITE DU COURANT DESCENDANT.
! PSDN       : ENERGIE STATIQUE SECHE DE DETRAINEMENT DU C. DESCENDANT.
! PUM        : MOYENNE PONDEREE DE LA VITESSE U DEPUIS LA SURFACE.
! PVM        : MOYENNE PONDEREE DE LA VITESSE V DEPUIS LA SURFACE.

! KNLABD     : INDICE DE COURANT DESCENDANT (C.D. SI EGAL A UN).

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

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

! COMMON/YOMPHY /
! COMMON/YOMCST /
! COMMON/YOMPHY0/
! COMMON/FCTTRM /

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

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

!     Methode.
!     --------
!        SCHEMA A FLUX DE MASSE (J.F. GUEREMY)

!        MASS-FLUX SCHEME (J.F. GUEREMY)

!     Auteur.
!     -------
!        02-09, J.F. GUEREMY (à partir de accvimp codé par J.F. GELEYN)

!     Modifications.
!     --------------
!        04-11, Calcul de la subsidence compensatoire avec le courant
!               ascendant - J.F. GUEREMY
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        06-01, Modif variables de detrainement dans la couche
!               seche - J.F. GUEREMY
!        06-03, KDN renamed to RKDN - A.Alias

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

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

USE YOMPHY   , ONLY : NBITER   ,LNEIGE   
USE YOMCST   , ONLY : RG       ,RD       ,RV       ,RCPD     ,&
 & RCPV     ,RETV     ,RCW      ,RCS      ,RLVTT    ,&
 & RLSTT    ,RTT      ,RALPW    ,RBETW    ,RGAMW    ,&
 & RALPS    ,RBETS    ,RGAMS    ,RALPD    ,RBETD    ,&
 & RGAMD  
USE YOMPHY0  , ONLY :     TENTR    ,TENTRX    ,&
 & GDDSDE   ,TDDGP    ,GCVADS   ,GAMAP1   ,RKDN

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 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNCDN(KLON,KLEV) 
INTEGER(KIND=JPIM),INTENT(IN)    :: KNLAB(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PALPH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLIC(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLIS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQSAT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQW(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTW(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBET(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDELA(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFORM(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQDN(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQN2(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSDN(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUM(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVM(KLON,KLEV) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KNLABD(KLON,KLEV) 
CHARACTER(LEN=8)  ,INTENT(IN)    :: CDLOCK 
!     DUMMY REAL
!     DUMMY INTEGER
INTEGER(KIND=JPIM) ::INIVBDC(KLON,KLEV)

REAL(KIND=JPRB) :: ZEPSI(KLON,KLEV)&
 & ,ZCP(KLON)&
 & ,ZLH(KLON),ZMIX(KLON)&
 & ,ZQB(KLON),ZQN(KLON)&
 & ,ZRBB(KLON),ZRBH(KLON),ZRVH(KLON)&
 & ,ZTB(KLON),ZTN(KLON)&
 & ,ZVVERFM1(KLON)&
 & ,ZVVER(KLON,0:KLEV),ZDWNDP(KLON,0:KLEV)&
 & ,ZFMOD(KLON,0:KLEV)  

REAL(KIND=JPRB) :: ZGAMA, ZKD, ZRVMD, ZCPVMD, ZCPVMW, ZCPVMS&
 & , ZEPSO, ZENTR, ZDELTA, ZDCP, ZDELT, ZDELQ, ZEW&
 & , ZESP, ZQW, ZDQW, ZCPS, ZTD, ZTNSEC, ZTVN, ZTVE, ZFLO, ZFLOI&
 & , ZDELPF, ZENTRT, ZVVERDEN, ZVVERN, ZVVERF, ZENTRO, ZTEST  

INTEGER(KIND=JPIM) :: JLEV, JLON, ITOP, JIT, ICDN, IBDC, IVVER, IDOMDP&
 & , IKUO1, INUA, ISUM  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "fcttrm.h"

#include "abor1.intfb.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

! *
! ------------------------------------------------------------------

!     I - CONSTANTES AUXILIAIRES.

!         AUXILIARY CONSTANTS.

! PARAMETRE DE MASSE VIRTUELLE + 1.
ZGAMA=GAMAP1
! COEFFICIENT DE RESISTANCE.
ZKD=RKDN*TENTRX/TENTR

ZRVMD=RV-RD
ZCPVMD=RCPV-RCPD
ZCPVMW=RCPV-RCW
ZCPVMS=RCPV-RCS

! *
! ------------------------------------------------------------------
!     II - CALCUL DES PARAMETRES DERIVES, CONSTANTES DE SECURITE (POUR
!     TROIS DES INTEGRALES VERTICALES DU SCHEMA).

!     COMPUTATION OF DERIVED PARAMETERS, SECURITY CONSTANTS (FOR
!     THREE OF THE VERTICAL INTEGRALS OF THE SCHEME).

ZEPSO=1.E-12_JPRB

! *
! ------------------------------------------------------------------
!     III - MISE A ZERO DE TOUS LES FLUX (POUR LE CAS SANS CONVECTION)

!           SETTING ALL FLUXES TO ZERO (FOR THE CASE WITHOUT CONVECTION)

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

! ZFMOD      : FONCTION DE LA VITESE DU COURANT DESCENDANT.

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

!      MISE A UN DE LA FONCTION DE MODULATION.
!      SETTING MODULATION FUNCTION TO ONE.

    ZFMOD(JLON,JLEV)=1.0_JPRB

  ENDDO
ENDDO

! *
! ------------------------------------------------------------------
!     IV - INITIALISATION A LA BASE. LE PROFIL DU COURANT DESCENDANT
!     SERA FINALEMENT CARACTERISE PAR SON HUMIDITE TOTALE ET SON ENERGIE
!     STATIQUE SECHE DE DETRAINEMENT AINSI QUE PAR UN INDICE DE STABILITE
!     (UN AUX DEUX BOUTS DE TOUTE COUCHE (DE COUCHE DU MODELE A COUCHE DU
!     MODELE ADJACENTE) ET ZERO AILLEURS) ET UN PROFIL NON ENCORE NORME
!     DU FLUX DE MASSE, TABLEAU DANS LEQUEL SERA ENSUITE RANGE LE
!     PRODUIT DU FLUX DE MASSE PAR LE PAS DE TEMPS (HOMOGENE A UNE
!     PRESSION).

!     BOTTOM INITIALISATION. THE DOWNDRAFT PROFILE WILL EVENTUALY BE
!     CHARACTERISED BY ITS TOTAL HUMIDITY AND ITS DETRAINING DRY STATIC
!     ENERGY AS WELL AS BY A STABILITY INDEX (ONE AT BOTH ENDS OF ANY
!     SLAB (FROM MODEL LAYER TO THE ADJACENT ONE) AND ZERO
!     ELSEWHERE) AND A YET UNNORMALIZED MASS FLUX PROFILE, ARRAY IN
!     WHICH THE PRODUCT OF THE MASS FLUX BY THE TIME STEP (QUANTITY
!     HOMOGENEOUS TO A PRESSURE) WILL AFTERWARDS BE WRITEN.

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

! PFORM     : PROFIL DE FLUX DE MASSE.
!           : PROFILE OF MASS FLUX.

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

! PSDN       : ENERGIE STATIQUE SECHE DE DETRAINEMENT DU COURANT DESCENDANT.
!            : DETRAINING DRY STATIC ENERGY OF THE DOWNDRAFT.
! PQDN       : HUMIDITE DE DETRAINEMENT DU COURANT DESCENDANT.
!            : DETRAINING DOWNDRAFT HUMIDITY.

DO JLON=KIDIA,KFDIA

!     CARACTERISTIQUES THERMODYNAMIQUES DU COURANT DESCENDANT.
!     THERMODYNAMIC CHARACTERISTICS OF THE DOWNDRAFT.

! - TEMPORAIRE(S) 1D .

! ZTN        : TEMPERATURE DU COURANT DESCENDANT.
!            : TEMPERATURE OF THE DOWNDRAFT.
! ZQN        : HUMIDITE SPECIFIQUE VAPEUR DU COURANT DESCENDANT.
!            : WATER VAPOUR SPECIFIC HUMIDITY OF THE DOWNDRAFT.

  ZTN(JLON)=PTW(JLON,KTDIA)
  ZQN(JLON)=PQW(JLON,KTDIA)
  PQN2(JLON,KTDIA)=ZQN(JLON)

  ZTD=PT(JLON,KTDIA)*(1.0_JPRB+(PQLIC(JLON,KTDIA)-RETV*(PQSAT(JLON,KTDIA)&
   & -PQ(JLON,KTDIA)))/(1.0_JPRB+RETV*PLH(JLON,KTDIA)*PQSAT(JLON,KTDIA)&
   & /(RV*PT(JLON,KTDIA))))  
  IF (LNEIGE) THEN
    ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZTD))
  ELSE
    ZDELTA=0.0_JPRB
  ENDIF
  ZEW=FOEW(ZTD,ZDELTA)
  ZESP=ZEW/PAPRSF(JLON,KTDIA)
  ZQW=FOQS(ZESP)
  PQDN(JLON,KTDIA)=ZQW+MAX(0.0_JPRB,PQLIC(JLON,KTDIA)-PQLIS(JLON,KTDIA))
  PSDN(JLON,KTDIA)=(RCPD+ZCPVMD*ZQW)*ZTD-FOLH(ZTD,ZDELTA)&
   & *MAX(0.0_JPRB,PQLIC(JLON,KTDIA)-PQLIS(JLON,KTDIA))+PAPHIF(JLON,KTDIA)  

!      CARACTERISTIQUES ACTIVES DU COURANT DESCENDANT.
! ACTIVE CHARACTERISTICS OF THE DOWNDRAFT.

! - TEMPORAIRE(S) 1D .

  KNLABD(JLON,KTDIA)=0
  PFORM(JLON,KTDIA-1)=0.0_JPRB

  PFORM(JLON,KLEV)=0.0_JPRB

! INIVBDC    : NIVEAU DE LA BASE DE LA DESCENDANCE CONVECTIVE.
! ZVVER      : VITESSE VERT. DE LA COLONNE CONVECTIVE AUX INTERCOUCHES.
! ZEPSI      : ENTRAINEMENT.
! PDELA      : DETRAINEMENT.
! ZVVERFM1   : VITESSE VERT. DE LA COLONNE CONVECTIVE, AU NIVEAU MOINS.
! ZDWNDP     : DERIVEE VERT. DE VITESSE VERT.
! ZCAPE      : CAPE DU NIVEAU.

  INIVBDC(JLON,KTDIA)=KTDIA
  ZVVER(JLON,KTDIA-1)=0.0_JPRB
  ZVVER(JLON,KTDIA)=0.0_JPRB
  ZEPSI(JLON,KTDIA)=TENTRX*PR(JLON,KTDIA)*PT(JLON,KTDIA)/PAPRSF(JLON,KTDIA)
  PDELA(JLON,KTDIA)=0.0_JPRB
  ZVVERFM1(JLON)=0.0_JPRB
  ZDWNDP(JLON,KTDIA-1)=0.0_JPRB
  ZDWNDP(JLON,KTDIA)=0.0_JPRB

! -TEMPORAIRES 2D: VALEUR A LA SURFACE:

! PBET       : COEFFICIENT BETA DE LA VITESSE HORIZONTALE
! PUM        : MOYENNE PONDEREE DE LA VITESSE U DEPUIS LA SURFACE
! PVM        : MOYENNE PONDEREE DE LA VITESSE V DEPUIS LA SURFACE

  PBET(JLON,KTDIA)=1.0_JPRB
  PUM(JLON,KTDIA)=PU(JLON,KTDIA)
  PVM(JLON,KTDIA)=PV(JLON,KTDIA)

ENDDO

! *
! ------------------------------------------------------------------
!     V - PREMIERE BOUCLE VERTICALE (VERS LE BAS) INCLUANT LE CALCUL
!     "EN ADIABATIQUE SATUREE" DU PROFIL DU COURANT DESCENDANT.

!     FIRST VERTICAL LOOP (DOWNWARDS) INCLUDING THE SATURATED
!     ADIABATIC TYPE CALCULATION OF THE DOWNDRAFT PROFILE.

!     INITIALISATION DU PARAMETRE QUI SERVIRA EVENTUELLEMENT A EVITER
!     DES CALCULS INUTILES EN HAUT DE L'ATMOSPHERE ET DEBUT DE LA
!     BOUCLE.
!     INITIALIZATION OF THE PARAMETER THAT SHALL EVENTUALLY HELP
!     AVOIDING UNNECESSARY COMPUTATIONS IN THE UPPER PART OF THE
!     ATMOSPHERE AND START OF THE VERTICAL LOOP.

ITOP=KTDIA
DO JLEV=KTDIA+1,KLEV

!     ADIABATIQUE SATUREE AVEC ENTRAINEMENT.
!     SATURATED ADIABAT WITH ENTRAINMENT.

  DO JLON=KIDIA,KFDIA

!     ENTRAINEMENT.
!     ENTRAINEMENT.

! - TEMPORAIRE(S) 1D .

! ZTB        : "ZTN" A LA BASE DE LA COUCHE EN INCLUANT L'ENTRAINEMENT.
!            : "ZTN" AT THE BOTTOM OF THE SLAB WITH ENTRAINMENT "IN".
! ZQB        : "ZQN" A LA BASE DE LA COUCHE EN INCLUANT L'ENTRAINEMENT.
!            : "ZQN" AT THE BOTTOM OF THE SLAB WITH ENTRAINMENT "IN".

    ZENTR=ZEPSI(JLON,JLEV-1)*PAPRSF(JLON,JLEV-1)/(PR(JLON,JLEV-1)&
     & *PT(JLON,JLEV-1))  
    ZENTR=(ZENTR+TENTRX)
    ZMIX(JLON)=ZENTR*(PAPHIF(JLON,JLEV-1)-PAPHIF(JLON,JLEV))
    ZMIX(JLON)=ZMIX(JLON)/(1.0_JPRB+ZMIX(JLON))
    ZTB(JLON)=ZTN(JLON)+ZMIX(JLON)*(PT(JLON,JLEV-1)-ZTN(JLON))
    ZQB(JLON)=ZQN(JLON)+ZMIX(JLON)*(PQ(JLON,JLEV-1)-ZQN(JLON))

!     ENTRAINEMENT DE LA VITESSE HORIZONTALE:
!     NOUVELLE PARAMETRISATION (KERSHAW & GREGORY).
!     MOMENTUM ENTRAINMENT:
!     NEW PARAMETERIZATION (KERSHAW & GREGORY).

    PBET(JLON,JLEV)=PBET(JLON,JLEV-1)*(1.0_JPRB-ZMIX(JLON))
    PUM(JLON,JLEV)=PUM(JLON,JLEV-1)&
     & +(ZMIX(JLON)*(PU(JLON,JLEV-1)-PUM(JLON,JLEV-1))&
     & +TDDGP*(PU(JLON,JLEV)-PU(JLON,JLEV-1)))&
     & /(1.0_JPRB-PBET(JLON,JLEV))  
    PVM(JLON,JLEV)=PVM(JLON,JLEV-1)&
     & +(ZMIX(JLON)*(PV(JLON,JLEV-1)-PVM(JLON,JLEV-1))&
     & +TDDGP*(PV(JLON,JLEV)-PV(JLON,JLEV-1)))&
     & /(1.0_JPRB-PBET(JLON,JLEV))  

!     COEFFICIENTS DE L'HYDROSTATIQUE DU PROFIL COURANT DESCENDANT.
!     HYDROSTATIC COEFFICIENTS FOR THE DOWNDRAFT PROFILE.

! - TEMPORAIRE(S) 1D .

! ZRBB       : POIDS DE "ZTB" DANS L'EPAISSEUR EN GEOPOTENTIEL.
!            : WEIGHT OF "ZTB" IN THE GEOPOTENTIAL THICKNESS.
! ZRBH       : POIDS DE "ZTN" A "ZQN=ZQB" DANS LA MEME EPAISSEUR.
!            : WEIGHT OF "ZTN" AT "ZQN=ZQB" IN THE SAME THICKNESS.
! ZRVH       : POUR LA CORRECTION DE VARIATION DE Q A ZRBH.
!            : FOR THE Q DEPENDENT CORRECTION OF ZRBH.

    ZRBB(JLON)=-PALPH(JLON,JLEV-1)*(RD+ZRVMD*ZQB(JLON))
    ZRBH(JLON)=(-PLNPR(JLON,JLEV)+PALPH(JLON,JLEV))*(RD+ZRVMD*ZQB(JLON))
    ZRVH(JLON)=(-PLNPR(JLON,JLEV)+PALPH(JLON,JLEV))*RV

!     DANS LE CALCUL DE L'ADIABATIQUE SATUREE GCVADS PERMET UNE
!     TRANSITION CONTINUE ENTRE LE TRAITEMENT EQUIPRESSION ET
!     EQUIGEOPOTENTIEL.

!     TO COMPUTE ADIABATIC PROFILE GCVADS ALLOWS TO GO
!     CONTINUOUSLY FROM EQUIPRESSURE TO EQUIGEOPOTENTIAL APPROACH.

    ZRBB(JLON)=(1.0_JPRB-GCVADS)*ZRBB(JLON)+GCVADS*(PAPHIF(JLON,JLEV)&
     & -PAPHIF(JLON,JLEV-1))/ZTB(JLON)    
    ZRBH(JLON)=(1.0_JPRB-GCVADS)*ZRBH(JLON)
    ZRVH(JLON)=(1.0_JPRB-GCVADS)*ZRVH(JLON)

!     CALCULS DEPENDANT DE L'OPTION NEIGE.
!     SNOW OPTION DEPENDENT CALCULATIONS.

    IF (LNEIGE) THEN
      ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZTB(JLON)))
    ELSE
      ZDELTA=0.0_JPRB
    ENDIF

!     APPEL A LA FONCTION DEFINIE POUR LE CALCUL DE LA PSEUDO CHALEUR
!     LATENTE A LA BASE (PARMI TROIS PARAMETRES CARACTERISTIQUES).
!     CALL TO THE DEFINED FUNCTION FOR THE COMPUTATION OF THE PSEUDO
!     LATENT HEAT AT THE BOTTOM (AMONG THREE CHARACTERISTIC PARAMETERS).

! - TEMPORAIRE(S) 1D .

! ZLH        : VALEUR COURANTE DU PSEUDO LH DURANT LA BOUCLE DE NEWTON.
!            : RUNNING VALUE OF THE PSEUDO LH DURING NEWTON'S LOOP.
! ZCP        : COMME PZLH MAIS POUR LA CHALEUR MASSIQUE CP.
!            : AS PZLH BUT FOR THE SPECIFIC HEAT CP.

    ZLH(JLON)= FOLH (ZTB(JLON),ZDELTA)+ZRVH(JLON)*ZTB(JLON)
    ZCP(JLON)=RCPD+ZCPVMD*ZQB(JLON)+ZRBH(JLON)
    ZDCP=ZRVH(JLON)+ZCPVMW+ZDELTA*(ZCPVMS-ZCPVMW)

!     CHANGEMENT DE NIVEAU POUR OBTENIR LA PREMIERE EBAUCHE, POINT DE
!     DEPART DE LA BOUCLE DE NEWTON.
!     CHANGE OF LEVEL TO OBTAIN A FIRST GUESS AS STARTING POINT FOR THE
!     NEWTON LOOP.

    ZDELT=PT(JLON,JLEV)-PT(JLON,JLEV-1)
    ZLH(JLON)=ZLH(JLON)+ZDCP*ZDELT
    ZDELQ=-((ZRBB(JLON)+ZRBH(JLON))*ZTB(JLON)+ZCP(JLON)*ZDELT)/ZLH(JLON)
    ZCP(JLON)=ZCP(JLON)+ZDCP*ZDELQ
    ZTN(JLON)=ZTB(JLON)+ZDELT
    ZQN(JLON)=ZQB(JLON)+ZDELQ
  ENDDO

!     BOUCLE DE NEWTON.
!     NEWTON'S LOOP.

  DO JIT=1,NBITER
    DO JLON=KIDIA,KFDIA

!     CALCULS DEPENDANT DE L'OPTION NEIGE.
!     SNOW OPTION DEPENDENT COMPUTATIONS.

      IF (LNEIGE) THEN
        ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZTN(JLON)))
      ELSE
        ZDELTA=0.0_JPRB
      ENDIF

!     CALCULS DE SATURATION UTILISANT LES FONCTIONS DEFINIES.
!     SATURATION CALCULATIONS USING DEFINED FUNCTIONS.

      ZEW= FOEW (ZTN(JLON),ZDELTA)
      ZESP=ZEW/PAPRSF(JLON,JLEV)
      ZQW= FOQS (ZESP)
      ZDQW= FODQS (ZQW,ZESP, FODLEW (ZTN(JLON),ZDELTA))

!     INCREMENTATIONS.
!     INCREMENTATIONS.

      ZDCP=ZRVH(JLON)+ZCPVMW+ZDELTA*(ZCPVMS-ZCPVMW)
      ZDELQ=(ZQW-ZQN(JLON))*ZCP(JLON)/(ZCP(JLON)+ZLH(JLON)*ZDQW)
      ZCP(JLON)=ZCP(JLON)+ZDCP*ZDELQ
      ZDELT=-ZDELQ*ZLH(JLON)/ZCP(JLON)
      ZLH(JLON)=ZLH(JLON)+ZDCP*ZDELT
      ZQN(JLON)=ZQN(JLON)+ZDELQ
      ZTN(JLON)=ZTN(JLON)+ZDELT
    ENDDO
  ENDDO

!     ADIABATIQUE SECHE.

  DO JLON=KIDIA,KFDIA
    ZCPS=RCPD*(1.0_JPRB-ZQB(JLON))+RCPV*ZQB(JLON)
    ZTNSEC=(ZCPS-ZRBB(JLON))*ZTB(JLON)/(ZCPS+ZRBH(JLON))
    ICDN=MAX(0,-SIGN(1,-KNCDN(JLON,JLEV)))
    ZTN(JLON)=ICDN*ZTN(JLON)+(1-ICDN)*ZTNSEC
    ZQN(JLON)=ICDN*ZQN(JLON)+(1-ICDN)*ZQB(JLON)
  ENDDO

!     TEST DE STABILITE, RECTIFICATION EVENTUELLE DU NIVEAU SUPERIEUR,
!     CALCUL DU PARAMETRE DE PROFIL DU FLUX DE MASSE ET DES DEUX
!     INTEGRALES INTERVENANT DANS LA CONDITION DE FERMETURE "TYPE KUO".
!     STABILITY TEST, OCCASIONAL CORRECTION OF THE BOTTOM LAYER,
!     COMPUTATION OF THE MASS FLUX PROFILE PARAMETER AND OF THE TWO
!     INTEGRALS CONNECTED WITH THE "KUO-TYPE" CLOSURE.

  DO JLON=KIDIA,KFDIA
!     TEST DE DECLENCHEMENT.
!     CALCUL DE L'INTEGRALE DE LA FLOTTABILITE
!     DURANT LE PAS DE TEMPS ET TEST DE SON SIGNE.

    IBDC=MAX(0,-SIGN(1,-INIVBDC(JLON,JLEV-1)))
    ZTVN=ZTN(JLON)*(1.0_JPRB+RETV*ZQN(JLON))
    ZTVE=PT(JLON,JLEV)*(1.0_JPRB+RETV*PQ(JLON,JLEV))
    ZFLO=(ZTVE-ZTVN)/ZTVE/ZTVE
    ZFLOI=RG*RG*PAPRSF(JLON,JLEV)/(RD*ZGAMA)
    ZFLO=ZFLOI*ZFLO

    ZDELPF=PDELP(JLON,JLEV)
    ZENTR=ZEPSI(JLON,JLEV-1)
    ZENTRT=TENTRX*PR(JLON,JLEV)*PT(JLON,JLEV)/PAPRSF(JLON,JLEV)
    ZENTR=ZENTR+ZENTRT

    ZVVERDEN=(0.25_JPRB*(ZKD+ZENTR)+0.5_JPRB/ZDELPF)
    ZVVERN=SQRT(MAX(0.0_JPRB,(ZFLO+(0.5_JPRB/ZDELPF-0.25_JPRB*(ZKD+ZENTR))&
     & *ZVVER(JLON,JLEV-1)**2)/ZVVERDEN))  

    ZVVER(JLON,JLEV)=ZVVERN
    ZVVERF=0.5_JPRB*(ZVVER(JLON,JLEV)+ZVVER(JLON,JLEV-1))
    ZDELPF=PAPRSF(JLON,JLEV)-PAPRSF(JLON,JLEV-1)
    ZDWNDP(JLON,JLEV-1)=(ZVVERF-ZVVERFM1(JLON))/ZDELPF

    ZVVERFM1(JLON)=ZVVERF

!     ENTRAINEMENT-DETRAINEMENT ORGANISES.
    IVVER=NINT(MAX(0.0_JPRB,SIGN(1.0_JPRB,ZVVERF)))
    IDOMDP=NINT(MAX(0.0_JPRB,SIGN(1.0_JPRB,ZDWNDP(JLON,JLEV-1))))
    ZENTRO=IVVER/MAX(ZEPSO,ZVVERF)*ZDWNDP(JLON,JLEV-1)
    ZEPSI(JLON,JLEV)=IDOMDP*ZENTRO
    PDELA(JLON,JLEV)=-(1-IDOMDP)*ZENTRO

    IKUO1=MAX(NINT(MAX(0.0_JPRB,-SIGN(1.0_JPRB,-ZVVER(JLON,JLEV-1))))&
     & ,NINT(MAX(0.0_JPRB,-SIGN(1.0_JPRB,-ZVVER(JLON,JLEV)))))  
    INUA=JLEV-1-INIVBDC(JLON,JLEV-1)
    INUA=MAX(0,-SIGN(1,-INUA))
    KNLABD(JLON,JLEV)=IKUO1*IBDC*KNLAB(JLON,JLEV)*KNLAB(JLON,JLEV-1)

!     VALEURS FINALES DE DETRAINEMENT AVEC APPEL A LA FONCTION DEFINIE
!     POUR REVENIR A LA VERITABLE CHALEUR LATENTE.
!     FINAL DETRAINMENT VALUES WITH A CALL TO THE DEFINED FUNCTION TO
!     COME BACK TO THE TRUE LATENT HEAT.

    ZTD=PT(JLON,JLEV)*(1.0_JPRB+(PQLIC(JLON,JLEV)-RETV*(PQSAT(JLON,JLEV)&
     & -PQ(JLON,JLEV)))/(1.0_JPRB+RETV*PLH(JLON,JLEV)*PQSAT(JLON,JLEV)&
     & /(RV*PT(JLON,JLEV))))  
    IF (LNEIGE) THEN
      ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZTD))
    ELSE
      ZDELTA=0.0_JPRB
    ENDIF
    ZEW=FOEW (ZTD,ZDELTA)
    ZESP=ZEW/PAPRSF(JLON,JLEV)
    ZQW=FOQS(ZESP)
    ICDN=MAX(0,-SIGN(1,-KNCDN(JLON,JLEV)))
    ZTD=ICDN*ZTD+(1-ICDN)*ZTN(JLON)
    ZQW=ICDN*ZQW+(1-ICDN)*ZQN(JLON)
    IF (LNEIGE) THEN
      ZDELTA=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-ZTD))
    ELSE
      ZDELTA=0.0_JPRB
    ENDIF
    PQDN(JLON,JLEV)=ZQW+MAX(0.0_JPRB,PQLIC(JLON,JLEV)-PQLIS(JLON,JLEV))
    PQN2(JLON,JLEV)=ZQN(JLON)
    PSDN(JLON,JLEV)=(RCPD+ZCPVMD*ZQW)*ZTD-FOLH(ZTD,ZDELTA)&
     & *MAX(0.0_JPRB,PQLIC(JLON,JLEV)-PQLIS(JLON,JLEV))+PAPHIF(JLON,JLEV)  

!     EN CAS DE COURANT DESCENDANT PLUS "CHAUD" QUE L'ENVIRONEMENT ON
!     REEGALISE  TEMPERATURE ET HUMIDITE SPECIFIQUES DU COURANT
!     DESCENDANT A CELLES DU THERMOMETRE MOUILLE DE L'ENVIRONEMENT.
!     IN CASE OF A "WARMER" DOWNDRAFT THAN THE ENVIRONMENT ONE SETS
!     BACK TEMPERATURE AND SPECIFIC HUMIDITY OF THE DOWNDRAFT TO
!     THAT OF THE WET BULB CHARACTERISTICS OF THE ENVIRONMENT.

    INUA=KNLABD(JLON,JLEV)

    INIVBDC(JLON,JLEV)=MIN(INIVBDC(JLON,JLEV-1),JLEV)
    INIVBDC(JLON,JLEV)=INUA*INIVBDC(JLON,JLEV)+(1-INUA)*JLEV
    INIVBDC(JLON,JLEV-1)=INUA*INIVBDC(JLON,JLEV-1)

    ZVVER(JLON,JLEV)=INUA*ZVVER(JLON,JLEV)

    ZTN(JLON)=INUA*ZTN(JLON)+(1-INUA)*PTW(JLON,JLEV)
    ZQN(JLON)=INUA*ZQN(JLON)+(1-INUA)*PQW(JLON,JLEV)

!     PROFIL DE FLUX DE MASSE.
!     MASS FLUX PROFILE.

    PFORM(JLON,JLEV-1)=KNLABD(JLON,JLEV)*ZVVER(JLON,JLEV-1)

    ZTEST=MAX(MAX(0.0_JPRB,-SIGN(1.0_JPRB,-PFORM(JLON,JLEV-1)))&
     & ,MAX(0.0_JPRB,-SIGN(1.0_JPRB,ZFMOD(JLON,JLEV-2)-1.0_JPRB)))  
    ZFMOD(JLON,JLEV-1)=(1.0_JPRB-ZTEST)+ZTEST*ZFMOD(JLON,JLEV-2)&
     & *((PAPRS(JLON,KLEV)-PAPRS(JLON,JLEV-1))&
     & /(PAPRS(JLON,KLEV)-PAPRS(JLON,JLEV-2)))&
     & **GDDSDE  
    PFORM(JLON,JLEV-1)=PFORM(JLON,JLEV-1)*ZFMOD(JLON,JLEV-1)

    ZFMOD(JLON,JLEV-1)=INUA*ZFMOD(JLON,JLEV-1)+(1-INUA)*1.0_JPRB

  ENDDO

!     VERIFICATION DE LA PRESENCE D'AU MOINS UN COURANT DESCENDANT LE
!     LONG DU VECTEUR "JLON" ET MODIFICATION SI NECESSAIRE DE ITOP.
!     VERIFICATION OF THE PRESENCE OF AT LEAST ONE DOWNDRAFT ALONG THE
!     "JLON" VECTOR AND MODIFICATION OF ITOP IF NECESSARY.

  ISUM=0
  DO JLON=KIDIA,KFDIA
    ISUM=ISUM+KNLABD(JLON,JLEV)
  ENDDO

  IF ((ISUM == 0).AND.(ITOP == JLEV-1)) THEN
    ITOP=JLEV
  ENDIF

ENDDO

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