!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACDIFV1 ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHIF,PAPRSF,PCP,PDELP,PKTROV,PKUROV,&
 & PQ,PQL,PQI,&
 & PRDELP,PT,PU,PV,PXTROV,PXUROV,&
 & PXDROV,PXHROV,&
 ! - OUTPUT 2D .
 & PXURO,PXQRO,PXTRO,&
 !
 & PCFAQ,PCFAS,PCFATH,PCFAU,&
 & PCFBQ,PCFBS,PCFBTH,PCFBU,PCFBV,&
 & PDSE,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACDIFV1 * - CALCULS PRELIMINAIRES POUR LA DIFFUSION VERTICALE.

!     Sujet.
!     ------
!     - ROUTINE DE CALCUL ACTIF .
!       CALCULS DES COEFFICIENTS POUR LA DIFFUSION VERTICALE TURBULENTE
!       DU SOMMET VERS L'AVANT DERNIER NIVEAU POUR LA QUANTITE DE 
!       MOUVEMENT, L'ENERGIE STATIQUE SECHE, LA TEMPERATURE POTENTIELLE,
!       L'HUMIDITE SPECIFIQUE (EN INCLUANT LA CORRECTION DES HUMIDITES 
!       NEGATIVES) ET L'EAU LIQUIDE ET SOLIDE.
!       CAS DU SCHEMA DE SOL VEGETATION EXTERNE (CLE LSVEXT)
!     - COMPUTATION OF COEFFICIENTS FOR VERTICAL TURBULENT DIFFUSION 
!       FROM THE TOP TO THE LAST BUT ONE LAYER FOR MOMENTUM,
!       DRY STATIC ENERGY, POTENTIAL TEMPERATURE, SPECIFIC HUMIDITY 
!       (INCLUDING A NEGATIVE HUMIDITY CORRECTION) AND LIQUID AND SOLID
!       WATER.
!       CASE OF EXTERNAL SOIL VEGETATION SCHEME (LSVEXT KEY)

!**   Interface.
!     ----------
!        *CALL* *ACDIFV1*

!-----------------------------------------------------------------------
! 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) .

! PKTROV     : COEFFICIENT D'ECHANGE VERTICAL DE T ET Q EN KG/(M*M*S).
! PKUROV     : COEFFICIENT D'ECHANGE VERTICAL DE U ET V EN KG/(M*M*S).
! PXTROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PKTROV.
! PXUROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PKUROV.

! - 2D (1:KLEV) .

! PAPHIF     : GEOPOTENTIEL AUX NIVEAUX DES COUCHES.
! PAPRSF     : PRESSION AUX NIVEAUX DES COUCHES.
! PCP        : CHALEUR MASSIQUE A PRESSION CONSTANTE DE L'AIR.
! PDELP      : EPAISSEUR EN PRESSION DE LA COUCHE.
! PQ         : HUMIDITE SPECIFIQUE DE LA VAPEUR D'EAU.
! PRDELP     : INVERSE DE L'EPAISSEUR EN PRESSION DE LA COUCHE.
! PT         : TEMPERATURE.
! PU         : COMPOSANTE EN X DU VENT.
! PV         : COMPOSANTE EN Y DU VENT.
! PQL        : HUMIDITE SPECIFIQUE DE L'EAU LIQUIDE.
! PQI        : HUMIDITE SPECIFIQUE DE L'EAU GLACE.

! PXDROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PCDROV.
! PXHROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PCHROV.

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

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

! - 2D (1:KLEV) .

! PCFAQ      : COEFFICIENT D'ELIMINATION POUR Q
! PCFAS      : COEFFICIENT D'ELIMINATION POUR S
! PCFATH     : COEFFICIENT D'ELIMINATION POUR THETA
! PCFAU      : COEFFICIENT D'ELIMINATION POUR U ET V


! PCFBQ      : SECOND MEMBRE POUR Q
! PCFBS      : SECOND MEMBRE POUR S
! PCFBTH     : SECOND MEMBRE POUR THETA
! PCFBU      : SECOND MEMBRE POUR U
! PCFBV      : SECOND MEMBRE POUR V


! - 2D (0:KLEV) .

! PDSE       : ENERGIE STATIQUE SECHE

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

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

