ocean_remap_scan_preconditions Subroutine

public pure subroutine ocean_remap_scan_preconditions(nx, ny, nz, h_old, h_new, rel_tol, n_bad, worst_rel, worst_neg)

Scan every column for the two remap preconditions and report how badly they are missed — the domain-wide counterpart of rdb_remap_column :: remap_column_preconditions_ok.

pure and flat-arg so the caller owns the fail-loud decision and the reduction can run on-device; three scalars come back rather than a per-column field, so a thermo-cadence call costs one pass plus a tiny D→H. Public for the unit-test suite.

CALLER CONTRACT under -gpu=...,mem:separate: h_old and h_new must be device-present — the reduction declares them present rather than letting them copy in, so a caller that forgot the map ABORTS instead of silently scanning stale host values and reporting a clean bill of health. Production satisfies it through ocean_vcoord_enter_data_impl, which maps remap_h_old and target_h; a host-side caller must add its own !$acc enter data copyin(...) plus an update device after every host edit.

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
real(kind=wp), intent(in) :: h_old(nx,ny,nz)

Source thicknesses (the pre-remap h_layer snapshot).
real(kind=wp), intent(in) :: h_new(nx,ny,nz)

Target thicknesses (vcoord%target_h, after any time filter).
real(kind=wp), intent(in) :: rel_tol

Relative tolerance on the column-total match.
integer, intent(out) :: n_bad

Number of columns violating either precondition.
real(kind=wp), intent(out) :: worst_rel

Largest relative column-total mismatch over the domain.
real(kind=wp), intent(out) :: worst_neg

Most negative thickness found (0 when there is none).

Called by

proc~~ocean_remap_scan_preconditions~~CalledByGraph proc~ocean_remap_scan_preconditions ocean_remap_scan_preconditions proc~check_remap_preconditions_or_die check_remap_preconditions_or_die proc~check_remap_preconditions_or_die->proc~ocean_remap_scan_preconditions proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~check_remap_preconditions_or_die proc~engine_step engine_step proc~engine_step->proc~ocean_dyn_step_split 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 :: hmin
integer, private :: i
integer, private :: j
integer, private :: k
real(kind=wp), private :: rel
real(kind=wp), private :: s_new
real(kind=wp), private :: s_old

Source Code

   pure subroutine ocean_remap_scan_preconditions(nx, ny, nz, h_old, h_new, rel_tol, &
                                                  n_bad, worst_rel, worst_neg)
      !! Scan every column for the two remap preconditions and report how
      !! badly they are missed — the domain-wide counterpart of
      !! `rdb_remap_column :: remap_column_preconditions_ok`.
      !!
      !! `pure` and flat-arg so the caller owns the fail-loud decision and
      !! the reduction can run on-device; three scalars come back rather than
      !! a per-column field, so a thermo-cadence call costs one pass plus a
      !! tiny D→H.  Public for the unit-test suite.
      !!
      !! CALLER CONTRACT under `-gpu=...,mem:separate`: `h_old` and `h_new`
      !! must be device-present — the reduction declares them `present` rather
      !! than letting them copy in, so a caller that forgot the map ABORTS
      !! instead of silently scanning stale host values and reporting a clean
      !! bill of health.  Production satisfies it through
      !! `ocean_vcoord_enter_data_impl`, which maps `remap_h_old` and
      !! `target_h`; a host-side caller must add its own
      !! `!$acc enter data copyin(...)` plus an `update device` after every
      !! host edit.
      integer, intent(in) :: nx, ny, nz
      real(wp), intent(in) :: h_old(nx, ny, nz)
         !! Source thicknesses (the pre-remap `h_layer` snapshot).
      real(wp), intent(in) :: h_new(nx, ny, nz)
         !! Target thicknesses (`vcoord%target_h`, after any time filter).
      real(wp), intent(in) :: rel_tol
         !! Relative tolerance on the column-total match.
      integer, intent(out) :: n_bad
         !! Number of columns violating either precondition.
      real(wp), intent(out) :: worst_rel
         !! Largest relative column-total mismatch over the domain.
      real(wp), intent(out) :: worst_neg
         !! Most negative thickness found (0 when there is none).

      integer :: i, j, k
      real(wp) :: s_old, s_new, rel, hmin

      n_bad = 0
      worst_rel = 0.0_wp
      worst_neg = 0.0_wp
      !$acc parallel loop collapse(2) present(h_old, h_new) &
      !$acc   reduction(+:n_bad) reduction(max:worst_rel) reduction(min:worst_neg) &
      !$acc   private(k, s_old, s_new, rel, hmin)
      do j = 1, ny
         do i = 1, nx
            s_old = 0.0_wp
            s_new = 0.0_wp
            hmin = 0.0_wp
            do k = 1, nz
               s_old = s_old + h_old(i, j, k)
               s_new = s_new + h_new(i, j, k)
               hmin = min(hmin, h_old(i, j, k), h_new(i, j, k))
            end do
            ! Relative to the LARGER total, so a land column (both zero)
            ! scores 0 rather than tripping on a 0/0.
            rel = abs(s_new - s_old)/max(abs(s_old), abs(s_new), H_DIV_EPS)
            worst_rel = max(worst_rel, rel)
            worst_neg = min(worst_neg, hmin)
            if (hmin < 0.0_wp .or. rel > rel_tol) n_bad = n_bad + 1
         end do
      end do
   end subroutine ocean_remap_scan_preconditions