check_h_positive_or_die Subroutine

private subroutine check_h_positive_or_die(grid, ms, label, stage, outer_step, check_layers)

&ocean_isopycnal_nml check_h_positive guard. Abort on the FIRST negative layer thickness, naming the pipeline stage that produced it, the offending (i,j,k), and that column’s full thickness profile.

Why this exists: a negative h surfaces much later and somewhere else — as a console-stats NaN, or as an hourly diagnostic minimum — by which point the producing kernel cannot be identified. Under conservative_floor it should not be reachable at all: continuity is handed h_min = 0, so its max(h - dt*div, h_min) clamps at zero, and the conservative borrow only redistributes WITHIN a column. A trip here therefore localises a real defect rather than a tuning problem.

Cheap on the healthy path: one device-side min-reduction, no H<-D copy. The host walk + column dump run only when already aborting.

Arguments

Type IntentOptional Attributes Name
type(hgrid_t), intent(in) :: grid
type(multilayer_state_t), intent(inout) :: ms
character(len=*), intent(in) :: label

Pipeline stage that last wrote h_layer (e.g. “after continuity”).

integer, intent(in) :: stage
integer, intent(in) :: outer_step
logical, intent(in) :: check_layers

.true. => also abort on a negative single LAYER. Pass .false. between the raw continuity update and the conservative borrow, where a transiently negative layer is legal; the column-total check runs unconditionally either way.


Called by

proc~~check_h_positive_or_die~~CalledByGraph proc~check_h_positive_or_die check_h_positive_or_die proc~ocean_dyn_step ocean_dyn_step proc~ocean_dyn_step->proc~check_h_positive_or_die proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~check_h_positive_or_die proc~run_gm_step run_gm_step proc~ocean_dyn_step_split->proc~run_gm_step proc~run_stage_split run_stage_split proc~ocean_dyn_step_split->proc~run_stage_split proc~run_continuity_chain run_continuity_chain proc~run_continuity_chain->proc~check_h_positive_or_die proc~run_gm_step->proc~check_h_positive_or_die proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step proc~engine_step->proc~ocean_dyn_step_split proc~run_stage_split->proc~run_continuity_chain proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~engine_step proc~rdb_ocean_step rdb_ocean_step proc~rdb_ocean_step->proc~engine_step proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: acc
real(kind=wp), private :: col_min
real(kind=wp), private :: col_sum
real(kind=wp), private :: h_min
integer, private :: i
integer, private :: i0
integer, private :: i1
integer, private :: ib
integer, private :: ig
integer, private :: j
integer, private :: j0
integer, private :: j1
integer, private :: jb
integer, private :: k
integer, private :: kb
real(kind=wp), private :: worst

