ice_compress_impl Subroutine

private pure subroutine ice_compress_impl(wet_mask, part_size, m_ice, m_snow, enth_ice, enth_snow, sal_ice, mh_lim, nghost, ncat, nk, nx, ny, ok)

Outer per-cell dispatch: ONE do concurrent(j,i) over physical cells (ghosts excluded), wet_mask > 0.5 inner gate, serial in category within the cell (same shape as ice_adjust_categories_impl). The per-cell algebra is the SAME algorithm ice_transport_compress_cell implements (public, directly unit-testable on small standalone arrays — SPEC §7 test 3’s single-cell hand-check) — but this production kernel does NOT call it with a derived slice: part_size(i,j,:) etc. are NON-CONTIGUOUS sections (the category axis is not the fastest dimension), which a device !$acc routine seq call cannot take safely (would force a compiler temporary — the array-of- derived-type/strided-slice indirection trap, CLAUDE.md memory). Instead the algorithm is INLINED here operating on (i,j,c) triples directly, mirroring ice_adjust_categories_impl’s established pattern. ok is a per-cell-then-reduced flag (D7: SIS2 FATALs on the top-category overflow inconsistency; ported as a !$acc parallel loop reduction instead, since do concurrent cannot itself carry a boolean/min reduction in the house style — CLAUDE.md “Reductions use !$acc parallel loop reduction(...)”).

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: wet_mask(nx,ny)
real(kind=wp), intent(inout) :: part_size(nx,ny,0:ncat)
real(kind=wp), intent(inout) :: m_ice(nx,ny,ncat)
real(kind=wp), intent(inout) :: m_snow(nx,ny,ncat)
real(kind=wp), intent(inout) :: enth_ice(nx,ny,ncat,nk)
real(kind=wp), intent(inout) :: enth_snow(nx,ny,ncat,1)
real(kind=wp), intent(inout) :: sal_ice(nx,ny,ncat,nk)
real(kind=wp), intent(in) :: mh_lim(ncat+1)
integer, intent(in) :: nghost
integer, intent(in) :: ncat
integer, intent(in) :: nk
integer, intent(in) :: nx
integer, intent(in) :: ny
logical, intent(out) :: ok

Calls

proc~~ice_compress_impl~~CallsGraph proc~ice_compress_impl ice_compress_impl local local proc~ice_compress_impl->local proc~ice_compress_cell_inline ice_compress_cell_inline proc~ice_compress_impl->proc~ice_compress_cell_inline reduce reduce proc~ice_compress_impl->reduce

Called by

proc~~ice_compress_impl~~CalledByGraph proc~ice_compress_impl ice_compress_impl proc~ice_transport_step ice_transport_step proc~ice_transport_step->proc~ice_compress_impl proc~engine_step_ice engine_step_ice proc~engine_step_ice->proc~ice_transport_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
logical, private :: cell_ok
integer, private :: i
integer, private :: i_hi
integer, private :: i_lo
integer, private :: j
integer, private :: j_hi
integer, private :: j_lo
real(kind=wp), private :: ok_acc

Source Code

   pure subroutine ice_compress_impl(wet_mask, part_size, m_ice, m_snow, enth_ice, enth_snow, &
                                     sal_ice, mh_lim, nghost, ncat, nk, nx, ny, ok)
      !! Outer per-cell dispatch: ONE `do concurrent(j,i)` over physical
      !! cells (ghosts excluded), `wet_mask > 0.5` inner gate, serial in
      !! category within the cell (same shape as
      !! `ice_adjust_categories_impl`).  The per-cell algebra is the SAME
      !! algorithm `ice_transport_compress_cell` implements (public,
      !! directly unit-testable on small standalone arrays — SPEC §7 test
      !! 3's single-cell hand-check) — but this production kernel does
      !! NOT call it with a derived slice: `part_size(i,j,:)` etc. are
      !! NON-CONTIGUOUS sections (the category axis is not the fastest
      !! dimension), which a device `!$acc routine seq` call cannot take
      !! safely (would force a compiler temporary — the array-of-
      !! derived-type/strided-slice indirection trap, CLAUDE.md memory).
      !! Instead the algorithm is INLINED here operating on `(i,j,c)`
      !! triples directly, mirroring `ice_adjust_categories_impl`'s
      !! established pattern.  `ok` is a per-cell-then-reduced flag
      !! (D7: SIS2 FATALs on the top-category overflow inconsistency;
      !! ported as a `!$acc parallel loop reduction` instead, since
      !! `do concurrent` cannot itself carry a boolean/min reduction in
      !! the house style — CLAUDE.md "Reductions use `!$acc parallel loop
      !! reduction(...)`").
      integer, intent(in) :: nghost, ncat, nk, nx, ny
      real(wp), intent(in) :: wet_mask(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)
      real(wp), intent(inout) :: enth_snow(nx, ny, ncat, 1)
      real(wp), intent(inout) :: sal_ice(nx, ny, ncat, nk)
      real(wp), intent(in) :: mh_lim(ncat + 1)
      logical, intent(out) :: ok
      integer :: i, j, i_lo, i_hi, j_lo, j_hi
      real(wp) :: ok_acc
      logical :: cell_ok

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

      ok_acc = 1.0_wp
      do concurrent(j=j_lo:j_hi, i=i_lo:i_hi) local(cell_ok) reduce(min:ok_acc)
         if (wet_mask(i, j) > 0.5_wp) then
            call ice_compress_cell_inline(part_size, m_ice, m_snow, enth_ice, &
                                          enth_snow, sal_ice, mh_lim, i, j, ncat, &
                                          nk, nx, ny, cell_ok)
            if (.not. cell_ok) ok_acc = min(ok_acc, 0.0_wp)
         end if
      end do
      ok = (ok_acc > 0.5_wp)
   end subroutine ice_compress_impl