MODULE FLAKEENE_MOD
CONTAINS
SUBROUTINE FLAKEENE                                                      &
  &  (KIDIA           , KFDIA             , KLON                  ,      &
  &   PDEPTH_W        , PAR_CORIOLIS      , LDLAKEPOINT           ,      &
  &   PEXTINCOEF_WATER_TYP                ,                              &
  &   PDEL_TIME       , PT_SFC_P          , PT_ICE_P_FLK          ,      &
  &   PT_WML_P_FLK    , PT_MNW_P_FLK      , PT_BOT_P_FLK          ,      &
  &   PH_ICE_P_FLK    , PH_ML_P_FLK       , PC_T_P_FLK            ,      &
  &   PQ_W_FLK        , PQ_ICE_FLK        , PU_STAR_W_FLK         ,      &
  &   PI_ICE_FLK      , PI_BOT_FLK        , PI_W_FLK              ,      &
  &   PI_H_FLK        , PI_INTM_0_H_FLK   , PI_INTM_H_D_FLK       ,      &
  &   PT_ICE_N_FLK    , PT_WML_N_FLK      , PT_MNW_N_FLK          ,      &
  &   PT_BOT_N_FLK    , PH_ICE_N_FLK      , PH_ML_N_FLK           ,      &
  &   PC_T_N_FLK      , PT_SFC_N                                         )         

!------------------------------------------------------------------------------
!
! Description:
!
!  The main driving routine of the lake model FLake 
!  where computations are performed.
!  Advances the surface temperature
!  and other FLake variables one time step.
!  At the moment, the Euler explicit scheme is used.
!
!  Lines embraced/marked with "!_dev" may be replaced
!  as improved parameterizations are developed and tested.
!  Lines embraced/marked with "!_dm" are DM's comments
!  that may be helpful to a user.
!  Lines embraced/marked with "!_dbg" are used 
!  for debugging purposes only.
!
!
! Current Code Owner: DWD, Dmitrii Mironov
!  Phone:  +49-69-8062 2705
!  Fax:    +49-69-8062 3721
!  E-mail: dmitrii.mironov@dwd.de
!
! History:
! Version    Date       Name
! ---------- ---------- ----
! 1.00       2005/11/17 Dmitrii Mironov 
!  Initial release
! 1.01T      10.03.2008     V. M. Stepanenko
!  The code and variables, relevant to snow and bottom sediments are omitted
!
! Code Description:
! Language: Fortran 90.
! Software Standards: "European Standards for Writing and
! Documenting Exchangeable Fortran 90 Code".
!==============================================================================
!
! Declarations:
!
! Modules used:

USE PARKIND1  ,ONLY: JPIM, JPRB

USE YOS_FLAKE, ONLY: & ! Thermodynamic parameters and dimensionless constants of FLake
 & RH_ICE_MIN_FLK,    &
 & RH_ML_MIN_FLK,     &
 & RTPL_KAPPA_W,      &
 & RPHI_T_PR0_1,      &
 & RPHI_T_PR0_2,      &
 & RTPL_T_F,          &
 & RC_SMALL_FLK,      &
 & RTPL_RHO_I,        &
 & RTPL_L_F,          &
 & RTPL_KAPPA_I,      &
 & RPHI_I_PR0_LIN,    &
 & RPHI_I_PR1_LIN,    &
 & RPHI_I_AST_MR,     &
 & RH_ICE_MAX,        &
 & RC_I_LIN,          &
 & RC_I_MR,           &
 & RTPL_C_I,          &
 & RTPL_RHO_W_R,      &
 & RTPL_C_W,          &
 & RC_T_MIN,          &
 & RC_T_MAX,          &
 & RU_STAR_MIN_FLK,   &
 & RC_RELAX_C,        &
 & RC_TT_1,           &
 & RC_TT_2,           &
 & RC_CBL_1,          &
 & RC_CBL_2,          &
 & RC_SBL_ZM_N,       &
 & RC_SBL_ZM_I,       &
 & RC_SBL_ZM_S,       &
 & RH_ML_MAX_FLK,     &
 & RC_RELAX_H,        &
 & RTPL_GRAV,         &
 & RTPL_A_T,          &
 & RTPL_T_R
   
             

!==============================================================================

IMPLICIT NONE

!==============================================================================
!
! Declarations

!  Input (procedure arguments)

INTEGER (KIND = JPIM), INTENT(IN):: KIDIA  
INTEGER (KIND = JPIM), INTENT(IN):: KFDIA  
INTEGER (KIND = JPIM), INTENT(IN):: KLON   

LOGICAL, INTENT(IN):: LDLAKEPOINT (:)                     ! Indicates, if it is lake point (.TRUE.) 
  
REAL (KIND = JPRB), INTENT(IN):: PDEPTH_W             (:) ! The lake depth [m]
REAL (KIND = JPRB), INTENT(IN):: PAR_CORIOLIS         (:) ! The Coriolis parameter [s^{-1}]
REAL (KIND = JPRB), INTENT(IN):: PT_SFC_P             (:) ! Surface temperature at the previous time step [K]  
                                                          ! (equal to either T_ice, T_snow or to T_wML)

REAL (KIND = JPRB), INTENT(IN):: PEXTINCOEF_WATER_TYP     ! "Typical" extinction coeff.of the lake water [m^{-1}]
                                                          ! used to compute the equilibrium CBL depth
REAL (KIND = JPRB), INTENT(IN):: PDEL_TIME                ! The model time step [s]


REAL (KIND = JPRB), INTENT(IN):: PT_ICE_P_FLK    (:) 
REAL (KIND = JPRB), INTENT(IN):: PT_WML_P_FLK    (:)
REAL (KIND = JPRB), INTENT(IN):: PT_MNW_P_FLK    (:)
REAL (KIND = JPRB), INTENT(IN):: PT_BOT_P_FLK    (:)
REAL (KIND = JPRB), INTENT(IN):: PH_ICE_P_FLK    (:)
REAL (KIND = JPRB), INTENT(IN):: PH_ML_P_FLK     (:)
REAL (KIND = JPRB), INTENT(IN):: PC_T_P_FLK      (:)
REAL (KIND = JPRB), INTENT(IN):: PQ_ICE_FLK      (:)
REAL (KIND = JPRB), INTENT(IN):: PU_STAR_W_FLK   (:)
REAL (KIND = JPRB), INTENT(IN):: PI_ICE_FLK      (:)
REAL (KIND = JPRB), INTENT(IN):: PI_BOT_FLK      (:)
REAL (KIND = JPRB), INTENT(IN):: PI_W_FLK        (:)
REAL (KIND = JPRB), INTENT(IN):: PI_H_FLK        (:)
REAL (KIND = JPRB), INTENT(IN):: PI_INTM_0_H_FLK (:)
REAL (KIND = JPRB), INTENT(IN):: PI_INTM_H_D_FLK (:)