! COMMON/YOMCST /
! COMMON/YOMPHY2/
! COMMON/YOMPHY4/
! COMMON/FCTTRM/

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

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

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

!     Auteur.
!     -------
!        2002-01, A.L. Gibelin d'apres ACDIFUS et Polcher et al (1998)

!     Modifications.
!     --------------
!        2004-05, Adaptation a la nouvelle version d'Arpege-Climat (4.2): 
!                 Calcul des flux de ql/qi (PDIFTQL/N) et utilisation en
!                 entree de PKQROV/PKQLROV (J.F. Gueremy) - I. Zuurendonk
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!        2007-05, Bug correction on antifibrillation - F. Bouyssel
!        2008-02, Introduction of pTKE - R. Brozkova
!        F. Vana  01-Sep-2008 moving all pTKE related stuff to ACPTKE
!        2008-10, Suppresion correction humidite negative - F. Bouyssel

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

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

USE YOMPHY   , ONLY :     LDIFCONS
USE YOMCST   , ONLY :  RATM     ,RG       ,RKAPPA   ,&
 & RV       ,RCPV     ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,&
 & RBETW    ,RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,&
 & RALPD    ,RBETD    ,RGAMD 
   
USE YOMPHY2  , ONLY :  TSPHY    ,LMULAF

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)    :: PAPHIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKTROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKUROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQL(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQI(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRDELP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PV(KLON,KLEV) 

REAL(KIND=JPRB)   ,INTENT(INOUT) :: PXTROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PXUROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PXDROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PXHROV(KLON)

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXURO(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXQRO(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXTRO(KLON,0:KLEV)

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFAQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFAS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFATH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFAU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFBQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFBS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFBTH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFBU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCFBV(KLON,KLEV)

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDSE(KLON,KLEV) 

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

REAL(KIND=JPRB) :: ZIPOI(KLON,KLEV),ZPOID(KLON,KLEV),ZQT(KLON,KLEV)&
 & ,ZTHETA(KLON,KLEV),ZTL(KLON,KLEV)

INTEGER(KIND=JPIM) :: JLEV, JLON

REAL(KIND=JPRB) :: ZELIM, ZELIM1, ZGDT, ZGDTI, ZMUL

REAL(KIND=JPRB) :: ZLV, ZLS
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

!     FUNCTIONS THERMODYNAMIQUES DE BASE
#include "fcttrm.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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


!     ------------------------------------------------------------------
!     I - VERT DIFF DES VARIABLES CONSERV.
!         VERT DIFF OF CONSERV VARIABLES.

IF ( LDIFCONS ) THEN
!cdir unroll=8
  DO JLEV = KTDIA, KLEV
    DO JLON = KIDIA, KFDIA
      ZLV  = FOLH(PT(JLON,JLEV),0.0_JPRB)
      ZLS  = FOLH(PT(JLON,JLEV),1.0_JPRB)
      ZQT(JLON,JLEV) = PQ(JLON,JLEV)+PQL(JLON,JLEV)+PQI(JLON,JLEV)
      ZTL(JLON,JLEV) = PT(JLON,JLEV) &
       & - (ZLV*PQL(JLON,JLEV)+ZLS*PQI(JLON,JLEV))/PCP(JLON,JLEV)
    ENDDO
  ENDDO
ELSE
!cdir unroll=8
  DO JLEV = KTDIA, KLEV
    DO JLON = KIDIA, KFDIA
      ZQT(JLON,JLEV)  = PQ (JLON,JLEV)
      ZTL(JLON,JLEV)  = PT (JLON,JLEV)
    ENDDO
  ENDDO
ENDIF !(LDIFCONS)

!*
!     ------------------------------------------------------------------
!     II - CALCUL DES PARAMETRES DERIVES 

!          COMPUTATION OF DERIVED PARAMETERS 

ZGDT=RG*TSPHY
ZGDTI=1.0_JPRB/ZGDT

IF (LMULAF) THEN
  DO JLEV=KTDIA+1,KLEV-1
    DO JLON=KIDIA,KFDIA
      PXTROV(JLON,JLEV)=MAX(PXTROV(JLON,JLEV),PXTROV(JLON,JLEV-1))
      PXUROV(JLON,JLEV)=MAX(PXUROV(JLON,JLEV),PXUROV(JLON,JLEV-1))
    ENDDO
  ENDDO
  DO JLON=KIDIA,KFDIA
    PXDROV(JLON)=MAX(PXDROV(JLON),PXUROV(JLON,KLEV-1))
    PXHROV(JLON)=MAX(PXHROV(JLON),PXTROV(JLON,KLEV-1))
  ENDDO
ENDIF

!*
!     ------------------------------------------------------------------
!     III - CALCULS PRELIMINAIRES D'ENERGIE STATIQUE SECHE, D'HUMIDITE
!     SPECIFIQUE CORRIGEE DES VALEURS NEGATIVES PAR POMPAGE DEPUIS LE
!     BAS (SAUF DANS LE CAS DU PLUS BAS NIVEAU CONSIDERE COMME POSSEDANT
!     UNE SOURCE FICTIVE A LA SURFACE) ET DE CARACTERISTIQUE DES NIVEAUX
!     DANS L'UNITE DES COEFFICIENTS D'ECHANGE NORMALISES (KG/M**2/S)
!     POUR "POID" ET SON INVERSE POUR "IPOI".

!           PRELIMINARY COMPUTATIONS OF DRY STATIC ENERGY, SPECIFIC
!     HUMIDITY CORRECTED OF ITS NEGATIVE VALUES THROUGH UPWARDS PUMPING
!     (EXCEPT IN THE CASE OF THE LOWEST LEVEL ASSUMED TO POSSES A
!     FICTITIOUS SOURCE AT THE SURFACE) AND OF LAYERS' CHARACTERISTICS
!     IN THE UNITS OF THE NORMALIZED EXCHANGE COEFFICIENTS (KG/M**2/S)
!     FOR "POID" AND ITS INVERSE FOR "IPOI".

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

! ZPOID     : DP/(RG*DT) POUR UNE COUCHE ET UN PAS DE TEMPS DONNES.
!           : DP/(RG*DT) FOR A GIVEN LAYER AND A GIVEN TIME STEP.
! ZIPOI     : INVERSE DE ZPOID.
!           : INVERSE OF ZPOID.
! ZTHETA    : TEMPERATURE POTENTIELLE
!           : POTENTIAL TEMPERATURE

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZPOID(JLON,JLEV)=PDELP(JLON,JLEV)*ZGDTI
    ZIPOI(JLON,JLEV)=PRDELP(JLON,JLEV)*ZGDT
    PDSE(JLON,JLEV)=PCP(JLON,JLEV)*ZTL(JLON,JLEV)+PAPHIF(JLON,JLEV)
    ZTHETA(JLON,JLEV)=ZTL(JLON,JLEV)&
     & *(RATM/PAPRSF(JLON,JLEV))**RKAPPA  
  ENDDO
ENDDO


!     AMPLIFICATION EVENTUELLE "ANTI-FIBRILLATION" DES COEFFICIENTS
!     D'ECHANGE.
!     POTENTIAL "ANTI-FIBRILLATION" AMPLIFICATION OF THE EXCHANGE
!     COEFFICIENTS.

!cdir unroll=8
DO JLEV=KTDIA,KLEV-1
  DO JLON=KIDIA,KFDIA
    PXURO(JLON,JLEV)=PKUROV(JLON,JLEV)*PXUROV(JLON,JLEV)
  ENDDO
ENDDO


!*
!     ------------------------------------------------------------------
!     IV - CALCULS POUR LA QUANTITE DE MOUVEMENT : PARTIE ELIMINATION.
!     DANS TOUTE LA SUITE ON UTILISERA ZELIM POUR DESIGNER L'ELEMENT
!     SUBDIAGONAL PAR LEQUEL IL FAUT MULTIPLIER LA LIGNE PRECEDENTE POUR
!     L'ELIMINER PAR SOUSTRACTION ET ZMUL POUR DESIGNER LE FACTEUR
!     MULTIPLICATIF DESTINE A METTRE LA DIAGONALE PRINCIPALE A "1".
!     PCFAU (U ET V), PCFAS, PCFAQ CONTIENDRONT LES COEFFICIENTS SURDIAGONAUX
!     MODIFIES QUI SERONT UTILISES LORS DE LA SUBSTITUTION 
!     ET PCFBU, PCFBV, PCFBS, PCFBQ CONTIENDRONT LES
!     SECONDS MEMBRES DESTINES A DEVENIR LES VALEURS FINALES.
!     PCFATH ET PCFBTH SERONT UTILISES POUR LA RESOLUTION DU BILAN
!     D'ENERGIE EN SURFACE DANS LE MODULE DE SOL-VEGETATION.

!          COMPUTATIONS FOR MOMENTUM / ELIMINATION PART. IN ALL THE
!     FOLLOWING ONE WILL USE ZELIM TO NAME THE SUBDIAGONAL ELEMENT BY
!     WHICH ONE SHOULD MULTIPLY THE PRECEEDING LINE TO ELIMINATE IT BY
!     SUBSTRACTION AND ZMUL TO NAME THE MULTIPLYING FACTOR TO PUT THE
!     MAIN DIAGONAL TO "1". PCFAU (U ET V), PCFAS, PCFAQ WILL CONTAIN 
!     THE MODIFIED SUPERDIAGONAL COEFFICIENTS THAT WILL BE USED IN THE 
!     SUBSTITUTION AND PCFBU, PCFBV, PCFBS, PCFBQ WILL
!     CONTAIN THE RIGHT HAND SIDES DUE TO BECOME THE FINAL VALUES.
!     PCFATH AND PCFBTH WILL BE USED FOR THE RESOLUTION OF THE 
!     SURFACE ENERGY BALANCE IN THE SOIL-VEGETATION MODULE.

!     ELIMINATION AU SOMMET POUR U ET V.
!     ELIMINATION AT THE TOP FOR U AND V.

DO JLON=KIDIA,KFDIA
  ZELIM1           =PXURO(JLON,KTDIA)*ZIPOI(JLON,KTDIA)
  ZMUL             =1.0_JPRB/(1.0_JPRB+ZELIM1)
  PCFAU(JLON,KTDIA)=ZMUL*ZELIM1
  PCFBU(JLON,KTDIA)=ZMUL*PU(JLON,KTDIA)
  PCFBV(JLON,KTDIA)=ZMUL*PV(JLON,KTDIA)
ENDDO

!     ELIMINATION POUR UNE COUCHE STANDARD POUR U ET V.
!     ELIMINATION FOR A STANDARD LEVEL FOR U AND V.

DO JLEV=KTDIA+1,KLEV-1
  DO JLON=KIDIA,KFDIA
    ZELIM           =PXURO(JLON,JLEV-1)*ZIPOI(JLON,JLEV)
    ZELIM1          =PXURO(JLON,JLEV)  *ZIPOI(JLON,JLEV)
    ZMUL            =1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFAU(JLON,JLEV-1))+ZELIM1)
    PCFAU(JLON,JLEV)=ZMUL*ZELIM1
    PCFBU(JLON,JLEV)=ZMUL*(PU(JLON,JLEV)+ZELIM*PCFBU(JLON,JLEV-1))
    PCFBV(JLON,JLEV)=ZMUL*(PV(JLON,JLEV)+ZELIM*PCFBV(JLON,JLEV-1))
  ENDDO
ENDDO

!      COEFFICIENTS AU DERNIER NIVEAU POUR U ET V.
!      PCFAU(KLEV) EST LE COEFFICIENT DU FLUX DE SURFACE ET NON DE LA 
!      VARIABLE AU NIVEAU INFERIEUR.
!      COEFFICIENTS AT LAST LEVEL FOR U AND V.
!      PCFAU(KLEV) IS THE COEFFICIENT FOR THE SURFACE FLUX AND NOT 
!      FOR THE FIELD AT LOWER LEVEL.

DO JLON=KIDIA,KFDIA
  ZELIM           =PXURO(JLON,KLEV-1)*ZIPOI(JLON,KLEV)
  ZMUL            =1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFAU(JLON,KLEV-1)))
  PCFAU(JLON,KLEV)=-ZMUL*ZIPOI(JLON,KLEV)*PXDROV(JLON)
  PCFBU(JLON,KLEV)=ZMUL*(PU(JLON,KLEV)+ZELIM*PCFBU(JLON,KLEV-1))
  PCFBV(JLON,KLEV)=ZMUL*(PV(JLON,KLEV)+ZELIM*PCFBV(JLON,KLEV-1))
