!OPTIONS XOPT(NOEVAL)
SUBROUTINE ARP_GROUND_PARAM ( KIDIA,KFDIA,KLON,KTDIA,KLEV,KCSS,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHI,PCP,PFRSO,&
 & PQ,PRDELP,PT,PU,PV,PXURO,PXQRO,PXTRO,&
 & PAPRS,PQL,PQI,PCOEFN,&
 ! - INPUT  1D .
 & PCD,PCDN,PCDROV,PCHROV,PCEROV,PCPS,PCT,PDQSTS,PEMIS,PFHPS,&
 & PHQ,PHTR,PHU,PHV,PLSM,PIVEG,PNEIJ,PQS,PQSATS,&
 & PTP,PTS,PVEG,PXDROV,PXHROV,PWS,PWSI,&
 ! - INPUT  2D from acdifv1.f90
 & PDSE,&
 & PCFAS,PCFAU,&
 & PCFBS,PCFBU,PCFBV,& 
 ! -- OUTPUT 2-D for acdifv2.f90 
 & PCFBQ,PCOEFA,PALPHA1,PLVT,PQICE,&
 ! - OUTPUT 1D .
 & PDIFWQ,PDIFWS,PSFU,PSFV,&  
 ! - OUTPUT 1D .
 & PFCHSP,PFCLL,PFCLN,PFCS,PFEVI,PFEVL,PFEVN,&
 & PFEVV,PFTR,PLHS,&
 ! - INPUT/OUTPUT 2D .
 & PFRTH,&
 ! - INPUT/OUTPUT 1D .
 & PGZ0F,PGZ0HF,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!!     Sujet.
!     ------
!     - ROUTINE DE CALCUL ACTIF .
!       CALCULS DES FLUX EN SURFACE INCLUANT LA CORRECTION
!       DES HUMIDITES NEGATIVES : FLUX TURBULENTS VERTICAUX, APPEL A LA
!       FORMULE DE CHARNOCK, CORRECTION DES FLUX DE RAYONNEMENT
!       THERMIQUE ET TOUS LES FLUX AU ET DANS LE SOL CORRESPONDANTS .
!     - COMPUTATION OF SURFACE FLUX INCLUDING A NEGATIVE
!       HUMIDITY CORRECTION : VERTICAL TURBULENT FLUXES, CALL TO THE
!       CHARNOCK FORMULA, THERMAL RADIATION FLUXES' CORRECTION AND ALL
!       CORRESPONDING FLUXES AT THE SURFACE OR IN THE SOIL .

!**   Interface.
!     ----------
!        *CALL* *ARP_GROUND_PARAM*

!-----------------------------------------------------------------------
! 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".
! KCSS       : NOMBRE DE NIVEAUX PROFONDS DANS LE SOL (1 SI LSOLV=.F.).

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

! - 2D (0:KLEV) .

! PAPHI      : GEOPOTENTIEL AUX DEMI-NIVEAUX.
! PFRSO      : FLUX DE RAYONNEMENT SOLAIRE.
! 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).
! PKNROV     : COEFFICIENT D'ECHANGE VERTICAL NEUTRE (U,V) EN KG/(M*M*S).
! PXTROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PKTROV.
! PXUROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PKUROV.
! PXPTKEROV  : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PTKEROV

! - 2D (1:KLEV) .

! PAPHIF     : GEOPOTENTIEL 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.
! PAPRSF     : PRESSION AUX NIVEAUX DES COUCHES.
! PR         : CONSTANTE DES GAZ POUR L'AIR.
! PQL        : HUMIDITE SPECIFIQUE DE L'EAU LIQUIDE.
! PQI        : HUMIDITE SPECIFIQUE DE L'EAU GLACE.
! PCOEFN     : COEFFICIENT STATISTIQUE POUR LES FLUX D'EAUX CONDENSEES.
! PTKE       : TURBULENT KINETIC ENERGY
! PALPH      : LOG(PAPRS(JLEV)/PAPRSF(JLEV)) (FOR HYDROSTATICS).
! PLNPR      : LOG(PAPRS(JLEV)/PAPRS(JLEV-1)) (FOR HYDROSTATICS).
! PTENDPTKE  : TKE INCREMENT (USED BY PSEUDOPROGNOSTIC TKE SCHEME)

! - 1D (PROGNOSTIQUE) .

! PTP        : TEMPERATURE EN PROFONDEUR.
!     (KCSS)
! PTS        : TEMPERATURE DE SURFACE.
! PWS        : RESERVOIR D'EAU SUPERFICIEL.
! PWSI       : RESERVOIR D'EAU GELEE SUPERFICIEL.

! - 1D (GEOGRAPHIQUE) .

! PLSM       : INDICE TERRE/MER.
! PIVEG      : TABLEAU PERMETTANT D'IDENTIFIER LE TYPE DE VEGETATION
!              DANS CHAQUE MAILLE DU DOMAINE SIMULE.
! PVEG       : PROPORTION DE SOL COUVERT PAR LA VEGETATION.

! - 1D (DIAGNOSTIQUE) .