REAL (KIND = JPRB), INTENT(INOUT):: PQ_W_FLK (:)

!  Output (procedure arguments)
REAL (KIND = JPRB), INTENT(OUT):: PT_SFC_N  (:)         ! Updated surface temperature [K] 
                                                        ! (equal to the updated value of either T_ice, T_snow or T_wML)

REAL (KIND = JPRB), INTENT(OUT) :: PT_ICE_N_FLK (:)
REAL (KIND = JPRB), INTENT(OUT) :: PT_WML_N_FLK (:)
REAL (KIND = JPRB), INTENT(OUT) :: PT_MNW_N_FLK (:)
REAL (KIND = JPRB), INTENT(OUT) :: PT_BOT_N_FLK (:)
REAL (KIND = JPRB), INTENT(OUT) :: PH_ICE_N_FLK (:)
REAL (KIND = JPRB), INTENT(OUT) :: PH_ML_N_FLK  (:)
REAL (KIND = JPRB), INTENT(OUT) :: PC_T_N_FLK   (:)


!  Local variables of type LOGICAL
LOGICAL:: LL_ICE_CREATE     ! Switch, .TRUE. = ice does not exist but should be created
LOGICAL:: LL_ICE_MELTABOVE  ! Switch, .TRUE. = snow/ice melting from above takes place

!  Local variables of type INTEGER
INTEGER (KIND = JPIM):: I, JL  ! Loop indexes

!  Local variables of type REAL
REAL (KIND = JPRB):: ZD_T_MNW_DT      ! Time derivative of T_mnw [K s^{-1}] 
REAL (KIND = JPRB):: ZD_T_ICE_DT      ! Time derivative of T_ice [K s^{-1}] 
REAL (KIND = JPRB):: ZD_T_BOT_DT      ! Time derivative of T_bot [K s^{-1}] 
REAL (KIND = JPRB):: ZD_H_ICE_DT      ! Time derivative of h_ice [m s^{-1}]
REAL (KIND = JPRB):: ZD_H_ML_DT       ! Time derivative of h_ML [m s^{-1}]
REAL (KIND = JPRB):: ZD_C_T_DT        ! Time derivative of C_T [s^{-1}]

!  Local variables of type REAL
REAL (KIND = JPRB):: ZN_T_MEAN            ! The mean buoyancy frequency in the thermocline [s^{-1}] 
REAL (KIND = JPRB):: ZM_H_SCALE           ! The ZM96 equilibrium SBL depth scale [m] 
REAL (KIND = JPRB):: ZCONV_EQUIL_H_SCALE  ! The equilibrium CBL depth scale [m]

!  Local variables of type REAL

REAL (KIND = JPRB):: ZH_ICE_THRESHOLD  ! If h_ice<ZH_ICE_THRESHOLD, use quasi-equilibrium ice model 
REAL (KIND = JPRB):: ZFLK_STR_1        ! Help storage variable
REAL (KIND = JPRB):: ZFLK_STR_2        ! Help storage variable
REAL (KIND = JPRB):: ZR_H_ICESNOW      ! Dimensionless ratio, used to store intermediate results
REAL (KIND = JPRB):: ZR_RHO_C_ICESNOW  ! Dimensionless ratio, used to store intermediate results
REAL (KIND = JPRB):: ZR_TI_ICESNOW     ! Dimensionless ratio, used to store intermediate results
REAL (KIND = JPRB):: ZR_TSTAR_ICESNOW  ! Dimensionless ratio, used to store intermediate results

!  The shape factor(s) at the previous time step ("p") and the updated value(s) ("n") 
REAL (KIND = JPRB):: ZC_TT_FLK       ! Dimensionless parameter (thermocline)
REAL (KIND = JPRB):: ZC_Q_FLK        ! Shape factor with respect to the heat flux (thermocline)
REAL (KIND = JPRB):: ZC_I_FLK        ! Shape factor (ice)

!  Derivatives of the shape functions
REAL (KIND = JPRB):: ZPHI_T_PR0_FLK  ! d\Phi_T(0)/d\zeta   (thermocline)
REAL (KIND = JPRB):: ZPHI_I_PR0_FLK  ! d\Phi_I(0)/d\zeta_I (ice)
REAL (KIND = JPRB):: ZPHI_I_PR1_FLK  ! d\Phi_I(1)/d\zeta_I (ice)

!  Heat and radiation fluxes
REAL (KIND = JPRB):: ZQ_BOT_FLK      ! Heat flux through the water-bottom sediment interface [W m^{-2}]
REAL (KIND = JPRB):: ZQ_STAR_FLK     ! A generalized heat flux scale [W m^{-2}]

!  Velocity scales
REAL (KIND = JPRB):: ZW_STAR_SFC_FLK ! Convective velocity scale, 
                                     ! using a generalized heat flux scale [m s^{-1}]

REAL (KIND = JPRB):: ZFLAKE_BUOYPAR  ! Buoyancy parameter
REAL (KIND = JPRB):: ZT_WATER        ! Temperature of water

! Declaration of FLAKE_BOUYPAR function (calculates bouyancy parameter)
ZFLAKE_BUOYPAR(ZT_WATER) = RTPL_GRAV*RTPL_A_T*(ZT_WATER-RTPL_T_R)

!==============================================================================
!  Start calculations
!------------------------------------------------------------------------------

!_dm 
! Security. Set time-rate-of-change of prognostic variables to zero.
! Set prognostic variables to their values at the previous time step.
! (This is to avoid spurious changes of prognostic variables 
! when FLake is used within a 3D model, e.g. to avoid spurious generation of ice 
! at the neighbouring lake points as noticed by Burkhardt Rockel.)
!_dm 

