!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACNTCLS ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPRS,PAPRSF,PCP,PQ,PT,PU,PV,&
 ! - INPUT  1D .
 & PCD,PCDN,PCDNH,PCH,PCPS,PDPHI,PDPHIT,PDPHIV,&
 & PQS,PSTAB,PTS,&
 ! - OUTPUT 1D .
 & PQCLS,PRHCLS,PTCLS,PUCLS,PVCLS,PUCLN,PVCLN,PZPCLS,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!**** *ACNTCLS * - INTERP. DES PARAMETRES U,V,T,Q AUX HAUTEURS CHOISIES.

!     Sujet.
!     ------

!     - ROUTINE DE CALCUL ACTIF .
!          INTERPOLATION DES TEMPERATURES, HUMIDITES (SPECIFIQUES ET
!          RELATIVES) ET VENTS AUX HAUTEURS "METEO" .

!          TEMPERATURE, MOISTURE (SPECIFIC AND RELATIVE) AND WIND
!          INTERPOLATION AT STANDARD "METEOROLOGICAL" LEVELS .

!**   Interface.
!     ----------
!        *CALL* *ACNTCLS*

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

! PAPRS      : PRESSION AUX DEMI-NIVEAUX.

! - 2D (1:KLEV) .

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

! - 1D (DIAGNOSTIQUE) .

! PCD        : COEFFICIENT D'ECHANGE EN SURFACE POUR U ET V.
! PCDN       : COEFFICIENT NEUTRE D'ECHANGE EN SURFACE.
! PCDNH      : COEFFICIENT THERMIQUE NEUTRE D'ECHANGE EN SURFACE.
! PCH        : COEFFICIENT D'ECHANGE EN SURFACE POUR T ET Q.
! PCPS       : CHALEUR MASSIQUE A PRESSION CONSTANTE DE L'AIR AU SOL.
! PQS        : HUMIDITE SPECIFIQUE DE SURFACE.
! PSTAB      : INDICE DE STABILITE A LA SURFACE.

! - 1D (PROGNOSTIQUE) .

! PTS        : TEMPERATURE DE SURFACE.

! - 1D (SPECIFIQUE) .

! PDPHIT     : HAUTEUR D INTERPOLATION POUR T ET Q (EN GEOPOTENTIEL).
! PDPHIT     : HAUTEUR D INTERPOLATION POUR T ET Q (EN GEOPOTENTIEL).
! PDPHIV     : HAUTEUR D INTERPOLATION POUR U ET V (EN GEOPOTENTIEL).

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

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

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

! - 1D (DIAGNOSTIQUE) .

! PQCLS      : SORTIE DIAGNOSTIQUE DE L'HUMIDITE SPECIFIQUE A HTQ METEO.
! PRHCLS     : SORTIE DIAGNOSTIQUE DE L'HUMIDITE RELATIVE A HTQ METEO.
! 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.

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

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

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

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

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

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

!     Auteur.
!     -------
!        92-05, J.F. Geleyn.

!     Modifications.
!     --------------
!        97-08, PZx variables > Zx, introduce CDLOCK - J.M. Piriou.
!        98-08, Pressure at HTQ                      - V. Lorant   
!        M.Hamrud      01-Oct-2003 CY28 Cleaning
!      2008-11, C.Payan, Neutral Wind.

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

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

USE YOMPHY   , ONLY : LNEIGE,  LBLVAR
USE YOMCST   , ONLY : RV       ,RCPD     ,RCPV     ,RETV     ,&
 & RCW      ,RCS      ,RLVTT    ,RLSTT    ,RTT      ,&
 & RALPW    ,RBETW    ,RGAMW    ,RALPS    ,RBETS    ,&
 & RGAMS    ,RALPD    ,RBETD    ,RGAMD  