! PCD        : COEFFICIENT D'ECHANGE EN SURFACE POUR U ET V.
! PCDN       : COEFFICIENT NEUTRE D'ECHANGE EN SURFACE.
! PCDROV     : PCD RENORME EN DENSITE FOIS VITESSE.
! PCHROV     : PCH RENORME EN DENSITE FOIS VITESSE.
! PCEROV     : PCE RENORME EN DENSITE FOIS VITESSE.
! PCPS       : CHALEUR MASSIQUE A PRESSION CONSTANTE DE L'AIR AU SOL.
! PCT        : COEFFICIENT THERMIQUE DU MILIEU SOL-VEGETATION.
! PDQSTS     : DERIVEE DE PQSATS PAR RAPPORT A LA TEMPERATURE.
! PEMIS      : EMISSIVITE DE SURFACE COURANTE.
! PFHPS      : FLUX DE CHALEUR VERS LE SOL ASSOCIE AUX PRECIPITATIONS.
! PHQ        : POIDS DE L'HUMIDITE DE L'AIR DANS L'HUMIDITE DE SURFACE.
! PHU        : POIDS DE L'HUMIDITE SATURANTE DANS L'HUMIDITE DE SURFACE.
! PHTR       : RESISTANCE A LA TRANSPIRATION DU COUVERT VEGETAL.
! PHV        : RESISTANCE A L'EVAPOTRANSPIRATION DU COUVERT VEGETAL.
! PNEIJ      : PROPORTION DE SOL ENNEIGE.
! PQS        : HUMIDITE SPECIFIQUE DE SURFACE.
! PQSATS     : HUMIDITE SPECIFIQUE DE SATURATION EN SURFACE.
! PXDROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PCDROV.
! PXHROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PCHROV.

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

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

! - 1D 

! PDIFWQ     : FLUX TURBULENT (ET Q NEGATIF) D'HUMIDITE SPECIFIQUE.
! PDIFWS     : FLUX TURBULENT D'ENTHALPIE (OU D'ENERGIE STATIQUE SECHE).
! 
! 
! PSFU       : FLUX TURBULENT DE QUANTITE DE MOUVEMENT "U".
! PSFV       : FLUX TURBULENT DE QUANTITE DE MOUVEMENT "V".

! - 2D (1:KLEV) .

! PTENDPTKE  : TENDENCE D'ENERGIE CINETIQUE TURBULENTE.

! - 1D (DIAGNOSTIQUE) .

! PFCHSP     : FLUX DE CHALEUR DE LA SURFACE VERS LE SOL PROFOND.
!     (KCSS)
! PFCLL      : FLUX DE CHALEUR LATENTE SUR EAU LIQUIDE (OU SOL HUMIDE).
! PFCLN      : FLUX DE CHALEUR LATENTE SUR NEIGE (OU GLACE).
! PFCS       : FLUX DE CHALEUR SENSIBLE EN SURFACE.
! PFEVI      : FLUX DE VAPEUR D'EAU SUR SOL GELE.
! PFEVL      : FLUX DE VAPEUR D'EAU SUR EAU LIQUIDE (OU SOL HUMIDE).
! PFEVN      : FLUX DE VAPEUR D'EAU SUR NEIGE (OU GLACE).
! PFEVV      : FLUX D'EVAPOTRANSPIRATION.
! PFTR       : FLUX DE TRANSPIRATION.
! PLHS       : CHALEUR LATENTE EN SURFACE.

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

! -   ARGUMENTS EN ENTREE/SORTIE.
!     ---------------------------

! - 2D (0:KLEV) .

! PFRTH      : FLUX DE RAYONNEMENT THERMIQUE.

! - 1D (GEOGRAPHIQUE) .

! PGZ0F      : CHAMP TEMPOREL DE G FOIS LA LONGUEUR DE RUGOSITE.
! PGZ0HF     : CHAMP TEMPOREL DE G FOIS LA LONGUEUR DE RUGOSITE THERM.

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

!     Auteur.
!     -------
!        2008-02, R. Brozkova

!     Modified.
!     ---------
!        2008-05, F. Bouyssel Introduction de PCEROV
!-----------------------------------------------------------------------

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

! COMMON/YOMPHY /
! COMMON/YOMCST /
! COMMON/YOMMCC /
! COMMON/YOMPHY0/
! COMMON/YOMPHY1/
! COMMON/YOMPHY2/
! COMMON/FCTTRM /

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

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

USE YOMPHY   , ONLY : LNEIGE   ,LSOLV    ,LFGEL    ,LDIFCONS ,&
 & LPHSPSH ,L3MT
USE YOMCST   , ONLY : RPI      ,RDAY     ,RG       ,RSIGMA   ,&
 & RV       ,RCPD     ,RCPV     ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,&
 & RBETW    ,RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,&
 & RALPD    ,RBETD    ,RGAMD    ,RD       ,RDT  
USE YOMMCC   , ONLY : LMCC02
USE YOMPHY0  , ONLY : VCHRNK   ,VZ0CM     ,&
 & VZIUSTAR0,RDTFAC   
USE YOMPHY1  , ONLY : SODELX   ,TMERGL   ,NTVGLA   ,&
 & NCHSP  
USE YOMPHY2  , ONLY : TSPHY    


IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
INTEGER(KIND=JPIM),INTENT(IN)    :: KCSS 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHI(KLON,0:KLEV)  
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFRSO(KLON,0:KLEV)