PT_ICE_N_FLK  = PT_ICE_P_FLK    
PT_WML_N_FLK  = PT_WML_P_FLK   
PT_MNW_N_FLK  = PT_MNW_P_FLK     
PT_BOT_N_FLK  = PT_BOT_P_FLK  
PH_ICE_N_FLK  = PH_ICE_P_FLK   
PH_ML_N_FLK   = PH_ML_P_FLK    
PC_T_N_FLK    = PC_T_P_FLK    

MAIN_LOOP: DO JL = KIDIA, KFDIA

LAKEPOINT: IF (LDLAKEPOINT(JL)) THEN ! Prognostic variables are updated only
                                     ! for points, that are indicated as lakes

ZD_T_MNW_DT   = 0._JPRB 
ZD_T_ICE_DT   = 0._JPRB 
ZD_T_BOT_DT   = 0._JPRB 
ZD_H_ICE_DT   = 0._JPRB 
ZD_H_ML_DT    = 0._JPRB 
ZD_C_T_DT     = 0._JPRB 

!------------------------------------------------------------------------------
!  Compute fluxes, using variables from the previous time step.
!------------------------------------------------------------------------------

!_dm
! At this point, the heat and radiation fluxes, namely,
! PQ_ICE_FLK, PQ_W_FLK,PI_ICE_FLK, PI_W_FLK, PI_H_FLK, PI_BOT_FLK,     
! the mean radiation flux over the mixed layer, PI_INTM_0_H_FLK, 
! and the mean radiation flux over the thermocline, PI_INTM_H_D_FLK, 
! should be known.
! They are computed within routine FLAKE_RADFLUX, called by FLAKE_DRIVER.
! In case a lake is ice-covered, PQ_W_FLK is re-computed below.
!_dm

! Heat flux through the ice-water interface
IF(PH_ICE_P_FLK(JL).GE.RH_ICE_MIN_FLK) THEN    ! Ice exists 
  IF(PH_ML_P_FLK(JL).LE.RH_ML_MIN_FLK) THEN    ! Mixed-layer depth is zero, compute flux 
    PQ_W_FLK(JL) = -RTPL_KAPPA_W*(PT_BOT_P_FLK(JL)-PT_WML_P_FLK(JL))/ &
   & PDEPTH_W(JL)                             ! Flux with linear T(z) 
    ZPHI_T_PR0_FLK = RPHI_T_PR0_1*PC_T_P_FLK(JL)-RPHI_T_PR0_2         ! d\Phi(0)/d\zeta (thermocline)
    PQ_W_FLK(JL)   = PQ_W_FLK(JL)*MAX(ZPHI_T_PR0_FLK, 1._JPRB)      ! Account for an increased d\Phi(0)/d\zeta 
  ELSE                    
    PQ_W_FLK(JL)   = 0._JPRB                  ! Mixed-layer depth is greater than zero, set flux to zero
  END IF   
END IF   

! A generalized heat flux scale 
ZQ_STAR_FLK = PQ_W_FLK(JL) + PI_W_FLK(JL) + PI_H_FLK(JL) - 2._JPRB*PI_INTM_0_H_FLK(JL)

! Heat flux through the water-bottom sediment interface
ZQ_BOT_FLK = 0._JPRB   ! The bottom-sediment scheme is not used



!------------------------------------------------------------------------------
!  Check if ice exists or should be created.
!  If so, compute the thickness and the temperature of ice.
!------------------------------------------------------------------------------

!_dm
! Notice that a quasi-equilibrium ice model is used 
! to avoid numerical instability when the ice is thin.
! This is always the case when new ice is created.
!_dm


! Default values
LL_ICE_CREATE    = .FALSE.  
LL_ICE_MELTABOVE = .FALSE.  

ICE_EXIST: IF(PH_ICE_P_FLK(JL).LT.RH_ICE_MIN_FLK) THEN   ! Ice does not exist 

  LL_ICE_CREATE = PT_WML_P_FLK(JL).LE.(RTPL_T_F+RC_SMALL_FLK).AND. &
 & PQ_W_FLK(JL).LT.0._JPRB
  IF(LL_ICE_CREATE) THEN                            ! Ice does not exist but should be created
    ZD_H_ICE_DT = -PQ_W_FLK(JL)/RTPL_RHO_I/RTPL_L_F
    PH_ICE_N_FLK(JL) = PH_ICE_P_FLK(JL) + ZD_H_ICE_DT*PDEL_TIME   ! Advance h_ice 
    PT_ICE_N_FLK(JL) = RTPL_T_F + PH_ICE_N_FLK(JL)*PQ_W_FLK(JL)/ &
   & RTPL_KAPPA_I/RPHI_I_PR0_LIN                                    ! Ice temperature
    ZPHI_I_PR1_FLK = RPHI_I_PR1_LIN                              & 
                   + RPHI_I_AST_MR*MIN(1._JPRB, PH_ICE_N_FLK(JL)/RH_ICE_MAX) ! d\Phi_I(1)/d\zeta_I (ice)
  END IF