ENDDO

!*
!     ------------------------------------------------------------------
!     V - CALCULS POUR LA TEMPERATURE ET L'HUMIDITE SPECIFIQUE :
!     PARTIE ELIMINATION. ON DIFFERENTIE LES
!     COEFFICIENTS NORMALISES (A PRIORI EGAUX) POUR S ET Q.

!         COMPUTATION FOR TEMPERATURE AND SPECIFIC HUMIDITY :
!     ELIMINATION PART. ONE DIFFERENTIATES THE
!     (A PRIORI EQUAL) NORMALIZED COEFFICIENTS FOR S AND Q.

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

! PXQRO     : VALEUR (DUPLIQUEE DE PKTROV) POUR LA DIFFUSION DE Q
!              MODIFIE POUR ATTENUER LES FIBRILLATIONS.
!           : VALUE (DUPLICATED FROM PKTROV) FOR THE Q DIFFUSION
!              MODIFIED TO ATTENUATE FIBRILLATIONS.
! PXTRO     : VALEUR (DUPLIQUEE DE PKTROV) POUR LA DIFFUSION DE S
!              MODIFIE POUR ATTENUER LES FIBRILLATIONS.
!           : VALUE (DUPLICATED FROM PKTROV) FOR THE S DIFFUSION
!              MODIFIED TO ATTENUATE FIBRILLATIONS.

