!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACPTKE ( KIDIA,KFDIA,KLON,KTDIA,KLEV,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHI,PAPHIF,PDELP,PRDELP,PKNROV,&
 & PT,PU,PV,PALPH,&
 & PAPRS,PR,PTKE,PLMU,PLNPR,&
 !- INPUT 1D
 & PCD,PGZ0,&
 ! - INPUT/OUTPUT 2D
 & PKUROV,PKTROV,PXPTKEROV,&
 ! - OUTPUT 2D .
 & PTENDPTKE, &
 ! - LOCK ARGUMENTS .
 & CDLOCK)  


!**** *ACPTKE * - Specific p-TKE computation.

!     Sujet.
!     ------
!     - ROUTINE DE CALCUL ACTIF .
!       CALCULS DE LA P-TKE. 

!**   Interface.
!     ----------
!        *CALL* *ACPTKE*

!-----------------------------------------------------------------------
! 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 
! * INPUT

! - 2D (1:KLEV) .
! PAPHI      : GEOPOTENTIEL AUX DEMI-NIVEAUX.
! PAPHIF     : GEOPOTENTIEL AUX NIVEAUX DES COUCHES. 
! PDELP      : EPAISSEUR EN PRESSION DE LA COUCHE. 
! PRDELP     : INVERSE DE L'EPAISSEUR EN PRESSION DE LA COUCHE.


! - 2D (0:KLEV) .
! PKNROV     : COEFFICIENT D'ECHANGE VERTICAL NEUTRE (U,V) EN KG/(M*M*S). 

! - 2D (1:KLEV) .
! PT         : TEMPERATURE.
! PU         : COMPOSANTE EN X DU VENT.
! PV         : COMPOSANTE EN Y DU VENT.
! PALPH      : LOG(PAPRS(JLEV)/PAPRSF(JLEV)) (FOR HYDROSTATICS).

! - 2D (0:KLEV) .
! PAPRS      : FULL LEVEL PRESSURE
! PLMU       : MIXING LENGTH FOR MOMENTUM

! - 2D (1:KLEV) .
! PR         : CONSTANTE DES GAZ POUR L'AIR. 
! PTKE       : TURBULENT KINETIC ENERGY
! PLNPR      : LOG(PAPRS(JLEV)/PAPRS(JLEV-1)) (FOR HYDROSTATICS).

! - 1D (DIAGNOSTIQUE) .
! PCD        : COEFFICIENT D'ECHANGE EN SURFACE POUR U ET V.
! PGZ0       : G FOIS LA LONGUEUR DE RUGOSITE COURANTE.

! * INPUT/OUTPUT ARGUMENTS

! - 2D (0:KLEV) .
! PKUROV     : COEFFICIENT D'ECHANGE VERTICAL DE U ET V EN KG/(M*M*S).
! PKTROV     : COEFFICIENT D'ECHANGE VERTICAL DE T ET Q EN KG/(M*M*S).
! PXPTKEROV  : "ANTI-FIBRILLATION" COEFFICIENT FOR THE TKE AUTO-DIFFUSION

! * OUTPUT
 
! - 2D (1:KLEV) .
! PTENDPTKE  : TKE INCREMENT (USED BY PSEUDO-PROGNOSTIC TKE SCHEME)
!-----------------------------------------------------------------------

!     Auteur.
!     -------
!        2008-02, R. Brozkova (moving relevant part from ACDIFUS)

!     Modifications.
!     --------------
!      F. Vana  01-Sep-2008: all pTKE specific stuff collected here.
!      F. Vana  21-Jan-2009: bug fix of PGZ0 + new stabilization of solver

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

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