ELSE ICE_EXIST                                     ! Ice exists

  MELTING: IF(PT_ICE_P_FLK(JL).GE.(RTPL_T_F-RC_SMALL_FLK)) THEN    ! T_sfc = T_f, check for melting from above
      ZFLK_STR_1 = PQ_ICE_FLK(JL) + PI_ICE_FLK(JL) - PI_W_FLK(JL) - PQ_W_FLK(JL)  ! Atmospheric forcing + heating from the water
    IF(ZFLK_STR_1.GE.0._JPRB) THEN  ! Melting of ice from above, snow accumulation may occur
      LL_ICE_MELTABOVE = .TRUE.
      ZD_H_ICE_DT  = -ZFLK_STR_1/RTPL_L_F/RTPL_RHO_I 
    END IF 
    IF(LL_ICE_MELTABOVE) THEN  ! Melting from above takes place
      PH_ICE_N_FLK(JL)  = PH_ICE_P_FLK(JL)  + ZD_H_ICE_DT *PDEL_TIME  ! Advance h_ice
      PT_ICE_N_FLK(JL)  = RTPL_T_F                                     ! Set T_ice to the freezing point
    END IF

  END IF MELTING

  NO_MELTING: IF(.NOT.LL_ICE_MELTABOVE) THEN                 ! No melting from above
    
    ZPHI_I_PR0_FLK = PH_ICE_P_FLK(JL)/RH_ICE_MAX                          ! h_ice relative to its maximum value
    ZC_I_FLK = RC_I_LIN - RC_I_MR*(1._JPRB+RPHI_I_AST_MR)*ZPHI_I_PR0_FLK    ! Shape factor (ice)
    ZPHI_I_PR1_FLK = RPHI_I_PR1_LIN + RPHI_I_AST_MR*ZPHI_I_PR0_FLK         ! d\Phi_I(1)/d\zeta_I (ice)
    ZPHI_I_PR0_FLK = RPHI_I_PR0_LIN - ZPHI_I_PR0_FLK                      ! d\Phi_I(0)/d\zeta_I (ice)

    ZH_ICE_THRESHOLD = MAX(1._JPRB, 2._JPRB*ZC_I_FLK*RTPL_C_I*(RTPL_T_F-PT_ICE_P_FLK(JL))/ &
   & RTPL_L_F)
    ZH_ICE_THRESHOLD = ZPHI_I_PR0_FLK/ZC_I_FLK*RTPL_KAPPA_I/RTPL_RHO_I/RTPL_C_I* &
   & ZH_ICE_THRESHOLD
    ZH_ICE_THRESHOLD = SQRT(ZH_ICE_THRESHOLD*PDEL_TIME)                   ! Threshold value of h_ice
    ZH_ICE_THRESHOLD = MIN(0.9_JPRB*RH_ICE_MAX, MAX(ZH_ICE_THRESHOLD, RH_ICE_MIN_FLK))
                                                                          ! h_ice(threshold) < 0.9*RH_Ice_max

    IF(PH_ICE_P_FLK(JL).LT.ZH_ICE_THRESHOLD) THEN  ! Use a quasi-equilibrium ice model

      ZFLK_STR_1 = PQ_ICE_FLK(JL) + PI_ICE_FLK(JL) - PI_W_FLK(JL)
      ZD_H_ICE_DT = -(ZFLK_STR_1-PQ_W_FLK(JL))/RTPL_L_F/RTPL_RHO_I
      PH_ICE_N_FLK(JL) = PH_ICE_P_FLK(JL) + ZD_H_ICE_DT *PDEL_TIME       ! Advance h_ice
      PT_ICE_N_FLK(JL) = RTPL_T_F + PH_ICE_N_FLK(JL)*ZFLK_STR_1/RTPL_KAPPA_I/ &
	 & ZPHI_I_PR0_FLK  ! Ice temperature

    ELSE                                     ! Use a complete ice model

      ZD_H_ICE_DT  = RTPL_KAPPA_I*(RTPL_T_F-PT_ICE_P_FLK(JL))/PH_ICE_P_FLK(JL)* &
	 & ZPHI_I_PR0_FLK
      ZD_H_ICE_DT  = (PQ_W_FLK(JL)+ZD_H_ICE_DT)/RTPL_L_F/RTPL_RHO_I
      PH_ICE_N_FLK(JL) = PH_ICE_P_FLK(JL)  + ZD_H_ICE_DT*PDEL_TIME  ! Advance h_ice

      ZR_TI_ICESNOW = RTPL_C_I*(RTPL_T_F-PT_ICE_P_FLK(JL))/RTPL_L_F   ! Dimensionless parameter
      ZR_TSTAR_ICESNOW = 1._JPRB - ZC_I_FLK                        ! Dimensionless parameter
      ZR_TSTAR_ICESNOW = ZR_TSTAR_ICESNOW*ZR_TI_ICESNOW            ! Dimensionless parameter

      ZFLK_STR_2 = PQ_ICE_FLK(JL)+PI_ICE_FLK(JL)-PI_W_FLK(JL)      ! Atmospheric fluxes
      ZFLK_STR_1  = ZC_I_FLK*PH_ICE_P_FLK(JL)
      ZD_T_ICE_DT = 0._JPRB
      ZD_T_ICE_DT = ZD_T_ICE_DT + RTPL_KAPPA_I*(RTPL_T_F-PT_ICE_P_FLK(JL))/ &
	 & PH_ICE_P_FLK(JL)*ZPHI_I_PR0_FLK * (1._JPRB-ZR_TSTAR_ICESNOW)  ! Add flux due to heat conduction
      ZD_T_ICE_DT = ZD_T_ICE_DT - ZR_TSTAR_ICESNOW*PQ_W_FLK(JL)      ! Add flux from water to ice
      ZD_T_ICE_DT = ZD_T_ICE_DT + ZFLK_STR_2                         ! Add atmospheric fluxes
      ZD_T_ICE_DT = ZD_T_ICE_DT/RTPL_RHO_I/RTPL_C_I                    ! Total forcing
      ZD_T_ICE_DT = ZD_T_ICE_DT/ZFLK_STR_1                           ! dT_ice/dt 
      PT_ICE_N_FLK(JL) = PT_ICE_P_FLK(JL) + ZD_T_ICE_DT*PDEL_TIME    ! Advance T_ice
    END IF

    ZPHI_I_PR1_FLK = MIN(1._JPRB, PH_ICE_N_FLK(JL)/RH_ICE_MAX)        ! h_ice relative to its maximum value
    ZPHI_I_PR1_FLK = RPHI_I_PR1_LIN + RPHI_I_AST_MR*ZPHI_I_PR1_FLK     ! d\Phi_I(1)/d\zeta_I (ice)

  END IF NO_MELTING

END IF ICE_EXIST   

! Security, limit h_ice by its maximum value
PH_ICE_N_FLK(JL) = MIN(PH_ICE_N_FLK(JL), RH_ICE_MAX)      

! Security, limit the ice and snow temperatures by the freezing point 
PT_ICE_N_FLK(JL) = MIN(PT_ICE_N_FLK(JL),  RTPL_T_F)    

