source: trunk/LMDZ.COMMON/libf/evolution/layered_deposits.F90 @ 4134

MODULE layered_deposits
!-----------------------------------------------------------------------
! NAME
!     layered_deposits
!
! DESCRIPTION
!     Manage layered deposits in the PEM with a linked list data structure.
!     Provides data types and subroutines to manipulate layers of ice and dust.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use numerics, only: dp, di, k4, tol
use geometry, only: ngrid, nslope
use surf_ice, only: rho_co2ice, rho_h2oice

! DECLARATION
! -----------
implicit none

! VARIABLES
! ---------
! Numerical parameter
logical(k4), protected :: do_layering

! Physical parameters
logical(k4), protected, private :: impose_dust_ratio            ! Impose dust-to-ice ratio instead of dust tendency (see 'dust2ice_ratio')
real(dp),    protected, private :: dust2ice_ratio               ! Dust-to-ice ratio when ice condenses (10% by default)
real(dp),    protected, private :: d_dust                       ! Tendency of dust [kg.m-2.y-1]
real(dp),    parameter, private :: dry_lag_porosity  = 0.2_dp   ! Porosity of dust lag
real(dp),    parameter, private :: wet_lag_porosity  = 0.15_dp  ! Porosity of water ice lag
real(dp),    parameter, private :: regolith_porosity = 0.4_dp   ! Porosity of regolith
real(dp),    parameter, private :: breccia_porosity  = 0.1_dp   ! Porosity of breccia
real(dp),    parameter, private :: co2ice_porosity   = 0.05_dp  ! Porosity of CO2 ice
real(dp),    parameter, private :: h2oice_porosity   = 0.1_dp   ! Porosity of H2O ice
real(dp),    parameter, private :: rho_dust          = 2500._dp ! Density of dust [kg.m-3]
real(dp),    parameter, private :: rho_rock          = 3200._dp ! Density of rock [kg.m-3]
real(dp),    parameter, private :: h_patchy_dust     = 5.e-4_dp ! Height under which a dust lag is considered patchy [m]
real(dp),    parameter, private :: h_patchy_ice      = 5.e-4_dp ! Height under which a H2O ice lag is considered patchy [m]

! Parameters for CO2 flux correction (inspired by Levrard et al. 2007)
real(dp), parameter, private :: hmin_lag_co2 = 0.5_dp ! Minimal height of the lag deposit to reduce the sublimation rate [m]
real(dp), parameter, private :: fred_sublco2 = 0.1_dp ! Reduction factor of sublimation rate

! DATA STRUCTURES
! ---------------
! Stratum = node of the linked list
type :: stratum
    real(dp)               :: top_elevation   ! Layer top_elevation (top height from the surface) [m]
    real(dp)               :: h_co2ice        ! Height of CO2 ice [m]
    real(dp)               :: h_h2oice        ! Height of H2O ice [m]
    real(dp)               :: h_dust          ! Height of dust [m]
    real(dp)               :: h_pore          ! Height of pores [m]
    real(dp)               :: poreice_volfrac ! Pore-filled ice volumetric fraction
    type(stratum), pointer :: up => null()    ! Upper stratum (next node)
    type(stratum), pointer :: down => null()  ! Lower stratum (previous node)
end type stratum

! Layering = linked list
type layering
    integer(di)            :: nb_str = 0       ! Number of strata
    type(stratum), pointer :: bottom => null() ! First stratum (head of the list)
    type(stratum), pointer :: top => null()    ! Last stratum (tail of the list)
    !real(dp)               :: h_toplag         ! Height of dust layer at the top [m]
    !type(stratum), pointer :: subice => null() ! Shallower stratum containing ice
    !type(stratum), pointer :: surf => null()   ! Surface stratum
end type layering

! Array of pointers to "stratum"
type ptrarray
    type(stratum), pointer :: p
end type ptrarray

contains
!+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

!=======================================================================
SUBROUTINE set_layered_deposits_config(do_layering_in,impose_dust_ratio_in,d_dust_in,dust2ice_ratio_in)
!-----------------------------------------------------------------------
! NAME
!     set_layered_deposits_config
!
! DESCRIPTION
!     Setter for 'layered_deposits' configuration parameters.
!
! AUTHORS & DATE
!     JB Clement, 02/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use utility,  only: real2str, bool2str
use display,  only: print_msg, LVL_NFO
use stoppage, only: stop_clean

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
logical(k4), intent(in) :: do_layering_in, impose_dust_ratio_in
real(dp),    intent(in) :: d_dust_in, dust2ice_ratio_in