!     DUPLICATION DES COEFFICIENTS D'ECHANGE VERTICAL DE S POUR Q.
!     DUPLICATION OF THE VERTICAL EXCHANGE COEFFICIENTS FOR S AND Q.

!     AMPLIFICATION EVENTUELLE "ANTI-FIBRILLATION" DES COEFFICIENTS
!     D'ECHANGE.
!     POTENTIAL "ANTI-FIBRILLATION" AMPLIFICATION OF THE EXCHANGE
!     COEFFICIENTS.


!cdir unroll=8
DO JLEV=KTDIA,KLEV-1
  DO JLON=KIDIA,KFDIA
    PXQRO(JLON,JLEV)=PKTROV(JLON,JLEV)*PXTROV(JLON,JLEV)
    PXTRO(JLON,JLEV)=PKTROV(JLON,JLEV)*PXTROV(JLON,JLEV)
  ENDDO
ENDDO


!     ELIMINATION AU SOMMET POUR S ET THETA.
!     TOP ELIMINATION FOR S AND THETA.

DO JLON=KIDIA,KFDIA
  ZELIM1           =PXTRO(JLON,KTDIA)*ZIPOI(JLON,KTDIA)
  ZMUL             =1.0_JPRB/(1.0_JPRB+ZELIM1)
  PCFAS(JLON,KTDIA)=ZMUL*ZELIM1
  PCFBS(JLON,KTDIA)=ZMUL*PDSE(JLON,KTDIA)
  PCFATH(JLON,KTDIA)=ZMUL*ZELIM1
  PCFBTH(JLON,KTDIA)=ZMUL*ZTHETA(JLON,KTDIA)
