!OPTIONS XOPT(NOEVAL)
!-----------------------------------------------------------------------
SUBROUTINE ACPBLHTM ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHI,PAPHIF,PDELP,PCP,&
 & PQ,PT,PU,PV,PAPRSF,PR,&
 & PSTRTU,PSTRTV,&
 ! - INPUT  1D .
 & PZPCLS,PTCLS,PQCLS,&
 & PFCS,PFCLL,PFCLN,PLHS,PGZ0,&
 ! - INPUT/OUTPUT 2D .
 & KCLPH,PBLH,PCLPU,PCLPV,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!     Sujet.
!     ------
!     CALCUL DE LA HAUTEUR DE LA COUCHE LIMITE PLANETAIRE 
!     SELON TROEN & MAHRT 1986

!**   Interface.
!     ----------
!        *CALL* *ACPBLHTM*

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

! PAPHI      : GEOPOTENTIEL AUX DEMI-NIVEAUX.
! - 2D (0:KLEV) .

! PSTRTU     : FLUX TURBULENT DE QUANTITE DE MOUVEMENT "U".
! PSTRTV     : FLUX TURBULENT DE QUANTITE DE MOUVEMENT "V".

! - 2D (1:KLEV) .

! PAPHIF     : GEOPOTENTIEL AUX NIVEAUX DES COUCHES.
! PAPRSF     : PRESSION AUX NIVEAUX DES COUCHES.
! PDELP         : EPAISSEUR EN PRESSION DE LA COUCHE.
! 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 (DIAGNOSTIQUE) .

! PQCLS      : SORTIE DIAGNOSTIQUE DE L'HUMIDITE SPECIFIQUE A HTQ METEO.
! PTCLS      : SORTIE DIAGNOSTIQUE DE LA TEMPERATURE A HTQ METEO.
! PZPCLS      : SORTIE DIAGNOSTIQUE DE LA PRESSION A HTQ METEO.

! PFCLL      : FLUX DE CHALEUR LATENTE EN SURFACE (LIQ).
! PFCLN      : FLUX DE CHALEUR LATENTE EN SURFACE (NEIG).
! PFCS       : FLUX DE CHALEUR SENSIBLE EN SURFACE.
! PLHS       : CHALEUR LATENTE EN SURFACE.
! PGZ0       : LONGUEUR DE RUGOSITE * G.
!-----------------------------------------------------------------------
! -   ARGUMENTS EN ENTREE/SORTIE.
!     ---------------------------

! KCLPH        : INDICE DU NIVEAU MODELE CONTENANT LE SOMMET DE LA CLP.
! PBLH          : CHAMP "HISTORIQUE" POUR LA HAUTEUR DE LA COUCHE LIMITE
! PCLPU        : VENT "U" AU SOMMET DE LA CLP.
! PCLPV        : VENT "V" AU SOMMET DE LA CLP.

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

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

! COMMON/YOMCST /
! COMMON/YOMPHY0/

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

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

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

!        1998-06, hauteur de la couche limite variable. D'apres 
!         Troen and Mahrt (BLM 86) et Holtslag and Boville (J. Clim. 93)

!     Auteur.
!     -------
!        2003-10-27, E. Bazile.
!        Copie de la routine ACPBLH du climat avec en plus le calcul 
!        de la temperature moyenne de la couche limite en interne pour 
!        eviter d'appeler ACNEBR.

!        Modified : 
!         2004-03-07: E.Bazile calcul des diagnostiques pour le vent au sommet
!                     de la CLP.
!-----------------------------------------------------------------------

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

USE YOMCST   , ONLY : RG       ,RV       ,&
 & RCPV     ,RETV     ,RCW      ,RCS      ,RLVTT    ,&
 & RLSTT    ,RTT      ,RALPW    ,RBETW    ,RGAMW    ,&
 & RALPS    ,RBETS    ,RGAMS    ,RALPD    ,RBETD    ,&
 & RGAMD    ,RATM     ,RKAPPA  