! Security, avoid too low values (these constraints are used for debugging purposes)
PT_ICE_N_FLK(JL) = MAX(PT_ICE_N_FLK(JL),  73.15_JPRB)    

! Remove too thin ice and/or snow
IF(PH_ICE_N_FLK(JL).LT.RH_ICE_MIN_FLK)  THEN        ! Check ice
  PH_ICE_N_FLK(JL) = 0._JPRB       ! Ice is too thin, remove it, and
  PT_ICE_N_FLK(JL) = RTPL_T_F       ! set T_ice to the freezing point.
  LL_ICE_CREATE    = .FALSE.       ! "Exotic" case, ice has been created but proved to be too thin
END IF


!------------------------------------------------------------------------------
!  Compute the mean temperature of the water column.
!------------------------------------------------------------------------------

IF(LL_ICE_CREATE) PQ_W_FLK(JL) = 0._JPRB     ! Ice has just been created, set Q_w to zero
ZD_T_MNW_DT = (PQ_W_FLK(JL) - ZQ_BOT_FLK + PI_W_FLK(JL) - PI_BOT_FLK(JL))/ &
& RTPL_RHO_W_R/RTPL_C_W/PDEPTH_W(JL)
PT_MNW_N_FLK(JL) = PT_MNW_P_FLK(JL) + ZD_T_MNW_DT*PDEL_TIME   ! Advance T_mnw
PT_MNW_N_FLK(JL) = MAX(PT_MNW_N_FLK(JL), RTPL_T_F)             ! Limit T_mnw by the freezing point 


!------------------------------------------------------------------------------
!  Compute the mixed-layer depth, the mixed-layer temperature, 
!  the bottom temperature and the shape factor
!  with respect to the temperature profile in the thermocline. 
!  Different formulations are used, depending on the regime of mixing. 
!------------------------------------------------------------------------------

HTC_WATER: IF(PH_ICE_N_FLK(JL).GE.RH_ICE_MIN_FLK) THEN    ! Ice exists

  PT_MNW_N_FLK(JL) = MIN(PT_MNW_N_FLK(JL), RTPL_T_R) ! Limit the mean temperature under the ice by T_r 
  PT_WML_N_FLK(JL) = RTPL_T_F                        ! The mixed-layer temperature is equal to the freezing point 

  IF(LL_ICE_CREATE) THEN                       ! Ice has just been created 
    IF(PH_ML_P_FLK(JL).GE.PDEPTH_W(JL)-RH_ML_MIN_FLK) THEN    ! h_ML=D when ice is created 
      PH_ML_N_FLK(JL) = 0._JPRB                ! Set h_ML to zero 
      PC_T_N_FLK(JL)  = RC_T_MIN               ! Set C_T to its minimum value 
    ELSE                                       ! h_ML<D when ice is created 
      PH_ML_N_FLK(JL) = PH_ML_P_FLK(JL)        ! h_ML remains unchanged 
      PC_T_N_FLK(JL)  = PC_T_P_FLK(JL)         ! C_T (thermocline) remains unchanged 
    END IF 
    PT_BOT_N_FLK(JL) = PT_WML_N_FLK(JL) - &
   & (PT_WML_N_FLK(JL)-PT_MNW_N_FLK(JL))/PC_T_N_FLK(JL)/ &
   & (1._JPRB-PH_ML_N_FLK(JL)/PDEPTH_W(JL))    ! Update the bottom temperature 

  ELSE IF(PT_BOT_P_FLK(JL).LT.RTPL_T_R) THEN   ! Ice exists and T_bot < T_r, molecular heat transfer 
    PH_ML_N_FLK(JL) = PH_ML_P_FLK(JL)          ! h_ML remains unchanged 
    PC_T_N_FLK(JL) = PC_T_P_FLK(JL)            ! C_T (thermocline) remains unchanged 
    PT_BOT_N_FLK(JL) = PT_WML_N_FLK(JL) - &
   & (PT_WML_N_FLK(JL)-PT_MNW_N_FLK(JL))/PC_T_N_FLK(JL)/ &
   & (1._JPRB-PH_ML_N_FLK(JL)/PDEPTH_W(JL))    ! Update the bottom temperature 

  ELSE                                         ! Ice exists and T_bot = T_r, convection due to bottom heating 
    PT_BOT_N_FLK(JL) = RTPL_T_R                ! T_bot is equal to the temperature of maximum density 
    IF(PH_ML_P_FLK(JL).GE.RC_SMALL_FLK) THEN   ! h_ML > 0 
      PC_T_N_FLK(JL) = PC_T_P_FLK(JL)          ! C_T (thermocline) remains unchanged 
      PH_ML_N_FLK(JL) = PDEPTH_W(JL)*(1._JPRB-(PT_WML_N_FLK(JL)-PT_MNW_N_FLK(JL))/ &
	 & (PT_WML_N_FLK(JL)-PT_BOT_N_FLK(JL))/PC_T_N_FLK(JL))
      PH_ML_N_FLK(JL) = MAX(PH_ML_N_FLK(JL), 0._JPRB) ! Update the mixed-layer depth  
    ELSE                                       ! h_ML = 0 
      PH_ML_N_FLK(JL) = PH_ML_P_FLK(JL)        ! h_ML remains unchanged 
      PC_T_N_FLK(JL)  = (PT_WML_N_FLK(JL)-PT_MNW_N_FLK(JL))/ &
	 & (PT_WML_N_FLK(JL)-PT_BOT_N_FLK(JL)) 
      PC_T_N_FLK(JL)  = MIN(RC_T_MAX, MAX(PC_T_N_FLK(JL), RC_T_MIN)) ! Update the shape factor (thermocline)  
    END IF 
  END IF 

  PT_BOT_N_FLK(JL) = MIN(PT_BOT_N_FLK(JL), RTPL_T_R) ! Security, limit the bottom temperature by T_r 

ELSE HTC_WATER                                      ! Open water

! Generalised buoyancy flux scale and convective velocity scale
  ZFLK_STR_1 = ZFLAKE_BUOYPAR(PT_WML_P_FLK(JL))*ZQ_STAR_FLK/RTPL_RHO_W_R/RTPL_C_W
  IF(ZFLK_STR_1.LT.0._JPRB) THEN       
    ZW_STAR_SFC_FLK = (-ZFLK_STR_1*PH_ML_P_FLK(JL))**(1._JPRB/3._JPRB)  ! Convection     
  ELSE 
    ZW_STAR_SFC_FLK = 0._JPRB                                           ! Neutral or stable stratification
  END IF 

