pure subroutine ice_init_apply_impl(wet_mask, geolatT, part_size, m_ice, m_snow, &
enth_ice, enth_snow, sal_ice, mh_lim, &
conc_config, conc_uniform, h_ice, h_snow, &
t_ice, s_ice, arctic_edge, antarctic_edge, &
ncat, nk_ice, nx, ny)
!! Per-cell seeder. Decl-order: integer dims before the
!! explicit-shape arrays that use them.
integer, intent(in) :: ncat, nk_ice, nx, ny
real(wp), intent(in) :: wet_mask(nx, ny)
real(wp), intent(in) :: geolatT(nx, ny)
real(wp), intent(inout) :: part_size(nx, ny, 0:ncat)
real(wp), intent(inout) :: m_ice(nx, ny, ncat)
real(wp), intent(inout) :: m_snow(nx, ny, ncat)
real(wp), intent(inout) :: enth_ice(nx, ny, ncat, nk_ice)
real(wp), intent(inout) :: enth_snow(nx, ny, ncat, 1)
real(wp), intent(inout) :: sal_ice(nx, ny, ncat, nk_ice)
real(wp), intent(in) :: mh_lim(ncat + 1)
integer, intent(in) :: conc_config
real(wp), intent(in) :: conc_uniform, h_ice, h_snow, t_ice, s_ice
real(wp), intent(in) :: arctic_edge, antarctic_edge
integer :: i, j, c_star
real(wp) :: conc, m_target, enth_i, enth_s
! Precompute once: t_ice/s_ice are uniform scalars, so the mapped
! enthalpy is the same at every seeded cell/category/layer
! (k-symmetric, see module docstring).
m_target = ICE_RHO_ICE*h_ice
enth_i = ice_enth_from_ts(t_ice, s_ice)
enth_s = ice_enth_from_ts(t_ice, 0.0_wp)
! Seed the FULL array, ghosts included (CLAUDE.md "formula
! bathymetry setters must fill ghost rows" gotcha wearing a
! different hat): ice_transport_step and the EVP periodic wrap both
! read neighbour ghost cells, so an unseeded ghost band would bleed
! the pack out at the domain edge / be flatly wrong under EVP
! periodicity.
do j = 1, ny
do i = 1, nx
if (wet_mask(i, j) <= 0.5_wp) cycle
! Land: leave the `init`-time defaults
! (part_size(:,:,0)=1, m_ice=m_snow=0) untouched.
select case (conc_config)
case (ICE_IC_CONC_UNIFORM)
conc = conc_uniform
case (ICE_IC_CONC_LATITUDES)
if (geolatT(i, j) > arctic_edge .or. geolatT(i, j) < antarctic_edge) then
conc = 1.0_wp
else
conc = 0.0_wp
end if
case default
! Unreachable: `ice_init_apply` already gated ZERO, and
! `validate_config` V8 rejects every other integer.
conc = 0.0_wp
end select
if (conc <= 0.0_wp) cycle
! Open water: leave the `init`-time defaults untouched.
if (ncat == 1) then
! Legacy lumped mode (module docstring, `rdb_ice_state`):
! `part_size` is NEVER maintained here; `m_ice`/`m_snow`
! are per-CELL area.
m_ice(i, j, 1) = m_target
m_snow(i, j, 1) = ICE_RHO_SNOW*h_snow
sal_ice(i, j, 1, :) = s_ice
enth_ice(i, j, 1, :) = enth_i
enth_snow(i, j, 1, 1) = enth_s
else
! SIS2 ITD mode: `part_size` is LIVE, `m_ice`/`m_snow` are
! per unit ICE-COVERED area (NOT x conc — see module
! docstring). Bin against the ALREADY-COMPUTED `mh_lim`
! (never a re-derivation) so the seeded state is an exact
! fixed point of `ice_adjust_categories`.
c_star = ice_ic_target_category(m_target, mh_lim, ncat)
part_size(i, j, 0) = 1.0_wp - conc
part_size(i, j, c_star) = conc
m_ice(i, j, c_star) = m_target
m_snow(i, j, c_star) = ICE_RHO_SNOW*h_snow
sal_ice(i, j, c_star, :) = s_ice
enth_ice(i, j, c_star, :) = enth_i
enth_snow(i, j, c_star, 1) = enth_s
end if
end do
end do
end subroutine ice_init_apply_impl