ice_snow_part_ocn_fill_impl Subroutine

private pure subroutine ice_snow_part_ocn_fill_impl(wet_mask, part_size, m_ice, snow_part_ocn, nghost, ncat, nx, ny)

PR 26: fill snow_part_ocn(i,j) — the ice-FREE share of the cell that a uniform snowfall lands on with no ice underneath — under the SAME PRE-column-snapshot contract as ice_fb_part_sum_fill_ impl (module docstring, this module docstring’s PR-26 paragraph): MUST run BEFORE ice_thermo_columns mutates m_ice, using the column’s OWN entry gate (m_ice(i,j,c) > ICE_RHO_ICE*H_VANISHED).

Two-mode dispatch (rdb_ice_state’s per-CELL vs per-ICE-AREA convention, load-bearing): at ncat==1 (legacy lumped, part_size never maintained) the ice-free share is BINARY — 0 if the cell’s one category has ice, 1 if it does not (ice_cell_concentration_ impl’s own ci = 1 iff m_ice(1) > 0 convention, mirrored here). At ncat>1 (SIS2 ITD, part_size live) it is 1 - Σ_{c : gate passes} part_size(c), clamped at 0 (categories that fail the gate but still carry part_size>0 — SIS2’s orphan-snow trap, PLAN_PR26_snowfall.md §11.1 — count toward the ocean share, never toward the column). The ncat branch is loop-invariant (same for every cell this call) so it stays INSIDE the one do concurrent (dc-uniform-case — splitting it would double the launch count for no benefit).

Decl-order: all integer dims declared before the explicit-shape arrays that use them. Inner if/serial do cat — never a masked do concurrent header.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: wet_mask(nx,ny)
real(kind=wp), intent(in) :: part_size(nx,ny,0:ncat)
real(kind=wp), intent(in) :: m_ice(nx,ny,ncat)
real(kind=wp), intent(inout) :: snow_part_ocn(nx,ny)
integer, intent(in) :: nghost
integer, intent(in) :: ncat
integer, intent(in) :: nx
integer, intent(in) :: ny

Calls

proc~~ice_snow_part_ocn_fill_impl~~CallsGraph proc~ice_snow_part_ocn_fill_impl ice_snow_part_ocn_fill_impl local local proc~ice_snow_part_ocn_fill_impl->local

Called by

proc~~ice_snow_part_ocn_fill_impl~~CalledByGraph proc~ice_snow_part_ocn_fill_impl ice_snow_part_ocn_fill_impl proc~ice_thermo_driver_step ice_thermo_driver_step proc~ice_thermo_driver_step->proc~ice_snow_part_ocn_fill_impl proc~engine_step_ice engine_step_ice 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 proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
integer, private :: cat
real(kind=wp), private :: cover
integer, private :: i
integer, private :: i_hi
integer, private :: i_lo
integer, private :: j
integer, private :: j_hi
integer, private :: j_lo

Source Code

   pure subroutine ice_snow_part_ocn_fill_impl(wet_mask, part_size, m_ice, snow_part_ocn, &
                                               nghost, ncat, nx, ny)
      !! PR 26: fill `snow_part_ocn(i,j)` — the ice-FREE share of the cell
      !! that a uniform snowfall lands on with no ice underneath — under
      !! the SAME PRE-column-snapshot contract as `ice_fb_part_sum_fill_
      !! impl` (module docstring, this module docstring's PR-26
      !! paragraph): MUST run BEFORE `ice_thermo_columns` mutates `m_ice`,
      !! using the column's OWN entry gate
      !! (`m_ice(i,j,c) > ICE_RHO_ICE*H_VANISHED`).
      !!
      !! Two-mode dispatch (`rdb_ice_state`'s per-CELL vs per-ICE-AREA
      !! convention, load-bearing): at `ncat==1` (legacy lumped, `part_size`
      !! never maintained) the ice-free share is BINARY — 0 if the cell's
      !! one category has ice, 1 if it does not (`ice_cell_concentration_
      !! impl`'s own `ci = 1 iff m_ice(1) > 0` convention, mirrored here).
      !! At `ncat>1` (SIS2 ITD, `part_size` live) it is `1 -
      !! Σ_{c : gate passes} part_size(c)`, clamped at 0 (categories that
      !! fail the gate but still carry `part_size>0` — SIS2's orphan-snow
      !! trap, PLAN_PR26_snowfall.md §11.1 — count toward the ocean share,
      !! never toward the column). The `ncat` branch is loop-invariant
      !! (same for every cell this call) so it stays INSIDE the one `do
      !! concurrent` (`dc-uniform-case` — splitting it would double the
      !! launch count for no benefit).
      !!
      !! Decl-order: all integer dims declared before the explicit-shape
      !! arrays that use them. Inner `if`/serial `do cat` — never a
      !! masked `do concurrent` header.
      integer, intent(in) :: nghost, ncat, nx, ny
      real(wp), intent(in) :: wet_mask(nx, ny)
      real(wp), intent(in) :: part_size(nx, ny, 0:ncat)
      real(wp), intent(in) :: m_ice(nx, ny, ncat)
      real(wp), intent(inout) :: snow_part_ocn(nx, ny)

      integer :: i, j, cat, i_lo, i_hi, j_lo, j_hi
      real(wp) :: cover

      i_lo = nghost + 1
      i_hi = nx - nghost
      j_lo = nghost + 1
      j_hi = ny - nghost

      do concurrent(j=j_lo:j_hi, i=i_lo:i_hi) local(cat, cover)
         snow_part_ocn(i, j) = 0.0_wp
         if (wet_mask(i, j) > 0.5_wp) then
            if (ncat == 1) then
               if (m_ice(i, j, 1) > ICE_RHO_ICE*H_VANISHED) then
                  snow_part_ocn(i, j) = 0.0_wp
               else
                  snow_part_ocn(i, j) = 1.0_wp
               end if
            else
               cover = 0.0_wp
               do cat = 1, ncat
                  if (m_ice(i, j, cat) > ICE_RHO_ICE*H_VANISHED) then
                     cover = cover + part_size(i, j, cat)
                  end if
               end do
               snow_part_ocn(i, j) = max(0.0_wp, 1.0_wp - cover)
            end if
         end if
      end do
   end subroutine ice_snow_part_ocn_fill_impl