SUBROUTINE ACTKE ( KIDIA, KFDIA, KLON, KTDIAT, KTDIAN, KLEV,&
            & PAPHI, PAPHIF, PAPRS, PAPRSF, PR, PT,&
            & PU, PV, PQ, PLSCPE, &
            & PCD, PCH, PGZ0, PTS, PQS, &
            & PQICE, PQLI, PECT, PPRODTH, PNLAB, PNLABCVP ,&
            & PKTROV, PKUROV, PXTROV, PXUROV, PNBVNO,&
            & PNEBS, PQCS, PNEBS0, PQCS0, PCOEFN , PFECT, &
            & PBLH, KCLPH, CDLOCK)

!**** *ACTKE * - SCHEMA DE TURBULENCE TKE

!     Sujet.
!     ------
!     - APPEL DES SOUS-PROGRAMMES ACBL89, ACTURB, ACEVOLET

!**   Interface.
!     ----------
!        *CALL* *ACTKE*

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

!     Auteur.
!     -------
!       04-11, Francois Bouyssel

!   Modifications.
!   --------------
!      2006-04-11 E. Bazile : Ajout de CDLOCK.
!      2006-05-04 E. Bazile : Possibilite de passer l'ECT sur Full-level 
!                             (LECTFL) pour l'advection.
!      2007-05-10 E. Bazile : PXTXX en sortie, PQC0, PNEBS0 pour rayt.
!      2008-04-28 E. Bazile : Introduction of PPROTH and removal PRS, PSTAB
!-----------------------------------------------------------------------


! -   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.
! KTDIAT     : INDICE DE DEPART DES BOUCLES VERTICALES (1 EN GENERAL)
!              POUR LES CALCULS DE TURBULENCE.
! KTDIAN     : INDICE DE DEPART DES BOUCLES VERTICALES (1 EN GENERAL)
!              POUR LES CALCULS DE TURBULENCE + NEBULOSITE.
! KLEV       : DIMENSION VERTICALE DES TABLEAUX "FULL LEVEL".

! - 2D (0:KLEV) .

! PAPHI      : GEOPOTENTIEL AUX DEMI-NIVEAUX.
! PAPRS      : PRESSION AUX DEMI-NIVEAUX.
! PPRODTH    : PRODUCTION THERMIQUE DU A AU SCHEMA SHALLOW.

! - 2D (1:KLEV) .

! PAPHIF     : GEOPOTENTIEL AUX NIVEAUX DES COUCHES.
! PAPRSF     : PRESSION AUX NIVEAUX DES COUCHES.
! PR         : CONSTANTE DES GAZ POUR L'AIR.
! PT         : TEMPERATURE (APRES AJUSTEMENT CONVECTIF).
! PU         : COMPOSANTE EN X DU VENT.
! PV         : COMPOSANTE EN Y DU VENT.
! PQ         : HUMIDITE SPECIFIQUE DE LA VAPEUR D'EAU.
! PLSCPE     : RAPPORT EFECTIF DES L ET CP EN CONDENSATION/EVAPORATION.
! PECT       : ENERGIE CINETIQUE TURBULENTE.

! - 1D (DIAGNOSTIQUE) .

! PCD        : COEFFICIENT D'ECHANGE EN SURFACE POUR U ET V
! PCH        : COEFFICIENT D'ECHANGE EN SURFACE POUR T ET Q
! PGZ0       : G FOIS LA LONGUEUR DE RUGOSITE COURANTE.
! PTS        : TEMPERATURE DE SURFACE
! PQS        : HUMIDITE SPECIFIQUE DE SURFACE.

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

! -   ARGUMENTS EN ENTREE/SORTIE.
!     ---------------------------

! - 2D (1:KLEV) .