! CODE
! ----
do_layering = do_layering_in
impose_dust_ratio = impose_dust_ratio_in
d_dust = d_dust_in
dust2ice_ratio = dust2ice_ratio_in
call print_msg('do_layering       = '//bool2str(do_layering),LVL_NFO)
call print_msg('impose_dust_ratio = '//bool2str(impose_dust_ratio),LVL_NFO)
call print_msg('d_dust            = '//real2str(d_dust),LVL_NFO)
call print_msg('dust2ice_ratio    = '//real2str(dust2ice_ratio),LVL_NFO)
if (dust2ice_ratio < 0._dp .or. dust2ice_ratio > 1._dp) call stop_clean(__FILE__,__LINE__,'''dust2ice_ratio'' outside admissible range [0.,1.]!',1)

END SUBROUTINE set_layered_deposits_config
!=======================================================================

!=======================================================================
SUBROUTINE print_stratum(this)
!-----------------------------------------------------------------------
! NAME
!     print_stratum
!
! DESCRIPTION
!     Print a stratum.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use utility, only: real2str
use display, only: print_msg, LVL_DBG

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(stratum), intent(in) :: this

! CODE
! ----
call print_msg('Top elevation       [m]: '//real2str(this%top_elevation),LVL_DBG)
call print_msg('Height of CO2 ice   [m]: '//real2str(this%h_co2ice),LVL_DBG)
call print_msg('Height of H2O ice   [m]: '//real2str(this%h_h2oice),LVL_DBG)
call print_msg('Height of dust      [m]: '//real2str(this%h_dust),LVL_DBG)
call print_msg('Height of pores     [m]: '//real2str(this%h_pore),LVL_DBG)
call print_msg('Pore-filled ice [m3/m3]: '//real2str(this%poreice_volfrac),LVL_DBG)

END SUBROUTINE print_stratum
!=======================================================================

!=======================================================================
SUBROUTINE add_stratum(this,top_elevation,co2ice,h2oice,dust,pore,poreice)
!-----------------------------------------------------------------------
! NAME
!     add_stratum
!
! DESCRIPTION
!     Add a stratum to the top of a layering.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), intent(inout)        :: this
real(dp),       intent(in), optional :: top_elevation, co2ice, h2oice, dust, pore, poreice

! LOCAL VARIABLES
! ---------------
type(stratum), pointer :: str

! CODE
! ----
! Creation of the stratum
allocate(str)
nullify(str%up,str%down)
str%top_elevation   = 1._dp
str%h_co2ice        = 0._dp
str%h_h2oice        = 0._dp
str%h_dust          = 1._dp
str%h_pore          = 0._dp
str%poreice_volfrac = 0._dp
if (present(top_elevation)) str%top_elevation   = top_elevation
if (present(co2ice))        str%h_co2ice        = co2ice
if (present(h2oice))        str%h_h2oice        = h2oice
if (present(dust))          str%h_dust          = dust
if (present(pore))          str%h_pore          = pore
if (present(poreice))       str%poreice_volfrac = poreice

! Increment the number of strata
this%nb_str = this%nb_str + 1

! Add the stratum to the layering
if (.not. associated(this%bottom)) then ! If it is the very first one
    this%bottom => str
    this%top => str
else
    str%down => this%top
    this%top%up => str
    this%top => str
end if

END SUBROUTINE add_stratum
!=======================================================================

!=======================================================================
SUBROUTINE insert_stratum(this,str_prev,top_elevation,co2ice,h2oice,dust,pore,poreice)
!-----------------------------------------------------------------------
! NAME
!     insert_stratum
!
! DESCRIPTION
!     Insert a stratum after a given previous stratum in the layering.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering),         intent(inout)        ::  this
type(stratum), pointer, intent(inout)        ::  str_prev
real(dp),               intent(in), optional :: top_elevation, co2ice, h2oice, dust, pore, poreice

! LOCAL VARIABLES
! ---------------
type(stratum), pointer :: str, current

! CODE
! ----
if (.not. associated(str_prev%up)) then ! If str_prev is the top stratum of the layering
    call add_stratum(this,top_elevation,co2ice,h2oice,dust,pore,poreice)
else
    ! Creation of the stratum
    allocate(str)
    nullify(str%up,str%down)
    str%top_elevation   = 1._dp
    str%h_co2ice        = 0._dp
    str%h_h2oice        = 0._dp
    str%h_dust          = 1._dp
    str%h_pore          = 0._dp
    str%poreice_volfrac = 0._dp
    if (present(top_elevation)) str%top_elevation   = top_elevation
    if (present(co2ice))        str%h_co2ice        = co2ice
    if (present(h2oice))        str%h_h2oice        = h2oice
    if (present(dust))          str%h_dust          = dust
    if (present(pore))          str%h_pore          = pore
    if (present(poreice))       str%poreice_volfrac = poreice

    ! Increment the number of strata
    this%nb_str = this%nb_str + 1

    ! Insert the stratum into the layering at the right place
    str%down => str_prev
    str%up => str_prev%up
    str_prev%up => str
    str%up%down => str

    ! Correct the value of top_elevation for the upper strata
    current => str%up
    do while (associated(current))
        current%top_elevation = current%down%top_elevation + thickness(current)
        current => current%up
    end do
end if

END SUBROUTINE insert_stratum
!=======================================================================

!=======================================================================
SUBROUTINE del_stratum(this,str)
!-----------------------------------------------------------------------
! NAME
!     del_stratum
!
! DESCRIPTION
!     Delete a stratum from the layering and fix links.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering),         intent(inout) :: this
type(stratum), pointer, intent(inout) :: str

! LOCAL VARIABLES
! ---------------
type(stratum), pointer :: new_str

! CODE
! ----
! Protect the sub-surface strata from deletion
if (str%top_elevation <= 0.) return

! Decrement the number of strata
this%nb_str = this%nb_str - 1

! Making the new links
if (associated(str%down)) then ! If there is a lower stratum
    str%down%up => str%up
else ! If it was the first stratum (bottom of layering)
    this%bottom => str%up
end if
if (associated(str%up)) then ! If there is an upper stratum
    str%up%down => str%down
else ! If it was the last stratum (top of layering)
    this%top => str%down
end if

! Remove the stratum from the layering
new_str => str%down
nullify(str%up,str%down)
deallocate(str)
nullify(str)
str => new_str

END SUBROUTINE del_stratum
!=======================================================================

!=======================================================================
FUNCTION get_stratum(lay,i) RESULT(str)
!-----------------------------------------------------------------------
! NAME
!     get_stratum
!
! DESCRIPTION
!     Return the i-th stratum in the layering.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use stoppage, only: stop_clean

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), intent(in) :: lay
integer(di),    intent(in) :: i
type(stratum), pointer     :: str

! LOCAL VARIABLES
! ---------------
integer(di) :: k

! CODE
! ----
if (i < 1 .or. i > lay%nb_str) call stop_clean(__FILE__,__LINE__,'requested number is beyond the number of strata of the layering!',1)
k = 1
str => lay%bottom
do while (k /= i)
    str => str%up
    k = k + 1
end do

END FUNCTION get_stratum
!=======================================================================

!=======================================================================
SUBROUTINE ini_layering(this)
!-----------------------------------------------------------------------
! NAME
!     del_layering
!
! DESCRIPTION
!     Initialize the layering base structure.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use soil,     only: do_soil, layer, index_breccia, index_bedrock
use geometry, only: nsoil

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), intent(inout) :: this

! LOCAL VARIABLES
! ---------------
integer(di) :: i
real(dp)    :: h_soil, h_pore, h_tot

! CODE
! ----
! Creation of strata at the bottom of the layering to describe the sub-surface
if (do_soil) then
    do i = nsoil,index_bedrock,-1
        h_soil = layer(i) - layer(i - 1) ! No porosity
        call add_stratum(this,-layer(i - 1),0._dp,0._dp,h_soil,0._dp,0._dp)
    end do
    do i = index_bedrock - 1,index_breccia,-1
        h_tot = layer(i) - layer(i - 1)
        h_pore = h_tot*breccia_porosity
        h_soil = h_tot - h_pore
        call add_stratum(this,-layer(i - 1),0._dp,0._dp,h_soil,h_pore,0._dp)
    end do
    do i = index_breccia - 1,2,-1
        h_tot = layer(i) - layer(i - 1)
        h_pore = h_tot*regolith_porosity
        h_soil = h_tot - h_pore
        call add_stratum(this,-layer(i - 1),0._dp,0._dp,h_soil,h_pore,0._dp)
    end do
    h_pore = layer(1)*regolith_porosity
    h_soil = layer(1) - h_pore
    call add_stratum(this,0._dp,0._dp,0._dp,h_soil,h_pore,0._dp)
end if

END SUBROUTINE ini_layering
!=======================================================================

!=======================================================================
SUBROUTINE del_layering(this)
!-----------------------------------------------------------------------
! NAME
!     del_layering
!
! DESCRIPTION
!     Delete all strata in a layering and reset counters.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), intent(inout) :: this

! LOCAL VARIABLES
! ---------------
type(stratum), pointer :: current, next

! CODE
! ----
current => this%bottom
do while (associated(current))
    next => current%up
    deallocate(current)
    nullify(current)
    current => next
end do
this%nb_str = 0

END SUBROUTINE del_layering
!=======================================================================

!=======================================================================
SUBROUTINE print_layering(this)
!-----------------------------------------------------------------------
! NAME
!     print_layering
!
! DESCRIPTION
!     Display all strata from top to bottom for a layering.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use utility, only: int2str
use display, only: print_msg, LVL_DBG

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), intent(in) :: this

! LOCAL VARIABLES
! ---------------
type(stratum), pointer :: current
integer(di)            :: i

! CODE
! ----
current => this%top

i = this%nb_str
do while (associated(current))
    call print_msg('Stratum '//int2str(i),LVL_DBG)
    call print_stratum(current)
    call print_msg('',LVL_DBG)
    current => current%down
    i = i - 1
end do

END SUBROUTINE print_layering
!=======================================================================

!=======================================================================
FUNCTION get_nb_str_max(layerings_map) RESULT(nb_str_max)
!-----------------------------------------------------------------------
! NAME
!     get_nb_str_max
!
! DESCRIPTION
!     Return the maximum number of strata across all grid/slope layerings.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use geometry, only: ngrid, nslope

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), dimension(:,:), intent(in) :: layerings_map
integer(di)                                :: nb_str_max

! LOCAL VARIABLES
! ---------------
integer(di) :: ig, islope

! CODE
! ----
nb_str_max = 0
do islope = 1,nslope
    do ig = 1,ngrid
        nb_str_max = max(layerings_map(ig,islope)%nb_str,nb_str_max)
    end do
end do

END FUNCTION get_nb_str_max
!=======================================================================

!=======================================================================
SUBROUTINE map2array(layerings_map,layerings_array)
!-----------------------------------------------------------------------
! NAME
!     map2array
!
! DESCRIPTION
!     Convert the layerings map into an allocatable array for output.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use geometry, only: ngrid, nslope

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), dimension(:,:),     intent(in)  :: layerings_map
real(dp),       dimension(:,:,:,:), intent(out) :: layerings_array

! LOCAL VARIABLES
! ---------------
type(stratum), pointer :: current
integer(di)            :: ig, islope, k

! CODE
! ----
layerings_array = 0.
do islope = 1,nslope
    do ig = 1,ngrid
        current => layerings_map(ig,islope)%bottom
        k = 1
        do while (associated(current))
            layerings_array(ig,islope,k,1) = current%top_elevation
            layerings_array(ig,islope,k,2) = current%h_co2ice
            layerings_array(ig,islope,k,3) = current%h_h2oice
            layerings_array(ig,islope,k,4) = current%h_dust
            layerings_array(ig,islope,k,5) = current%h_pore
            layerings_array(ig,islope,k,6) = current%poreice_volfrac
            current => current%up
            k = k + 1
        end do
    end do
end do

END SUBROUTINE map2array
!=======================================================================

!=======================================================================
SUBROUTINE array2map(layerings_array,layerings_map)
!-----------------------------------------------------------------------
! NAME
!     array2map
!
! DESCRIPTION
!     Convert the stratification array back into the layerings map.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use geometry, only: ngrid, nslope

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
real(dp),       dimension(:,:,:,:), intent(in)    :: layerings_array
type(layering), dimension(:,:),     intent(inout) :: layerings_map

! LOCAL VARIABLES
! ---------------
integer(di) :: ig, islope, k

! CODE
! ----
do islope = 1,nslope
    do ig = 1,ngrid
        do k = 1,size(layerings_array,3)
            call add_stratum(layerings_map(ig,islope),layerings_array(ig,islope,k,1),layerings_array(ig,islope,k,2),layerings_array(ig,islope,k,3),layerings_array(ig,islope,k,4),layerings_array(ig,islope,k,5),layerings_array(ig,islope,k,6))
        end do
    end do
end do

END SUBROUTINE array2map
!=======================================================================

!=======================================================================
SUBROUTINE layering2surfice(layerings_map,h2o_ice,co2_ice,h2oice_depth)
!-----------------------------------------------------------------------
! NAME
!     layering2surfice
!
! DESCRIPTION
!     Convert the layerings map into surface ice arrays.
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use geometry, only: ngrid, nslope

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), dimension(:,:), intent(in)  :: layerings_map
real(dp),       dimension(:,:), intent(out) :: h2o_ice, co2_ice, h2oice_depth

! LOCAL VARIABLES
! ---------------
integer(di) :: ig, islope

! CODE
! ----
do ig = 1,ngrid
    do islope = 1,nslope
        if (is_co2ice_str(layerings_map(ig,islope)%top)) then
            co2_ice(ig,islope) = layerings_map(ig,islope)%top%h_co2ice*rho_co2ice
        else if (is_h2oice_str(layerings_map(ig,islope)%top)) then
            h2o_ice(ig,islope) = layerings_map(ig,islope)%top%h_h2oice*rho_h2oice
        else
            call subsurface_ice_layering(layerings_map(ig,islope),h2oice_depth(ig,islope),h2o_ice(ig,islope),co2_ice(ig,islope))
        end if
    end do
end do

END SUBROUTINE layering2surfice
!=======================================================================

!=======================================================================
SUBROUTINE surfice2layering(h2o_ice,co2_ice,layerings_map)
!-----------------------------------------------------------------------
! NAME
!     surfice2layering
!
! DESCRIPTION
!     Convert surface ice arrays into the layerings map.
!
! AUTHORS & DATE
!     JB Clement, 01/2026
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use geometry, only: ngrid, nslope

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
real(dp),       dimension(:,:), intent(in)    :: h2o_ice, co2_ice
type(layering), dimension(:,:), intent(inout) :: layerings_map

! LOCAL VARIABLES
! ---------------
integer(di) :: i, islope

! CODE
! ----
do islope = 1,nslope
    do i = 1,ngrid
        layerings_map(i,islope)%top%h_h2oice = h2o_ice(i,islope)/rho_h2oice
        layerings_map(i,islope)%top%h_co2ice = co2_ice(i,islope)/rho_co2ice
    end do
end do

END SUBROUTINE surfice2layering
!=======================================================================

!=======================================================================
SUBROUTINE print_layerings_map(this)
!-----------------------------------------------------------------------
! NAME
!     print_layerings_map
!
! DESCRIPTION
!     Display the entire layerings map for all grids and slopes.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use utility, only: int2str
use display, only: print_msg, LVL_DBG

! DEPENDENCIES
! ------------
use geometry, only: ngrid, nslope

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), dimension(:,:), intent(in) :: this

! LOCAL VARIABLES
! ---------------
integer(di) :: ig, islope

! CODE
! ----
do ig = 1,ngrid
    call print_msg('Grid cell '//int2str(ig),LVL_DBG)
    do islope = 1,nslope
        call print_msg('Slope number '//int2str(islope),LVL_DBG)
        call print_layering(this(ig,islope))
        call print_msg('~~~~~~~~~~',LVL_DBG)
    end do
    call print_msg('--------------------',LVL_DBG)
end do

END SUBROUTINE print_layerings_map
!=======================================================================

!=======================================================================
FUNCTION thickness(this) RESULT(h_str)
!-----------------------------------------------------------------------
! NAME
!     thickness
!
! DESCRIPTION
!     Compute the total thickness of a stratum.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(stratum), intent(in) :: this

! LOCAL VARIABLES
! ---------------
real(dp) :: h_str

! CODE
! ----
h_str = this%h_co2ice + this%h_h2oice + this%h_dust + this%h_pore

END FUNCTION thickness
!=======================================================================

!=======================================================================
FUNCTION is_co2ice_str(str) RESULT(co2ice_str)
!-----------------------------------------------------------------------
! NAME
!     is_co2ice_str
!
! DESCRIPTION
!     Check if a stratum can be considered as a CO2 ice layer.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(stratum), intent(in) :: str

! LOCAL VARIABLES
! ---------------
logical(k4) :: co2ice_str

! CODE
! ----
co2ice_str = .false.
if (str%h_co2ice > str%h_h2oice .and. str%h_co2ice > str%h_dust) co2ice_str = .true.

END FUNCTION is_co2ice_str
!=======================================================================

!=======================================================================
FUNCTION is_h2oice_str(str) RESULT(h2oice_str)
!-----------------------------------------------------------------------
! NAME
!     is_h2oice_str
!
! DESCRIPTION
!     Check if a stratum can be considered as a H2O ice layer.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(stratum), intent(in) :: str

! LOCAL VARIABLES
! ---------------
logical(k4) :: h2oice_str

! CODE
! ----
h2oice_str = .false.
if (str%h_h2oice > str%h_co2ice .and. str%h_h2oice > str%h_dust) h2oice_str = .true.

END FUNCTION is_h2oice_str
!=======================================================================

!=======================================================================
FUNCTION is_dust_str(str) RESULT(dust_str)
!-----------------------------------------------------------------------
! NAME
!     is_dust_str
!
! DESCRIPTION
!     Check if a stratum can be considered as a dust layer.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(stratum), intent(in) :: str

! LOCAL VARIABLES
! ---------------
logical(k4) :: dust_str

! CODE
! ----
dust_str = .false.
if (str%h_dust > str%h_co2ice .and. str%h_dust > str%h_h2oice) dust_str = .true.

END FUNCTION is_dust_str
!=======================================================================

!=======================================================================
FUNCTION is_dust_lag(str) RESULT(dust_lag)
!-----------------------------------------------------------------------
! NAME
!     is_dust_lag
!
! DESCRIPTION
!     Check if a stratum is a dust lag (no ice content).
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(stratum), intent(in) :: str

! LOCAL VARIABLES
! ---------------
logical(k4) :: dust_lag

! CODE
! ----
dust_lag = .false.
if (str%h_co2ice < tol .and. str%h_h2oice < tol .and. str%poreice_volfrac < tol) dust_lag = .true.

END FUNCTION is_dust_lag
!=======================================================================

!=======================================================================
SUBROUTINE subsurface_ice_layering(this,h_toplag,h2o_ice,co2_ice)
!-----------------------------------------------------------------------
! NAME
!     subsurface_ice_layering
!
! DESCRIPTION
!     Get data about possible subsurface ice in a layering.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering), intent(in)  :: this
real(dp),       intent(out) :: h2o_ice, co2_ice, h_toplag

! LOCAL VARIABLES
! ---------------
type(stratum), pointer :: current

! CODE
! ----
h_toplag = 0._dp
h2o_ice = 0._dp
co2_ice = 0._dp
current => this%top
! Is the considered stratum a dust lag?
if (.not. is_dust_lag(current)) return
do while (is_dust_lag(current))
    h_toplag = h_toplag + thickness(current)
    if (associated(current%down)) then
        current => current%down
    else
        exit
    end if
end do

if (.not. associated(current%down)) then ! Bottom of the layering -> no ice below
    h_toplag = 0._dp
    return
end if

! Is the stratum below the dust lag made of ice?
if (current%h_h2oice > 0._dp .and. current%h_h2oice > current%h_co2ice) then ! Yes, there is more H2O ice than CO2 ice
    if (h_toplag < h_patchy_dust) then ! But the dust lag is too thin to considered ice as subsurface ice
        h_toplag = 0._dp
        h2o_ice = current%h_h2oice*rho_h2oice
    end if
else if (current%h_co2ice > 0._dp .and. current%h_co2ice > current%h_h2oice) then ! No, there is more CO2 ice than H2O ice
    h_toplag = 0._dp ! Because it matters only for H2O ice
    if (h_toplag < h_patchy_ice) co2_ice = current%h_co2ice*rho_co2ice ! But the dust lag is too thin to considered ice as subsurface ice
end if

END SUBROUTINE subsurface_ice_layering
!=======================================================================

!=======================================================================
SUBROUTINE lift_dust(this,str,h2lift)
!-----------------------------------------------------------------------
! NAME
!     lift_dust
!
! DESCRIPTION
!     Lift dust in a stratum by wind erosion or other processes.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering),         intent(inout) :: this
type(stratum), pointer, intent(inout) :: str
real(dp),               intent(in)    :: h2lift

! CODE
! ----
! Update of properties in the eroding dust lag
str%top_elevation = str%top_elevation - h2lift*(1._dp + str%h_pore/str%h_dust)
str%h_pore        = str%h_pore        - h2lift*str%h_pore/str%h_dust
str%h_dust        = str%h_dust        - h2lift

! Remove the eroding dust lag if there is no dust anymore
if (str%h_dust < tol) call del_stratum(this,str)

END SUBROUTINE lift_dust
!=======================================================================

!=======================================================================
SUBROUTINE sublimate_ice(this,str,h2subl_co2ice,h2subl_h2oice,new_lag,zlag)
!-----------------------------------------------------------------------
! NAME
!     sublimate_ice
!
! DESCRIPTION
!     Handle ice sublimation in a stratum and create lag layer.
!
! AUTHORS & DATE
!     JB Clement, 2024
!
! NOTES
!
!-----------------------------------------------------------------------

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering),         intent(inout) :: this
type(stratum), pointer, intent(inout) :: str
logical(k4),            intent(inout) :: new_lag
real(dp),               intent(inout) :: zlag
real(dp),               intent(in)    :: h2subl_co2ice, h2subl_h2oice

! LOCAL VARIABLES
! ---------------
real(dp)               :: h2subl, h_ice, h_pore, h_pore_new, h_tot
real(dp)               :: hlag_dust, hlag_h2oice
type(stratum), pointer :: current

! CODE
! ----
h_ice = str%h_co2ice + str%h_h2oice
h_pore = str%h_pore
h2subl = h2subl_co2ice + h2subl_h2oice

! How much dust and H2O ice does ice sublimation involve to create the lag?
hlag_dust = str%h_dust*h2subl/h_ice
hlag_h2oice = 0._dp
if (h2subl_co2ice > 0._dp .and. h2subl_h2oice < tol) hlag_h2oice = str%h_h2oice*h2subl/h_ice

! Update of properties in the sublimating stratum
str%top_elevation = str%top_elevation - h2subl*(1._dp + h_pore/h_ice) - hlag_dust - hlag_h2oice
str%h_co2ice      = str%h_co2ice      - h2subl_co2ice
str%h_h2oice      = str%h_h2oice      - h2subl_h2oice - hlag_h2oice
str%h_dust        = str%h_dust        - hlag_dust
str%h_pore        = str%h_pore        - h2subl*h_pore/h_ice

! Correct the value of top_elevation for the upper strata
current => str%up
do while (associated(current))
    current%top_elevation = current%down%top_elevation + thickness(current)
    current => current%up
end do

! Remove the sublimating stratum if there is no ice anymore
if (str%h_co2ice < tol .and. str%h_h2oice < tol) call del_stratum(this,str)

! Which porosity is considered?
if (hlag_dust >= hlag_h2oice) then
    h_pore_new = hlag_dust*dry_lag_porosity/(1._dp - dry_lag_porosity)
else
    h_pore_new = hlag_h2oice*wet_lag_porosity/(1._dp - wet_lag_porosity)
end if
h_tot = hlag_dust + hlag_h2oice + h_pore_new

! New stratum above the current stratum as a lag layer
if (new_lag) then
    call insert_stratum(this,str,str%top_elevation + h_tot,0._dp,hlag_h2oice,hlag_dust,h_pore_new,0._dp)
    new_lag = .false.
else
    str%up%top_elevation = str%up%top_elevation + h_tot
    str%up%h_h2oice      = str%up%h_h2oice      + hlag_h2oice
    str%up%h_dust        = str%up%h_dust        + hlag_dust
    str%up%h_pore        = str%up%h_pore        + h_pore_new
end if

zlag = zlag + h_tot

END SUBROUTINE sublimate_ice
!=======================================================================

!=======================================================================
SUBROUTINE evolve_layering(this,d_co2ice,d_h2oice,new_str,zshift_surf,new_lag,zlag,current)
!-----------------------------------------------------------------------
! NAME
!     evolve_layering
!
! DESCRIPTION
!     Main algorithm for layering evolution. Manages ice condensation/sublimation
!     and dust sedimentation/lifting. Handles multiple scenarios: building new
!     strata from ice/dust, retreating strata from sublimation/lifting, and mixed
!     scenarios with CO2 ice sublimation combined with H2O ice condensation.
!
! AUTHORS & DATE
!     JB Clement, 09/2024
!
! NOTES
!     Creates dust lag layers when ice sublimation occurs.
!-----------------------------------------------------------------------

! DEPENDENCIES
! ------------
use stoppage, only: stop_clean
use utility,  only: real2str
use display,  only: print_msg, LVL_ERR

! DECLARATION
! -----------
implicit none

! ARGUMENTS
! ---------
type(layering),         intent(inout) ::  this
type(stratum), pointer, intent(inout) ::  current
real(dp),               intent(inout) ::  d_co2ice, d_h2oice
logical(k4),            intent(inout) ::  new_str, new_lag
real(dp),               intent(out)   ::  zshift_surf, zlag

! LOCAL VARIABLES
! ---------------
real(dp)               :: dh_co2ice, dh_h2oice, dh_dust, dh_dust_co2, dh_dust_h2o
real(dp)               :: h_co2ice_old, h_h2oice_old
real(dp)               :: h2subl_co2ice, h2subl_h2oice, h2subl_co2ice_tot, h2subl_h2oice_tot
real(dp)               :: h2lift, h2lift_tot, h_pore, h_tot, h_toplag, R_subl
logical(k4)            :: unexpected
type(stratum), pointer :: currentloc

! CODE
! ----
dh_co2ice = d_co2ice/rho_co2ice
dh_h2oice = d_h2oice/rho_h2oice
dh_dust = 0._dp
if (dh_h2oice > 0._dp) then ! To put a dust sedimentation tendency only when ice is condensing
    if (impose_dust_ratio) then
        if (dh_co2ice > 0._dp) then
            dh_dust = dust2ice_ratio*(dh_h2oice + dh_co2ice)
        else
            dh_dust = dust2ice_ratio*dh_h2oice
        end if
    else
        dh_dust = d_dust/rho_dust
    end if
end if
zshift_surf = this%top%top_elevation
zlag = 0._dp
unexpected = .false.

!~~~~~~~~~~
! NOTHING HAPPENS
if (abs(dh_co2ice) < tol .and. abs(dh_h2oice) < tol .and. abs(dh_dust) < tol) then
    ! So we do nothing
!~~~~~~~~~~
! BUILDING A STRATUM (ice condensation and/or dust desimentation)
else if (dh_co2ice >= 0._dp .and. dh_h2oice >= 0._dp .and. dh_dust >= 0._dp) then
    ! Which porosity is considered?
    if (dh_co2ice > dh_h2oice .and. dh_co2ice > dh_dust) then ! CO2 ice is dominant
        h_pore = dh_co2ice*co2ice_porosity/(1._dp - co2ice_porosity)
    else if (dh_h2oice > dh_co2ice .and. dh_h2oice > dh_dust) then ! H2O ice is dominant
        h_pore = dh_h2oice*h2oice_porosity/(1._dp - h2oice_porosity)
    else if (dh_dust > dh_co2ice .and. dh_dust > dh_h2oice) then ! Dust is dominant
        h_pore = dh_dust*regolith_porosity/(1._dp - regolith_porosity)
    else
        unexpected = .true.
    end if
    h_tot = dh_co2ice + dh_h2oice + dh_dust + h_pore
    ! New stratum at the top of the layering
    if (new_str) then
        call add_stratum(this,this%top%top_elevation + h_tot,dh_co2ice,dh_h2oice,dh_dust,h_pore,0._dp)
        new_str = .false.
    else
        this%top%top_elevation = this%top%top_elevation + h_tot
        this%top%h_co2ice      = this%top%h_co2ice      + dh_co2ice
        this%top%h_h2oice      = this%top%h_h2oice      + dh_h2oice
        this%top%h_dust        = this%top%h_dust        + dh_dust
        this%top%h_pore        = this%top%h_pore        + h_pore
    end if
!~~~~~~~~~~
 ! RETREATING A STRATUM (ice sublimation and/or dust lifting)
else if (dh_co2ice <= 0._dp .and. dh_h2oice <= 0._dp .and. dh_dust <= 0._dp) then
        h2subl_co2ice_tot = abs(dh_co2ice)
        h2subl_h2oice_tot = abs(dh_h2oice)
        h2lift_tot = abs(dh_dust)
        do while ((h2subl_co2ice_tot > 0._dp .or. h2subl_h2oice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. associated(current))
            h_co2ice_old = current%h_co2ice
            h_h2oice_old = current%h_h2oice

            ! How much is CO2 ice sublimation inhibited by the top dust lag?
            R_subl = 1.
            if (associated(current%up)) then ! If there is an upper stratum
                h_toplag = 0._dp
                currentloc => current%up
                do while (is_dust_lag(currentloc) .and. associated(currentloc%up))
                    h_toplag = h_toplag + thickness(currentloc)
                    currentloc => currentloc%up
                end do
                if (currentloc%h_h2oice >= h_patchy_ice) then
                    R_subl = 0._dp
                else if (0._dp < currentloc%h_h2oice .and. currentloc%h_h2oice < h_patchy_ice) then
                    h_toplag = h_toplag + thickness(currentloc)
                    R_subl = fred_sublco2**(h_toplag/hmin_lag_co2)
                else
                    R_subl = fred_sublco2**(h_toplag/hmin_lag_co2)
                end if
            end if
           h2subl_co2ice_tot = h2subl_co2ice_tot*R_subl

            ! Is there CO2 ice to sublimate?
            h2subl_co2ice = 0._dp
            if (h_co2ice_old > 0._dp .and. h2subl_co2ice_tot > 0._dp) then
                h2subl_co2ice = min(h2subl_co2ice_tot,h_co2ice_old)
                h2subl_co2ice_tot = h2subl_co2ice_tot - h2subl_co2ice
            end if
            ! Is there H2O ice to sublimate?
            h2subl_h2oice = 0._dp
            if (h_h2oice_old > 0._dp .and. h2subl_h2oice_tot > 0._dp) then
                h2subl_h2oice = min(h2subl_h2oice_tot,h_h2oice_old)
                h2subl_h2oice_tot = h2subl_h2oice_tot - h2subl_h2oice
            end if
            ! Ice sublimation
            if (h2subl_co2ice > 0._dp .or. h2subl_h2oice > 0._dp) call sublimate_ice(this,current,h2subl_co2ice,h2subl_h2oice,new_lag,zlag)

            ! Is there dust to lift?
            h2lift = 0._dp
            if (is_dust_lag(current) .and. h2lift_tot > 0._dp) then
                h2lift = min(h2lift_tot,current%h_dust)
                h2lift_tot = h2lift_tot - h2lift
                ! Dust lifting
                if (h2lift > 0._dp) call lift_dust(this,current,h2lift)
            else if (associated(current%up)) then
                if (is_dust_lag(current%up) .and. h2lift_tot > 0._dp) then
                    h2lift = min(h2lift_tot,current%up%h_dust)
                    h2lift_tot = h2lift_tot - h2lift
                    ! Dust lifting
                    if (h2lift > 0._dp) call lift_dust(this,current%up,h2lift)
                end if
            end if

            ! Still ice to be sublimated or dust to be lifted and no more ice in the current stratum so we move to the underlying stratum
            if ((h2subl_co2ice_tot > 0. .or. h2subl_h2oice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. current%h_co2ice < tol .and. current%h_h2oice < tol .and. current%poreice_volfrac < tol) then
                current => current%down
                new_lag = .true.
            else
                exit
            end if
        end do
        if (h2subl_co2ice_tot > 0._dp) dh_co2ice = 0._dp ! No CO2 ice available anymore so the tendency is set to 0
        if (h2subl_h2oice_tot > 0._dp) dh_h2oice = 0._dp ! No H2O ice available anymore so the tendency is set to 0
        if (h2lift_tot > 0._dp) dh_dust = 0._dp ! No dust available anymore so the tendency is set to 0
!~~~~~~~~~~
! CO2 ICE SUBLIMATION + H2O ICE CONDENSATION
else if (dh_co2ice <= 0._dp .and. dh_h2oice >= 0._dp) then
    if (dh_dust >= 0._dp) then
        dh_dust_co2 = 0._dp
        dh_dust_h2o = dh_dust
    else
        dh_dust_co2 = dh_dust
        dh_dust_h2o = 0._dp
    end if
    if (abs(dh_co2ice) > dh_h2oice) then ! CO2 ice sublimation is dominant
        ! CO2 ICE SUBLIMATION: retreating a stratum
        h2subl_co2ice_tot = abs(dh_co2ice)
        h2lift_tot = abs(dh_dust_co2)
        do while ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. associated(current))
            h_co2ice_old = current%h_co2ice

            ! How much is CO2 ice sublimation inhibited by the top dust lag?
            R_subl = 1.
            if (associated(current%up)) then ! If there is an upper stratum
                h_toplag = 0._dp
                currentloc => current%up
                do while (is_dust_lag(currentloc) .and. associated(currentloc%up))
                    h_toplag = h_toplag + thickness(currentloc)
                    currentloc => currentloc%up
                end do
                if (currentloc%h_h2oice >= h_patchy_ice) then
                    R_subl = 0._dp
                else if (0._dp < currentloc%h_h2oice .and. currentloc%h_h2oice < h_patchy_ice) then
                    h_toplag = h_toplag + thickness(currentloc)
                    R_subl = fred_sublco2**(h_toplag/hmin_lag_co2)
                else
                    R_subl = fred_sublco2**(h_toplag/hmin_lag_co2)
                end if
            end if
           h2subl_co2ice_tot = h2subl_co2ice_tot*R_subl

            ! Is there CO2 ice to sublimate?
            h2subl_co2ice = 0._dp
            if (h_co2ice_old > 0._dp .and. h2subl_co2ice_tot > 0._dp) then
                h2subl_co2ice = min(h2subl_co2ice_tot,h_co2ice_old)
                h2subl_co2ice_tot = h2subl_co2ice_tot - h2subl_co2ice
            end if
            ! Ice sublimation
            if (h2subl_co2ice > 0._dp) call sublimate_ice(this,current,h2subl_co2ice,0._dp,new_lag,zlag)

            ! Is there dust to lift?
            h2lift = 0._dp
            if (is_dust_lag(current) .and. h2lift_tot > 0._dp) then
                h2lift = min(h2lift_tot,current%h_dust)
                h2lift_tot = h2lift_tot - h2lift
                ! Dust lifting
                if (h2lift > 0._dp) call lift_dust(this,current,h2lift)
            else if (associated(current%up)) then
                if (is_dust_lag(current%up) .and. h2lift_tot > 0._dp) then
                    h2lift = min(h2lift_tot,current%up%h_dust)
                    h2lift_tot = h2lift_tot - h2lift
                    ! Dust lifting
                    if (h2lift > 0._dp) call lift_dust(this,current%up,h2lift)
                end if
            end if

            ! Still ice to be sublimated or dust to be lifted and no more ice in the current stratum so we move to the underlying stratum
            if ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. current%h_co2ice < tol) then
                current => current%down
                new_lag = .true.
            else
                exit
            end if
        end do
        if (h2subl_co2ice_tot > 0._dp) dh_co2ice = 0._dp ! No CO2 ice available anymore so the tendency is set to 0
        if (h2lift_tot > 0._dp) dh_dust = 0._dp ! No dust available anymore so the tendency is set to 0

        ! H2O ICE CONDENSATION: building a stratum
        h_pore = dh_h2oice*h2oice_porosity/(1._dp - h2oice_porosity)
        h_tot = dh_h2oice + dh_dust_h2o + h_pore
        ! New stratum at the top of the layering
        if (new_str) then
            call add_stratum(this,this%top%top_elevation + h_tot,0._dp,dh_h2oice,dh_dust_h2o,h_pore,0._dp)
            new_str = .false.
        else
            this%top%top_elevation = this%top%top_elevation + h_tot
            this%top%h_h2oice      = this%top%h_h2oice      + dh_h2oice
            this%top%h_dust        = this%top%h_dust        + dh_dust_h2o
            this%top%h_pore        = this%top%h_pore        + h_pore
        end if
    else ! H2O ice condensation is dominant
        ! H2O ICE CONDENSATION: building a stratum
        h_pore = dh_h2oice*h2oice_porosity/(1._dp - h2oice_porosity)
        h_tot = dh_h2oice + dh_dust_h2o + h_pore
        ! New stratum at the top of the layering
        if (new_str) then
            call add_stratum(this,this%top%top_elevation + h_tot,0._dp,dh_h2oice,dh_dust_h2o,h_pore,0._dp)
            new_str = .false.
        else
            this%top%top_elevation = this%top%top_elevation + h_tot
            this%top%h_h2oice      = this%top%h_h2oice      + dh_h2oice
            this%top%h_dust        = this%top%h_dust        + dh_dust_h2o
            this%top%h_pore        = this%top%h_pore        + h_pore
        end if

        ! CO2 ICE SUBLIMATION: retreating a stratum
        h2subl_co2ice_tot = abs(dh_co2ice)
        h2lift_tot = abs(dh_dust_co2)
        do while ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. associated(current))
            h_co2ice_old = current%h_co2ice

            ! How much is CO2 ice sublimation inhibited by the top dust lag?
            R_subl = 1._dp
            if (associated(current%up)) then ! If there is an upper stratum
                h_toplag = 0._dp
                currentloc => current%up
                do while (is_dust_lag(currentloc) .and. associated(currentloc%up))
                    h_toplag = h_toplag + thickness(currentloc)
                    currentloc => currentloc%up
                end do
                if (currentloc%h_h2oice >= h_patchy_ice) then
                    R_subl = 0._dp
                else if (0._dp < currentloc%h_h2oice .and. currentloc%h_h2oice < h_patchy_ice) then
                    h_toplag = h_toplag + thickness(currentloc)
                    R_subl = fred_sublco2**(h_toplag/hmin_lag_co2)
                else
                    R_subl = fred_sublco2**(h_toplag/hmin_lag_co2)
                end if
            end if
           h2subl_co2ice_tot = h2subl_co2ice_tot*R_subl

            ! Is there CO2 ice to sublimate?
            h2subl_co2ice = 0._dp
            if (h_co2ice_old > 0._dp .and. h2subl_co2ice_tot > 0._dp) then
                h2subl_co2ice = min(h2subl_co2ice_tot,h_co2ice_old)
                h2subl_co2ice_tot = h2subl_co2ice_tot - h2subl_co2ice
            end if
            ! Ice sublimation
            if (h2subl_co2ice > 0._dp) call sublimate_ice(this,current,h2subl_co2ice,0._dp,new_lag,zlag)

            ! Is there dust to lift?
            h2lift = 0._dp
            if (is_dust_lag(current) .and. h2lift_tot > 0._dp) then
                h2lift = min(h2lift_tot,current%h_dust)
                h2lift_tot = h2lift_tot - h2lift
                ! Dust lifting
                if (h2lift > 0._dp) call lift_dust(this,current,h2lift)
            else if (associated(current%up)) then
                if (is_dust_lag(current%up) .and. h2lift_tot > 0.) then
                    h2lift = min(h2lift_tot,current%up%h_dust)
                    h2lift_tot = h2lift_tot - h2lift
                    ! Dust lifting
                    if (h2lift > 0.) call lift_dust(this,current%up,h2lift)
                end if
            end if

            ! Still ice to be sublimated or dust to be lifted and no more ice in the current stratum so we move to the underlying stratum
            if ((h2subl_co2ice_tot > 0._dp .or. h2lift_tot > 0._dp) .and. current%h_co2ice < tol) then
                current => current%down
                new_lag = .true.
            else
                exit
            end if
        end do
        if (h2subl_co2ice_tot > 0._dp) dh_co2ice = 0._dp ! No CO2 ice available anymore so the tendency is set to 0
        if (h2lift_tot > 0._dp) dh_dust = 0._dp ! No dust available anymore so the tendency is set to 0
    end if
!~~~~~~~~~~
! NOT EXPECTED SITUATION
else
    unexpected = .true.
end if

if (unexpected) then
    call print_msg('    dh_co2ice [m/y] = '//real2str(dh_co2ice),LVL_ERR)
    call print_msg('    dh_h2oice [m/y] = '//real2str(dh_h2oice),LVL_ERR)
    call print_msg('    dh_dust   [m/y] = '//real2str(dh_dust),LVL_ERR)
    call stop_clean(__FILE__,__LINE__,'situation for the layering construction not managed!',1)
end if

zshift_surf = this%top%top_elevation - zshift_surf

END SUBROUTINE evolve_layering
!=======================================================================

END MODULE layered_deposits