USE YOMCST   , ONLY : RG       
USE YOMPHY0  , ONLY : NUPTKE   ,VKARMN    
USE YOMPHY2  , ONLY : TSPHY    ,LMULAF
USE YOM_YGFL , ONLY : YTKE_NL
USE YOMCT2   , ONLY : NSTAR2
USE YOMCT3   , ONLY : NSTEP

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

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)    :: PRDELP(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PKNROV(KLON,0: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)    :: PALPH(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PAPRS(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PR(KLON,KLEV) 
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTKE(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLMU(KLON,0:KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PLNPR(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PCD(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0(KLON)  
 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PKUROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PKTROV(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PXPTKEROV(KLON,0:KLEV)

REAL(KIND=JPRB)   ,INTENT(OUT)   :: PTENDPTKE(KLON,KLEV)

CHARACTER(LEN=6)  ,INTENT(IN)    :: CDLOCK 

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

INTEGER(KIND=JPIM) :: JLEV, JLON

REAL(KIND=JPRB) :: ZALTKE, ZLIMTKE, ZNU3TKE, ZTAUICONV, ZGDT

REAL(KIND=JPRB) :: ZDPHI, ZRTI, ZTKES, ZRLM
REAL(KIND=JPRB) :: ZEPSTKE, ZEPSKRV, ZRELAXB, ZDRELAXB
REAL(KIND=JPRB) :: ZDOW, ZDUP, ZMUL, ZELIM

REAL(KIND=JPRB) :: ZTKETILD(KLON,0:KLEV),ZCONVERT(KLON,0:KLEV) &
 & ,ZKERV(KLON,0:KLEV),ZTAUITKE(KLON,0:KLEV)
REAL(KIND=JPRB) :: ZDBET(KLON,0:KLEV),ZBET(KLON,0:KLEV),ZKESROV(KLON,0:KLEV)
REAL(KIND=JPRB) :: ZIPOI(KLON,KLEV), ZSUB1(KLON,KLEV), ZN1(KLON,KLEV)

REAL(KIND=JPRB) :: ZHOOK_HANDLE

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

#include "abor1.intfb.h"

!     ------------------------------------------------------------------
!     CHECK RELIABILITY OF INPUT ARGUMENTS.

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

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

! * Initialization of constants

ZRELAXB=1.5_JPRB
ZDRELAXB=1._JPRB - ZRELAXB

ZEPSKRV=1.E-8_JPRB
ZEPSTKE=1.E-8_JPRB  ! not really needed, it should be secured in ALPLAR

ZALTKE=1.0_JPRB/(NUPTKE*NUPTKE)
ZNU3TKE=NUPTKE*NUPTKE*NUPTKE
ZLIMTKE=0.5_JPRB*NUPTKE*ZNU3TKE*ZRELAXB/(RG*RG)

ZGDT=RG*TSPHY

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

IF (LMULAF) THEN
!cdir unroll=8
  DO JLEV=KTDIA,KLEV-1
     DO JLON=KIDIA,KFDIA
        PXPTKEROV(JLON,JLEV)=SQRT(PXPTKEROV(JLON,JLEV))
     ENDDO
  ENDDO
  
  DO JLEV=KTDIA+1,KLEV-1
    DO JLON=KIDIA,KFDIA
       PXPTKEROV(JLON,JLEV)=MAX(PXPTKEROV(JLON,JLEV),PXPTKEROV(JLON,JLEV-1))
    ENDDO
  ENDDO
ENDIF

!*
!     -----------------------------------------------------------------
!     COMPUTATION OF PTKE RELATED VALUES
!     

!cdir unroll=8
DO JLEV=KTDIA,KLEV-1
  DO JLON=KIDIA,KFDIA

    ZRTI=2._JPRB/(PR(JLON,JLEV)*PT(JLON,JLEV)+PR(JLON,JLEV+1)*PT(JLON,JLEV+1))
    ZDPHI=PAPHIF(JLON,JLEV)-PAPHIF(JLON,JLEV+1)
    ZRLM=MAX(1._JPRB, &
     & ((ZLIMTKE*ZDPHI/(PXPTKEROV(JLON,JLEV)&
     & *PAPRS(JLON,JLEV)*ZRTI))*MAX(PDELP(JLON,JLEV)*(PALPH(JLON,JLEV)&
     & /PLNPR(JLON,JLEV)),PDELP(JLON,JLEV+1)*(1._JPRB-PALPH(JLON,JLEV+1)&
     & /PLNPR(JLON,JLEV+1))))/(PLMU(JLON,JLEV)*PLMU(JLON,JLEV)) )
    ZCONVERT(JLON,JLEV)=PAPRS(JLON,JLEV)*PLMU(JLON,JLEV)*RG*ZRTI*NUPTKE/ZDPHI
    ZTAUICONV=TSPHY*ZNU3TKE/(PLMU(JLON,JLEV)*ZCONVERT(JLON,JLEV))
    ZKESROV(JLON,JLEV)=SQRT(PKNROV(JLON,JLEV)*PKUROV(JLON,JLEV))
    ZTKETILD(JLON,JLEV)=(ZKESROV(JLON,JLEV)/ZCONVERT(JLON,JLEV))**2

    ZTKES=0.5_JPRB*(PTKE(JLON,JLEV)+PTKE(JLON,JLEV+1))

    ! CHOICE OF COEFFICIENTS FOR TKE DIFUSION AND RELAXATION
    ! THEY CAN BE COMPUTED FROM THE PREVIOUS TIMESTEP TKE VALUE
    ! OR FROM THE TILDED TKE VALUE (DIAGNOSED AT THE INSTANT
    ! TIMESTEP FROM THE EXCHANGE COEFFICIENT)

    IF ((NSTEP <= NSTAR2).AND.(YTKE_NL%NREQIN == 0)) THEN

      ! COEFFICIENT FOR DIFFUSION CORRESPONDS TO TILDED VALUES
      ZKERV(JLON,JLEV)=ZALTKE*ZKESROV(JLON,JLEV)*ZRLM

      ! COEFFICIENT FOR RELAXATION (times dt)
      ! CORRESPONDS TO TILDED VALUES
      ZTAUITKE(JLON,JLEV)=ZTAUICONV*ZKESROV(JLON,JLEV)

    ELSE

      ! COEFFICIENT FOR DIFFUSION CORRESPONDS TO PREVIOUS TKE VALUE
      ZKERV(JLON,JLEV)=ZALTKE*ZCONVERT(JLON,JLEV) &
       & *SQRT(MAX(ZEPSTKE,ZTKES))*ZRLM

      ! COEFFICIENT FOR RELAXATION (times dt)
      ! CORRESPONDS TO PREVIOUS TKE VALUE
      ZTAUITKE(JLON,JLEV)=ZTAUICONV*ZCONVERT(JLON,JLEV) &
       & *SQRT(MAX(ZEPSTKE,ZTKES))

    ENDIF


  ENDDO
ENDDO

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

! - TEMPORAIRE(S) 2D (1:KLEV) .

! ZIPOI     : (RG*DT)/DP POUR UNE COUCHE ET UN PAS DE TEMPS DONNES.
!           : (RG*DT)/DP FOR A GIVEN LAYER AND A GIVEN TIME STEP.

! - TEMPORAIRE(S) 1D          .

! ZXDRO     : PCDROV MODIFIE POUR ATTENUER LES FIBRILLATIONS.
!            : PCDROV MODIFIED TO ATTENUATE FIBRILLATIONS.

!cdir unroll=8
DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZIPOI(JLON,JLEV)=PRDELP(JLON,JLEV)*ZGDT
  ENDDO
ENDDO
!     ------------------------------------------------------------------

!   PSEUDO TKE SOLVER

!     ELIMINATION AU SOMMET.
!     ELIMINATION AT THE TOP.

DO JLON=KIDIA,KFDIA

  ZBET(JLON,KTDIA) =          PXPTKEROV(JLON,KTDIA) *ZKERV(JLON,KTDIA)
  ZDBET(JLON,KTDIA)=(1.0_JPRB-PXPTKEROV(JLON,KTDIA))*ZKERV(JLON,KTDIA)
  ZDOW=0.5_JPRB*PALPH(JLON,KTDIA)/PLNPR(JLON,KTDIA)*ZTAUITKE(JLON,KTDIA)

  ZMUL=1.0_JPRB/(1.0_JPRB+ZBET(JLON,KTDIA)*ZIPOI(JLON,KTDIA)+ZDOW*ZRELAXB)
  ZSUB1(JLON,KTDIA)=ZMUL*(ZBET(JLON,KTDIA)*ZIPOI(JLON,KTDIA)-ZDOW*ZRELAXB)
  ZN1(JLON,KTDIA)=ZMUL*(PTKE(JLON,KTDIA)-ZIPOI(JLON,KTDIA)*ZDBET(JLON,KTDIA)&
   & *(PTKE(JLON,KTDIA)-PTKE(JLON,KTDIA+1))-ZDRELAXB*ZDOW*(PTKE(JLON,KTDIA)&
   & +PTKE(JLON,KTDIA+1))+(ZDOW+ZDOW)*ZTKETILD(JLON,KTDIA))

ENDDO

!     ELIMINATION POUR UNE COUCHE STANDARD.
!     ELIMINATION FOR A STANDART LEVEL.

DO JLEV=KTDIA+1,KLEV-1
  DO JLON=KIDIA,KFDIA

    ZBET(JLON,JLEV) =          PXPTKEROV(JLON,JLEV) *ZKERV(JLON,JLEV)
    ZDBET(JLON,JLEV)=(1.0_JPRB-PXPTKEROV(JLON,JLEV))*ZKERV(JLON,JLEV)
    ZDUP=0.5_JPRB*(1.0_JPRB-PALPH(JLON,JLEV)/PLNPR(JLON,JLEV)) &
     & * ZTAUITKE(JLON,JLEV-1)
    ZDOW=0.5_JPRB*PALPH(JLON,JLEV)/PLNPR(JLON,JLEV) &
     & * ZTAUITKE(JLON,JLEV)

    ZELIM=ZBET(JLON,JLEV-1)*ZIPOI(JLON,JLEV)-ZDUP*ZRELAXB
    ZMUL=1.0_JPRB/(1.0_JPRB-ZELIM*ZSUB1(JLON,JLEV-1)+(ZBET(JLON,JLEV-1)&
     & +ZBET(JLON,JLEV))*ZIPOI(JLON,JLEV)+(ZDUP+ZDOW)*ZRELAXB)
    ZSUB1(JLON,JLEV)=ZMUL*(ZBET(JLON,JLEV)*ZIPOI(JLON,JLEV)-ZDOW*ZRELAXB)
    ZN1(JLON,JLEV)=ZMUL*(PTKE(JLON,JLEV)-ZIPOI(JLON,JLEV)*(ZDBET(JLON,JLEV-1)&
     & *(PTKE(JLON,JLEV)-PTKE(JLON,JLEV-1))+ZDBET(JLON,JLEV)*(PTKE(JLON,JLEV)&
     & -PTKE(JLON,JLEV+1)))-ZDRELAXB*(ZDUP*(PTKE(JLON,JLEV)&
     & +PTKE(JLON,JLEV-1))+ZDOW*(PTKE(JLON,JLEV)+PTKE(JLON,JLEV+1)))&
     & +2.0_JPRB*(ZDUP*ZTKETILD(JLON,JLEV-1)+ZDOW*ZTKETILD(JLON,JLEV))&
     & +ZELIM*ZN1(JLON,JLEV-1))
  ENDDO
ENDDO

!     CALCULS EN SURFACE.
!     SURFACE CALCULATIONS.

DO JLON=KIDIA,KFDIA

  ZTKETILD(JLON,KLEV)=ZALTKE*PCD(JLON)&
   & *(PU(JLON,KLEV)**2+PV(JLON,KLEV)**2)
  ZTAUITKE(JLON,KLEV)=TSPHY*ZNU3TKE*RG*SQRT(ZTKETILD(JLON,KLEV))&
   & /(VKARMN*(PGZ0(JLON)+PAPHIF(JLON,KLEV)-PAPHI(JLON,KLEV)))
  ZDUP=0.5_JPRB*(1.0_JPRB-PALPH(JLON,KLEV)/PLNPR(JLON,KLEV))* &
   &  ZTAUITKE(JLON,KLEV-1)
  ZDOW=0.5_JPRB*PALPH(JLON,KLEV)/PLNPR(JLON,KLEV)* &
   &  ZTAUITKE(JLON,KLEV)

  ZELIM=ZBET(JLON,KLEV-1)*ZIPOI(JLON,KLEV)-ZDUP*ZRELAXB
  ZMUL=1.0_JPRB/(1.0_JPRB-ZELIM*ZSUB1(JLON,KLEV-1)+ZBET(JLON,KLEV-1)&
   & *ZIPOI(JLON,KLEV)+(ZDUP+ZDOW+ZDOW)*ZRELAXB)
  ZN1(JLON,KLEV)=ZMUL*(PTKE(JLON,KLEV)-ZIPOI(JLON,KLEV)*ZDBET(JLON,KLEV-1)&
   & *(PTKE(JLON,KLEV)-PTKE(JLON,KLEV-1))-ZDRELAXB*(ZDUP*(PTKE(JLON,KLEV)&
   & +PTKE(JLON,KLEV-1))+(ZDOW+ZDOW)*PTKE(JLON,KLEV))+2.0_JPRB*(ZDUP&
   & *ZTKETILD(JLON,KLEV-1)+ZDOW*ZTKETILD(JLON,KLEV))+ZELIM*ZN1(JLON,KLEV-1))
  PTENDPTKE(JLON,KLEV)=ZN1(JLON,KLEV)

ENDDO

!     SUBSTITUTION POUR UNE COUCHE STANDARD ET AU SOMMET.
!     BACK-SUBSTITUTION FOR A STANDART LAYER AND AT THE TOP.

DO JLEV=KLEV-1,KTDIA,-1
  DO JLON=KIDIA,KFDIA
    ZN1(JLON,JLEV)=ZN1(JLON,JLEV)+ZSUB1(JLON,JLEV)*ZN1(JLON,JLEV+1)
    PTENDPTKE(JLON,JLEV)=ZN1(JLON,JLEV)
  ENDDO
ENDDO

!* !     ------------------------------------------------------------------
! * Modification of exchange coefficients

!cdir unroll=8
DO JLEV=KTDIA,KLEV-1
  DO JLON=KIDIA,KFDIA
    ! preparation only: keeps the ratio of original PKTROV, PKUROV
    PKTROV(JLON,JLEV)=(PKTROV(JLON,JLEV)/MAX(ZEPSKRV,PKUROV(JLON,JLEV)))
    ! now the PKUROV,PKTROV are redefined
    PKUROV(JLON,JLEV)=ZCONVERT(JLON,JLEV)*SQRT(MAX(ZEPSTKE,&
     & 0.5_JPRB*(PTENDPTKE(JLON,JLEV)+PTENDPTKE(JLON,JLEV+1)))) &
     & *(PKUROV(JLON,JLEV)/ZKESROV(JLON,JLEV))
    PKTROV(JLON,JLEV)=PKUROV(JLON,JLEV)*PKTROV(JLON,JLEV)
  ENDDO
ENDDO

! Until here the PTENDPTKE contains TKE+ (PTKE1) values
!     ------------------------------------------------------------------

!     pTKE TENDENCY EVALUATION (PTENDPTKE=(PTKE1-PTKE0)/DT)

!cdir unroll=8
DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    PTENDPTKE(JLON,JLEV)=(PTENDPTKE(JLON,JLEV)-PTKE(JLON,JLEV))/TSPHY
  ENDDO
ENDDO

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

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