! PQICE      : HUMIDITE SPECIFIQUE  SOLIDE "PRONOSTIQUE".
! PQLI       : HUMIDITE SPECIFIQUE LIQUIDE "PRONOSTIQUE".
! PNLAB      : Si 1 Presence d'un nuage Shallow (used in ACBL89)
! PNLABCVP   : Si 1 Presence d'un nuage Deep    (used in ACBL89)


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

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

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

! - 2D (0:KLEV) .

! PKTROV     : COEFFICIENT D'ECHANGE VERTICAL DE T ET Q EN KG/(M*M*S).
! PKUROV     : COEFFICIENT D'ECHANGE VERTICAL DE U ET V EN KG/(M*M*S).
! PXTROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PKTROV.
! PXUROV     : MULTIPLICATEUR "ANTI-FIBRILLATION" DE PKUROV.
! PNBVNO     : CARRE DE FR. BRUNT-VAISALA DIVISEE PAR G FOIS LA DENSITE.

! - 2D (1:KLEV) .

! PNEBS      : NEBULOSITE PARTIELLE STRATIFORME.
! PQCS       : EAU CONDENSEE STRATIFORME.
! PNEBS      : NEBULOSITE PARTIELLE STRATIFORME APRES AJUSTEMENT.
!            : STRATIFORM FRACTIONAL CLOUDINESS APRES AJUSTEMENT.
! PQCS0      : CONTENU "STRATIFORME" EN CONDENSAT NUAGEUX POUR RAYT.
!            : STRATIRORM CLOUD WATER (LIQUID + SOLID) FOR RADIATION.
! PNEBS0     : NEBULOSITE PARTIELLE STRATIFORME POUR RAYT.
! PCOEFN     : COEFFICIENT STATISTIQUE POUR LES FLUX D'EAUX CONDENSEES.

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

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

USE YOMCST   , ONLY : RG
USE YOMPHY   , ONLY : LECTFL, LNSMLIS
USE YOMPHY0  , ONLY : ECTMIN, RPRTH
USE YOMPHY2  , ONLY : TSPHY

IMPLICIT NONE

