!OPTIONS XOPT(NOEVAL)
!-----------------------------------------------------------------------
SUBROUTINE ACPBLH ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHI,PAPHIF,PCP,&
 & PQ,PT,PU,PV,PAPRSF,PR,&
 & PSTRTU,PSTRTV,&
 ! - INPUT  1D .
 & PZPCLS,PTCLS,PQCLS,&
 & PFCS,PFCLL,PFCLN,PLHS,PRTI,&
 ! - OUTPUT 2D .
 & PLM,&
 ! - LOCK ARGUMENTS .
 & CDLOCK)  

!     Sujet.
!     ------
!     CALCUL DE LA HAUTEUR DE LA COUCHE LIMITE PLANETAIRE 

!**   Interface.
!     ----------
!        *CALL* *ACPBLH*

!-----------------------------------------------------------------------
! 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.
! 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.
! PRTI       : INVERSE DE R*T.

! XBLM       : COEFFICIENT-FLUX DE CHALEUR DANS LA CLP
! XWSALM     : COEFFICIENT-ECHELLE DE VITESE VERTICALE DANS LA CLP
! XWSBLM     : COEFFICIENT-ECHELLE DE VITESE VERTICALE DANS LA CLP
!-----------------------------------------------------------------------
! -   ARGUMENTS EN ENTREE/SORTIE.
!     ---------------------------

! PLM        : CHAMP "HISTORIQUE" POUR LA HAUTEUR DE LA COUCHE LIMITE

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

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

! COMMON/YOMCST /
! COMMON/YOMPHY0/

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

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

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

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

!      CALCUL DE LA HAUTEUR DE LA COUCHE DE MELANGE TROEN-BOVILLE
!      D'apres la version 1D codee par I.Beau

!     Modifications.
!     --------------

!      2006-03-09   P.Marquet : A new version of the Top-PBL height (see APLPAR and ACNEBR)
!      2008-02-06   P.Marquet : A new use of PQCLS=PQS,  PTCLS=PQS 
!                               and PZPCLS=PAPRS(KLEV) : see APLPAR
!-----------------------------------------------------------------------
USE PARKIND1  ,ONLY : JPIM     ,JPRB
USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK

USE YOMCST   , ONLY : RG     ,RKAPPA      ,RETV     ,     RATM
USE YOMPHY0  , ONLY : VKARMN &
 & ,       XBLM ,XMINLM, 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)    :: 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)    :: PRTI(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLM(KLON) 
CHARACTER(LEN=6)  ,INTENT(IN)    :: CDLOCK 
REAL(KIND=JPRB) :: ZTETA(KLEV),ZTETAV(KLON,KLEV)&
 & ,ZXMOD(KLEV),ZTETAS(KLON),ZTETAVS(KLON)  
REAL(KIND=JPRB) :: ZRIBAS(KLON)
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"

!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

!*
!     ------------------------------------------------------------------

!      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

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

!        CALCUL DE LA TEMPERATURE POTENTIELLE VIRTUELLE EN SURFACE
  ZTETAVS(JLON)=PTCLS(JLON)*(RATM/PZPCLS(JLON))&
   & **RKAPPA*(1.0_JPRB+RETV*PQCLS(JLON))  

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

  IF (ZFCVS >= 0.0_JPRB) THEN
    ZTETAS(JLON)=ZTETAVS(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/ZTETAVS(JLON))*(-ZFCVS)*PLM(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)=ZTETAVS(JLON)-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))&
     & /(ZTETAVS(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)
      PLM(JLON)=ZBS+((ZHT - ZBS)/(ZRI - ZRIBS))*(RICRLM - ZRIBS)
      PLM(JLON)=MIN(XMAXLM,MAX(XMINLM,PLM(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
    PLM(JLON)=XMAXLM
  ENDIF
ENDDO

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