ice_validity_reduce_impl Subroutine

private pure subroutine ice_validity_reduce_impl(mca_ice, mca_snow, nghost, nx_phys, ny_phys, ncat, nx, ny, ok)

ok = .false. when min(mca_ice) < 0, min(mca_snow) < 0, or an “orphan snow” cell exists (mca_snow > 0 where mca_ice <= 0 by more than H_NEGLECT_ICE_TRANSPORT) — SIS2 FATALs on any of these; ported as a post-pass reduction (GPU-safe fail-loud, D7) rather than an in-loop abort. Physical cells only.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: mca_ice(nx,ny,ncat)
real(kind=wp), intent(in) :: mca_snow(nx,ny,ncat)
integer, intent(in) :: nghost
integer, intent(in) :: nx_phys
integer, intent(in) :: ny_phys
integer, intent(in) :: ncat
integer, intent(in) :: nx
integer, intent(in) :: ny
logical, intent(out) :: ok

Calls

proc~~ice_validity_reduce_impl~~CallsGraph proc~ice_validity_reduce_impl ice_validity_reduce_impl reduce reduce proc~ice_validity_reduce_impl->reduce

Called by

proc~~ice_validity_reduce_impl~~CalledByGraph proc~ice_validity_reduce_impl ice_validity_reduce_impl proc~ice_pass_x ice_pass_x proc~ice_pass_x->proc~ice_validity_reduce_impl proc~ice_pass_y ice_pass_y proc~ice_pass_y->proc~ice_validity_reduce_impl proc~ice_transport_step ice_transport_step proc~ice_transport_step->proc~ice_pass_x proc~ice_transport_step->proc~ice_pass_y 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
integer, private :: c
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 :: max_orphan
real(kind=wp), private :: min_ice
real(kind=wp), private :: min_snow

Source Code

   pure subroutine ice_validity_reduce_impl(mca_ice, mca_snow, nghost, nx_phys, ny_phys, &
                                            ncat, nx, ny, ok)
      !! `ok = .false.` when `min(mca_ice) < 0`, `min(mca_snow) < 0`, or
      !! an "orphan snow" cell exists (`mca_snow > 0` where `mca_ice <= 0`
      !! by more than `H_NEGLECT_ICE_TRANSPORT`) — SIS2 FATALs on any of
      !! these; ported as a post-pass reduction (GPU-safe fail-loud, D7)
      !! rather than an in-loop abort.  Physical cells only.
      integer, intent(in) :: nghost, nx_phys, ny_phys, ncat, nx, ny
      real(wp), intent(in) :: mca_ice(nx, ny, ncat)
      real(wp), intent(in) :: mca_snow(nx, ny, ncat)
      logical, intent(out) :: ok
      integer :: i, j, c, i_lo, i_hi, j_lo, j_hi
      real(wp) :: min_ice, min_snow, max_orphan

      i_lo = nghost + 1
      i_hi = nghost + nx_phys
      j_lo = nghost + 1
      j_hi = nghost + ny_phys

      min_ice = 0.0_wp
      min_snow = 0.0_wp
      max_orphan = 0.0_wp
      do concurrent(c=1:ncat, j=j_lo:j_hi, i=i_lo:i_hi) reduce(min:min_ice, min_snow)
         min_ice = min(min_ice, mca_ice(i, j, c))
         min_snow = min(min_snow, mca_snow(i, j, c))
      end do
      do concurrent(c=1:ncat, j=j_lo:j_hi, i=i_lo:i_hi) reduce(max:max_orphan)
         if (mca_ice(i, j, c) <= 0.0_wp) then
            max_orphan = max(max_orphan, mca_snow(i, j, c))
         end if
      end do

      ok = (min_ice >= 0.0_wp) .and. (min_snow >= 0.0_wp) &
           .and. (max_orphan <= H_NEGLECT_ICE_TRANSPORT)
   end subroutine ice_validity_reduce_impl