INTEGER(KIND=JPIM),INTENT(IN)    :: KIDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KFDIA 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLON 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIAT 
INTEGER(KIND=JPIM),INTENT(IN)    :: KTDIAN 
INTEGER(KIND=JPIM),INTENT(IN)    :: KLEV 
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)    :: PR(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)    :: PQ(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLSCPE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCD(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCH(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQS(KLON) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQICE(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PQLI(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PECT(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PPRODTH(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNLAB(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PNLABCVP(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PKTROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PKUROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXTROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PXUROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PNBVNO(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PNEBS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQCS(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PNEBS0(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PQCS0(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PCOEFN(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PFECT(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(OUT)   :: PBLH(KLON) 
INTEGER(KIND=JPIM),INTENT(OUT)   :: KCLPH(KLON)

CHARACTER(LEN=7)  ,INTENT(IN)    :: CDLOCK
INTEGER(KIND=JPIM) :: JLEV, JLON
REAL(KIND=JPRB) :: ZUSLE  (KLON,KLEV), ZLMECT(KLON,KLEV), ZPHI3(KLON,KLEV)
REAL(KIND=JPRB) :: ZPRODTH(KLON,KLEV)
REAL(KIND=JPRB) :: ZECT(KLON,KLEV), ZECT1(KLON,KLEV), ZECT1FL(KLON,KLEV)
REAL(KIND=JPRB) :: ZDET(KLON,KLEV)
REAL(KIND=JPRB) :: ZKCLS(KLON), ZECTCLS(KLON)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

#include "acbl89.intfb.h"
#include "acturb.intfb.h"
#include "acevolet.intfb.h"
#include "abor1.intfb.h"

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

!   CHECK RELIABILITY OF INPUT ARGUMENTS.

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

!     ------------------------------------------------------------------
! 0.   Passage eventuel sur les demi-niveaux dans le cas ou LECTFL=.TRUE.
!      en effet en sortie d'ACTKE on a passe l'ECT sur les niveaux pleins pour 
!      l'advecter.
IF (LECTFL) THEN
! PECT en entree sur les FL donc passage sur les HL pour les calculs physiques 
   DO JLEV = 1, KLEV-1
      DO JLON = KIDIA,KFDIA
         ZECT(JLON,JLEV)=((PECT(JLON,JLEV+1)-PECT(JLON,JLEV))*PAPRS(JLON,JLEV)&
                & + PECT(JLON,JLEV)*PAPRSF(JLON,JLEV+1) &
                & - PECT(JLON,JLEV+1)*PAPRSF(JLON,JLEV))& 
                & / (PAPRSF(JLON,JLEV+1)-PAPRSF(JLON,JLEV))
      ENDDO
   ENDDO
   DO JLON = KIDIA,KFDIA
      ZECT(JLON,KLEV)=ECTMIN
   ENDDO
ELSE
!  ECT toujours sur les demi-niveaux
   DO JLEV = 1, KLEV
      DO JLON = KIDIA,KFDIA
         ZECT(JLON,JLEV)=PECT(JLON,JLEV)
      ENDDO
   ENDDO 
ENDIF
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 1.   Trois parties : ACBL89 (longueur de melange de
!      Bougeault-Lacarerre-1989) + ACTURB (calculs de
!      l'ect et de ses evolutions) + ACEVOLET (evolution
!      proprement dite de l'ect + calcul des flux
!      des tendances physiques pour CPTEND). 
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

DO JLEV = 1, KLEV
  DO JLON = KIDIA,KFDIA
    ZUSLE  (JLON,JLEV) = 0.0_JPRB
    ZLMECT (JLON,JLEV) = 0.0_JPRB
    ZPHI3  (JLON,JLEV) = 0.0_JPRB
  ENDDO
ENDDO

DO JLON = KIDIA,KFDIA
  ZECTCLS (JLON) = 0.0_JPRB
  ZKCLS   (JLON) = 0.0_JPRB
ENDDO

DO JLEV=KTDIAT,KLEV
  DO JLON=KIDIA,KFDIA
    ZECT(JLON,JLEV) = MAX( ECTMIN, ZECT(JLON,JLEV) )
  ENDDO
ENDDO

!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
! 1.1   Calculs : des longueurs de melange (ZLMECT, ZUSLE)
!       de l'ect en surface (ZECTCLS)
!       de la production thermique (ZPRODTH)
!       des coefficients d'echange (PKTROV,PKUROV, ZKCLS)
!       de la frequence de Brunt-Vaisala (PNBVNO)
!- - - - - - - - - - - - - - - - - - - - - - - - - - - - -
     
CALL ACBL89   ( KIDIA, KFDIA, KLON, KTDIAN, KLEV,&
              & PAPHI, PAPHIF, PAPRS, PAPRSF, PT,&
              & ZECT, PQ, PQICE, PQLI, PNLAB, PNLABCVP,&
              & PGZ0, PTS,&
              & ZUSLE, ZLMECT, ZPHI3, 'ACBL89 ' )

CALL ACTURB   ( KIDIA, KFDIA, KLON, KTDIAT, KTDIAN, KLEV,&
              & PAPHI, PAPHIF, PAPRS, PAPRSF, PR, PT,&
              & PU, PV, ZECT, PQ, PLSCPE,&
              & ZLMECT, ZPHI3,&
              & PCD, PCH, PGZ0, PTS, PQS, &
              & PQICE, PQLI,&
              & PKTROV, PKUROV, PNBVNO,&
              & ZPRODTH, PNEBS, PQCS, PCOEFN,&
              & ZKCLS, ZECTCLS , PBLH, KCLPH, 'ACTURB ' )

PNEBS0(:,:)=PNEBS(:,:)
PQCS0(:,:)=PQCS(:,:)
IF (LNSMLIS) THEN
   DO JLEV=KTDIAT+1,KLEV-1
   DO JLON=KIDIA,KFDIA
   IF (PNEBS(JLON,JLEV)<MIN(PNEBS(JLON,JLEV-1),PNEBS(JLON,JLEV+1))) THEN
      IF (PNEBS(JLON,JLEV-1)<PNEBS(JLON,JLEV+1)) THEN
         PQCS0 (JLON,JLEV) = PQCS (JLON,JLEV-1)
         PNEBS0(JLON,JLEV) = PNEBS(JLON,JLEV-1)
      ELSE
         PQCS0 (JLON,JLEV) = PQCS (JLON,JLEV+1)
         PNEBS0(JLON,JLEV) = PNEBS(JLON,JLEV+1)
      ENDIF
   ENDIF
   ENDDO
   ENDDO
ENDIF


PXTROV(:,:)=1.0_JPRB
PXUROV(:,:)=1.0_JPRB

!- - - - - - - - - - - - - - - - - - - - - - - - - -
! 1.2 Calcul du flux d'evolution de l'ECT
!- - - - - - - - - - - - - - - - - - - - - - - - - -

DO JLEV = KTDIAT, KLEV-1
   DO JLON = KIDIA,KFDIA
      ZPRODTH(JLON,JLEV)=ZPRODTH(JLON,JLEV)+ &
          &              RPRTH*MAX(0._JPRB,PPRODTH(JLON,JLEV))
   ENDDO
ENDDO

CALL ACEVOLET ( KIDIA, KFDIA, KLON, KTDIAT, KTDIAN, KLEV, &
              & PAPHI, PAPHIF, PAPRS, PAPRSF, ZECT, &
              & PKUROV, PR, PT, PU, PV, ZUSLE, ZPRODTH,&
              & ZKCLS, ZECTCLS,&
              & PFECT, ZECT1, 'ACEVOLET')

!     ------------------------------------------------------------------
! 2.   Passage eventuel sur les niveaux pleins dans le cas ou LECTFL=.TRUE.
!      pour l'advecter.
IF (LECTFL) THEN
! Passage de ZECT1 sur les niveaux pleins pour calculer la tendance sur les FL
! puis le flux  
   DO JLEV = KTDIAT+1, KLEV
      DO JLON = KIDIA,KFDIA
         ZECT1FL(JLON,JLEV)=((ZECT1(JLON,JLEV)-ZECT1(JLON,JLEV-1)) &
                & *PAPRSF(JLON,JLEV) &
                & + ZECT1(JLON,JLEV-1)*PAPRS(JLON,JLEV) &
                & - ZECT1(JLON,JLEV)*PAPRS(JLON,JLEV-1)) & 
                & / (PAPRS(JLON,JLEV)-PAPRS(JLON,JLEV-1))
         ZDET(JLON,JLEV)=(ZECT1FL(JLON,JLEV)-PECT(JLON,JLEV))/TSPHY
      ENDDO
   ENDDO
   DO JLON = KIDIA,KFDIA
      ZECT1FL(JLON,KTDIAT)=ECTMIN
      ZDET(JLON,KTDIAT)=0._JPRB
   ENDDO
   DO JLEV = KTDIAT, KLEV
      DO JLON = KIDIA,KFDIA
         PFECT(JLON,JLEV)=PFECT(JLON,JLEV-1)- ZDET(JLON,JLEV) &
               & * (PAPRS(JLON,JLEV)-PAPRS(JLON,JLEV-1))/RG
      ENDDO
   ENDDO
ELSE
!  ECT toujours sur les demi-niveaux
   DO JLEV = 1, KLEV
      DO JLON = KIDIA,KFDIA
         PECT(JLON,JLEV)=ZECT(JLON,JLEV)
      ENDDO
   ENDDO 
ENDIF
IF (LHOOK) CALL DR_HOOK('ACTKE',1,ZHOOK_HANDLE)
END SUBROUTINE ACTKE
