!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACHMT ( KIDIA,KFDIA,KLON,KTDIA,KLEV,KVCLIV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHI,PAPHIF,PAPRS,PAPRSF,PCP,PQ,PR,PT,PU,PV,&
 & PFPLSH,PFPLCH,&
 ! - INPUT  1D .
 & PDPHIT,PDPHIV,PGZ0F,PGZ0HF,PGZ0RLF,PHV,PLSM,&
 & PNEIJG,PNEIJV,PSNS,PTS,PVEG0,PWFC,PWS,PWSI,&
 ! - INPUT  LOGIQUE .
 & LDCLS,LDHMT,&
 ! - OUTPUT 2D .
 & PNBVNO,&
 ! - OUTPUT 1D .
 & PCD,PCDN,PCDROV,PCH,PCHROV,PCPS,PDQSTS,PGWDCS,&
 & PGZ0,PGZ0H,PHQ,PHU,PNEIJ,PQCLS,PQS,PQSATS,&
 & PRHCLS,PRS,PRTI,PSTAB,PTCLS,PUCLS,PVCLS,PUCLN,PVCLN,PZPCLS,PVEG,&
 & PXDROV,PXHROV,PURAF,PVRAF,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACHMT   * - DETERMINATION DES CARACTERISTIQUES DE SURFACE.
!**** *ACHMT   * - INTERP. DES PARAMETRES U,V,T,Q AUX HAUTEURS CHOISIES.

!     Sujet.
!     ------

!     - ROUTINE DE CALCUL ACTIF .
!       DETERMINATION DE CARACTERISTIQUES DE SURFACE CONCERNANT LA
!       NEIGE, L'HUMIDITE DU SOL ET LES COEFFICIENTS D'ECHANGE EN
!       SURFACE PLUS LEUR AMPLIFICATION SI "ANTI-FIBRILLATION" ACTIVEE .
!     - SI L'OPTION 'CLS' EST SELECTIONNEE :
!          DETERMINATION DE PARAMETRES SUPPLEMENTAIRES NECESSAIRES POUR
!          LES CALCULS DE DIFFUSION VERTICALE ET DE TRAINEE DES ONDES DE
!          GRAVITE OROGRAPHIQUES .
!     - SI L'OPTION 'HMT' EST SELECTIONNEE :
!          INTERPOLATION DES TEMPERATURES, HUMIDITES (SPECIFIQUES ET
!          RELATIVES) ET VENTS AUX HAUTEURS "METEO" .

!     - COMPUTATION OF SURFACE CHARACTERISTICS FOR SNOW, SOIL HUMIDITY
!       AND SURFACE EXCHANGE COEFFICIENTS PLUS THEIR AMPLIFICATION
!       FACTOR IF "ANTI-FIBRILLATION" IS ACTIVATED .
!     - IF THE SWITCH 'CLS' IS ON :
!          COMPUTATION OF ADDITIONNAL PARAMETERS NECESSARY FOR THE
!          VERTICAL DIFFUSION AND GRAVITY WAVE DRAG PARAMETERIZATIONS .
!     - IF THE SWITCH 'HMT' IS ON :
!          TEMPERATURE, MOISTURE (SPECIFIC AND RELATIVE) AND WIND
!          INTERPOLATION AT STANDARD "METEOROLOGICAL" LEVELS .

!**   Interface.
!     ----------
!        *CALL* *ACHMT*

!-----------------------------------------------------------------------
! 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".
! KVCLIV     : NOMBRE DE CHAMPS POUR LA VEGETATION (NVCLIV DANS CPG).
! KVCLIV     : NUMBER OF FIELDS FOR VEGETATION (NVCLIV IN CPG).

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

! - 2D (0:KLEV) .

! PAPHI      : GEOPOTENTIEL AUX DEMI-NIVEAUX.
! PAPRS      : PRESSION AUX DEMI-NIVEAUX.
! PFPLSH     : CHAMP "HISTORIQUE" DES PRECIPITATIONS STRATIFORMES.
! PFPLCH     : CHAMP "HISTORIQUE" DES PRECIPITATIONS CONVECTIVES.

! - 2D (1:KLEV) .

! PAPHIF     : GEOPOTENTIEL AUX NIVEAUX DES COUCHES.
! PAPRSF     : PRESSION AUX NIVEAUX.
! PCP        : CHALEUR MASSIQUE A PRESSION CONSTANTE DE L'AIR.
! PQ         : HUMIDITE SPECIFIQUE DE LA VAPEUR D'EAU.
! PR         : CONSTANTE DES GAZ POUR L'AIR.
! PT         : TEMPERATURE.
! PU         : COMPOSANTE EN X DU VENT.
! PV         : COMPOSANTE EN Y DU VENT.

! - 1D (PROGNOSTIQUE) .

! PSNS       : MASSE PAR UNITE DE SURFACE DE LA COUCHE NEIGEUSE.
! PTS        : TEMPERATURE DE SURFACE.
! PWS        : CONTENU EN EAU DU RESERVOIR DE SURFACE.
! PWSI       : CONTENU EN EAU GELEE DU RESERVOIR DE SURFACE.

! - 1D (SPECIFIQUE SELON L'UTILISATION DE ACHMT) .

! PDPHIT     : HAUTEUR D INTERPOLATION POUR T ET Q (EN GEOPOTENTIEL).
! PDPHIV     : HAUTEUR D INTERPOLATION POUR U ET V (EN GEOPOTENTIEL).
! PHV        : RESISTANCE AU FLUX D'EVAPOTRANSPIRATION.
! PWFC       : TENEUR EN EAU A LA CAPACITE AU CHAMPS.

! - 1D (DIAGNOSTIQUE) .

! PNEIJG     : PROPORTION DE SOL RECOUVERTE DE NEIGE.
! PNEIJV     : PROPORTION DE VEGETATION RECOUVERTE DE NEIGE.

! - 1D (GEOGRAPHIQUE) .

! PGZ0F      : CHAMP TEMPOREL DE G FOIS LA LONGUEUR DE RUGOSITE.
! PGZ0HF     : CHAMP TEMPOREL DE G FOIS LA LONGUEUR DE RUGOSITE THERM.
! PGZ0RLF    : GRAVITE * LONGUEUR DE RUGOSITE DUE AU RELIEF.
! PLSM       : INDICE TERRE/MER.
! PVEG0      : PROPORTION DE SOL COUVERTE DE VEGETATION.

! - LOGIQUES .

! LDCLS      : DETERMINATION COMPLETE DES CARACTERISTIQUES DE SURFACE.

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

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

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

! - 2D (0:KLEV) .

! PNBVNO     : CARRE DE FR. BRUNT-VAISALA DIVISEE PAR G FOIS LA DENSITE.

! - 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.
! PCH        : COEFFICIENT D'ECHANGE EN SURFACE POUR T ET Q.
! PCHROV     : PCH RENORME EN DENSITE FOIS VITESSE.
! PCPS       : CHALEUR MASSIQUE A PRESSION CONSTANTE DE L'AIR AU SOL.
! PDQSTS     : DERIVEE DE PQSATS PAR RAPPORT A LA TEMPERATURE.
! PGWDCS     : DENSITE EN SURFACE POUR LE DRAG OROGRAPHIQUE.
! PGZ0       : G FOIS LA LONGUEUR DE RUGOSITE COURANTE.
! PGZ0H      : G*LONGUEUR DE RUGOSITE THERMIQUE COURANTE (SI KVCLIV >= 8)
! PHQ        : POIDS DE L'HUMIDITE DE L'AIR DANS L'HUMIDITE DE SURFACE.
! PHU        : POIDS DE L'HUMIDITE SATURANTE DANS L'HUMIDITE DE SURFACE.
! PNEIJ      : PROPORTION DE LA MAILLE RECOUVERTE DE NEIGE.
! PQCLS      : SORTIE DIAGNOSTIQUE DE L'HUMIDITE SPECIFIQUE A HTQ METEO.
! PQS        : HUMIDITE SPECIFIQUE DE SURFACE.
! PQSATS     : HUMIDITE SPECIFIQUE DE SATURATION EN SURFACE.
! PRHCLS     : SORTIE DIAGNOSTIQUE DE L'HUMIDITE RELATIVE A HTQ METEO.
! PRS        : CONSTANTE DES GAZ POUR L'AIR AU SOL.
! PRTI       : INVERSE DE R*T.
! PSTAB      : INDICE DE STABILITE A LA SURFACE.
! PTCLS      : SORTIE DIAGNOSTIQUE DE LA TEMPERATURE A HTQ METEO.
! PUCLS      : SORTIE DIAGNOSTIQUE DU VENT EN X A HUV METEO.
! PVCLS      : SORTIE DIAGNOSTIQUE DU VENT EN Y A HUV METEO.
! PUCLN      : SORTIE DIAGNOSTIQUE DU VENT NEUTRE EN X A HUV METEO.
! PVCLN      : SORTIE DIAGNOSTIQUE DU VENT NEUTRE EN Y A HUV METEO.
! PZPCLS     : SORTIE DIAGNOSTIQUE DE PRESSION A HTQ METEO.
! PVEG       : PROPORTION DE VEGETATION APPARENTE (NON RECOUVERTE DE NEIGE).
! PXDROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PCDROV.
! PXHROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PCHROV.
! PURAF      : SORTIE DIAGNOSTIQUE DU VENT DE RAFALES TURBULENTES EN X
! PVRAF      : SORTIE DIAGNOSTIQUE DU VENT DE RAFALES TURBULENTES EN Y

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

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

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

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

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

!     *ACNTCLS*

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

!     Auteur.
!     -------
!        89-12, J.F. Geleyn.

!     Modifications.
!     --------------
!        92-03, fusion ACCLS/ACNTCLS/ACHMT - R. El Khatib.
!               *** ATTENTION ***  a cette occasion les deux anciennes
!               autres routines ont ete supprimees.
!        92-04, diagnostic de l'humidite relative - J.M. Piriou.
!        92-04, chang. d'unite de l'output vers le g.w.d. - J.F. Geleyn.
!        92-02, soil/veg param. - H. Giordani, W. Maurel, P. Le Moigne.
!        92-05, reintroduction de l'appel a ACNTCLS - J.F. Geleyn.
!        94-11, Z0 thermique - P. Lacarrere.
!        95-01, Nouvelle parametrisation de la neige - H. Douville.
!        95-03, Limitation du nombre de Richardson - M. Deque.
!        95-04, int. de l'anti-fibrillation Girard-Delage - J.F. Geleyn.
!        97-05, liberation de Z0H sur mer/banquise - M. Deque.
!        96-05, modification des fractions de neige pour Z0 - M. Deque.
!        97-08, PZx variables > Zx, introduce CDLOCK - J.M. Piriou.
!        97-08, PGZ0H becomes local ZGZ0H - J.M. Piriou.
!        97-09/97-11, correction Z0H sur mer/banquise - DG + EB + MD
!        98-08, Sortie PCLS - V. Lorant
!        98-03, Nouvelle anti-fibrillation (XMULAF<0) P. Benard + A. Marki
!        99-02, Introduction du gel de surface (LFGELS). E. Bazile.
!        99-06, Richardson number variable in the vertical - J.M. Piriou.
!        00-08, Turbulent gusts - R. El Khatib & JF Geleyn
!      2000-08, New use of the Richardson critical number (USURID) - J.M. Piriou.
!      2001-08, New definition and use of the thermal mixing length - J.M. Piriou / J.F Geleyn.
!      2001-08, Consistency between USURID and antifibrillation - J.M. Piriou / J.F Geleyn.
!      2002-06, Gustiness term in case of precipitations - F. Bouyssel.
!        R. El Khatib : 01-08-07 Pruning options
!      2003-12, Minimum value for wind shear in turbulent computations - J.M. Piriou.
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!      2003-04, M. Bellus: change of calling arguments, removing LSOLV,
!               added initialization of "METEO" heights, some cleaning
!      2003-10, M. Tudor: cleaning, reintroduce LSOLV and initialization of "METEO" heights
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!      2004-02, Introduces EDK for Fm and Fh in stable case and correction for using USURIC=0. - E. Bazile.
!      2007-05, New formulation for XMULAF>0 - F. Bouyssel
!      2008-02, Modification of PGZ0H computation pending land/sea mask;
!               moving LRRGUST bloc after anti-fibrillation - R. Brozkova
!      2006-03, New output (PRTI=1/R*T) and introduction of LZ0HSREL - J.F. Gueremy.
!      2008-11, Neutral Wind - C. Payan
!-----------------------------------------------------------------------

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

USE YOMPHY   , ONLY : LNEIGE   ,LSNV     ,LSOLV    ,LFGEL    ,&
 & LRRGUST   ,LZ0HSREL    
USE YOMCST   , ONLY : RPI      ,RG       ,RD       ,RV       ,&
 & RCPD     ,RCPV     ,RKAPPA   ,RETV     ,RCW      ,&
 & RCS      ,RLVTT    ,RLSTT    ,RTT      ,RALPW    ,&
 & RBETW    ,RGAMW    ,RALPS    ,RBETS    ,RGAMS    ,&
 & RALPD    ,RBETD    ,RGAMD  
USE YOMPHY0  , ONLY : EDB      ,EDC      ,EDD      ,USURIC   ,VKARMN,&
 & USURICL, USURID    ,UTILGUST ,RRGAMMA  ,RRSCALE, GCISMIN,&
 & EDK, VZIUSTAR0
USE YOMPHY1  , ONLY : GCZ0H    ,ALRCN1   ,ALRCN2   ,GCONV    ,&
 & RD1      ,WCRIN    ,WSMX     ,RZHZ0M  
USE YOMPHY2  , ONLY : TSPHY    , XMULAF  ,LRAFTUR  ,GZ0RAF   ,FACRAF
USE YOMCLI   , ONLY : STHER    ,SZZ0D

#define FZH(X,Y) 1.0_JPRB+X/Y

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)               :: KTDIA ! Argument NOT used
INTEGER(KIND=JPIM)               :: KVCLIV ! Argument NOT used
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHI(KLON,0: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)    :: PCP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PU(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PV(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFPLSH(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFPLCH(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDPHIT(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDPHIV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0F(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0HF(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0RLF(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PHV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSM(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNEIJG(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNEIJV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSNS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PVEG0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWFC(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PWSI(KLON) 
LOGICAL           ,INTENT(IN)    :: LDCLS 
LOGICAL           ,INTENT(IN)    :: LDHMT 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PNBVNO(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCD(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCDN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCDROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCH(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCHROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PCPS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PDQSTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PGWDCS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGZ0(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PGZ0H(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHQ(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PHU(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PNEIJ(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQSATS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRHCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRTI(KLON)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PSTAB(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PUCLN(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVCLN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZPCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PVEG(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXDROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXHROV(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PURAF(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVRAF(KLON) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZCDNH(KLON),ZDELT(KLON),ZDPHI(KLON),ZESP(KLON)&
 & ,ZU(KLON),ZSTABV(KLON)  

INTEGER(KIND=JPIM) :: JLON

LOGICAL :: LLAFGD, LLZ0H

REAL(KIND=JPRB) :: Z0CR, Z2B, Z3B, Z3BC, ZA1, ZAPRIM, ZAT, ZAU,&
 & ZB1, ZBE, ZBETA, ZBETAP, ZBPRIM, ZC1, ZCD, &
 & ZCD0, ZCH, ZCH0, ZCIS, ZCKD, ZCKH, ZCPRIM, &
 & ZCPVMD, ZCRIT1, ZCRIT2, ZDELTA1, &
 & ZDENUM, ZDEW, ZDID, ZDIH, ZDS, &
 & ZEW, ZGA, ZGAMDZ, ZGKT, ZGKU, ZIT, ZIU, ZLOI, &
 & ZLOS, ZMU, ZMULA2, ZPD, ZPH, ZRI, ZRVMD, &
 & ZRZD, ZRZH, ZSDPRIM, ZST, ZSU, ZTAU, &
 & ZSCRAF, ZRIH, ZRIOLD, &
 & ZUZ0CN, ZWFC, ZWS, ZUSURIC, ZSTA, ZIXP, ZSTAH, &
 & ZHS, ZDERH, ZFP, ZRRCOR, ZGZ0N, ZGZ0MR, ZRZDMR 
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"
#include "acntcls.intfb.h"

#include "fcttrm.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

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

!         AUXILIARY CONSTANTS.


ZCPVMD=RCPV-RCPD
ZRVMD=RV-RD
ZUSURIC=USURIC*USURICL

! LLZ0H      : DIFFERENTES LONGUEURS DE RUGOSITE DYN/THER.

LLZ0H=(KVCLIV>=8).AND.LSOLV

!   ZGZ0N   : VALEUR MIN. DE G FOIS LA LONG. DE RUG. DYN. SANS RELIEF.
!            : MIN VALUE OF G * DYN. ROUGHNESS L. WITHOUT TOPOGRAPHY.

ZGZ0N=RG*SZZ0D

!*
!     ------------------------------------------------------------------
!     II - CALCUL DES PARAMETRES DERIVES ET CONSTANTE DE SECURITE (POUR
!     LE CARRE DU CISAILLEMENT DE VENT).

!          COMPUTATION OF DERIVED PARAMETERS AND SECURITY CONSTANT (FOR
!     THE SQUARE OF THE WIND SHEAR).

Z2B=2.0_JPRB*EDB
Z3B=3._JPRB*EDB
Z3BC=3._JPRB*EDB*EDC

LLAFGD=XMULAF /= 0.0_JPRB

!*
!     ------------------------------------------------------------------
!     III - PASSAGE EN GEOPOTENTIEL POUR LES CONSTANTES RELATIVES A LA
!     LONGUEUR DE RUGOSITE EN CAS DE NEIGE.

!           GOING TO GEOPOTENTIAL FOR CONSTANTS RELATIVE TO ROUGHNESS
!     LENGTH IN CASE OF SNOW COVER.

Z0CR=RG*ALRCN1
ZUZ0CN=1.0_JPRB/(RG*ALRCN2)

!*
!     ------------------------------------------------------------------
!     IV - CALCUL DE L EPAISSEUR DE LA CLS (EN GEOPOTENTIEL).

!          COMPUTATION OF THE THICKNESS OF THE SBL (IN GEOPOTENTIAL).

! - TEMPORAIRE(S) 1D .

! ZDPHI     : EPAISSEUR EN GEOPOTENTIEL DU NIVEAU DE SURFACE.
!            : GEOPOTENTIAL THICKNESS OF THE SURFACE LEVEL.

DO JLON=KIDIA,KFDIA
  ZDPHI(JLON)=PAPHIF(JLON,KLEV)-PAPHI(JLON,KLEV)
ENDDO

!*
!     ------------------------------------------------------------------
!     VI - CALCULS PROPREMENT DITS DES CARACTERISTIQUES DE SURFACE.

!          EFFECTIVE CALCULATIONS OF THE SURFACE CHARACTERISTICS.

IF(USURID == 0.0_JPRB) THEN
  ZIXP=1.0_JPRB
ELSE
  ZIXP=3._JPRB
ENDIF

DO JLON=KIDIA,KFDIA

!     CALCULS CONCERNANT LA PRESENCE OU NON DE NEIGE AU SOL.
!     COMPUTATIONS CONCERNING THE PRESENCE OR ABSENCE OF SNOW ON GROUND.

! - TEMPORAIRE(S) 1D .

! ZDELT     : UN POUR CALCULS DE SATURATION SUR GLACE, ZERO SINON.
!            : ONE FOR SATURATION CALCULATION FOR ICE, ZERO OTHERWISE.

  IF (LNEIGE) THEN
    IF (LSNV) THEN
      PNEIJ(JLON)=PLSM(JLON) *&
       & ((1.0_JPRB-PVEG0(JLON))*PNEIJG(JLON) + PVEG0(JLON)*PNEIJV(JLON))  
      PVEG(JLON)=(1.0_JPRB-PNEIJV(JLON))*PVEG0(JLON)
      PGZ0(JLON)=SQRT((1.0_JPRB-PNEIJV(JLON))*PGZ0F(JLON)**2+&
       & PNEIJV(JLON)*(Z0CR**2+PGZ0RLF(JLON)**2))  
    ELSE
      PNEIJ(JLON)=PLSM(JLON)*PSNS(JLON)/(PSNS(JLON)+WCRIN)
      PVEG(JLON)=PVEG0(JLON)
      PGZ0(JLON)=PGZ0F(JLON)+(Z0CR-PGZ0F(JLON))*PLSM(JLON)&
       & *PSNS(JLON)/(PSNS(JLON)+WCRIN*(1+ZUZ0CN*PGZ0F(JLON)))  
    ENDIF
    ZDELT(JLON)=MAX(0.0_JPRB,SIGN(1.0_JPRB,RTT-PTS(JLON)))
  ELSE
    PNEIJ(JLON)=0.0_JPRB
    PVEG(JLON)=PVEG0(JLON)
    PGZ0(JLON)=PGZ0F(JLON)
    ZDELT(JLON)=0.0_JPRB
  ENDIF

!     CAS DE DEUX LONGUEURS DE RUGOSITE (SUR CONTINENT NON TOTALEMENT
!     COUVERT DE NEIGE).
!     CASE OF TWO ROUGHNESS LENGTHS (ON PARTIALLY SNOW-FREE LAND ONLY).

  IF (LLZ0H) THEN

    IF (LNEIGE) THEN
      IF (LSNV) THEN
        IF (LZ0HSREL) THEN
          PGZ0H(JLON)=SQRT((1.0_JPRB-PNEIJV(JLON))*PGZ0HF(JLON)**2 &
           &+PNEIJV(JLON)*(STHER*Z0CR)**2)
        ELSE
          PGZ0H(JLON)=SQRT((1.0_JPRB-PNEIJV(JLON))*PGZ0HF(JLON)**2+&
           & PNEIJV(JLON)   *&
           & (Z0CR**2+(PGZ0RLF(JLON)*PGZ0HF(JLON)/PGZ0F(JLON))**2))  
        ENDIF
      ELSE
        IF (LZ0HSREL) THEN
          PGZ0H(JLON)=PGZ0HF(JLON)+(Z0CR*STHER-PGZ0HF(JLON))&
           &*PLSM(JLON)*PSNS(JLON)/(PSNS(JLON)+WCRIN&
           &*(1+ZUZ0CN*PGZ0HF(JLON)))
        ELSE
          PGZ0H(JLON)=PGZ0HF(JLON)+(Z0CR-PGZ0HF(JLON))*PLSM(JLON)&
           & *PSNS(JLON)/(PSNS(JLON)+WCRIN*(1+ZUZ0CN*PGZ0HF(JLON)))  
        ENDIF
      ENDIF
    ELSE
      PGZ0H(JLON)=PGZ0HF(JLON)
    ENDIF

! PGZ0H = ZGZ0 OVER SEA UNLESS REQUIRED IN NAMPHY1 (CLIMATE RUNS)

     IF (VZIUSTAR0 > 0) THEN
       PGZ0H(JLON)=PLSM(JLON)*PGZ0H(JLON)&
        & +(1.0_JPRB-PLSM(JLON))*PGZ0HF(JLON)
     ELSE    
       PGZ0H(JLON)=MIN(PGZ0(JLON),PLSM(JLON)*PGZ0H(JLON)&
        & +(1.0_JPRB-PLSM(JLON))*PGZ0(JLON)*RZHZ0M)  
     ENDIF

  ELSE

    PGZ0H(JLON)=PGZ0(JLON)

  ENDIF

!     CALCUL DE SATURATION UTILISANT LES FONCTIONS DEFINIES.
!     SATURATION CALCULATION WITH CALL TO DEFINED FUNCTIONS.

! - TEMPORAIRE(S) 1D .

! ZESP      : PRESSION DE VAPEUR SATURANTE SUR PRESSION.
!            : SATURATION WATER VAPOUR PRESSURE OVER PRESSURE.

  ZEW= FOEW (PTS(JLON),ZDELT(JLON))
  ZESP(JLON)=ZEW/PAPRS(JLON,KLEV)
  PQSATS(JLON)= FOQS (ZESP(JLON))

!     CALCULS RELATIFS A L'HUMIDITE DE SURFACE.
!     COMPUTATIONS CONCERNING SURFACE HUMIDITY.

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

  IF (LSOLV) THEN
    ZWFC=PWFC(JLON)*RD1*GCONV
    IF (LFGEL) THEN
      ZWS=PWS(JLON)+PWSI(JLON)
    ELSE
      ZWS=PWS(JLON)
    ENDIF
    IF (LSNV) THEN
      PHU(JLON)=1.0_JPRB+PLSM(JLON)*(1.0_JPRB-PNEIJG(JLON))*&
       & (0.5_JPRB*(1.0_JPRB-COS(RPI*MIN(ZWS/ZWFC,1.0_JPRB)))-1.0_JPRB)  
      PHU(JLON)=MAX(PHU(JLON),MIN(PQ(JLON,KLEV)/PQSATS(JLON),1.0_JPRB))
      PQS(JLON)= ( PVEG(JLON)*PHV(JLON) +&
       & PVEG0(JLON)*PNEIJV(JLON) +&
       & (1.0_JPRB-PVEG0(JLON))*PHU(JLON) ) * PQSATS(JLON) +&
       & (1.0_JPRB-PHV(JLON))*PVEG(JLON) * PQ(JLON,KLEV)  
    ELSE
      PHU(JLON)=1.0_JPRB+PLSM(JLON)*(1.0_JPRB-PNEIJ(JLON))*&
       & (0.5_JPRB*(1.0_JPRB-COS(RPI*MIN(ZWS/ZWFC,1.0_JPRB)))-1.0_JPRB)  
      PHU(JLON)=MAX(PHU(JLON),MIN(PQ(JLON,KLEV)/PQSATS(JLON),1.0_JPRB))
      PQS(JLON)= ( PVEG(JLON)*PHV(JLON) +&
       & (1.0_JPRB-PVEG(JLON))*PHU(JLON)  ) * PQSATS(JLON) +&
       & (1.0_JPRB-PHV(JLON))*PVEG(JLON) * PQ(JLON,KLEV)  
    ENDIF
  ELSE
    PHU(JLON)=1.0_JPRB+PLSM(JLON)*(1.0_JPRB-PNEIJ(JLON))&
     & *(0.5_JPRB*(1.0_JPRB-COS(RPI*PWS(JLON)/WSMX))-1.0_JPRB)  
    PHQ(JLON)=(1.0_JPRB-PHU(JLON))*PVEG(JLON)
    ZDEW=MAX(0.0_JPRB,SIGN(1.0_JPRB,PQ(JLON,KLEV)-PQSATS(JLON)))
    PHU(JLON)=PHU(JLON)+ZDEW*PHQ(JLON)
    PHQ(JLON)=PHQ(JLON)-ZDEW*PHQ(JLON)
    PQS(JLON)=PHU(JLON)*PQSATS(JLON)+PHQ(JLON)*PQ(JLON,KLEV)
  ENDIF

  PCPS(JLON)=RCPD+ZCPVMD*PQS(JLON)
  PRS(JLON)=RD+ZRVMD*PQS(JLON)

!     CALCULS GEOMETRIQUES.
!     GEOMETRIC CALCULATIONS.

  ZRZD=1.0_JPRB+ZDPHI(JLON)/PGZ0(JLON)
  PCDN(JLON)=(VKARMN/LOG(ZRZD))**2

!     CALCUL PRELIMINAIRES NECESSAIRES A LA DETERMINATION DES
!     COEFFICIENTS D'ECHANGE CD ET CH DANS LE CAS DE DEUX RUGOSITES
!     DYNAMIQUE Z0 ET THERMIQUE ZOH.

!     PRELIMINARY COMPUTATIONS NECESSARY FOR THE DETERMINATION OF
!     EXCHANGE COEFFICIENTS CD AND CH IN THE CASE OF TWO ROUGHNESS
!     LENGTHS Z0 DYNAMICAL AND ZOH THERMAL.

! - TEMPORAIRE(S) 1D .

! ZCDNH     : COEFFICIENT THERMIQUE NEUTRE D'ECHANGE EN SURFACE.
!            : NEUTRAL SURFACE THERMAL EXCHANGE COEFFICIENT.

  IF (LZ0HSREL) THEN
    ZRZH=FZH(ZDPHI(JLON),PGZ0H(JLON))
    ZGZ0MR=PLSM(JLON)*SQRT(MAX(ZGZ0N**2,PGZ0(JLON)**2 &
     &-PGZ0RLF(JLON)**2))+(1.0_JPRB-PLSM(JLON))*PGZ0(JLON)
    ZGZ0MR=MAX(ZGZ0MR,PGZ0H(JLON))
    ZRZDMR=1.0_JPRB+ZDPHI(JLON)/ZGZ0MR
    ZCDNH(JLON)=VKARMN**2/(LOG(ZRZH)*LOG(ZRZDMR))
    ZMU=LOG(ZGZ0MR/PGZ0H(JLON))
  ELSE
    ZRZH=FZH(ZDPHI(JLON),PGZ0H(JLON))
    ZCDNH(JLON)=VKARMN**2/(LOG(ZRZH)*LOG(ZRZD))
    ZMU=LOG(PGZ0(JLON)/PGZ0H(JLON))
  ENDIF
  ZCD0=(GCZ0H(0,1)+ZMU*(GCZ0H(1,1)+ZMU*(GCZ0H(2,1)+ZMU &
   & *GCZ0H(3,1))))/(1.5_JPRB*EDC)  
  ZPD=(GCZ0H(0,2)+ZMU*(GCZ0H(1,2)+ZMU*(GCZ0H(2,2)+ZMU*GCZ0H(3,2))))-0.5_JPRB
  ZCH0=(GCZ0H(0,3)+ZMU*(GCZ0H(1,3)+ZMU*(GCZ0H(2,3)+ZMU*GCZ0H(3,3))))/EDC
  ZPH=(GCZ0H(0,4)+ZMU*(GCZ0H(1,4)+ZMU*(GCZ0H(2,4)+ZMU*GCZ0H(3,4))))-0.5_JPRB
  ZCD=ZCD0*ZRZD**ZPD
  ZCH=ZCH0*ZRZH**ZPH

!     CISAILLEMENT DE VENT.
!     WIND SHEAR.

! - TEMPORAIRE(S) 1D .

! ZU        : MODULE DU VENT DE SURFACE.
!            : SURFACE WIND SPEED.

  ZCIS=PU(JLON,KLEV)**2+PV(JLON,KLEV)**2+(GCISMIN*ZDPHI(JLON)/RG)**2
  ZU(JLON)=SQRT(ZCIS)

!     CALCUL DE STABILITE.
!     STABILITY COMPUTATION.

! - TEMPORAIRE(S) 1D .

! ZSTA      : APPROXIMATION DE DELTA(PHI)*DELTA(LN(THETA)).
!            : APPROXIMATION OF DELTA(PHI)*DELTA(LN(THETA)).

  PRTI(JLON)=2.0_JPRB/(PR(JLON,KLEV)*PT(JLON,KLEV)+RKAPPA*ZDPHI(JLON)&
   & +PRS(JLON)*PTS(JLON))  
  ZSTA=ZDPHI(JLON)*(PR(JLON,KLEV)*PT(JLON,KLEV)+RKAPPA &
   & *ZDPHI(JLON)-PRS(JLON)*PTS(JLON))*PRTI(JLON)  
  ZSTABV(JLON)=ZSTA
  ZSTAH=ZSTA/(1.0_JPRB+ZIXP*ZUSURIC*MAX(0.0_JPRB,ZSTA)/ZCIS)**(1.0_JPRB/ZIXP)
  ZSTA=ZSTA/(1.0_JPRB+ZUSURIC*MAX(0.0_JPRB,ZSTA)/ZCIS)
  PSTAB(JLON)=MAX(0.0_JPRB,SIGN(1.0_JPRB,ZSTA))

!     CALCULS COMMUNS POUR QUANTITE DE MOUVEMENT ET ENERGIE.
!     COMMON COMPUTATIONS FOR MOMENTUM AND ENERGY.

  ZDS=SQRT(ZCIS+EDD/EDK*ABS(ZSTA))
  ZHS=SQRT(ZCIS+EDD*EDK*ABS(ZSTAH))
  ZDID=1.0_JPRB/(ZU(JLON)+ZCD*Z3BC*PCDN(JLON)*SQRT(ABS(ZSTA)*ZRZD))
  ZDIH=1.0_JPRB/(ZU(JLON)+ZCH*Z3BC*ZCDNH(JLON)*SQRT(ABS(ZSTA)*ZRZH))

!     CALCULS POUR LES COMPOSANTES DU VENT DE CD ET DE SON PRODUIT PAR
!     DENSITE FOIS MODULE DU VENT.
!     COMPUTATIONS FOR MOMENTUM OF CD AND OF ITS PRODUCT BY DENSITY
!     TIME WIND SPEED.

  ZLOS=ZCIS*ZDS/(ZU(JLON)*ZDS+Z2B*ABS(ZSTA))
  ZLOI=ZU(JLON)-Z2B*ZSTA*ZDID
  PCD(JLON)=(ZLOI+PSTAB(JLON)*(ZLOS-ZLOI))*PCDN(JLON)/ZU(JLON)

!     IDEM POUR LA TEMPERATURE ET L'HUMIDITE.
!     THE SAME FOR TEMPERATURE AND HUMIDITY.

  ZLOS=ZCIS**2/(ZU(JLON)*ZCIS+Z3B*ABS(ZSTAH)*ZHS)
  ZLOI=ZU(JLON)-Z3B*ZSTA*ZDIH
  PCH(JLON)=(ZLOI+PSTAB(JLON)*(ZLOS-ZLOI))*ZCDNH(JLON)/ZU(JLON)

  PXDROV(JLON)=1.0_JPRB
  PXHROV(JLON)=1.0_JPRB

!     CALCUL ANTI-FIBRILLATION "GIRARD-DELAGE".
!     ANTI-FIBRILLATION "GIRARD-DELAGE" COMPUTATION.

  IF (LLAFGD) THEN
    ZRI=ABS(ZSTA)/ZCIS
    ZRIH=ABS(ZSTAH)/ZCIS
    ZRIOLD=ABS(ZSTABV(JLON))/ZCIS
    ZDERH=(1.0_JPRB+(ZIXP-1.0_JPRB)*ZUSURIC*ZRIOLD)/(1.0_JPRB+ZIXP*ZUSURIC*ZRIOLD) 
    ZST=-3._JPRB*EDB*ZRIH*(1.0_JPRB+1.5_JPRB*EDD*EDK*ZRIH)/(SQRT(1.0_JPRB+EDD*EDK*ZRIH)+ &
     & 3._JPRB*EDB*ZRIH*(1.0_JPRB+EDD*EDK*ZRIH))*ZDERH  
    ZSU=-2.0_JPRB*EDB*ZRI*(1.0_JPRB+0.5_JPRB*EDD*ZRI/EDK)/((SQRT(1.0_JPRB+EDD*ZRI/EDK)+2.0_JPRB* &
     & EDB*ZRI)*(1.0_JPRB+EDD*ZRI/EDK))*(1.0_JPRB-ZRI*ZUSURIC)  
    ZCKD=ZCD*Z3BC*PCDN(JLON)*SQRT(ZRZD)
    ZCKH=ZCH*Z3BC*ZCDNH(JLON)*SQRT(ZRZH)
    ZIT=3._JPRB*EDB*ZRI*(1.0_JPRB+0.5_JPRB*ZCKH*SQRT(ZRI))/((1.0_JPRB+ZCKH*&
     & SQRT(ZRI))*(1.0_JPRB+ZCKH*SQRT(ZRI)+3._JPRB*EDB*ZRI))  
    ZIU=2.0_JPRB*EDB*ZRI*(1.0_JPRB+0.5_JPRB*ZCKD*SQRT(ZRI))/((1.0_JPRB+ZCKD*&
     & SQRT(ZRI))*(1.0_JPRB+ZCKD*SQRT(ZRI)+2.0_JPRB*EDB*ZRI))  
    ZAT=ZIT+PSTAB(JLON)*(ZST-ZIT)
    ZAU=ZIU+PSTAB(JLON)*(ZSU-ZIU)
    ZBE=3._JPRB+ZAT-2.0_JPRB*ZAU
    ZGA=2.0_JPRB+2.0_JPRB*ZAT-3._JPRB*ZAU
    IF(XMULAF > 0.0_JPRB) THEN
      PXDROV(JLON)=MAX(PXDROV(JLON),XMULAF)
      PXHROV(JLON)=MAX(PXHROV(JLON),XMULAF)
    ELSE
      ZGAMDZ=4._JPRB*TSPHY*(RG/ZDPHI(JLON))
      ZGKU=ZGAMDZ*PCD(JLON)*ZU(JLON)
      ZGKT=ZGAMDZ*PCH(JLON)*ZU(JLON)
      ZMULA2=XMULAF**2
      ZDENUM=ZGKU*ZGKT
      ZA1=(1.0_JPRB+ZGKU)*(1.0_JPRB+ZGKT)
      ZB1=(1.0_JPRB+ZGKU)*ZGKT*(1.0_JPRB+ZAT)+2.0_JPRB*(1.0_JPRB+ZGKT)*ZGKU*(1.0_JPRB-ZAU)
      ZC1=ZDENUM*ZGA
      ZDELTA1=ZB1**2-4._JPRB*ZA1*ZC1
      ZCRIT1=MAX(SIGN(1.0_JPRB,ZDELTA1),0.0_JPRB)
      ZTAU=-0.5_JPRB * ZCRIT1*(ZB1+SQRT(ABS(ZDELTA1)))/ZA1
      ZCRIT2=MAX(SIGN(1.0_JPRB,XMULAF-ZTAU),0.0_JPRB)
      ZAPRIM=ZMULA2*ZDENUM
      ZBPRIM=ZMULA2*(ZGKU+ZGKT)+XMULAF*ZDENUM*ZBE
      ZCPRIM=ZMULA2+XMULAF*(ZGKT*(1.0_JPRB+ZAT)+2.0_JPRB*ZGKU*(1.0_JPRB-ZAU))&
       & +ZDENUM*ZGA  
      ZSDPRIM=SQRT(ABS(ZBPRIM**2-4._JPRB*ZAPRIM*ZCPRIM))
      ZBETAP= 0.5_JPRB*(-ZBPRIM +ZSDPRIM)/MAX(ZAPRIM,1.0_JPRB-ZCRIT2)
      ZBETA=1.0_JPRB+ZCRIT2*(ZBETAP-1.0_JPRB)
      PXDROV(JLON)=MAX(PXDROV(JLON),ZBETA)
      PXHROV(JLON)=MAX(PXHROV(JLON),ZBETA)
    ENDIF
  ENDIF

!     CORRECTION DES COEFFICIENTS TURBULENTS EN PRESENCE DE PRECIPITATIONS.
!     CORRECTION OF TURBULENT COEFFICIENTS IN CASE OF PRECIPITATIONS.

  IF (LRRGUST) THEN
    ZFP=MAX(0.0_JPRB,PFPLSH(JLON,KLEV)+PFPLCH(JLON,KLEV))
    ZRRCOR=SQRT(1.0_JPRB+((((ZFP/(ZFP+RRSCALE))**RRGAMMA)*UTILGUST)**2) &
     & /(PCD(JLON)*ZU(JLON)**2))
    PCD(JLON)=PCD(JLON)*ZRRCOR
    PCH(JLON)=PCH(JLON)*ZRRCOR
    PCDN(JLON)=PCDN(JLON)*ZRRCOR
  ENDIF

ENDDO

IF (LDCLS) THEN
  DO JLON=KIDIA,KFDIA

!     CALCUL DE LA DERIVEE PAR RAPPORT A TS DE QSATS ET DES COEFFICIENTS
!     D'ECHANGE MULTIPLIES PAR DENSITE ET MODULE DU VENT.
!     COMPUTATION OF THE DERIVATIVE OF QSATS WITH RESPECT TO TS AND OF
!     THE EXCHANGE COEFFICIENTS MULTIPLIED BY DENSITY AND WIND SPEED.

    PDQSTS(JLON)= FODQS (PQSATS(JLON) , ZESP(JLON),&
     & FODLEW (PTS(JLON) , ZDELT(JLON)))  
    PCDROV(JLON)=PCD(JLON)*ZU(JLON)*PAPRS(JLON,KLEV)*PRTI(JLON)
    PCHROV(JLON)=PCH(JLON)*ZU(JLON)*PAPRS(JLON,KLEV)*PRTI(JLON)

!     CALCULS DE UN SUR G FOIS LA FREQUENCE DE BRUNT-VAISALA DIVISEE PAR
!     LA DENSITE LE TOUT AU CARRE DE MEME QUE LA DENSITE (POUR G.W.D.).
!     COMPUTATION OF ONE OVER G TIME THE BRUNT-VAISALA FREQUENCY DIVIDED
!     BY DENSITY THE WHOLE BEING SQUARED AS WELL AS DENSITY (FOR G.W.D.)

    PNBVNO(JLON,KLEV)=ZSTABV(JLON)/(PAPRS(JLON,KLEV)*PRTI(JLON)*ZDPHI(JLON))**2
    PGWDCS(JLON)=PAPRS(JLON,KLEV)*PRTI(JLON)
  ENDDO
ENDIF

!*
!     ------------------------------------------------------------------
!     VII - INTERPOLATION.

!           INTERPOLATION.

IF (LDHMT) THEN

  CALL ACNTCLS ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
   & PAPRS,PAPRSF,PCP,PQ,PT,PU,PV,&
   & PCD,PCDN,ZCDNH,PCH,PCPS,ZDPHI,PDPHIT,PDPHIV,&
   & PQS,PSTAB,PTS,&
   & PQCLS,PRHCLS,PTCLS,PUCLS,PVCLS,PUCLN,PVCLN,PZPCLS,&
   & 'ACNTCLS' )  

  IF (LRAFTUR) THEN
    DO JLON=KIDIA,KFDIA
      ZSCRAF=(PCD(JLON)*(PU(JLON,KLEV)**2+PV(JLON,KLEV)**2)/ &
       & (PUCLS(JLON)**2+PVCLS(JLON)**2+(GCISMIN*PDPHIV(JLON)/RG)**2))/ &
       & (1.0_JPRB+(LOG(1.0_JPRB+PDPHIV(JLON)/GZ0RAF)/ &
       & LOG(1.0_JPRB+PDPHIV(JLON)/PGZ0(JLON)))**2)  
      ZSCRAF=1.0_JPRB+FACRAF*SQRT(ZSCRAF)
      PURAF(JLON)=ZSCRAF*PUCLS(JLON)
      PVRAF(JLON)=ZSCRAF*PVCLS(JLON)
    ENDDO
  ENDIF

ENDIF

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