evp_truncate_final_impl Subroutine

   pure subroutine evp_truncate_final_impl(areaT, dy_cu, dx_cv, mi_u, mi_v, ui, vi, &
                                           cfl_trunc, dt_tr, m_neglect, nghost, nx_phys, &
                                           ny_phys, nx, ny, n_trunc, count_w, count_s)
      !! PR 36: the FINAL CFL clip (SIS2 `:1443-1500`) -- `TRUNC_BACKOFF`
      !! (0.95) back-off instead of the exact bound, PLUS a count of the
      !! ice-bearing faces it touched (`mi > m_neglect`, SIS2 `:1466,1469`
      !! -- massless faces clip silently, matching SIS2: counting them
      !! would flood the driver's warning with meaningless ice-free clips
      !! at every margin). Not a `do concurrent`: reductions use
      !! `!$acc parallel loop reduction(...)` (`ice_compress_impl` is the
      !! local precedent for a reduction that also mutates the arrays it
      !! walks). Same bound algebra as `evp_truncate_velocity_impl`,
      !! duplicated rather than shared: the in-loop variant runs
      !! `evp_sub_steps` (432 by default) times per outer step and must
      !! NOT carry a reduction (each would be a device->host sync); this
      !! variant runs once and must. `CLAUDE.md`'s "duplicate explicitly"
      !! rule -- merging the two costs 432 syncs per outer step.
      integer, intent(in) :: nghost, nx_phys, ny_phys, nx, ny
      real(wp), intent(in) :: areaT(nx, ny)
      real(wp), intent(in) :: dy_cu(nx + 1, ny), dx_cv(nx, ny + 1)
      real(wp), intent(in) :: mi_u(nx + 1, ny), mi_v(nx, ny + 1)
      real(wp), intent(inout) :: ui(nx + 1, ny), vi(nx, ny + 1)
      real(wp), intent(in) :: cfl_trunc, dt_tr, m_neglect
      integer, intent(out) :: n_trunc
      logical, intent(in), optional :: count_w, count_s
         !! Count the WEST (`i = nghost+1`) / SOUTH (`j = nghost+1`) edge
         !! face.  That face is clipped either way; it is COUNTED only when
         !! this tile owns it — a physical, non-periodic edge.  Across an
         !! MPI seam the west/south neighbour owns it (D1), and across a
         !! periodic seam it is the same face as the east/north edge face,
         !! so counting it there would count one face twice in the
         !! rank-summed total.  Absent => `.true.` (count every face).
      integer :: i, j, i_lo, i_hi, j_lo, j_hi, i_cnt, j_cnt
      real(wp) :: u_hi, u_lo, v_hi, v_lo, loc_scale
      integer :: n_acc

      n_acc = 0
      ! First counted edge face: nghost+1 when this tile owns it, else +1.
      i_cnt = nghost + 1
      if (present(count_w)) then
         if (.not. count_w) i_cnt = nghost + 2
      end if
      j_cnt = nghost + 1
      if (present(count_s)) then
         if (.not. count_s) j_cnt = nghost + 2
      end if

      i_lo = nghost + 1
      i_hi = nghost + nx_phys + 1
      j_lo = nghost + 1
      j_hi = nghost + ny_phys
      do concurrent(j=j_lo:j_hi, i=i_lo:i_hi) local(u_hi, u_lo, loc_scale) reduce(+:n_acc)
         u_hi = 0.0_wp
         u_lo = 0.0_wp
         if (dy_cu(i, j) > 0.0_wp) then
            loc_scale = cfl_trunc/(dt_tr*dy_cu(i, j))
            u_hi = TRUNC_BACKOFF*loc_scale*areaT(i - 1, j)
            u_lo = -TRUNC_BACKOFF*loc_scale*areaT(i, j)
         end if
         if (ui(i, j) > u_hi .or. ui(i, j) < u_lo) then
            if (mi_u(i, j) > m_neglect .and. i >= i_cnt) n_acc = n_acc + 1
            ui(i, j) = merge(u_hi, u_lo, ui(i, j) > u_hi)
         end if
      end do

      i_lo = nghost + 1
      i_hi = nghost + nx_phys
      j_lo = nghost + 1
      j_hi = nghost + ny_phys + 1
      do concurrent(j=j_lo:j_hi, i=i_lo:i_hi) local(v_hi, v_lo, loc_scale) reduce(+:n_acc)
         v_hi = 0.0_wp
         v_lo = 0.0_wp
         if (dx_cv(i, j) > 0.0_wp) then
            loc_scale = cfl_trunc/(dt_tr*dx_cv(i, j))
            v_hi = TRUNC_BACKOFF*loc_scale*areaT(i, j - 1)
            v_lo = -TRUNC_BACKOFF*loc_scale*areaT(i, j)
         end if
         if (vi(i, j) > v_hi .or. vi(i, j) < v_lo) then
            if (mi_v(i, j) > m_neglect .and. j >= j_cnt) n_acc = n_acc + 1
            vi(i, j) = merge(v_hi, v_lo, vi(i, j) > v_hi)
         end if
      end do

      n_trunc = n_acc
   end subroutine evp_truncate_final_impl