USE YOMPHY0  , ONLY : VKARMN

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
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(IN)    :: PQ(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)    :: PCD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCDN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCDNH(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCH(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCPS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDPHI(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDPHIT(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDPHIV(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTAB(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PRHCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PUCLN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PVCLN(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PZPCLS(KLON) 
CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK 
INTEGER(KIND=JPIM) :: JLON

REAL(KIND=JPRB) :: ZBD, ZBH, ZBN, ZBNH, ZCORS, ZCORU, ZCPVMD,&
 & ZDELTA, ZEW, ZIV, ZLOGS, ZLOGU, ZRS, ZRU  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "fcttrm.h"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

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

!         AUXILIARY CONSTANTS.

ZCPVMD=RCPV-RCPD

!*
!     ------------------------------------------------------------------
!     II - INTERPOLATION.

!          INTERPOLATION.

DO JLON=KIDIA,KFDIA

!     CALCULS PREPARATOIRES.
!     PREPARATORY CALCULATIONS.

  ZBN=VKARMN/SQRT(PCDN(JLON))
  ZBNH=VKARMN*SQRT(PCDN(JLON))/PCDNH(JLON)
  ZBD=VKARMN/SQRT(PCD(JLON))
  ZBH=VKARMN*SQRT(PCD(JLON))/PCH(JLON)
  ZRU=PDPHIV(JLON)/PDPHI(JLON)
  ZRS=PDPHIT(JLON)/PDPHI(JLON)
  ZLOGU=LOG(1.0_JPRB+ZRU*(EXP(ZBN)-1.0_JPRB))
  ZLOGS=LOG(1.0_JPRB+ZRS*(EXP(ZBNH)-1.0_JPRB))
  ZCORU=PSTAB(JLON)*ZRU*(ZBN-ZBD)+(1.0_JPRB-PSTAB(JLON))*LOG(1.0_JPRB+ZRU &
   & *(EXP(MAX(0.0_JPRB,ZBN-ZBD))-1.0_JPRB))  
  ZCORS=PSTAB(JLON)*ZRS*(ZBNH-ZBH)+(1.0_JPRB-PSTAB(JLON))*LOG(1.0_JPRB+ZRS &
   & *(EXP(MAX(0.0_JPRB,ZBNH-ZBH))-1.0_JPRB))  

!     INTERPOLATION DES COMPOSANTES DU VENT.
!     INTERPOLATION OF WIND COMPONENTS.

  ZIV=MAX(0.0_JPRB,MIN(1.0_JPRB,(ZLOGU-ZCORU)/ZBD))
  PUCLS(JLON)=PU(JLON,KLEV)*ZIV
  PVCLS(JLON)=PV(JLON,KLEV)*ZIV

!     INTERPOLATION DES COMPOSANTES DU VENT NEUTRE.
!     INTERPOLATION OF NEUTRAL WIND COMPONENTS.

  ZIV=MAX(0.0_JPRB,MIN(1.0_JPRB,ZLOGU/ZBD))
  PUCLN(JLON)=PU(JLON,KLEV)*ZIV
  PVCLN(JLON)=PV(JLON,KLEV)*ZIV

!     INTERPOLATION DES VARIABLES THERMODYNAMIQUES.
!     INTERPOLATION OF THERMODYNAMIC VARIABLES.

  ZIV=MAX(0.0_JPRB,MIN(1.0_JPRB,(ZLOGS-ZCORS)/ZBH))
  IF (LBLVAR) THEN
     PQCLS(JLON)=PQ(JLON,KLEV)
     PTCLS(JLON)=PT(JLON,KLEV)
  ELSE
     PQCLS(JLON)=PQS(JLON)+ZIV*(PQ(JLON,KLEV)-PQS(JLON))
     PTCLS(JLON)=(PCPS(JLON)*PTS(JLON)+ZIV*(PCP(JLON,KLEV)&
     & *PT(JLON,KLEV)-PCPS(JLON)*PTS(JLON)+PDPHI(JLON))&
     & -PDPHIT(JLON))/(RCPD+ZCPVMD*PQCLS(JLON))  
  ENDIF

!     CALCUL DE L'HUMIDITE RELATIVE.
!     RELATIVE HUMIDITY COMPUTATION.

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

  PZPCLS(JLON)=PAPRS(JLON,KLEV)+ZRS*(PAPRSF(JLON,KLEV)-PAPRS(JLON,KLEV))
  ZEW= FOEW (PTCLS(JLON),ZDELTA)
  PRHCLS(JLON)=(PZPCLS(JLON)*PQCLS(JLON)*(RETV+1.0_JPRB))/&
   & (ZEW*(1.0_JPRB+RETV*PQCLS(JLON)))  
ENDDO

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