ENDDO

!     ELIMINATION POUR UNE COUCHE STANDARD POUR S ET THETA.
!     ELIMINATION FOR A STANDARD LAYER FOR S AND THETA.

DO JLEV=KTDIA+1,KLEV-1
  DO JLON=KIDIA,KFDIA
    ZELIM=PXTRO(JLON,JLEV-1)*ZIPOI(JLON,JLEV)
    ZELIM1=PXTRO(JLON,JLEV)*ZIPOI(JLON,JLEV)
    ZMUL=1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFAS(JLON,JLEV-1))+ZELIM1)
    PCFAS(JLON,JLEV)=ZMUL*ZELIM1
    PCFBS(JLON,JLEV)=ZMUL*(PDSE(JLON,JLEV)+ZELIM*PCFBS(JLON,JLEV-1))
    ZMUL=1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFATH(JLON,JLEV-1))+ZELIM1)
    PCFATH(JLON,JLEV)=ZMUL*ZELIM1
    PCFBTH(JLON,JLEV)=ZMUL*(ZTHETA(JLON,JLEV)+ZELIM*PCFBTH(JLON,JLEV-1))
  ENDDO
ENDDO

!      COEFFICIENTS AU DERNIER NIVEAU POUR S ET THETA.
!      PCFAS(KLEV) EST LE COEFFICIENT DU FLUX DE SURFACE ET NON DE LA 
!      VARIABLE AU NIVEAU INFERIEUR.
!      COEFFICIENTS AT LAST LEVEL FOR S AND THETA.
!      PCFAS(KLEV) IS THE COEFFICIENT FOR THE SURFACE FLUX AND NOT 
!      FOR THE FIELD AT LOWER LEVEL.