USE YOMPHY0  , ONLY : VKARMN &
 & ,       XBLM , XMAXLM, RICRLM,XWSALM,XWSBLM  

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)    :: PAPHI(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPHIF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PDELP(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)    :: PAPRSF(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTRTU(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PSTRTV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PZPCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQCLS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFCS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFCLL(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PFCLN(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLHS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0(KLON) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KCLPH(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PBLH(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLPU(KLON) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCLPV(KLON) 
CHARACTER(LEN=8)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZXT0(KLON)
REAL(KIND=JPRB) :: ZTETA(KLEV),ZTETAV(KLON,KLEV),ZXMOD(KLEV),ZTETAS(KLON)
REAL(KIND=JPRB) :: ZPHI(KLON,KLEV+1)
REAL(KIND=JPRB) :: ZRIBAS(KLON),ZI0(KLON)
REAL(KIND=JPRB) :: ZGZ, ZPSI
INTEGER(KIND=JPIM) :: IBIN
INTEGER(KIND=JPIM) :: ICONT(KLON)

INTEGER(KIND=JPIM) :: JLEV, JLON

REAL(KIND=JPRB) :: ZBS, ZFCVS, ZHT, ZRHO, ZRI, &
 & ZRIBS, ZUSTAR, ZWS, ZWSTAR  
REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "abor1.intfb.h"

#include "fcttrm.h"
!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

!*
!     ------------------------------------------------------------------
PCLPU(:)=0.0_JPRB
PCLPV(:)=0.0_JPRB
KCLPH(:)=KLEV
DO JLON=KIDIA,KFDIA
  ZPHI(JLON,KLEV+1)=PAPHI(JLON,KLEV)
ENDDO
DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZPHI(JLON,JLEV)=PAPHIF(JLON,JLEV)
  ENDDO
ENDDO
!      CALCUL DE LA TEMPERATURE VIRTUELLE AU NIVEAU 
DO  JLEV=KTDIA,KLEV
  DO JLON = KIDIA,KFDIA
    ZTETA(JLEV)=PT(JLON,JLEV)*(RATM/PAPRSF(JLON,JLEV))**RKAPPA
    ZTETAV(JLON,JLEV)=ZTETA(JLEV)*(1.0_JPRB+RETV*PQ(JLON,JLEV))
  ENDDO
ENDDO

!      CALCUL DE LA TEMPERATURE MOYENNE DE LA CLP.
! ZI0 : CUMUL DE PRESSION DANS LA CLP.
! ZXT0: TEMPERATURE MOYENNE DE LA CLP.

ZI0(:)=0.0_JPRB
ZXT0(:)=0.0_JPRB

DO JLEV=KLEV,KTDIA,-1
  DO JLON = KIDIA,KFDIA
    ZGZ=(PAPHI(JLON,JLEV)-PAPHI(JLON,KLEV)+PGZ0(JLON))/RG
    IF(ZGZ < PBLH(JLON))THEN
      ZXT0(JLON)=ZXT0(JLON)+PT(JLON,JLEV)*PDELP(JLON,JLEV)
      ZI0(JLON)=ZI0(JLON)+PDELP(JLON,JLEV)
    ENDIF
  ENDDO
ENDDO
DO JLON = KIDIA,KFDIA
  IF (ZI0(JLON) > 0.0_JPRB) THEN
    ZXT0(JLON)=ZXT0(JLON)/ZI0(JLON)
  ELSE
    ZXT0(JLON)=PTCLS(JLON)
  ENDIF
ENDDO

!      TEST SUR CE FLUX ET CALCUL DE ZTETAS
!      EN CONDITIONS STABLES (ZFCVS.GE.0.)
!      ET INSTABLES          (ZFCVS.LE.0.)
DO JLON = KIDIA,KFDIA

!        CALCUL DU FLUX DE CHALEUR VIRTUELLE EN SURFACE
  ZRHO=PAPRSF(JLON,KLEV)/(PR(JLON,KLEV)*PT(JLON,KLEV))
  ZFCVS= 1.0_JPRB/(ZRHO*PCP(JLON,KLEV))*PFCS(JLON)+RETV*&
   & (PFCLL(JLON)+PFCLN(JLON))*ZXT0(JLON)&
   & /(ZRHO*PLHS(JLON))   

  IF (ZFCVS >= 0.0_JPRB) THEN
    ZTETAS(JLON)=PTCLS(JLON)*(RATM/PZPCLS(JLON))**RKAPPA*&
     & (1+RETV*PQCLS(JLON))  
  ELSE
!           CALCUL DE U*
    ZUSTAR=((PSTRTU(JLON,KLEV)/ZRHO)**2+(PSTRTV(JLON,KLEV)/ZRHO &
     & )**2)**0.25_JPRB  
!           CALCUL DE W* (ECHELLE DE VITESSE CONVECTIVE)
    ZWSTAR=((RG/ZTETAV(JLON,KLEV))*(-ZFCVS)*PBLH(JLON))**(1.0_JPRB/3._JPRB)
!           CALCUL DE l'ECHELLE DE VITESSE VERTICALE DANS LA CMP
!           (TROEN ET MAHRT, 1986)
    ZWS=(ZUSTAR**3+VKARMN*XWSALM*XWSBLM*ZWSTAR**3)**(1.0_JPRB/3._JPRB)
    ZTETAS(JLON)=&
     & PTCLS(JLON)*(1+RETV*PQCLS(JLON))*&
     & (RATM/PZPCLS(JLON))**RKAPPA &
     & -XBLM*ZFCVS/ZWS  
  ENDIF
ENDDO

DO JLON=KIDIA,KFDIA
  ICONT(JLON)=0
  ZRIBAS(JLON)=RICRLM
ENDDO
DO JLEV=KLEV-2,KTDIA,-1
  DO JLON=KIDIA,KFDIA

!          CALCUL DU MODULE DU VENT AU NIVEAU
    ZXMOD(JLEV)=PU(JLON,JLEV)**2+PV(JLON,JLEV)**2

!          CALCUL DU NOMBRE DE RICHARDSON
    ZRI=(0.5_JPRB*(PAPHIF(JLON,JLEV)+PAPHIF(JLON,JLEV+1))&
     & -PAPHI(JLON,KLEV))*(ZTETAV(JLON,JLEV)-ZTETAS(JLON))&
     & /(ZXT0(JLON)*ZXMOD(JLEV))  
    IF(ZRI >= RICRLM.AND.ICONT(JLON) == 0)THEN
!            HAUTEUR DE LA COUCHE LIMITE PLANETAIRE
      ZHT=(0.5_JPRB*(PAPHIF(JLON,JLEV)+&
       & PAPHIF(JLON,JLEV+1))&
       & -PAPHI(JLON,KLEV))/RG  
      ZBS=(0.5_JPRB*(PAPHIF(JLON,JLEV+1)+&
       & PAPHIF(JLON,JLEV+2))&
       & -PAPHI(JLON,KLEV))/RG  
      ZRIBS=ZRIBAS(JLON)
      PBLH(JLON)=ZBS+((ZHT - ZBS)/(ZRI - ZRIBS))*(RICRLM - ZRIBS)
!      PBLH(JLON)=MIN(XMAXLM,MAX(XMINLM,PBLH(JLON)))
    ENDIF
    IF (ZRI >= RICRLM) THEN
      ICONT(JLON)=ICONT(JLON)+1
    ENDIF
    ZRIBAS(JLON)=ZRI
  ENDDO
ENDDO
DO JLON=KIDIA,KFDIA
  IF (ICONT(JLON) == 0) THEN
    PBLH(JLON)=XMAXLM
  ENDIF
ENDDO

!----------------------------------------------------------------------
!   VENT AU SOMMET DE LA CLA
!----------------------------------------------------------------------

DO JLEV=KLEV,KTDIA,-1
  DO JLON=KIDIA,KFDIA
    ZPSI=MAX(0.0_JPRB,MIN(1.0_JPRB,(PBLH(JLON)*RG+PAPHI(JLON,KLEV)-ZPHI(JLON,JLEV+1))&
     & /(ZPHI(JLON,JLEV)-ZPHI(JLON,JLEV+1))))  
    PCLPU(JLON)=ZPSI*PU(JLON,JLEV)+(1.0_JPRB-ZPSI)*PCLPU(JLON)
    PCLPV(JLON)=ZPSI*PV(JLON,JLEV)+(1.0_JPRB-ZPSI)*PCLPV(JLON)
    IBIN=NINT(ZPSI)
    KCLPH(JLON)=IBIN*JLEV+(1-IBIN)*KCLPH(JLON)
  ENDDO
ENDDO
IF (LHOOK) CALL DR_HOOK('ACPBLHTM',1,ZHOOK_HANDLE)

END SUBROUTINE ACPBLHTM
