!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACSOL ( KIDIA,KFDIA,KLON,&
 !-----------------------------------------------------------------------
 ! - INPUT  1D
 & PARG,PD2,PGZ0F,PGZ0RLF,PLSM,PIVEG,&
 & PRHONS,PSAB,PSNS,PTS,PVEG0,PWP,PWPI,PWS,PWSI,&
 ! - INPUT  LOGIQUE
 & LDHMT,&
 ! - OUTPUT 1D .
 & PC1,PC2,PC3,PCG,PCN,PCT,&
 & PNEIJG,PNEIJV,&
 & PWFC,PWPMX,PWSEQ,PWSMX,PWWILT,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACSOL  * - DETERMINATION DES CARACTERISTIQUES DE SURFACE.

!     Sujet.
!     ------

!     - ROUTINE DE CALCUL ACTIF .
!       DETERMINATION DES CARACTERISTIQUES DE SURFACE CONCERNANT LES
!       COEFFICIENTS THERMO-HYDRIQUES, LES TENEURS EN EAU MAXIMALES
!       DES RESERVOIRS PROFOND ET SUPERFICIEL AINSI QUE LA TENEUR EN
!       EAU A L'EQUILIBRE DU RESERVOIR SUPERFICIEL.
!       CAS DE L EAU: ON POSE C1=C2=1.

!**   Interface.
!     ----------
!        *CALL* *ACSOL*

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

! - NOM DES CLES LOGIQUES

! LDHMT      : ETAPE DANS LE CALCUL DES CHAMPS AUX HAUTEURS METEO

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

! - 1D (PROGNOSTIQUE) .

! PRHONS     : DENSITE DE LA NEIGE.
! PSNS       : MASSE DE NEIGE PAR UNITE DE SURFACE.
! PTS        : TEMPERATURE DE SURFACE.
! PWP        : CONTENU EN EAU DU RESERVOIR PROFOND.
! PWPI       : CONTENU EN EAU GELEE DU RESERVOIR PROFOND.
! PWS        : CONTENU EN EAU DU RESERVOIR DE SURFACE.
! PWSI       : CONTENU EN EAU GELEE DU RESERVOIR DE SURFACE.

! - 1D (GEOGRAPHIQUE) .

! PARG       : POURCENTAGE D'ARGILE DANS LA MAILLE.
! PD2        : EPAISSEUR DU RESERVOIR PROFOND.
! PGZ0F      : GRAVITE * LONGUEUR DE RUGOSITE.
! PGZ0RLF    : GRAVITE * LONGUEUR DE RUGOSITE DUE AU RELIEF.
! PLSM       : INDICE TERRE/MER.
! PIVEG      : TYPE DE SURFACE (MER, BANQUISE OU GLACIER, TERRE).
! PSAB       : POURCENTAGE DE SABLE DANS LA MAILLE.
! PVEG0      : PROPORTION DE SOL COUVERT PAR LA VEGETATION.

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

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

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

! - 1D (DIAGNOSTIQUE) .

! PC1        : COEFFICIENT HYDRIQUE REPRESENTANT L'INTENSITE AVEC LAQUEL
!              LES FLUX DE SURFACE PARTICIPENT A L'EVOLUTION DE WS.
! PC2        : COEFFICIENT HYDRIQUE TRADUISANT LA RAPIDITE DES TRANSFERT
!              D'EAU ENTRE LES RESERVOIRS PROFOND ET DE SURFACE.
! PC3        : COEFFICIENT UTILE POUR LE CALCUL DU DRAINAGE
! PCG        : COEFFICIENT THERMIQUE DU SOL NU.
! PCN        : COEFFICIENT THERMIQUE DE LA NEIGE.
! PCT        : COEFFICIENT THERMIQUE DU MILIEU SOL-VEGETATION.
! PNEIJG     : FRACTION DE NEIGE RECOUVRANT LE SOL.
! PNEIJV     : FRACTION DE NEIGE RECOUVRANT LA VEGETATION.
! PWFC       : TENEUR EN EAU A LA CAPACITE AUX CHAMPS.
! PWPMX      : TENEUR EN EAU MAXIMALE DU RESERVOIR PROFOND.
! PWSEQ      : TENEUR EN EAU A L'EQUILIBRE POUR LE RESERVOIR DE SURFACE.
!              (EQUILIBRE ENTRE FORCES DE GRAVITE ET CAPILLARITE).
! PWSMX      : TENEUR EN EAU MAXIMALE DU RESERVOIR DE SURFACE.
! PWWILT     : TENEUR EN EAU CORRESPONDANT AU POINT DE FLETRISSEMENT.

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

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

! COMMON/YOMPHY1/
! COMMON/YOMPHY/
! COMMON/YOMCST/

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

!     Externes :  ACSOLW
!     ---------

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

!     Auteur.
!     -------
!        91-12, J. Noilhan.

!     Modifications.
!     --------------
!     D. Giard   94/10/07  pour l'analyse : PC2REF en sortie, option LDHMT
!                                   (calcul des champs aux hauteurs meteo)
!                          constantes en namelist, restructuration
!                          controle des coefficients d'inertie (LIMC,LIMW)
!     M. Deque   94/11/14  coefficient C3
!     H.Douville 95/01/13 Calcul du coefficient thermique Ct
!     D. Giard   95-09-08 ajout de Ts pour le calcul de C1-option phase vapeur
!     M. Deque   96-05-30 modification des fractions de neige
!     E. Bazile  97-05-30 C1-option phase vapeur en Gaussienne
!     M. Deque   97-04-11 utilisation de NTVGLA pour reperer la glace
!     D. Giard   97-06-09 suppression de PC2REF (refonte de l'analyse)
!     J.M.Piriou 97-08-20 PZx variables > Zx, introduce CDLOCK.
!     E. Bazile  97-11-25 Introduction du gel de l'eau du sol
!     D. Giard   98-03-15 Appel a ACSOLW
!     R. El Khatib : 01-08-07 Pruning options
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!-----------------------------------------------------------------------

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

USE YOMPHY1  , ONLY : RCTVEG   ,EA       ,EC2REF   ,GA       ,&
 & GC1      ,GC1S1    ,GC1S2    ,GC1S3    ,GC1S4    ,&
 & GC1Y1    ,GTSVAP   ,GC2      ,GC2REF   ,GC3      ,&
 & GC31     ,GC32     ,GCONV    ,G1B      ,G1CGSAT  ,&
 & G1C1SAT  ,G1P      ,G2B      ,G2CGSAT  ,G2C1SAT  ,&
 & G2P      ,G3CGSAT  ,GSNC1    ,GSNC2    ,RC1MAX   ,&
 & RCTGLA   ,RCGMAX   ,RD1      ,WCRIN    ,WCRINC   ,&
 & WCRING   ,XCRINR   ,XCRINV   ,LIMC     ,LIMW     ,&
 & LC1VAP   ,NTVGLA   ,NTVMER  
USE YOMPHY   , ONLY : LSNV     ,LFGEL
USE YOMCST   , ONLY : RG       ,RTT

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PARG(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PD2(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0F(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0RLF(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PIVEG(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PRHONS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSAB(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSNS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEG0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWP(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWPI(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWSI(KLON) 
LOGICAL           ,INTENT(IN)    :: LDHMT 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PC1(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PC2(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PC3(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCG(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCT(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PNEIJG(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNEIJV(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWFC(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWPMX(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PWSEQ(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWSMX(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PWWILT(KLON) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZWSAT(KLON)

INTEGER(KIND=JPIM) :: JLON

REAL(KIND=JPRB) :: Z1, Z2, ZA, ZARG, ZB, ZBWA, ZBWB, ZC1MAX,&
 & ZC1SAT, ZC1X2, ZC1Y2, ZC2REF, ZC3REF, ZCGSAT, &
 & ZCRIN, ZD1, ZD2, ZDELTA, ZEPS, ZEPS1, ZEPW, &
 & ZLYMY1, ZNEIJC, ZNEIJV, ZP, ZSAB, ZTS, ZTSVAR, &
 & ZWP, ZWPI, ZWPSWS, ZWS, ZWSSWS, ZZ0V, ZZA, &
 & ZZB, ZZC  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "acsolw.intfb.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

ZEPS=1.E-1_JPRB
ZEPS1=1.E-5_JPRB
ZEPW=1.E-2_JPRB
ZTSVAR=MAX(0.0_JPRB,SIGN(1.0_JPRB,GTSVAP))
ZD1=RD1*GCONV

!     ------------------------------------------------------------------
!     I - CALCULS DES TENEURS EN EAU DU SOL CARACTERISTIQUES
!         --------------------------------------------------
!         COMPUTING CHARACTERISTIC SOIL MOISTURES
!         ---------------------------------------

CALL ACSOLW ( KIDIA,KFDIA,KLON,&
 & PARG,PD2,PLSM,PIVEG,PSAB,&
 & LDHMT,&
 & PWFC,PWPMX,ZWSAT,PWSMX,PWWILT,&
 & 'ACSOLW ')  
IF (LDHMT .AND. LHOOK) CALL DR_HOOK('ACSOL',1,ZHOOK_HANDLE)
IF (LDHMT) RETURN

!     ------------------------------------------------------------------
!     II - CALCUL DES AUTRES CHAMPS
!          ------------------------
!          COMPUTING OTHER FIELDS
!          ----------------------

DO JLON=KIDIA,KFDIA

! ** INTERMEDIAIRES NE DEPENDANT QUE DE LA TEXTURE **

  ZSAB = MAX(ZEPS,PSAB(JLON))
  ZARG = MAX(ZEPS,PARG(JLON))

  ZA = GA*(ZARG**EA)
  ZB = G1B*ZARG+G2B
  ZP = G1P*ZARG+G2P
  ZC1SAT = (G1C1SAT*ZARG+G2C1SAT)*GC2
  ZCGSAT = G1CGSAT*ZSAB + G2CGSAT*ZARG + G3CGSAT
  ZC2REF = GC2REF*(ZARG**EC2REF)
  ZC3REF = GC31*(ZARG**GC32)

! ** WSEQ **

  ZD2=PD2(JLON)*GCONV

  ZWP = PWP(JLON)/ZD2
  IF (LFGEL) THEN
    ZWPSWS = MAX(ZEPW,ZWP/MAX(ZEPW,ZWSAT(JLON)-PWPI(JLON)/ZD2))
  ELSE
    ZWPSWS = MAX(ZEPW,ZWP/ZWSAT(JLON))
  ENDIF
  IF ( NINT(PIVEG(JLON)) == NTVGLA ) ZWPSWS = 1.0_JPRB
  PWSEQ(JLON) = (ZWPSWS-ZA*(ZWPSWS**ZP)*(1.0_JPRB-(ZWPSWS**(GC3*ZP))))&
   & * PWSMX(JLON)  

! ** CAS DE LA MER - SEA **

  IF ( NINT(PIVEG(JLON)) == NTVMER ) THEN
    PSNS(JLON) = 0.0_JPRB
    PNEIJG(JLON) = 0.0_JPRB
    PNEIJV(JLON) = 0.0_JPRB
    PCN(JLON) = RCTGLA
    PCG(JLON) = ZCGSAT
    PCT(JLON) = PCG(JLON)
    PC1(JLON) = 100._JPRB*RD1
    PC2(JLON) = 1.0_JPRB
    PC3(JLON) = 1.0_JPRB

  ELSE

! ** EXTENSION DE LA COUVERTURE NEIGEUSE - SNOW COVER **

    IF (LSNV) THEN
      PSNS(JLON) = MAX(0.0_JPRB,PSNS(JLON))
      PNEIJG(JLON) = PSNS(JLON)&
       & /(PSNS(JLON)+WCRIN*(1.0_JPRB+PGZ0RLF(JLON)*XCRINR))  
      ZZ0V = SQRT(MAX(0.0_JPRB,PGZ0F(JLON)**2-PGZ0RLF(JLON)**2))/RG
      ZCRIN = MAX(WCRING,PRHONS(JLON)*XCRINV*ZZ0V)
      PNEIJV(JLON) = PNEIJG(JLON)*(PSNS(JLON)+WCRING)/(PSNS(JLON)+ZCRIN)
    ENDIF

    IF ( NINT(PIVEG(JLON)) /= NTVGLA ) THEN

! ** COEFFICIENTS THERMIQUES
!    DU SOL NU CG, DE LA NEIGE CN ET DU MILIEU SOL-NEIGE-VEGETATION CT **
! ** THERMICAL COEFFICIENTS
!    OF BARE SOIL CG, OF SNOW CN AND OF SOIL-SNOW-VEGETATION SYSTEM CT **

      ZBWB = GC1*ZB/LOG(GC2)
      IF (LIMW) ZWPSWS = MAX(ZEPW,PWWILT(JLON)/ZWSAT(JLON),ZWPSWS)
      PCG(JLON) = ZCGSAT/(ZWPSWS**ZBWB)
      IF (LFGEL) THEN
        ZWPI=PWPI(JLON)/MAX(PWP(JLON)+PWPI(JLON),ZEPS1)
        PCG(JLON)=1.0_JPRB/ ( (1-ZWPI)/PCG(JLON) + ZWPI/RCTGLA )
      ENDIF
      IF (LIMC)  PCG(JLON) = MIN(RCGMAX,PCG(JLON))
      IF (LSNV) THEN
        ZNEIJC = MIN(1.0_JPRB,PSNS(JLON)/WCRINC)
        ZNEIJV = MIN(ZNEIJC,PNEIJV(JLON))
        PCN(JLON) = 2.0_JPRB*SQRT( GSNC1/(PRHONS(JLON)**GSNC2) )
        PCT(JLON) = 1.0_JPRB/&
         & ( (1.0_JPRB-PVEG0(JLON))*(1.0_JPRB-ZNEIJC) /PCG(JLON)&
         & +(1.0_JPRB-PVEG0(JLON))*   ZNEIJC   /PCN(JLON)&
         & +  PVEG0(JLON)   *   ZNEIJV   /PCN(JLON)&
         & +  PVEG0(JLON)   *(1.0_JPRB-ZNEIJV) /&
         & RCTVEG(NINT(PIVEG(JLON))) )  
      ELSE
        PCT(JLON) = 1.0_JPRB/((1.0_JPRB-PVEG0(JLON)) /PCG(JLON)&
         & +   PVEG0(JLON)/RCTVEG(NINT(PIVEG(JLON))))  
      ENDIF

! ** COEFFICIENT HYDRAULIQUE C1 - HYDRAULIC COEFFICIENT C1 **

      ZBWA = GC1*ZB+1.0_JPRB
      IF (LFGEL) THEN
        ZWS=PWS(JLON)+PWSI(JLON)
      ELSE
        ZWS=PWS(JLON)
      ENDIF
      ZWSSWS = MAX(ZEPW,ZWS/PWSMX(JLON))
      IF (LIMW.AND.(.NOT.LC1VAP))&
       & ZWSSWS = MAX(ZEPW,PWWILT(JLON)/ZWSAT(JLON),ZWSSWS)  
      PC1(JLON) = ZC1SAT*RD1/(ZWSSWS**ZBWA)
      IF (LIMC.AND.(.NOT.LC1VAP))PC1(JLON) = MIN(RC1MAX*RD1,PC1(JLON))

      IF (LC1VAP.AND.((ZWS/ZD1) < PWWILT(JLON))) THEN
        ZTS=ZTSVAR * MAX(RTT,PTS(JLON)) + (1.0_JPRB-ZTSVAR) * (RTT-GTSVAP)
        ZC1MAX=(GC1S1*PWWILT(JLON)+GC1S2)*ZTS+ (GC1S3*PWWILT(JLON)+GC1S4)
        ZC1X2=PWWILT(JLON)*ZD1
        ZC1Y2=ZC1SAT/((PWWILT(JLON)/ZWSAT(JLON))**ZBWA)
        ZC1MAX=MAX(ZC1Y2,ZC1MAX)
        ZZA=LOG(ZC1Y2/GC1Y1)
        ZLYMY1=LOG(ZC1MAX/GC1Y1)
        ZZB = -2.0_JPRB * ZC1X2 * ZLYMY1
        ZZC = ZC1X2**2 * ZLYMY1
        ZDELTA = ZZB**2 - 4._JPRB * ZZA * ZZC
        ZDELTA=MAX(0.0_JPRB,ZDELTA)
        Z1=(-ZZB-SQRT(ZDELTA))/(2.0_JPRB*ZZA)
        Z2= Z1**2 / ZLYMY1
        PC1(JLON)= ZC1MAX * RD1 * EXP(-(ZWS-Z1)**2/Z2)
      ENDIF

! ** COEFFICIENTS HYDRAULIQUES C2, C3 - HYDRAULIC COEFFICIENTS C2, C3 **
      IF (LFGEL) THEN
        ZWP=ZWP+PWPI(JLON)/ZD2
      ENDIF
      IF (LIMW) ZWP=MAX(PWWILT(JLON),ZWP)
      PC2(JLON)=MAX(0.0_JPRB,ZC2REF*ZWP/(ZWSAT(JLON)-ZWP+ZEPW))
      PC3(JLON)=ZC3REF/PD2(JLON)

! ** CAS DE LA GLACE - ICE CAP **

    ELSE
      PCG(JLON) = RCTGLA
      PCN(JLON) = RCTGLA
      PCT(JLON) = RCTGLA
      PC1(JLON) = 0.0_JPRB
      PC2(JLON) = 0.0_JPRB
      PC3(JLON) = 0.0_JPRB
    ENDIF
  ENDIF

ENDDO

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