subroutine compute_ice_totals(wet_T, areaT, part_size, m_ice, ncat, nghost, &
wet_area, ci_area, hi_area)
!! Σ wet_T·areaT, Σ ci·areaT and Σ (mice/ICE_RHO_ICE)·areaT over
!! PHYSICAL cells (ghosts excluded) — ci/mice from the two-mode
!! per-cell gather (`ice_cell_concentration_impl` convention,
!! inlined; `test_ocean_ice_diags` pins the fills' copy of the same
!! math). One pass, three `reduction(+:)` accumulators.
real(wp), intent(in) :: wet_T(:, :), areaT(:, :)
real(wp), intent(in) :: part_size(:, :, 0:)
real(wp), intent(in) :: m_ice(:, :, :)
integer, intent(in) :: ncat, nghost
real(wp), intent(out) :: wet_area, ci_area, hi_area
real(wp) :: acc_w, acc_c, acc_h, ci, mice
integer :: i, j, c, nx, ny, i_lo, i_hi, j_lo, j_hi
nx = min(size(wet_T, 1), size(areaT, 1), size(m_ice, 1))
ny = min(size(wet_T, 2), size(areaT, 2), size(m_ice, 2))
i_lo = nghost + 1
i_hi = nx - nghost
j_lo = nghost + 1
j_hi = ny - nghost
acc_w = 0.0_wp
acc_c = 0.0_wp
acc_h = 0.0_wp
if (ncat == 1) then
!$acc parallel loop collapse(2) reduction(+:acc_w, acc_c, acc_h) &
!$acc& private(ci, mice) present(wet_T, areaT, m_ice)
do j = j_lo, j_hi
do i = i_lo, i_hi
acc_w = acc_w + wet_T(i, j)*areaT(i, j)
if (wet_T(i, j) > 0.5_wp .and. m_ice(i, j, 1) > 0.0_wp) then
mice = m_ice(i, j, 1)
ci = 1.0_wp
acc_c = acc_c + ci*areaT(i, j)
acc_h = acc_h + (mice/ICE_RHO_ICE)*areaT(i, j)
end if
end do
end do
else
!$acc parallel loop collapse(2) reduction(+:acc_w, acc_c, acc_h) &
!$acc& private(ci, mice, c) present(wet_T, areaT, part_size, m_ice)
do j = j_lo, j_hi
do i = i_lo, i_hi
acc_w = acc_w + wet_T(i, j)*areaT(i, j)
if (wet_T(i, j) > 0.5_wp) then
mice = 0.0_wp
ci = 0.0_wp
do c = 1, ncat
mice = mice + part_size(i, j, c)*m_ice(i, j, c)
ci = ci + part_size(i, j, c)
end do
ci = min(1.0_wp, ci)
acc_c = acc_c + ci*areaT(i, j)
acc_h = acc_h + (mice/ICE_RHO_ICE)*areaT(i, j)
end if
end do
end do
end if
wet_area = acc_w
ci_area = acc_c
hi_area = acc_h
end subroutine compute_ice_totals