!_dm
! The equilibrium depth of the CBL due to surface cooling with the volumetric heating
! is not computed as a solution to the transcendental equation.
! Instead, an algebraic formula is used
! that interpolates between the two asymptotic limits.
!_dm

  ZCONV_EQUIL_H_SCALE = -PQ_W_FLK(JL)/MAX(PI_W_FLK(JL), RC_SMALL_FLK)
  IF(ZCONV_EQUIL_H_SCALE.GT.0._JPRB .AND. ZCONV_EQUIL_H_SCALE.LT.1._JPRB  &
    .AND. PT_WML_P_FLK(JL).GT.RTPL_T_R) THEN       ! The equilibrium CBL depth scale is only used above T_r
    ZCONV_EQUIL_H_SCALE = SQRT(6._JPRB*ZCONV_EQUIL_H_SCALE)                 &
                       + 2._JPRB*ZCONV_EQUIL_H_SCALE/(1._JPRB-ZCONV_EQUIL_H_SCALE)
    ZCONV_EQUIL_H_SCALE = MIN(PDEPTH_W(JL), ZCONV_EQUIL_H_SCALE/PEXTINCOEF_WATER_TYP)
  ELSE
    ZCONV_EQUIL_H_SCALE = 0._JPRB       ! Set the equilibrium CBL depth to zero
  END IF

! Mean buoyancy frequency in the thermocline
  ZN_T_MEAN = ZFLAKE_BUOYPAR(0.5_JPRB*(PT_WML_P_FLK(JL)+PT_BOT_P_FLK(JL)))* &
 & (PT_WML_P_FLK(JL)-PT_BOT_P_FLK(JL))
  IF(PH_ML_P_FLK(JL).LE.PDEPTH_W(JL)-RH_ML_MIN_FLK) THEN
    ZN_T_MEAN = SQRT(ZN_T_MEAN/(PDEPTH_W(JL)-PH_ML_P_FLK(JL)))  ! Compute N
  ELSE 
    ZN_T_MEAN = 0._JPRB                            ! h_ML=D, set N to zero
  END IF 

! The rate of change of C_T
  ZD_C_T_DT = MAX(ZW_STAR_SFC_FLK, PU_STAR_W_FLK(JL), RU_STAR_MIN_FLK)**2_JPIM
  ZD_C_T_DT = ZN_T_MEAN*(PDEPTH_W(JL)-PH_ML_P_FLK(JL))**2_JPIM       &
           /RC_RELAX_C/ZD_C_T_DT                                 ! Relaxation time scale for C_T
  ZD_C_T_DT = (RC_T_MAX-RC_T_MIN)/MAX(ZD_C_T_DT, RC_SMALL_FLK)     ! Rate-of-change of C_T 

! Compute the shape factor and the mixed-layer depth, 
! using different formulations for convection and wind mixing

  ZC_TT_FLK = RC_TT_1*PC_T_P_FLK(JL)-RC_TT_2       ! C_TT, using C_T at the previous time step
  ZC_Q_FLK = 2._JPRB*ZC_TT_FLK/PC_T_P_FLK(JL)      ! C_Q using C_T at the previous time step

  MIXING_REGIME: IF(ZFLK_STR_1.LT.0._JPRB) THEN    ! Convective mixing 

    PC_T_N_FLK(JL) = PC_T_P_FLK(JL) + ZD_C_T_DT*PDEL_TIME                ! Update C_T, assuming dh_ML/dt>0
    PC_T_N_FLK(JL) = MIN(RC_T_MAX, MAX(PC_T_N_FLK(JL), RC_T_MIN))        ! Limit C_T 
    ZD_C_T_DT = (PC_T_N_FLK(JL)-PC_T_P_FLK(JL))/PDEL_TIME                ! Re-compute dC_T/dt


    IF(PH_ML_P_FLK(JL).LE.PDEPTH_W(JL)-RH_ML_MIN_FLK) THEN       ! Compute dh_ML/dt
      IF(PH_ML_P_FLK(JL).LE.RH_ML_MIN_FLK) THEN                  ! Use a reduced entrainment equation (spin-up)
        ZD_H_ML_DT = RC_CBL_1/RC_CBL_2*MAX(ZW_STAR_SFC_FLK, RC_SMALL_FLK)
      ELSE                                   ! Use a complete entrainment equation 
        ZR_H_ICESNOW     = PDEPTH_W(JL)/PH_ML_P_FLK(JL)
        ZR_RHO_C_ICESNOW = ZR_H_ICESNOW-1._JPRB
        ZR_TI_ICESNOW    = PC_T_P_FLK(JL)/ZC_TT_FLK
        ZR_TSTAR_ICESNOW = (ZR_TI_ICESNOW/2._JPRB-1._JPRB)*ZR_RHO_C_ICESNOW + 1._JPRB
        ZD_H_ML_DT = -ZQ_STAR_FLK*(ZR_TSTAR_ICESNOW*(1._JPRB+RC_CBL_1)-1._JPRB) - ZQ_BOT_FLK
        ZD_H_ML_DT = ZD_H_ML_DT/RTPL_RHO_W_R/RTPL_C_W           ! Q_* and Q_b flux terms
        ZFLK_STR_2 = (PDEPTH_W(JL)-PH_ML_P_FLK(JL))*(PT_WML_P_FLK(JL)-PT_BOT_P_FLK(JL))* &
	   & RC_TT_2/ZC_TT_FLK*ZD_C_T_DT 
        ZD_H_ML_DT = ZD_H_ML_DT + ZFLK_STR_2                    ! Add dC_T/dt term
        ZFLK_STR_2 = PI_BOT_FLK(JL) + (ZR_TI_ICESNOW-1._JPRB)*PI_H_FLK(JL) - &
	   & ZR_TI_ICESNOW*PI_INTM_H_D_FLK(JL)
        ZFLK_STR_2 = ZFLK_STR_2 + (ZR_TI_ICESNOW-2._JPRB)*ZR_RHO_C_ICESNOW* &
	   & (PI_H_FLK(JL)-PI_INTM_0_H_FLK(JL))
        ZFLK_STR_2 = ZFLK_STR_2/RTPL_RHO_W_R/RTPL_C_W
        ZD_H_ML_DT = ZD_H_ML_DT + ZFLK_STR_2                    ! Add radiation terms
        ZFLK_STR_2 = -RC_CBL_2*ZR_TSTAR_ICESNOW*ZQ_STAR_FLK/RTPL_RHO_W_R/RTPL_C_W/ &
	   & MAX(ZW_STAR_SFC_FLK, RC_SMALL_FLK)
        ZFLK_STR_2 = ZFLK_STR_2 + PC_T_P_FLK(JL)*(PT_WML_P_FLK(JL)-PT_BOT_P_FLK(JL))
        ZD_H_ML_DT = ZD_H_ML_DT/ZFLK_STR_2                      ! dh_ML/dt = r.h.s.
      END IF 
