ke_regions_impl Subroutine

private subroutine ke_regions_impl(h, u, v, nx, ny, nz, nghost, nx_phys, ny_phys, rim_w, east_w, ke_full, ke_rim, ke_east)

h-weighted layer KE over the three regions, one device pass. Per cell: KE = Σ_k [ ¼(h_W·u_W² + h_E·u_E²) + ¼(h_S·v_S² + h_N·v_N²) ] with h_face the centred face thickness (m³/s² per unit area; uniform-Δx Cartesian, so the area factor is a constant and is dropped — attribution only needs a consistent measure). Explicit OpenACC reduction — a sum() intrinsic on a present-mapped array silently runs host-side under NVHPC non-managed mode and returns the stale host shadow.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: h(nx,ny,nz)
real(kind=wp), intent(in) :: u(nx+1,ny,nz)
real(kind=wp), intent(in) :: v(nx,ny+1,nz)
integer, intent(in) :: nx
integer, intent(in) :: ny
integer, intent(in) :: nz
integer, intent(in) :: nghost
integer, intent(in) :: nx_phys
integer, intent(in) :: ny_phys
integer, intent(in) :: rim_w
integer, intent(in) :: east_w
real(kind=wp), intent(out) :: ke_full
real(kind=wp), intent(out) :: ke_rim
real(kind=wp), intent(out) :: ke_east

Calls

proc~~ke_regions_impl~~CallsGraph proc~ke_regions_impl ke_regions_impl reduce reduce proc~ke_regions_impl->reduce

Called by

proc~~ke_regions_impl~~CalledByGraph proc~ke_regions_impl ke_regions_impl proc~ke_probe_sample ke_probe_sample proc~ke_probe_sample->proc~ke_regions_impl proc~run_stage_split run_stage_split proc~run_stage_split->proc~ke_probe_sample proc~ocean_dyn_step_split ocean_dyn_step_split proc~ocean_dyn_step_split->proc~run_stage_split 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

Variables

Type Visibility Attributes Name Initial
real(kind=wp), private :: h_e
real(kind=wp), private :: h_n
real(kind=wp), private :: h_s
real(kind=wp), private :: h_w
integer, private :: i
integer, private :: i_hi
integer, private :: i_lo
integer, private :: j
integer, private :: j_hi
integer, private :: j_lo
integer, private :: k
real(kind=wp), private :: ke_cell

Source Code

   subroutine ke_regions_impl(h, u, v, nx, ny, nz, nghost, nx_phys, ny_phys, &
                              rim_w, east_w, ke_full, ke_rim, ke_east)
      !! h-weighted layer KE over the three regions, one device pass.
      !! Per cell: KE = Σ_k [ ¼(h_W·u_W² + h_E·u_E²) + ¼(h_S·v_S² + h_N·v_N²) ]
      !! with h_face the centred face thickness (m³/s² per unit area;
      !! uniform-Δx Cartesian, so the area factor is a constant and is
      !! dropped — attribution only needs a consistent measure).
      !! Explicit OpenACC reduction — a `sum()` intrinsic on a
      !! present-mapped array silently runs host-side under NVHPC
      !! non-managed mode and returns the stale host shadow.
      integer, intent(in) :: nx, ny, nz, nghost, nx_phys, ny_phys
      integer, intent(in) :: rim_w, east_w
      real(wp), intent(in) :: h(nx, ny, nz)
      real(wp), intent(in) :: u(nx + 1, ny, nz)
      real(wp), intent(in) :: v(nx, ny + 1, nz)
      real(wp), intent(out) :: ke_full, ke_rim, ke_east

      integer :: i, j, k, i_lo, i_hi, j_lo, j_hi
      real(wp) :: h_w, h_e, h_s, h_n, ke_cell

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

      ke_full = 0.0_wp
      ke_rim = 0.0_wp
      ke_east = 0.0_wp
      do concurrent(k=1:nz, j=j_lo:j_hi, i=i_lo:i_hi) reduce(+:ke_full, ke_rim, ke_east)
         h_w = 0.5_wp*(h(i - 1, j, k) + h(i, j, k))
         h_e = 0.5_wp*(h(i, j, k) + h(i + 1, j, k))
         h_s = 0.5_wp*(h(i, j - 1, k) + h(i, j, k))
         h_n = 0.5_wp*(h(i, j, k) + h(i, j + 1, k))
         ke_cell = 0.25_wp*(h_w*u(i, j, k)*u(i, j, k) + &
                            h_e*u(i + 1, j, k)*u(i + 1, j, k)) + &
                   0.25_wp*(h_s*v(i, j, k)*v(i, j, k) + &
                            h_n*v(i, j + 1, k)*v(i, j + 1, k))
         ke_full = ke_full + ke_cell
         if (i - i_lo < rim_w .or. i_hi - i < rim_w .or. &
             j - j_lo < rim_w .or. j_hi - j < rim_w) then
            ke_rim = ke_rim + ke_cell
         end if
         if (i_hi - i < east_w) ke_east = ke_east + ke_cell
      end do
   end subroutine ke_regions_impl