!OPTIONS XOPT(NOEVAL)
SUBROUTINE ACMIXELEN ( KIDIA,KFDIA,KLON,KTDIA,KLEV,KMLTYPE,&
 !-----------------------------------------------------------------------
 ! - INPUT  2D .
 & PAPHI,PAPHIF,PAPRS,PAPRSF,PT,PQV,PQLI,PQICE,PQRAIN,PQSNOW,PTKE,&
 ! - INPUT 1D .
 & PGZ0,PTS,&
 ! - INPUT/OUTPUT 2D .
 & PLMU,PLMT)

!**** *ACMIXELEN * - COMPUTATION OF TKE-TYPE MIXING LENGTHS.

! -   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)
!              POUR LES CALCULS DE TURBULENCE.
! KTDIA     : START OF THE VERTICAL LOOP FOR THE TURBUL COMPUTATIONS.
! KLEV       : DIMENSION VERTICALE DES TABLEAUX "FULL LEVEL".
! KMLTYPE   : TYPE OF MIXING LENGTH
!            = 1  pure BL89 
!            = 2  corrected BL89 mixed with Prandtl one
!            = 3  const * sqrt(e)/N
!            = 4  const * sqrt(e)/N mixed with Prandtl one


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

! - 2D (0:KLEV) .

! PAPHI      : GEOPOTENTIEL AUX DEMI-NIVEAUX.
! PAPRS      : PRESSION AUX DEMI-NIVEAUX.

! - 2D (1:KLEV) .

! PAPHIF     : GEOPOTENTIEL AUX NIVEAUX DES COUCHES.
! PAPRSF     : PRESSION AUX NIVEAUX DES COUCHES.
! PT         : TEMPERATURE.
! PQV        : PROGNOSTIC VATER VAPOUR.
! PQLI       : PROGNOSTIC SUSPENDED CLOUD WATER.
! PQICE      : PROGNOSTIC SUSPENDED CLOUD ICE.
! PQRAIN     : PROGNOSTIC LIQUID PRECIPITATIONS.
! PQSNOW     : PROGNOSTIC FROZEN PRECIPITATIONS.
! PTKE       : PROGNOSTIC FULL LEVEL TKE.


! - 1D (PROGNOSTIQUE) .

! PGZ0       : G FOIS LA LONGUEUR DE RUGOSITE COURANTE.
! PTS        : TEMPERATURE DE SURFACE

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

! -   ARGUMENTS D'ENTREE/SORTIE.
!     --------------------------

! - 2D (0:KLEV) .
! PLMU        : LONGUEUR DE MELANGE POUR LE VENT.
! PLMT        : LONGUEUR DE MELANGE POUR T ET Q.

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

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

! COMMON/YOMPHY0/
! COMMON/YOMCST /

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

!     Externals.
!     ---------

!     Method.
!     --------
!     Bougeault and Lacarrere, M.W.R. (1989), Sukorianski et al. (2005)...
!     and ALARO physics documentation.

!     Author.
!     -------
!        F. Vana (LACE/CHMI) using bl89 of Meso-NH and
!                                  acbl89 of Arpege.

!     Modifications.
!     --------------
!        Original version 20-Sep-2007
!        F. Vana 26-Mar-2008: consistency with eTKE + more options
!        F. Vana 21-Jan-2009: phased with CY35T1

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

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

USE YOMCST   , ONLY : RG       ,RATM     ,RKAPPA  ,&
 & RETV     ,RPI