!_dm
! Notice that dh_ML/dt may appear to be negative  
! (e.g. due to buoyancy loss to bottom sediments and/or
! the effect of volumetric radiation heating),
! although a negative generalized buoyancy flux scale indicates 
! that the equilibrium CBL depth has not yet been reached
! and convective deepening of the mixed layer should take place.
! Physically, this situation reflects an approximate character of the lake model.
! Using the self-similar temperature profile in the thermocline, 
! there is always communication between the mixed layer, the thermocline 
! and the lake bottom. As a result, the rate of change of the CBL depth
! is always dependent on the bottom heat flux and the radiation heating of the thermocline.
! In reality, convective mixed-layer deepening may be completely decoupled
! from the processes underneath. In order to account for this fact,
! the rate of CBL deepening is set to a small value
! if dh_ML/dt proves to be negative.
! This is "double insurance" however, 
! as a negative dh_ML/dt is encountered very rarely.
!_dm

      ZD_H_ML_DT = MAX(ZD_H_ML_DT, RC_SMALL_FLK)    
      PH_ML_N_FLK(JL) = PH_ML_P_FLK(JL) + ZD_H_ML_DT*PDEL_TIME     ! Update h_ML 
      PH_ML_N_FLK(JL) = MAX(RH_ML_MIN_FLK, MIN(PH_ML_N_FLK(JL), PDEPTH_W(JL)))  ! Security, limit h_ML
    ELSE                                              ! Mixing down to the lake bottom
      PH_ML_N_FLK(JL) = PDEPTH_W(JL)
    END IF

  ELSE MIXING_REGIME                                  ! Wind mixing

    ZD_H_ML_DT = MAX(PU_STAR_W_FLK(JL), RU_STAR_MIN_FLK)     ! The surface friction velocity
    ZM_H_SCALE = (ABS(PAR_CORIOLIS(JL))/RC_SBL_ZM_N + &
   & ZN_T_MEAN/RC_SBL_ZM_I)*ZD_H_ML_DT**2_JPIM
    ZM_H_SCALE = ZM_H_SCALE + ZFLK_STR_1/RC_SBL_ZM_S
    ZM_H_SCALE = MAX(ZM_H_SCALE, RC_SMALL_FLK)
    ZM_H_SCALE = ZD_H_ML_DT**3_JPIM/ZM_H_SCALE 
    ZM_H_SCALE = MAX(RH_ML_MIN_FLK, MIN(ZM_H_SCALE, RH_ML_MAX_FLK)) ! The ZM96 SBL depth scale 
    ZM_H_SCALE = MAX(ZM_H_SCALE, ZCONV_EQUIL_H_SCALE)               ! Equilibrium mixed-layer depth 

!_dm 
! In order to avoid numerical discretization problems,
! an analytical solution to the evolution equation 
! for the wind-mixed layer depth is used.
! That is, an exponential relaxation formula is applied
! over the time interval equal to the model time step.
!_dm 

    ZD_H_ML_DT = RC_RELAX_H*ZD_H_ML_DT/ZM_H_SCALE*PDEL_TIME
    PH_ML_N_FLK(JL) = ZM_h_scale - (ZM_h_scale-PH_ML_P_FLK(JL))* &
   & EXP(-ZD_H_ML_DT)    ! Update h_ML 
    PH_ML_N_FLK(JL) = MAX(RH_ML_MIN_FLK, MIN(PH_ML_N_FLK(JL), PDEPTH_W(JL)))  ! Limit h_ML 
    ZD_H_ML_DT = (PH_ML_N_FLK(JL)-PH_ML_P_FLK(JL))/PDEL_TIME                  ! Re-compute dh_ML/dt

    IF(PH_ML_N_FLK(JL).LE.PH_ML_P_FLK(JL))           &
      ZD_C_T_DT = -ZD_C_T_DT            ! Mixed-layer retreat or stationary state, dC_T/dt<0

    PC_T_N_FLK(JL) = PC_T_P_FLK(JL) + ZD_C_T_DT*PDEL_TIME          ! Update C_T
    PC_T_N_FLK(JL) = MIN(RC_T_MAX, MAX(PC_T_N_FLK(JL), RC_T_MIN))  ! Limit C_T 
    ZD_C_T_DT = (PC_T_N_FLK(JL)-PC_T_P_FLK(JL))/PDEL_TIME          ! Re-compute dC_T/dt

!_dbg
! WRITE*, 'FLake: wind mixing: ZD_H_ML_DT*PDEL_TIME = ', ZD_H_ML_DT*PDEL_TIME
! WRITE*, '              h_CBL_eqi = ', ZCONV_EQUIL_H_SCALE
! WRITE*, '              ZM scale  = ', ZM_h_scale
! WRITE*, '              w_*       = ', ZW_STAR_SFC_FLK
! WRITE*, '              u_*       = ', PU_STAR_W_FLK
! WRITE*, '             PH_ML_P_FLK = ', PH_ML_P_FLK
!_dbg

  END IF MIXING_REGIME

