ice_rebalance_layers Subroutine

public pure subroutine ice_rebalance_layers(nk, m_lay, enthalpy, salin, mtot_ice)

Equal-mass repartition of ice layers 1..nk, mass-weighting enthalpy and salinity (SIS2_ice_thm.F90:1448-1512; prototype sis2_resize.py:114-161). The snow slot (m_lay(0), enthalpy(0)) is untouched. mtot_ice = sum(m_lay(1:nk)) is returned; mtot_ice == 0 is an early exit leaving the ice layers untouched (there is no ice to rebalance). The k1/k2 two-pointer drain loop follows the SIS2/prototype branch order exactly, including the (m_ice_avg - mlay_new(k2) > src_m(k1)) .or. (k2 == nk) test.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nk

Number of ice layers (declared first — decl-order).
real(kind=wp), intent(inout) :: m_lay(0:nk)

Layer masses (kg/m²), 0 = snow (untouched), 1..nk = ice.
real(kind=wp), intent(inout) :: enthalpy(0:nk)

Layer specific enthalpies (J/kg).
real(kind=wp), intent(inout) :: salin(0:nk)

Layer bulk salinities (PSU).
real(kind=wp), intent(out) :: mtot_ice

Summed ice mass (kg/m²), sum(m_lay(1:nk)) on entry.

Called by

proc~~ice_rebalance_layers~~CalledByGraph proc~ice_rebalance_layers ice_rebalance_layers proc~ice_column_step ice_column_step proc~ice_column_step->proc~ice_rebalance_layers proc~ice_frazil_uptake_column ice_frazil_uptake_column proc~ice_frazil_uptake_column->proc~ice_rebalance_layers proc~ice_frazil_uptake_impl ice_frazil_uptake_impl proc~ice_frazil_uptake_impl->proc~ice_frazil_uptake_column proc~ice_frazil_uptake_multicat_impl ice_frazil_uptake_multicat_impl proc~ice_frazil_uptake_multicat_impl->proc~ice_frazil_uptake_column proc~ice_thermo_columns ice_thermo_columns proc~ice_thermo_columns->proc~ice_column_step proc~ice_frazil_uptake ice_frazil_uptake proc~ice_frazil_uptake->proc~ice_frazil_uptake_impl proc~ice_frazil_uptake->proc~ice_frazil_uptake_multicat_impl proc~ice_thermo_driver_step ice_thermo_driver_step proc~ice_thermo_driver_step->proc~ice_thermo_columns proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_frazil_uptake proc~engine_step_ice->proc~ice_thermo_driver_step proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step_ice proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step_ice

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: enth_ice_new(ICE_NK_MAX)
integer, private :: k
integer, private :: k1
integer, private :: k2
real(kind=wp), private :: m_ice_avg
real(kind=wp), private :: m_transfer
real(kind=wp), private :: mlay_new(ICE_NK_MAX)
real(kind=wp), private :: sal_ice_new(ICE_NK_MAX)
real(kind=wp), private :: src_m(ICE_NK_MAX)

Source Code

   pure subroutine ice_rebalance_layers(nk, m_lay, enthalpy, salin, mtot_ice)
      !! Equal-mass repartition of ice layers 1..nk, mass-weighting
      !! enthalpy and salinity (SIS2_ice_thm.F90:1448-1512; prototype
      !! sis2_resize.py:114-161). The snow slot (`m_lay(0)`,
      !! `enthalpy(0)`) is untouched. `mtot_ice = sum(m_lay(1:nk))` is
      !! returned; `mtot_ice == 0` is an early exit leaving the ice
      !! layers untouched (there is no ice to rebalance). The k1/k2
      !! two-pointer drain loop follows the SIS2/prototype branch
      !! order exactly, including the
      !! `(m_ice_avg - mlay_new(k2) > src_m(k1)) .or. (k2 == nk)` test.
      !$acc routine seq
      integer, intent(in) :: nk
         !! Number of ice layers (declared first — decl-order).
      real(wp), intent(inout) :: m_lay(0:nk)
         !! Layer masses (kg/m²), 0 = snow (untouched), 1..nk = ice.
      real(wp), intent(inout) :: enthalpy(0:nk)
         !! Layer specific enthalpies (J/kg).
      real(wp), intent(inout) :: salin(0:nk)
         !! Layer bulk salinities (PSU).
      real(wp), intent(out) :: mtot_ice
         !! Summed ice mass (kg/m²), `sum(m_lay(1:nk))` on entry.

      real(wp) :: mlay_new(ICE_NK_MAX), enth_ice_new(ICE_NK_MAX), sal_ice_new(ICE_NK_MAX)
      real(wp) :: src_m(ICE_NK_MAX)
      real(wp) :: m_ice_avg, m_transfer
      integer :: k1, k2, k

      mtot_ice = 0.0_wp
      do k = 1, nk
         mtot_ice = mtot_ice + m_lay(k)
      end do
      if (mtot_ice == 0.0_wp) return

      do k = 1, nk
         mlay_new(k) = 0.0_wp
         enth_ice_new(k) = 0.0_wp
         sal_ice_new(k) = 0.0_wp
         src_m(k) = m_lay(k)
      end do
      m_ice_avg = mtot_ice/real(nk, wp)

      k1 = 1
      k2 = 1
      do
         if (mlay_new(k2) >= m_ice_avg .and. k2 < nk) then
            k2 = k2 + 1
         else if (src_m(k1) <= 0.0_wp) then
            k1 = k1 + 1
         else if ((m_ice_avg - mlay_new(k2) > src_m(k1)) .or. (k2 == nk)) then
            m_transfer = src_m(k1)
            enth_ice_new(k2) = enth_ice_new(k2) + m_transfer*enthalpy(k1)
            sal_ice_new(k2) = sal_ice_new(k2) + m_transfer*salin(k1)
            mlay_new(k2) = mlay_new(k2) + m_transfer
            src_m(k1) = 0.0_wp
            k1 = k1 + 1
         else
            m_transfer = m_ice_avg - mlay_new(k2)
            enth_ice_new(k2) = enth_ice_new(k2) + m_transfer*enthalpy(k1)
            sal_ice_new(k2) = sal_ice_new(k2) + m_transfer*salin(k1)
            mlay_new(k2) = m_ice_avg
            src_m(k1) = src_m(k1) - m_transfer
            k2 = k2 + 1
         end if
         if (k1 > nk) exit
      end do

      do k = 1, nk
         if (mlay_new(k) > 0.0_wp) then
            enthalpy(k) = enth_ice_new(k)/mlay_new(k)
            salin(k) = sal_ice_new(k)/mlay_new(k)
         end if
         m_lay(k) = mlay_new(k)
      end do
   end subroutine ice_rebalance_layers