REAL(KIND=JPRB)   ,INTENT(IN)    :: PQ(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(IN)    :: PAPRS(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQL(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQI(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCOEFN(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCDN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCDROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCHROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCEROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCT(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDQSTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PEMIS(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFHPS(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHQ(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHTR(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHU(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIVEG(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNEIJ(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQSATS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTP(KLON,KCSS) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEG(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXDROV(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXHROV(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWSI(KLON)

! - OUTPUT  2D for acdifv2.f90
 

REAL(KIND=JPRB)   ,INTENT(OUT)    :: PCFBQ(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)    :: PALPHA1(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)    :: PCOEFA(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)    :: PLVT(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(OUT)    :: PQICE(KLON,0:KLEV)

! - INPUT  2D from acdifv1.f90

REAL(KIND=JPRB)   ,INTENT(IN)    :: PDSE(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFAS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCFAU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFBS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFBU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCFBV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXURO(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXQRO(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PXTRO(KLON,0:KLEV)




REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIFWQ(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDIFWS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFU(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PSFV(KLON) 


REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCHSP(KLON,KCSS) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCLL(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCLN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFCS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFEVI(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFEVL(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFEVN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFEVV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFTR(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PLHS(KLON) 



REAL(KIND=JPRB)   ,INTENT(INOUT) :: PFRTH(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGZ0F(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGZ0HF(KLON) 
CHARACTER(LEN=16)  ,INTENT(IN)    :: CDLOCK 




REAL(KIND=JPRB) :: ZN1(KLON,KLEV),ZN2(KLON,KLEV)&
 & ,ZSUB1(KLON,KLEV),ZSUB2(KLON,KLEV)&
 & ,ZCSVT(KLON),ZRHST(KLON),ZXLRO(KLON)&
 & ,ZCHRL(KLON),ZCHRS(KLON),ZCQVQ(KLON)&
 & ,ZCQVT(KLON),ZCSDT(KLON),ZCTVQ(KLON)&
 & ,ZCTVS(KLON),ZCTVT(KLON),ZDLLS(KLON),ZDLLW(KLON)&
 & ,ZDLS(KLON),ZDRCN(KLON),ZDTPL(KLON,KCSS),ZLHS(KLON)&
 & ,ZLHW(KLON),ZPN(KLON),ZRCOR(KLON),ZRHSQ(KLON)&
 & ,ZRHSS(KLON),ZSUBS(KLON),ZNTS(KLON)&
 & ,ZWSI(KLON),ZXDRO(KLON),ZXSRO(KLON)  

REAL(KIND=JPRB) :: ZGDT,ZMUL

REAL(KIND=JPRB) :: ZIPOI(KLON,KLEV) 

REAL(KIND=JPRB) :: ZQT(KLON,KLEV)  


INTEGER(KIND=JPIM) :: JCSS, JLEV, JLON

REAL(KIND=JPRB) :: ZCPVMD, ZCPVMS, ZCPVMW, ZDIVIS, ZDLDQ, ZELIM, &
 & ZEPS1, ZFENT, ZFQ, ZPUL, &
 & ZMERL, ZDQSATL, ZLV, ZLIQ, ZDQSATI, ZLS, ZICE, ZQSATL, ZTLI, &
 & ZSRVCPT2, ZTH, ZQSATI, ZCPH,ZEISP,ZELSP      


   
  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "fcttrm.h"
#include "fctdoi.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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


!     ------------------------------------------------------------------
!     0 - FORCAGES DES FLUX DE SURFACE, DIFF VERT DES VARIABLES CONSERV.
!         SURFACE FLUXES FORCING TERMS, VERT DIFF OF CONSERV VARIABLES.


DO JLEV=KTDIA,KLEV
   DO JLON=KIDIA,KFDIA
      ZN1(JLON,JLEV)=0.0_JPRB
      ZN2(JLON,JLEV)=0.0_JPRB
      ZSUB1(JLON,JLEV)=0.0_JPRB
      ZSUB2(JLON,JLEV)=0.0_JPRB
   ENDDO
ENDDO



IF ( LDIFCONS ) THEN
  DO JLEV = KTDIA, KLEV
    DO JLON = KIDIA, KFDIA            
      ZQT(JLON,JLEV) = PQ(JLON,JLEV)+PQL(JLON,JLEV)+PQI(JLON,JLEV)      
    ENDDO
  ENDDO
  !     GOING TO HALF-LEVELS FOR THE OTHER COMPUTATIONS.

  DO JLEV=KTDIA,KLEV-1
    DO JLON=KIDIA,KFDIA
      ZTH=(PT(JLON,JLEV)+PT(JLON,JLEV+1))*0.5_JPRB
      ZLV = FOLH(ZTH,0.0_JPRB)
      ZLS = FOLH(ZTH,1.0_JPRB)
      PQICE(JLON,JLEV) = FONICE(ZTH)
      ZCPH=(PCP(JLON,JLEV)+PCP(JLON,JLEV+1))*0.5_JPRB
      ZTLI=ZTH-0.5_JPRB*(ZLV*(PQL(JLON,JLEV)+PQL(JLON,JLEV+1))&
       &                +ZLS*(PQI(JLON,JLEV)+PQI(JLON,JLEV+1)))/ZCPH
      ZICE=PQICE(JLON,JLEV)
      ZLIQ=1.0_JPRB-ZICE
      PLVT(JLON,JLEV)=ZLV*ZLIQ+ZLS*ZICE
      ZEISP = FOEW(ZTLI,1.0_JPRB)/PAPRS(JLON,JLEV) 
      ZELSP = FOEW(ZTLI,0.0_JPRB)/PAPRS(JLON,JLEV) 
      ZQSATI = FOQS(ZEISP)
      ZQSATL = FOQS(ZELSP)
      ZSRVCPT2=1.0_JPRB/(RV*ZTLI*ZTLI*ZCPH)
      ZDQSATI=ZQSATI*FOLH(ZTLI,1.0_JPRB)*ZSRVCPT2
      ZDQSATL=ZQSATL*FOLH(ZTLI,0.0_JPRB)*ZSRVCPT2
      PALPHA1(JLON,JLEV)=(ZLIQ*ZDQSATL+ZICE*ZDQSATI)
      PCOEFA(JLON,JLEV)=(PCOEFN(JLON,JLEV)+PCOEFN(JLON,JLEV+1))*0.5_JPRB&
       & /((1.0_JPRB+ZDQSATL*ZLV)*ZLIQ&
       &  +(1.0_JPRB+ZDQSATI*ZLS)*ZICE)
    ENDDO
  ENDDO
  
ELSE
    
      ! - - - - - - - - - - - - - - - - - - - - - - - - -
      ! Set the "moist" variables to "dry" neutral values
      ! - - - - - - - - - - - - - - - - - - - - - - - - -
    DO JLEV = KTDIA, KLEV
      DO JLON = KIDIA, KFDIA
      ZQT(JLON,JLEV)=PQ(JLON,JLEV)      
      ENDDO
    ENDDO

    DO JLEV=KTDIA,KLEV-1
    DO JLON=KIDIA,KFDIA
      PQICE  (JLON,JLEV)=0.0_JPRB
      PLVT   (JLON,JLEV)=0.0_JPRB
      PALPHA1(JLON,JLEV)=0.0_JPRB
      PCOEFA (JLON,JLEV)=0.0_JPRB
    ENDDO
  ENDDO
   

ENDIF

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

!          COMPUTATION OF DERIVED PARAMETERS 

ZGDT=RG*TSPHY



!     ------------------------------------------------------------------
!     I - CONSTANTES AUXILIAIRES.

!         AUXILIARY CONSTANTS.

ZCPVMD=RCPV-RCPD
ZCPVMW=RCPV-RCW
ZCPVMS=RCPV-RCS

!*
!     ------------------------------------------------------------------
!     II - CALCUL DES PARAMETRES DERIVES ET CONSTANTE DE SECURITE (POUR
!     CSDT).

!          COMPUTATION OF DERIVED PARAMETERS AND SECURITY CONSTANT (FOR
!     CSDT).



ZPUL=2.0_JPRB*RPI/RDAY

ZEPS1=1.E-08_JPRB


!*
!     ------------------------------------------------------------------
!     III - MISE A DES VALEURS CONSTANTES DES VALEURS DERIVEES DE
!     L'INERTIE THERMIQUE ET DU TEMPS CARACTERISTIQUE (DIURNE PAR
!     DEFINITION) DU SOL (PHYSIQUE DU SOL HYPER-SIMPLIFIEE).

!           SETTING TO CONSTANT VALUES OF THE VALUES DERIVED FROM THE
!     SOIL'S THERMAL INERTIA AND CHARACTERISTIC TIME (DIURNAL BY
!     DEFINITION) (HYPER-SIMPLIFIED SOIL PHYSICS).

! - TEMPORAIRE(S) 1D .

! ZCSDT     : PRODUIT DU PAS DE TEMPS PAR LA CONSTANTE DU SOL.
!            : PRODUCT OF THE TIME-STEP BY THE SOIL CONSTANT.
! ZDTPL     : PRODUIT DU PAS DE TEMPS PAR LA PULSATION DIURNE.
!     (KCSS)
!            : PRODUCT OF THE TIME-STEP BY THE DIURNAL PULSATION.

!     CALCULS OPTIONNELS SUIVANT LE TYPE DE SCHEMA SOL/VEG CHOISI.
!     OPTIONAL COMPUTATIONS ACCORDING TO THE CHOSEN SOIL/VEG SCHEME.

IF (LSOLV) THEN
  DO JLON=KIDIA,KFDIA
    ZCSDT(JLON)=PLSM(JLON)*TSPHY*PCT(JLON)
  ENDDO
  DO JCSS=1,KCSS
    ZDIVIS=1.0_JPRB/(SODELX(0)*(SODELX(JCSS-1)+SODELX(JCSS)))
    DO JLON=KIDIA,KFDIA
      IF (NCHSP == 0) THEN
        ZDTPL(JLON,JCSS)=PLSM(JLON)*TSPHY*ZPUL*ZDIVIS
      ELSE
        ZDTPL(JLON,JCSS)=PLSM(JLON)*TSPHY*ZPUL*ZDIVIS*(1.0_JPRB-PNEIJ(JLON)&
         &**NCHSP)
      ENDIF
    ENDDO
  ENDDO
ELSE
  DO JLON=KIDIA,KFDIA
    ZCSDT(JLON)=PLSM(JLON)*TSPHY*PCT(JLON)
    ZDTPL(JLON,1)=PLSM(JLON)*TSPHY*ZPUL
  ENDDO
  DO JCSS=2,KCSS
    DO JLON=KIDIA,KFDIA
      ZDTPL(JLON,JCSS)=0.0_JPRB
    ENDDO
  ENDDO
ENDIF


!*

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZIPOI(JLON,JLEV)=PRDELP(JLON,JLEV)*ZGDT
  ENDDO
ENDDO

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

DO JLON=KIDIA,KFDIA
  ZXDRO(JLON)=PCDROV(JLON)*PXDROV(JLON)
ENDDO

!     ------------------------------------------------------------------
!     VI - CALCULS POUR LA QUANTITE DE MOUVEMENT : CONDITION DE SURFACE,
!     CALCUL DE "CHARNOCK" PUIS SUBSTITUTION AVEC CALCUL DES FLUX A TOUS
!     LES NIVEAUX.

!          COMPUTATION FOR MOMENTUM : SURFACE CONDITION, "CHARNOCK-TYPE"
!     CALCULATION THEN SUBSTITUTION WITH FLUXES' COMPUTATION AT ALL
!     LEVELS.

!     CALCULS EN SURFACE.
!     SURFACE CALCULATIONS.


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))+ZXDRO(JLON)&
   & *ZIPOI(JLON,KLEV))  
  PCFBU(JLON,KLEV)=ZMUL*(PU(JLON,KLEV)+ZELIM*PCFBU(JLON,KLEV-1))
  PCFBV(JLON,KLEV)=ZMUL*(PV(JLON,KLEV)+ZELIM*PCFBV(JLON,KLEV-1))

  ZMERL=(1.0_JPRB-PLSM(JLON))*(1.0_JPRB &
   & -MAX(0.0_JPRB,SIGN(1.0_JPRB,TMERGL-PTS(JLON))))  
  PGZ0F(JLON)=PGZ0F(JLON)+ZMERL &
   & *(RG*VZ0CM*PCD(JLON)/PCDN(JLON)+VCHRNK*PCD(JLON)&
   & *SQRT((PCFBU(JLON,KLEV)**2+PCFBV(JLON,KLEV)**2)&
   & *(PU(JLON,KLEV)**2+PV(JLON,KLEV)**2))-PGZ0F(JLON))  
  PGZ0HF(JLON)=PGZ0HF(JLON)+ZMERL&
   &*(PGZ0F(JLON)*EXP(-SQRT(PCD(JLON)&
   &*SQRT((PCFBU(JLON,KLEV)**2+PCFBV(JLON,KLEV)**2)&
   &*(PU(JLON,KLEV)**2+PV(JLON,KLEV)**2)))*VZIUSTAR0)-PGZ0HF(JLON))
  PSFU(JLON)=PCDROV(JLON)*PCFBU(JLON,KLEV)
  PSFV(JLON)=PCDROV(JLON)*PCFBV(JLON,KLEV)
ENDDO

!*
!     ------------------------------------------------------------------
!     VII - CALCULS PRELIMINAIRES AU SOL POUR LE COUPLAGE DES SOLUTIONS
!     IMPLICITES EN S ET Q A TRAVERS LA VALEUR DE TS (ON AURA DEUX
!     VALEURS, A PRIORI EGALES, DU COEFFICIENT CH NORMALISE POUR LES
!     ETUDES DE SENSIBILITE AUX CHALEURS LATENTES/SENSIBLES).

!           PRELIMINARY COMPUTATIONS AT THE SURFACE FOR THE COUPLING OF
!     THE IMPLICIT SOLUTIONS IN S AND Q THROUGH THE TS VALUE (ONE WILL
!     HAVE TWO VALUES, A PRIORI IDENTICAL, OF THE NORMALIZED CH
!     COEFFICIENT TO ALLOW SENSITIVITY STUDIES FOR SENSIBLE/LATENT
!     HEATS).

DO JLON=KIDIA,KFDIA

!     CALCULS CORRESPONDANT A EVAPORATION/SUBLIMATION.
!     COMPUTATIONS CORRESPONDING TO EVAPORATION/SUBLIMATION.

! - TEMPORAIRE(S) 1D .

! ZPN       : PROPORTION DE LA SURFACE EVAPORANT EN PHASE GLACE.
!           : PROPORTION OF THE SURFACE EVAPORATING IN ICE PHASE.
! ZWSI      : PROPORTION DE GLACE DANS LE RESERVOIR DE SURFACE.
!           : PROPORTION OF ICE IN THE SUPERFICIAL RESERVOIR.

  IF (LNEIGE) THEN
    IF (LFGEL) THEN
      ZWSI(JLON)=MIN(1.0_JPRB,PWSI(JLON)/MAX(PWSI(JLON)+PWS(JLON),ZEPS1))
    ELSE
      ZWSI(JLON)=0.0_JPRB
    ENDIF
    ZPN(JLON)=PLSM(JLON)*(PNEIJ(JLON)+&
     & (1.0_JPRB-PNEIJ(JLON))*ZWSI(JLON))+&
     & (1.0_JPRB-PLSM(JLON))*MAX(0.0_JPRB,SIGN(1.0_JPRB,TMERGL-PTS(JLON)))  
    IF(LSOLV.AND.LMCC02)THEN
      IF(NINT(PIVEG(JLON)) == NTVGLA) ZPN(JLON)=1.0_JPRB
    ENDIF
  ELSE
    ZPN(JLON)=0.0_JPRB
  ENDIF

!     CALCUL DE LA CHALEUR LATENTE PONDEREE ET DE SES DEUX CONTRIBUTIONS
!     PAR APPEL A LA FONCTION DEFINIE.
!     COMPUTATION OF THE WEIGHTED LATENT HEAT AND OF ITS TWO COMPONENTS
!     THROUGH CALLS TO THE DEFINED FUNCTION.

! - TEMPORAIRE(S) 1D .

! ZLHW      : CONTRIBUTION DE LA PHASE LIQUIDE A LA CHALEUR LATENTE.
!            : CONTRIBUTION OF THE LIQUID PHASE TO THE LATENT HEAT.
! ZLHS      : CONTRIBUTION DE LA PHASE GLACE A LA CHALEUR LATENTE.
!            : CONTRIBUTION OF THE ICE PHASE TO THE LATENT HEAT.

  ZLHW(JLON)=(1.0_JPRB-ZPN(JLON))* FOLH (PTS(JLON),0.0_JPRB)
  ZLHS(JLON)=ZPN(JLON)* FOLH (PTS(JLON),1.0_JPRB)
  PLHS(JLON)=ZLHW(JLON)+ZLHS(JLON)

!     DIFFERENTIATION DU COEFFICIENT D'ECHANGE EN SURFACE ENTRE CHALEUR
!     LATENTE/SENSIBLE.
!     DIFFERENTIATION BETWEEN THE SURFACE EXCHANGE COEFFICIENTS FOR
!     LATENT/SENSIBLE HEAT.

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

! - TEMPORAIRE(S) 1D .

! ZCHRL     : COEFFICIENT D'ECHANGE PCHROV POUR LA CHALEUR LATENTE.
!            : EXCHANGE COEFFICIENT PCHROV FOR LATENT HEAT.
! ZCHRS     : COEFFICIENT D'ECHANGE PCHROV POUR LA CHALEUR SENSIBLE.
!            : EXCHANGE COEFFICIENT PCHROV FOR SENSIBLE HEAT.

  ZCHRL(JLON)=PCEROV(JLON)
  ZXLRO(JLON)=ZCHRL(JLON)*PXHROV(JLON)
  ZCHRS(JLON)=PCHROV(JLON)
  ZXSRO(JLON)=ZCHRS(JLON)*PXHROV(JLON)


!     CONTRIBUTION AUX COEFFICIENTS DE LA MATRICE TRIDIAGONALE.
!     CONTRIBUTION TO THE COEFFICIENTS OF THE TRIDIAGONAL MATRIX.

! - TEMPORAIRE(S) 1D .

! ZDLS      : DERIVEE EN TEMPERATURE DU FLUX TOTAL ; PARTIE SENSIBLE.
!            : TEMPERATURE DERIVATIVE OF THE TOTAL FLUX ; SENSIBLE PART.
! ZDLLW     : COMME ZDLS ; MOINS PARTIE LATENTE, PHASE LIQUIDE.
!            : AS ZDLS ; MINUS LATENT PART, LIQUID PHASE.
! ZDLLS     : COMME ZDLS ; MOINS PARTIE LATENTE, PHASE GLACE.
!            : AS ZDLS ; MINUS LATENT PART, ICE PHASE.
! ZDRCN     : MOINS DERIVEE EN TEMPERATURE DU FLUX DE RAYONNEMENT.
!            : MINUS TEMPERATURE DERIVATIVE OF THE RADIATIVE FLUX.
! ZCQVQ     : CONTRIBUTION AU COEFFICIENT MATRICIEL LIANT Q A Q.
!            : CONTRIBUTION TO THE MATRIX COEFFICIENT LINKING Q TO Q.
! ZCTVQ     : CONTRIBUTION AU COEFFICIENT MATRICIEL LIANT TS A Q.
!            : CONTRIBUTION TO THE MATRIX COEFFICIENT LINKING TS TO Q.
! ZRHSQ     : CONTRIBUTION AU MEMBRE DE DROITE POUR LA LIGNE EN Q.
!            : CONTRIBUTION TO THE RIGHT HAND SIDE FOR THE Q LINE.
! ZCTVS     : CONTRIBUTION AU COEFFICIENT MATRICIEL LIANT TS A S.
!            : CONTRIBUTION TO THE MATRIX COEFFICIENT LINKING TS TO S.
! ZRHSS     : CONTRIBUTION AU MEMBRE DE DROITE POUR LA LIGNE EN S.
!            : CONTRIBUTION TO THE RIGHT HAND SIDE FOR THE S LINE.
! ZCSVT     : CONTRIBUTION AU COEFFICIENT MATRICIEL LIANT S A TS.
!            : CONTRIBUTION TO THE MATRIX COEFFICIENT LINKING S TO TS.
! ZCTVT     : CONTRIBUTION AU COEFFICIENT MATRICIEL LIANT TS A TS.
!            : CONTRIBUTION TO THE MATRIX COEFFICIENT LINKING TS TO TS.
! ZCQVT     : CONTRIBUTION AU COEFFICIENT MATRICIEL LIANT Q A TS.
!            : CONTRIBUTION TO THE MATRIX COEFFICIENT LINKING Q TO TS.
! ZRHST     : CONTRIBUTION AU MEMBRE DE DROITE POUR LA LIGNE EN TS.
!            : CONTRIBUTION TO THE RIGHT HAND SIDE FOR THE TS LINE.

  ZDLS(JLON)=(PQS(JLON)-PQ(JLON,KLEV))*ZCHRS(JLON)*ZCPVMD
  ZDLLW(JLON)=(PQS(JLON)-PQ(JLON,KLEV))*ZCHRL(JLON)*ZCPVMW*(1.0_JPRB-ZPN(JLON))
  ZDLLS(JLON)=(PQS(JLON)-PQ(JLON,KLEV))*ZCHRL(JLON)*ZCPVMS*ZPN(JLON)
  ZDLDQ=ZDLLW(JLON)+ZDLLS(JLON)-ZDLS(JLON) 
  ZDRCN(JLON)=PEMIS(JLON)*4._JPRB*RSIGMA*PTS(JLON)*PTS(JLON)*PTS(JLON)
  ZCQVQ(JLON)=1.0_JPRB-PHQ(JLON)
  ZCTVQ(JLON)=PHU(JLON)*PDQSTS(JLON)
  ZRHSQ(JLON)=PHU(JLON)*(PQSATS(JLON)-PTS(JLON)*PDQSTS(JLON))
  ZCTVS(JLON)=PCPS(JLON)+ZCPVMD*PTS(JLON)*ZCTVQ(JLON)
  ZRHSS(JLON)=PAPHI(JLON,KLEV)-ZCPVMD*PTS(JLON)*ZCTVQ(JLON)*PTS(JLON)
  ZCSVT(JLON)=ZCHRS(JLON)*ZCSDT(JLON)
  ZCSVT(JLON)=ZCSVT(JLON)*PXHROV(JLON)
  ZCTVT(JLON)=ZDTPL(JLON,1)+ZCSDT(JLON)*(ZDRCN(JLON)+ZDLDQ &
   & +ZCHRL(JLON)*PLHS(JLON)*ZCTVQ(JLON)+ZCHRS(JLON)&
   & *PCPS(JLON))  
  ZCTVT(JLON)=ZCTVT(JLON)*PXHROV(JLON) 
  ZCQVT(JLON)=ZCQVQ(JLON)*ZCSDT(JLON)*(ZCHRL(JLON)*PLHS(JLON)&
   & -ZCHRS(JLON)*ZCPVMD*PTS(JLON))  
  ZCQVT(JLON)=ZCQVT(JLON)*PXHROV(JLON)
 
  ZRHST(JLON)=ZDTPL(JLON,1)*PTP(JLON,1)+ZCSDT(JLON)&
   & *(PFRSO(JLON,KLEV)+PFRTH(JLON,KLEV)+(ZDRCN(JLON)&
   & +ZDLDQ)*PTS(JLON)-ZCHRL(JLON)*PLHS(JLON)&
   & *ZRHSQ(JLON)-ZCHRS(JLON)*(PAPHI(JLON,KLEV)-ZCPVMD &
   & *PHU(JLON)*PTS(JLON)*PQSATS(JLON)))  
   IF (LPHSPSH) THEN
     ZRHST(JLON)=ZRHST(JLON)+PFHPS(JLON)*ZCSDT(JLON)
   ENDIF
  ZRHST(JLON)=ZRHST(JLON)*PXHROV(JLON)
  ENDDO

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

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




!     CALCULS D'ELIMINATION EN SURFACE POUR S, TS ET Q.
!     SURFACE ELIMINATION CALCULATION FOR S, TS AND Q.

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))+ZXSRO(JLON)&
   & *ZIPOI(JLON,KLEV))  
  ZSUB1(JLON,KLEV)=ZMUL*ZXSRO(JLON)*ZIPOI(JLON,KLEV)*ZCTVS(JLON)
  PCFBS(JLON,KLEV)=ZMUL*(PDSE(JLON,KLEV)+ZXSRO(JLON)&
   & *ZIPOI(JLON,KLEV)*ZRHSS(JLON)+ZELIM &
   & *PCFBS(JLON,KLEV-1))  
  
  ZELIM=ZCSVT(JLON)
  ZMUL=1.0_JPRB/(1.0_JPRB-ZELIM*ZSUB1(JLON,KLEV)+ZCTVT(JLON))
  ZSUBS(JLON)=ZMUL*ZCQVT(JLON)
  ZNTS(JLON)=ZMUL*(PTS(JLON)+ZRHST(JLON)+ZELIM*PCFBS(JLON,KLEV))
 

  ZELIM=ZXLRO(JLON)*ZIPOI(JLON,KLEV)*ZCTVQ(JLON)
  ZMUL=1.0_JPRB/(1.0_JPRB-ZELIM*ZSUBS(JLON)+ZXLRO(JLON)*ZIPOI(JLON,KLEV)&
   & *ZCQVQ(JLON)+PXQRO(JLON,KLEV-1)*ZIPOI(JLON,KLEV))  
  ZSUB2(JLON,KLEV)=ZMUL*PXQRO(JLON,KLEV-1)*ZIPOI(JLON,KLEV)
  ZN2(JLON,KLEV)=ZMUL*(ZQT(JLON,KLEV)+ZXLRO(JLON)&
   & *ZIPOI(JLON,KLEV)*ZRHSQ(JLON)+ZELIM*ZNTS(JLON))  
ENDDO


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

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

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

DO JLON=KIDIA,KFDIA
  ZELIM=PXQRO(JLON,KTDIA)*ZIPOI(JLON,KTDIA)
  ZMUL=1.0_JPRB/(1.0_JPRB+ZELIM*(1.0_JPRB-ZSUB2(JLON,KTDIA+1)))
  ZN2(JLON,KTDIA)=ZMUL*(ZQT(JLON,KTDIA)+ZELIM*ZN2(JLON,KTDIA+1))
ENDDO

!     SUBSTITUTION POUR UNE COUCHE STANDARD POUR Q.
!     BACK-SUBSTITUTION FOR A STANDART LEVEL FOR Q.

DO JLEV=KTDIA+1,KLEV
  DO JLON=KIDIA,KFDIA
    ZN2(JLON,JLEV)=ZN2(JLON,JLEV)+ZSUB2(JLON,JLEV)*ZN2(JLON,JLEV-1)
  ENDDO
ENDDO


DO JLEV=KTDIA,KLEV
    DO JLON=KIDIA,KFDIA
       PCFBQ(JLON,JLEV)=ZN2(JLON,JLEV)
    ENDDO
ENDDO


!     CALCULS DE SUBSTITUTION EN SURFACE POUR TS ET S.
!     SURFACE BACK-SUBSTITUTION CALCULATIONS FOR TS AND S.

DO JLON=KIDIA,KFDIA
  ZNTS(JLON)=ZNTS(JLON)+ZSUBS(JLON)*ZN2(JLON,KLEV)
  PCFBS(JLON,KLEV)=PCFBS(JLON,KLEV)+ZSUB1(JLON,KLEV)*ZNTS(JLON)
ENDDO


!     SUBSTITUTION POUR UNE COUCHE STANDARD ET AU SOMMET POUR S.
!     BACK-SUBSTITUTION FOR A STANDART LEVEL AND AT THE TOP FOR S.

DO JLEV=KLEV-1,KTDIA,-1
  DO JLON=KIDIA,KFDIA
    PCFBS(JLON,JLEV)=PCFBS(JLON,JLEV)+PCFAS(JLON,JLEV)*PCFBS(JLON,JLEV+1)
  ENDDO
ENDDO

!     FLUX EN SURFACE ET DANS LE SOL.
!     SURFACE AND SOIL FLUXES.

! - TEMPORAIRE(S) 1D .

! ZRCOR     : CORRECTION UNIFORME DU RAYONNEMENT THERMIQUE.
!            : UNIFORM CORRECTION FOR THE THERMAL RADIATION FLUX.

DO JLON=KIDIA,KFDIA
  ZFQ=ZCHRL(JLON)*(ZCQVQ(JLON)*ZN2(JLON,KLEV)-ZCTVQ(JLON)&
   & *ZNTS(JLON)-ZRHSQ(JLON))  
  PFEVI(JLON)=ZFQ*ZWSI(JLON)*(1.0_JPRB-PNEIJ(JLON))
  PFEVL(JLON)=ZFQ*(1.0_JPRB-ZPN(JLON))
  PFEVN(JLON)=ZFQ*ZPN(JLON)
  PFCLL(JLON)=ZLHW(JLON)*ZFQ-ZDLLW(JLON)*(ZNTS(JLON)-PTS(JLON))
  PFCLN(JLON)=ZLHS(JLON)*ZFQ-ZDLLS(JLON)*(ZNTS(JLON)-PTS(JLON))
  PFCHSP(JLON,1)=(ZNTS(JLON)-PTP(JLON,1))*ZDTPL(JLON,1)&
   & /MAX(ZEPS1,ZCSDT(JLON))  
  ZFENT=ZCHRS(JLON)*(PCFBS(JLON,KLEV)-ZCTVS(JLON)*ZNTS(JLON)-ZRHSS(JLON))
  PFCS(JLON)=ZFENT-ZCPVMD*PTS(JLON)*ZFQ+ZDLS(JLON)*(ZNTS(JLON)-PTS(JLON))
  ZRCOR(JLON)=-ZDRCN(JLON)*(ZNTS(JLON)-PTS(JLON))
  PFRTH(JLON,KLEV)=PFRTH(JLON,KLEV)+ZRCOR(JLON)
  PDIFWQ(JLON)=ZFQ
  PDIFWS(JLON)=ZFENT

!     CALCULS OPTIONNELS POUR UN TYPE DE SCHEMA SOL/VEG.
!     OPTIONAL COMPUTATIONS FOR ONE SOIL/VEG SCHEME.

  IF (LSOLV) THEN
    PFEVV(JLON)=ZCHRL(JLON)*PVEG(JLON)*(PHV(JLON)-PNEIJ(JLON))&
     & *(ZN2(JLON,KLEV)-PQSATS(JLON)-PDQSTS(JLON)&
     & *(ZNTS(JLON)-PTS(JLON)))  
    PFTR(JLON)=MAX(0.0_JPRB,SIGN(1.0_JPRB,PQSATS(JLON)-PQ(JLON,KLEV)))&
     & *ZCHRL(JLON)*PHTR(JLON)*PVEG(JLON)*(1.0_JPRB-PNEIJ(JLON))&
     & *(ZN2(JLON,KLEV)-PQSATS(JLON)-PDQSTS(JLON)&
     & *(ZNTS(JLON)-PTS(JLON)))  
  ENDIF

ENDDO

!     AUTRES COUCHES PROFONDES (S'IL Y EN A).
!     OTHER DEEP LAYERS (IF ANY).

DO JCSS=2,KCSS
  DO JLON=KIDIA,KFDIA
    PFCHSP(JLON,JCSS)=(PTP(JLON,JCSS-1)-PTP(JLON,JCSS))&
     & *ZDTPL(JLON,JCSS)/MAX(ZEPS1,ZCSDT(JLON))  
  ENDDO
ENDDO

!     FLUX ATMOSPHERIQUES.
!     ATMOSPHERIC FLUXES.

DO JLEV=KLEV-1,KTDIA,-1
  DO JLON=KIDIA,KFDIA
    PFRTH(JLON,JLEV)=PFRTH(JLON,JLEV)+ZRCOR(JLON)
  ENDDO
ENDDO

!     CONDITION A LA LIMITE SUPERIEURE.
!     UPPER BOUNDARY CONDITION.

DO JLON=KIDIA,KFDIA
  PFRTH(JLON,KTDIA-1)=PFRTH(JLON,KTDIA-1)+ZRCOR(JLON)
ENDDO





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