! Compute the time-rate-of-change of the the bottom temperature, 
! depending on the sign of dh_ML/dt 
! Update the bottom temperature and the mixed-layer temperature

  IF(PH_ML_N_FLK(JL).LE.PDEPTH_W(JL)-RH_ML_MIN_FLK) THEN  ! Mixing did not reach the bottom 

    IF(PH_ML_N_FLK(JL).GT.PH_ML_P_FLK(JL)) THEN   ! Mixed-layer deepening 
      ZR_H_ICESNOW     = PH_ML_P_FLK(JL)/PDEPTH_W(JL)
      ZR_RHO_C_ICESNOW = 1._JPRB-ZR_H_ICESNOW 
      ZR_TI_ICESNOW    = 0.5_JPRB*PC_T_P_FLK(JL)*ZR_RHO_C_ICESNOW+ZC_TT_FLK* &
	 & (2._JPRB*ZR_H_ICESNOW-1._JPRB)
      ZR_TSTAR_ICESNOW = (0.5_JPRB+ZC_TT_FLK-ZC_Q_FLK)/ZR_TI_ICESNOW
      ZR_TI_ICESNOW    = (1._JPRB-PC_T_P_FLK(JL)*ZR_RHO_C_ICESNOW)/ZR_TI_ICESNOW
     
      ZD_T_BOT_DT = (PQ_W_FLK(JL)-ZQ_BOT_FLK+PI_W_FLK(JL)-PI_BOT_FLK(JL))/ &
	 & RTPL_RHO_W_R/RTPL_C_W
      ZD_T_BOT_DT = ZD_T_BOT_DT - PC_T_P_FLK(JL)*(PT_WML_P_FLK(JL)-PT_BOT_P_FLK(JL))* &
	 & ZD_H_ML_DT
      ZD_T_BOT_DT = ZD_T_BOT_DT*ZR_TSTAR_ICESNOW/PDEPTH_W(JL) ! Q+I fluxes and dh_ML/dt term

      ZFLK_STR_2 = PI_INTM_H_D_FLK(JL) - (1._JPRB-ZC_Q_FLK)*PI_H_FLK(JL) - &
	 & ZC_Q_FLK*PI_BOT_FLK(JL)
      ZFLK_STR_2 = ZFLK_STR_2*ZR_TI_ICESNOW/(PDEPTH_W(JL)-PH_ML_P_FLK(JL))/ &
	 & RTPL_RHO_W_R/RTPL_C_W
      ZD_T_BOT_DT = ZD_T_BOT_DT + ZFLK_STR_2       ! Add radiation-flux term

      ZFLK_STR_2 = (1._JPRB-RC_TT_2*ZR_TI_ICESNOW)/PC_T_P_FLK(JL)
      ZFLK_STR_2 = ZFLK_STR_2*(PT_WML_P_FLK(JL)-PT_BOT_P_FLK(JL))*ZD_C_T_DT
      ZD_T_BOT_DT = ZD_T_BOT_DT + ZFLK_STR_2       ! Add dC_T/dt term
      
    ELSE                                ! Mixed-layer retreat or stationary state
      ZD_T_BOT_DT = 0._JPRB             ! dT_bot/dt=0
    END IF

    PT_BOT_N_FLK(JL) = PT_BOT_P_FLK(JL) + ZD_T_BOT_DT*PDEL_TIME  ! Update T_bot  
    PT_BOT_N_FLK(JL) = MAX(PT_BOT_N_FLK(JL), RTPL_T_F)           ! Security, limit T_bot by the freezing point
    ZFLK_STR_2 = (PT_BOT_N_FLK(JL)-RTPL_T_R)*ZFLAKE_BUOYPAR(PT_MNW_N_FLK(JL))
    IF(ZFLK_STR_2.LT.0._JPRB) PT_BOT_N_FLK(JL) = RTPL_T_R        ! Security, avoid T_r crossover 
    PT_WML_N_FLK(JL) = PC_T_N_FLK(JL)*(1._JPRB-PH_ML_N_FLK(JL)/PDEPTH_W(JL))
    PT_WML_N_FLK(JL) = (PT_MNW_N_FLK(JL)-PT_BOT_N_FLK(JL)*PT_WML_N_FLK(JL))/ &
   & (1._JPRB-PT_WML_N_FLK(JL))
    PT_WML_N_FLK(JL) = MAX(PT_WML_N_FLK(JL), RTPL_T_F)           ! Security, limit T_wML by the freezing point

  ELSE                                                           ! Mixing down to the lake bottom 

    PH_ML_N_FLK(JL)  = PDEPTH_W(JL)
    PT_WML_N_FLK(JL) = PT_MNW_N_FLK(JL)
    PT_BOT_N_FLK(JL) = PT_MNW_N_FLK(JL)
    PC_T_N_FLK(JL)   = RC_T_MIN

  END IF

END IF HTC_WATER


!------------------------------------------------------------------------------
!  Impose additional constraints.
!------------------------------------------------------------------------------

! In case of unstable stratification, force mixing down to the bottom
ZFLK_STR_2 = (PT_WML_N_FLK(JL)-PT_BOT_N_FLK(JL))*ZFLAKE_BUOYPAR(PT_MNW_N_FLK(JL))
IF(ZFLK_STR_2.LT.0._JPRB) THEN 
  PH_ML_N_FLK(JL)  = PDEPTH_W(JL)
  PT_WML_N_FLK(JL) = PT_MNW_N_FLK(JL)
  PT_BOT_N_FLK(JL) = PT_MNW_N_FLK(JL)
  PC_T_N_FLK(JL)   = RC_T_MIN
END IF

!------------------------------------------------------------------------------
!  Update the surface temperature.
!------------------------------------------------------------------------------

IF(PH_ICE_N_FLK(JL).GE.RH_ICE_MIN_FLK) THEN
  PT_SFC_N(JL) = PT_ICE_N_FLK(JL) ! Ice exists but there is no snow, use the ice temperature
ELSE 
  PT_SFC_N(JL) = PT_WML_N_FLK(JL) ! No ice-snow cover, use the mixed-layer temperature
END IF

ENDIF LAKEPOINT

ENDDO MAIN_LOOP

!------------------------------------------------------------------------------
!  End calculations
!==============================================================================

END SUBROUTINE FLAKEENE
END MODULE FLAKEENE_MOD