Source Code

   subroutine check_h_positive_or_die(grid, ms, label, stage, outer_step, check_layers)
      !! `&ocean_isopycnal_nml check_h_positive` guard.  Abort on the FIRST
      !! negative layer thickness, naming the pipeline stage that produced it,
      !! the offending `(i,j,k)`, and that column's full thickness profile.
      !!
      !! Why this exists: a negative `h` surfaces much later and somewhere else
      !! — as a console-stats NaN, or as an hourly diagnostic minimum — by
      !! which point the producing kernel cannot be identified.  Under
      !! `conservative_floor` it should not be reachable at all: continuity is
      !! handed `h_min = 0`, so its `max(h - dt*div, h_min)` clamps at zero,
      !! and the conservative borrow only redistributes WITHIN a column.  A
      !! trip here therefore localises a real defect rather than a tuning
      !! problem.
      !!
      !! Cheap on the healthy path: one device-side min-reduction, no H<-D
      !! copy.  The host walk + column dump run only when already aborting.
      type(hgrid_t), intent(in) :: grid
      type(multilayer_state_t), intent(inout) :: ms
      character(len=*), intent(in) :: label
         !! Pipeline stage that last wrote `h_layer` (e.g. "after continuity").
      integer, intent(in) :: stage, outer_step
      logical, intent(in) :: check_layers
         !! `.true.` => also abort on a negative single LAYER.  Pass `.false.`
         !! between the raw continuity update and the conservative borrow,
         !! where a transiently negative layer is legal; the column-total
         !! check runs unconditionally either way.
      integer :: i, j, k, ig, i0, i1, j0, j1, ib, jb, kb
      real(wp) :: h_min, col_sum, col_min, worst, acc

      ig = grid%nghost
      i0 = ig + 1
      i1 = grid%nx_total - ig
      j0 = ig + 1
      j1 = grid%ny_total - ig

      ! Column TOTAL is the invariant that always holds.  A negative single
      ! LAYER is legal between the raw continuity update and the conservative
      ! borrow (see the call-site comment), but no column may ever reach a
      ! non-positive total — and if one does, `min_thickness_target_column`'s
      ! degenerate branch (`total <= nz*h_floor`) spreads that negative total
      ! uniformly over every layer, poisoning the whole column silently.
      ! Catching the total here names the stage that evacuated the column.
      col_min = huge(1.0_wp)
      !$acc parallel loop collapse(2) reduction(min:col_min) &
      !$acc   private(k, col_sum) present(ms%h_layer)
      do j = j0, j1
         do i = i0, i1
            col_sum = 0.0_wp
            do k = 1, ms%nz_ml
               col_sum = col_sum + ms%h_layer(i, j, k)
            end do
            col_min = min(col_min, col_sum)
         end do
      end do

      h_min = huge(1.0_wp)
      if (check_layers) then
         !$acc parallel loop collapse(3) reduction(min:h_min) present(ms%h_layer)
         do k = 1, ms%nz_ml
            do j = j0, j1
               do i = i0, i1
                  h_min = min(h_min, ms%h_layer(i, j, k))
               end do
            end do
         end do
      end if
      if (h_min >= 0.0_wp .and. col_min > 0.0_wp) return

      ! Abort path.  Pull the COMPONENT array, never the aggregate `ms` — an
      ! aggregate D->H copy overwrites the host allocatable descriptors with
      ! DEVICE addresses and the next host read segfaults.
      !$acc update self(ms%h_layer)

      ! Locate the worst column: if a column total went non-positive that is
      ! the primary failure, so report the most-negative TOTAL.  Otherwise
      ! report the column holding the most-negative single layer.
      ib = i0
      jb = j0
      worst = huge(1.0_wp)
      if (col_min <= 0.0_wp) then
         do j = j0, j1
            do i = i0, i1
               acc = 0.0_wp
               do k = 1, ms%nz_ml
                  acc = acc + ms%h_layer(i, j, k)
               end do
               if (acc < worst) then
                  worst = acc
                  ib = i
                  jb = j
               end if
            end do
         end do
      else
         do k = 1, ms%nz_ml
            do j = j0, j1
               do i = i0, i1
                  if (ms%h_layer(i, j, k) < worst) then
                     worst = ms%h_layer(i, j, k)
                     ib = i
                     jb = j
                  end if
               end do
            end do
         end do
      end if
      ! Thinnest layer within the reported column.
      kb = 1
      do k = 1, ms%nz_ml
         if (ms%h_layer(ib, jb, k) < ms%h_layer(ib, jb, kb)) kb = k
      end do

      write (output_unit, "(a)") repeat("=", 68)
      if (col_min <= 0.0_wp) then
         write (output_unit, '("[h-guard] NON-POSITIVE COLUMN TOTAL (column evacuated)")')
      else
         write (output_unit, '("[h-guard] NEGATIVE LAYER THICKNESS")')
      end if
      write (output_unit, '("[h-guard]   stage      : ", a)') trim(label)
      write (output_unit, '("[h-guard]   outer step : ", i0, "   rk2 stage : ", i0)') &
         outer_step, stage
      write (output_unit, '("[h-guard]   at (i,j,k) : ", i0, ", ", i0, ", ", i0, &
                          &"   (physical i0/j0 = ", i0, "/", i0, ")")') &
         ib, jb, kb, i0, j0
      write (output_unit, '("[h-guard]   thinnest k : ", i0, "   h = ", es13.5)') &
         kb, ms%h_layer(ib, jb, kb)
      write (output_unit, '("[h-guard]   min layer h over interior  : ", es13.5)') h_min
      write (output_unit, '("[h-guard]   min column total over interior : ", es13.5)') col_min
      col_sum = 0.0_wp
      do k = 1, ms%nz_ml
         col_sum = col_sum + ms%h_layer(ib, jb, k)
      end do
      write (output_unit, '("[h-guard]   column sum : ", es13.5)') col_sum
      write (output_unit, '("[h-guard]   column profile (k, h):")')
      do k = 1, ms%nz_ml
         write (output_unit, '("[h-guard]     ", i4, "  ", es14.6)') k, ms%h_layer(ib, jb, k)
      end do
      write (output_unit, "(a)") repeat("=", 68)
      flush (output_unit)
      error stop "h-guard: negative layer thickness (see [h-guard] block above)"
   end subroutine check_h_positive_or_die