DO JLON=KIDIA,KFDIA
  ZELIM=PXTRO(JLON,KLEV-1)*ZIPOI(JLON,KLEV)
  ZMUL=1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFAS(JLON,KLEV-1)))
  PCFAS(JLON,KLEV)=-ZMUL*ZIPOI(JLON,KLEV)
  PCFBS(JLON,KLEV)=ZMUL*(PDSE(JLON,KLEV)+ZELIM*PCFBS(JLON,KLEV-1))
  ZMUL=1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFATH(JLON,KLEV-1)))
  PCFATH(JLON,KLEV)=-ZMUL*ZIPOI(JLON,KLEV)
  PCFBTH(JLON,KLEV)=ZMUL*(ZTHETA(JLON,KLEV)+ZELIM*PCFBTH(JLON,KLEV-1))
ENDDO

!     ELIMINATION AU SOMMET POUR Q.
!     TOP ELIMINATION FOR Q.

DO JLON=KIDIA,KFDIA
  ZELIM1=PXQRO(JLON,KTDIA)*ZIPOI(JLON,KTDIA)
  ZMUL=1.0_JPRB/(1.0_JPRB+ZELIM1)
  PCFAQ(JLON,KTDIA)=ZMUL*ZELIM1
  PCFBQ(JLON,KTDIA)=ZMUL*ZQT(JLON,KTDIA)
ENDDO

!     ELIMINATION POUR UNE COUCHE STANDARD POUR L'HUMIDITE SPECIFIQUE
!     CORRIGEE DES VALEURS NEGATIVES, Q.
!     ELIMINATION FOR A STANDARD LAYER FOR THE SPECIFIC HUMIDITY
!     CORRECTED FROM NEGATIVE VALUES, Q.

DO JLEV=KTDIA+1,KLEV-1
  DO JLON=KIDIA,KFDIA
    ZELIM=PXQRO(JLON,JLEV-1)*ZIPOI(JLON,JLEV)
    ZELIM1=PXQRO(JLON,JLEV)  *ZIPOI(JLON,JLEV)
    ZMUL=1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFAQ(JLON,JLEV-1))+ZELIM1)
    PCFAQ(JLON,JLEV)=ZMUL*ZELIM1
    PCFBQ(JLON,JLEV)=ZMUL*(ZQT(JLON,JLEV)+ZELIM*PCFBQ(JLON,JLEV-1))
  ENDDO
ENDDO

!      COEFFICIENTS AU DERNIER NIVEAU POUR Q.
!      PCFAQ(KLEV) EST LE COEFFICIENT DU FLUX DE SURFACE ET NON DE LA 
!      VARIABLE AU NIVEAU INFERIEUR.
!      COEFFICIENTS AT LAST LEVEL Q.
!      PCFAQ(KLEV) IS THE COEFFICIENT FOR THE SURFACE FLUX AND NOT 
!      FOR THE FIELD AT LOWER LEVEL.

DO JLON=KIDIA,KFDIA
  ZELIM           =PXQRO(JLON,KLEV-1)*ZIPOI(JLON,KLEV)
  ZMUL            =1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-PCFAQ(JLON,KLEV-1)))
  PCFAQ(JLON,KLEV)=-ZMUL*ZIPOI(JLON,KLEV)
  PCFBQ(JLON,KLEV)=ZMUL*(ZQT(JLON,KLEV)+ZELIM*PCFBQ(JLON,KLEV-1))
ENDDO

!     ------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ACDIFV1',1,ZHOOK_HANDLE)
END SUBROUTINE ACDIFV1
