ice_transport_step Subroutine

   subroutine ice_transport_step(grid, metrics, ms, ice, dt, adv_substeps, roll_factor, ok, bc)
      !! Entry point (host orchestration; kernels inside).  Outer-shim +
      !! flat-impl: every phase below dispatches to a `pure` `_impl`
      !! kernel; this routine only sequences them and owns the
      !! host-visible `ok` fail-loud signal.
      type(hgrid_t), intent(in) :: grid
      type(ocean_metrics_t), intent(in) :: metrics
      type(multilayer_state_t), intent(in) :: ms
         !! READ-ONLY: `wet_mask` (physical-cell gate) + the surface-layer
         !! face velocities the v1 sampler reads.
      type(ocean_sea_ice_t), intent(inout) :: ice
      real(wp), intent(in) :: dt
         !! The thermo-step dt (cadence = the ice slow step).
      integer, intent(in) :: adv_substeps
         !! SIS2 `NSTEPS_ADV` (`&ocean_ice_nml adv_substeps`), >= 1.
      real(wp), intent(in) :: roll_factor
         !! SIS2 `SEA_ICE_ROLL_FACTOR` (`&ocean_ice_nml roll_factor`).
         !! 0 disables rolling.
      logical, intent(out) :: ok
         !! `.false.` => the caller (driver) must abort fail-loud
         !! (conservation/positivity violation, or a compress-time
         !! consistency failure SIS2 would FATAL on).  Rank-uniform.
      type(ocean_bc_state_t), intent(in), optional :: bc
         !! Edge policy (`periodic_x/_y`, `has_*`).  Present (the engine
         !! always passes it): X4 per substep and walls only on a physical,
         !! non-periodic edge.  Absent (the single-tile unit-test seam):
         !! no exchange and every tile edge is a wall, as before.

      integer :: nx, ny, nz, nghost, n
      real(wp) :: dt_adv, vmax, vglob
      logical :: wall_w, wall_e, wall_s, wall_n, x4

      ok = .true.
      if (.not. ice%is_init) return
      if (ice%ncat == 1) return

      nx = grid%nx_total
      ny = grid%ny_total
      nz = ms%nz_ml
      nghost = grid%nghost
      wall_w = .true.
      wall_e = .true.
      wall_s = .true.
      wall_n = .true.
      x4 = .false.
      if (present(bc)) then
         wall_w = bc%has_west .and. .not. bc%periodic_x
         wall_e = bc%has_east .and. .not. bc%periodic_x
         wall_s = bc%has_south .and. .not. bc%periodic_y
         ! A tripolar north edge is topologically connected (folded), not
         ! a solid boundary -- `bc%north_fold` is the fold-seam twin of
         ! `periodic_y` here, and must be excluded from the wall test the
         ! same way.  Missing this made `vhtot_work` at the exact
         ! fold-line face (`nghost+ny_phys+1`) get force-zeroed every
         ! substep regardless of the (now fold-exchanged) ghost data, so
         ! category transport could never cross the seam at all: any
         ! poleward convergence simply piled up against this phantom wall
         ! with no outlet, which is the dominant mechanism behind the
         ! fold-row ice growing without bound (CLAUDE.md fold-seam fix).
         wall_n = bc%has_north .and. .not. bc%periodic_y .and. .not. bc%north_fold
         x4 = ocean_halo_is_init()
      end if

      ! ---- Phase 0: sample the ocean surface-layer velocity onto the
      ! ice C-grid faces (v1 interim filler).  PR 5: skipped when EVP
      ! dynamics is on — ice_evp_step (driver, runs BEFORE this call)
      ! already wrote u_ice/v_ice directly; the sampler would clobber
      ! them with the ocean surface velocity. ----
      if (.not. ice%dynamics) then
         call ice_sample_velocity_impl(ms%u_face_x_layer(:, :, nz), ms%v_face_y_layer(:, :, nz), &
                                       metrics%wet_u, metrics%wet_v, ice%u_ice, ice%v_ice, nx, ny)
      end if

      ! ---- Zero-velocity exact no-op (D6): the CAS<->IST round trip
      ! re-derives part_size by division and would otherwise perturb
      ! last bits even under zero flow. ----
      call ice_max_speed_impl(ice%u_ice, ice%v_ice, nghost, grid%nx_phys, grid%ny_phys, &
                              nx, ny, vmax)
      ! Rank-uniform: a rank that skips the round trip while another
      ! enters the substep exchanges deadlocks.  A max is exact.
      if (ocean_halo_is_decomposed()) then
         call halo_allreduce_max(vmax, vglob)
         vmax = vglob
      end if
      if (vmax == 0.0_wp) return

      ! ---- Phase 1: IST -> CAS ----
      call ice_ist_to_cas_impl(ms%wet_mask, ice%part_size, ice%m_ice, ice%m_snow, &
                               ice%mca_ice, ice%mca_snow, nghost, ice%ncat, nx, ny)

      ! ---- Phase 2: adv_substeps advective iterations, x-pass then y-pass ----
      dt_adv = dt/real(max(adv_substeps, 1), wp)
      do n = 1, adv_substeps
         ! X4: seam ghosts of the CAS masses + riding tracers (and, on one
         ! periodic rank, the wrap) before this substep's stencils read them.
         if (x4) call ocean_halo_exchange_ice_transport(ice, grid, bc)
         call ice_pass_x(grid, metrics, ice, dt_adv, wall_w, wall_e, ok)
         call ok_all_ranks(ok)
         if (.not. ok) return
         call ice_pass_y(grid, metrics, ice, dt_adv, wall_s, wall_n, ok)
         call ok_all_ranks(ok)
         if (.not. ok) return
      end do

      ! ---- Phase 3: CAS -> IST ----
      call ice_cas_to_ist_impl(ms%wet_mask, metrics%areaT, ice%mca_ice, ice%mca_snow, &
                               ice%part_size, ice%m_ice, ice%m_snow, ice%mh_lim, roll_factor, &
                               nghost, ice%ncat, nx, ny)

      ! ---- Phase 4: compress_ice ----
      call ice_compress_impl(ms%wet_mask, ice%part_size, ice%m_ice, ice%m_snow, &
                             ice%enth_ice, ice%enth_snow, ice%sal_ice, ice%mh_lim, &
                             nghost, ice%ncat, ice%nk_ice, nx, ny, ok)
      call ok_all_ranks(ok)
      if (.not. ok) return

      ! ---- Phase 5: recategorize (PR 4a, unchanged) ----
      call ice_adjust_categories(grid, ms, ice)
   end subroutine ice_transport_step