USE YOMPHY0  , ONLY : VKARMN   ,NUPTKE   ,C4TKE  ,TKEMULT, &
 & C3TKEFREE, CTHETA
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 
INTEGER(KIND=JPIM),INTENT(IN)    :: KMLTYPE
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)    :: PT(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQV(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQLI(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQICE(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQRAIN(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PQSNOW(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTKE(KLON,KLEV)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PGZ0(KLON)
REAL(KIND=JPRB)   ,INTENT(IN)    :: PTS(KLON)
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLMU(KLON,0:KLEV) 
REAL(KIND=JPRB)   ,INTENT(INOUT) :: PLMT(KLON,0:KLEV) 

INTEGER(KIND=JPIM) :: JLEV, JLON, JJLEV

REAL(KIND=JPRB) :: ZHOOK_HANDLE
REAL(KIND=JPRB) :: ZINTE(KLON),ZLWORK(KLON)

REAL(KIND=JPRB) :: ZPREF, ZQV, ZQC, ZTESTM, ZTEST0, ZTEST, ZKONV, ZC3, &
 &                 ZPOWERED2, ZMASK
REAL(KIND=JPRB) :: zlwork1_, zlwork2_, zpote_

REAL(KIND=JPRB) :: ZDZZ(KLON,0:KLEV)
REAL(KIND=JPRB) :: ZDELTVPT(KLON,0:KLEV)
REAL(KIND=JPRB) :: ZHLVPT(KLON,0:KLEV)
REAL(KIND=JPRB) :: ZVPT(KLON,KLEV)
REAL(KIND=JPRB) :: ZG_O_THVREF(KLON,KLEV)
REAL(KIND=JPRB) :: ZTHETA(KLON,KLEV)
REAL(KIND=JPRB) :: ZLM(KLON,KLEV)
REAL(KIND=JPRB) :: ZLMU(KLON,0:KLEV) 
REAL(KIND=JPRB) :: ZLMT(KLON,0:KLEV) 
REAL(KIND=JPRB) :: ZMOIST(KLON) 
    
!---------------------------------------------------------------------

IF (LHOOK) CALL DR_HOOK('ACMIXELEN',0,ZHOOK_HANDLE)

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

! 0. Initial settings

! 0.1 Setup of constants

!   conversion factor L -> l
ZKONV = 0.5_JPRB *C3TKEFREE*NUPTKE*NUPTKE*NUPTKE/(CTHETA*C4TKE)
!   precomputed 2^(5/4)
ZPOWERED2=2.378414230005442_JPRB

! 0.2 Setup of fields

DO JLEV=KTDIA,KLEV-1
  DO JLON=KIDIA,KFDIA
    ! calculation of ZDZZ
    ZDZZ(JLON,JLEV)=(PAPHIF(JLON,JLEV)-PAPHIF(JLON,JLEV+1))/RG
  ENDDO
ENDDO
ZDZZ(KIDIA:KFDIA,KLEV)=(PAPHIF(KIDIA:KFDIA,KLEV)-PAPHI(KIDIA:KFDIA,KLEV))/RG

DO JLEV=KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ! calculation of dry Theta
    ZPREF= PAPRSF(JLON,JLEV)
    ZTHETA(JLON,JLEV)= PT(JLON,JLEV)*(RATM/ZPREF)**(RKAPPA)
    ! calculation of Theta_v
    ZQV=PQV(JLON,JLEV)
    ZQC=PQLI(JLON,JLEV)+PQICE(JLON,JLEV)+PQRAIN(JLON,JLEV)+PQSNOW(JLON,JLEV)
    !ZMOIST(JLON)=(1._JPRB+RETV*ZQV-ZQC)
    ZMOIST(JLON)=1._JPRB
    ! Arpege version (extended by falling species)
    ZVPT(JLON,JLEV)=ZTHETA(JLON,JLEV)*ZMOIST(JLON)
    ! Reference state (should be consistent with buoyancy term of TKE eq.)
    ! Moist reference state
    ZG_O_THVREF(JLON,JLEV)   = RG/ZVPT(JLON,JLEV)
    ! Dry reference state
    !ZG_O_THVREF(JLON,JLEV)   = RG/ZTHETA(JLON,JLEV)
  ENDDO
ENDDO

DO JLEV=KTDIA,KLEV-1
  DO JLON=KIDIA,KFDIA
    ! deltas of Theta_v
    ZDELTVPT(JLON,JLEV)=ZVPT(JLON,JLEV)-ZVPT(JLON,JLEV+1)
    ! half levels of Theta_v
    ZHLVPT(JLON,JLEV)=(ZVPT(JLON,JLEV)+ZVPT(JLON,JLEV+1))*0.5_JPRB
  ENDDO
ENDDO
! For surface the moist part is taken from full level above
ZHLVPT(KIDIA:KFDIA,KLEV)=PTS(KIDIA:KFDIA)* &
  &    (RATM/PAPRS(KIDIA:KFDIA,KLEV))**(RKAPPA) * ZMOIST(KIDIA:KFDIA)
! Alternatively: ZHLVPT(KIDIA:KFDIA,KLEV)=ZVPT(KIDIA:KFDIA,KLEV)
ZDELTVPT(KIDIA:KFDIA,KLEV)=ZVPT(KIDIA:KFDIA,KLEV)-ZHLVPT(KIDIA:KFDIA,KLEV)

! and a bit of security ...
WHERE (ABS(ZDELTVPT(KIDIA:KFDIA,KTDIA:KLEV))<1.E-10_JPRB)
  ZDELTVPT(KIDIA:KFDIA,KTDIA:KLEV)=1.E-10_JPRB
END WHERE

!---------------------------------------------------------------------
! 1. Computation of the BL89 mixing length (on full levels) 

IF (KMLTYPE < 3) THEN

! 1.0. Main loop on model levels

DO JLEV=KTDIA,KLEV

  ! 1.1.   mixing length for a downwards displacement

  ZINTE(KIDIA:KFDIA)=TKEMULT*PTKE(KIDIA:KFDIA,JLEV)
  ZLWORK(KIDIA:KFDIA)=0._JPRB
  ZTESTM=1._JPRB
  DO JJLEV=JLEV,KLEV
    IF(ZTESTM > 0._JPRB) THEN
      ZTESTM=0._JPRB
      DO JLON=KIDIA,KFDIA
        ZTEST0=0.5_JPRB+SIGN(0.5_JPRB,ZINTE(JLON))
        ZTESTM=ZTESTM+ZTEST0
        zlwork1_= ZDZZ(JLON,JJLEV)
        zpote_ = -ZTEST0*ZG_O_THVREF(JLON,JLEV)*      &
         &  (ZHLVPT(JLON,JJLEV)-ZVPT(JLON,JLEV) )*zlwork1_
        ZTEST =0.5_JPRB+SIGN(0.5_JPRB,ZINTE(JLON)-zpote_)
        zlwork2_= ( ZG_O_THVREF(JLON,JLEV) *                                &
         &  (  ZVPT(JLON,JJLEV) - ZVPT(JLON,JLEV) )                         &
         &  + SQRT (ABS(                                                    &
         & (ZG_O_THVREF(JLON,JLEV)*(ZVPT(JLON,JJLEV)-ZVPT(JLON,JLEV)) )**2  &
         &  + 2._JPRB * ZINTE(JLON) * ZG_O_THVREF(JLON,JLEV)                &
         &  * ZDELTVPT(JLON,JJLEV) / zlwork1_        ))) /                  &
         & ( ZG_O_THVREF(JLON,JLEV) * ZDELTVPT(JLON,JJLEV) / zlwork1_ )
        ZLWORK(JLON)=ZLWORK(JLON)+ZTEST0*(ZTEST*zlwork1_+       &
         &     (1._JPRB-ZTEST)*zlwork2_)
        ZINTE(JLON) = ZINTE(JLON) - zpote_
      ENDDO
    ELSE
      EXIT
    ENDIF
  ENDDO

  ! 1.2.   intermediate storage (and security) of L_down

  IF (KMLTYPE == 1) THEN
    ZLM(KIDIA:KFDIA,JLEV)=MIN(  ZLWORK(KIDIA:KFDIA), &
     &  (PAPHIF(KIDIA:KFDIA,JLEV)-PAPHI(KIDIA:KFDIA,KLEV))/RG  )
  ELSE
    ZLM(KIDIA:KFDIA,JLEV)= ZLWORK(KIDIA:KFDIA)
  ENDIF

  ! 1.3.  mixing length for an upwards displacement

  ZINTE(KIDIA:KFDIA)=TKEMULT*PTKE(KIDIA:KFDIA,JLEV)
  ZLWORK(KIDIA:KFDIA)=0._JPRB
  ZTESTM=1._JPRB
  DO JJLEV=JLEV-1,KTDIA,-1
    IF(ZTESTM > 0._JPRB) THEN
    ZTESTM=0._JPRB
      DO JLON=KIDIA,KFDIA
        ZTEST0=0.5_JPRB+SIGN(0.5_JPRB,ZINTE(JLON))
        ZTESTM=ZTESTM+ZTEST0
        zlwork1_=ZDZZ(JLON,JJLEV)
        zpote_ = ZTEST0*ZG_O_THVREF(JLON,JLEV)   *      &
         &  ( ZHLVPT(JLON,JJLEV) - ZVPT(JLON,JLEV) ) * zlwork1_
        ZTEST =0.5_JPRB+SIGN(0.5_JPRB,ZINTE(JLON)-zpote_)
        zlwork2_=        ( - ZG_O_THVREF(JLON,JLEV) *                        &
         &  (  ZVPT(JLON,JJLEV+1) - ZVPT(JLON,JLEV) )                        &
         &  + SQRT (ABS(                                                     &
         &  (ZG_O_THVREF(JLON,JLEV)*(ZVPT(JLON,JJLEV+1)-ZVPT(JLON,JLEV)))**2 &
         &  + 2._JPRB * ZINTE(JLON) * ZG_O_THVREF(JLON,JLEV)                 &
         &   * ZDELTVPT(JLON,JJLEV) / zlwork1_   ))    ) /                   &
         &  ( ZG_O_THVREF(JLON,JLEV) * ZDELTVPT(JLON,JJLEV) / zlwork1_ )
        ZLWORK(JLON)=ZLWORK(JLON)+ZTEST0*(ZTEST*zlwork1_+  &
         &          (1._JPRB-ZTEST)*zlwork2_)
        ZINTE(JLON) = ZINTE(JLON) - zpote_
      ENDDO
    ELSE
      EXIT
    ENDIF
  ENDDO


  ! 1.4.   to ensure the convergence of L toward sqrt(e)/N
  IF (KMLTYPE == 2) THEN
    DO JLON=KIDIA,KFDIA
    ZMASK=0.5_JPRB+SIGN(0.5_JPRB, ZLM(JLON,JLEV)- &
        & (PAPHIF(JLON,JLEV)-PAPHI(JLON,KLEV))/RG  )
    ZLM(JLON,JLEV)=ZMASK*ZLWORK(JLON) + (1._JPRB-ZMASK)*ZLM(JLON,JLEV)
    ENDDO
  ENDIF

  ! 1.5. final mixing length

  ! following formula should be compatible with the  
  ! ZLM(:,:)= ( 0.5 * (ZLM(:,:)**(-4/5) + ZLWORK(:)**(-4/5)) )**(-5/4)
  ! Note that this differs from the original BL89 formulation.
  DO JLON=KIDIA,KFDIA
     zlwork1_=MAX(ZLM(JLON,JLEV),1.E-10_JPRB)
     zlwork2_=MAX(ZLWORK(JLON)  ,1.E-10_JPRB)
     zpote_  = zlwork1_ / zlwork2_
     zlwork2_=(1._JPRB + (zpote_)**(0.8_JPRB))
     ZLM(JLON,JLEV) = ZPOWERED2 * zlwork1_/ &
      &               (zlwork2_*SQRT(SQRT(zlwork2_)))
  ENDDO

  ! 1.6. end of the loop on the vertical levels
ENDDO

ENDIF ! KMLTYPE = 1,2

!---------------------------------------------------------------------
! 2. Computation of the sqrt(e)/N type mixing length

IF (KMLTYPE > 2) THEN

DO JLEV = KTDIA,KLEV
  DO JLON=KIDIA,KFDIA
    ZLM(JLON,JLEV)=MAX(SQRT( 2._JPRB * TKEMULT * PTKE(KLON,JLEV) *  &
      & (PAPHIF(JLON,JLEV-1)-PAPHIF(JLON,JLEV)) / &
      & (RG*ZG_O_THVREF(JLON,JLEV)* &
      & (ZHLVPT(JLON,JLEV-1)-ZHLVPT(JLON,JLEV)) ) ),1.E-10_JPRB)
  ENDDO
ENDDO

ENDIF

!---------------------------------------------------------------------
! 3. Conversion of full level TKE-type mixing length to half-level
!    mixing length of Prandtl type.

IF ((KMLTYPE == 2).or.(KMLTYPE == 4)) THEN
  DO JLEV=KTDIA,KLEV-1
    DO JLON=KIDIA,KFDIA
      ZC3=PLMT(JLON,JLEV)/PLMU(JLON,JLEV)
      ZLMU(JLON,JLEV)=(ZLM(JLON,JLEV)+ZLM(JLON,JLEV+1))*ZKONV
      ZLMU(JLON,JLEV)=(ZLMU(JLON,JLEV)*PLMU(JLON,JLEV))/ &
        &             (ZLMU(JLON,JLEV)+PLMU(JLON,JLEV))
      ZLMT(JLON,JLEV)=ZC3*ZLMU(JLON,JLEV)
    ENDDO
  ENDDO
ELSE
  DO JLEV=KTDIA,KLEV-1
    DO JLON=KIDIA,KFDIA
      ZC3=PLMT(JLON,JLEV)/PLMU(JLON,JLEV)
      ZLMU(JLON,JLEV)=(ZLM(JLON,JLEV)+ZLM(JLON,JLEV+1))*ZKONV
      ZLMT(JLON,JLEV)=ZC3*ZLMU(JLON,JLEV)
    ENDDO
  ENDDO
ENDIF
ZLMU(KIDIA:KFDIA,KLEV)= PGZ0(KIDIA:KFDIA)*VKARMN/RG
ZLMT(KIDIA:KFDIA,KLEV)= ZLMU(KIDIA:KFDIA,KLEV)
!uppermost level is probably not needed but anyway...
ZLMU(KIDIA:KFDIA,KTDIA-1)=ZLMU(KIDIA:KFDIA,KTDIA)
ZLMT(KIDIA:KFDIA,KTDIA-1)=ZLMT(KIDIA:KFDIA,KTDIA)

! Finaly overwrite the original mixing length by the new one.
PLMU(KIDIA:KFDIA,KTDIA-1:KLEV)=ZLMU(KIDIA:KFDIA,KTDIA-1:KLEV)
PLMT(KIDIA:KFDIA,KTDIA-1:KLEV)=ZLMT(KIDIA:KFDIA,KTDIA-1:KLEV)


! ----------------------------------------------------------------------
IF (LHOOK) CALL DR_HOOK('ACMIXELEN',1,ZHOOK_HANDLE)

END SUBROUTINE ACMIXELEN
