compute_total_ke_efp Function

private function compute_total_ke_efp(h_layer, u_face, v_face, areaT, nghost) result(total)

EFP twin of compute_total_ke. See compute_total_h_efp for the k-slab blocking design; face-averaging + extent clamping copied verbatim from compute_total_ke.

Arguments

Type IntentOptional Attributes Name
real(kind=wp), intent(in) :: h_layer(:,:,:)
real(kind=wp), intent(in) :: u_face(:,:,:)
real(kind=wp), intent(in) :: v_face(:,:,:)
real(kind=wp), intent(in) :: areaT(:,:)
integer, intent(in) :: nghost

Return Value type(efp_t)


Calls

proc~~compute_total_ke_efp~~CallsGraph proc~compute_total_ke_efp compute_total_ke_efp proc~efp_carry efp_carry proc~compute_total_ke_efp->proc~efp_carry proc~efp_decompose_impl efp_decompose_impl proc~compute_total_ke_efp->proc~efp_decompose_impl proc~efp_summands_guard efp_summands_guard proc~compute_total_ke_efp->proc~efp_summands_guard error error proc~efp_summands_guard->error

Called by

proc~~compute_total_ke_efp~~CalledByGraph proc~compute_total_ke_efp compute_total_ke_efp proc~ocean_console_stats_report ocean_console_stats_report proc~ocean_console_stats_report->proc~compute_total_ke_efp proc~driver_run_ocean driver_run_ocean proc~driver_run_ocean->proc~ocean_console_stats_report proc~driver_run driver_run proc~driver_run->proc~driver_run_ocean

Variables

Type Visibility Attributes Name Initial
integer(kind=int64), private :: d1
integer(kind=int64), private :: d2
integer(kind=int64), private :: d3
integer(kind=int64), private :: d4
integer(kind=int64), private :: d5
integer(kind=int64), private :: d6
integer(kind=int64), private :: dpoison
integer(kind=int64), private :: e1
integer(kind=int64), private :: e2
integer(kind=int64), private :: e3
integer(kind=int64), private :: e4
integer(kind=int64), private :: e5
integer(kind=int64), private :: e6
integer(kind=int64), private :: epoison
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
integer, private :: nx
integer, private :: ny
integer, private :: nz
integer(kind=int64), private :: slab_e(EFP_DIGITS)
real(kind=wp), private :: uc
real(kind=real64), private :: val
real(kind=wp), private :: vc

Source Code

   function compute_total_ke_efp(h_layer, u_face, v_face, areaT, nghost) result(total)
      !! EFP twin of `compute_total_ke`.  See `compute_total_h_efp` for the
      !! k-slab blocking design; face-averaging + extent clamping copied
      !! verbatim from `compute_total_ke`.
      real(wp), intent(in) :: h_layer(:, :, :)
      real(wp), intent(in) :: u_face(:, :, :), v_face(:, :, :)
      real(wp), intent(in) :: areaT(:, :)
      integer, intent(in) :: nghost
      type(efp_t) :: total
      integer :: i, j, k, nx, ny, nz, i_lo, i_hi, j_lo, j_hi
      integer(int64) :: e1, e2, e3, e4, e5, e6, epoison
      integer(int64) :: d1, d2, d3, d4, d5, d6, dpoison
      integer(int64) :: slab_e(EFP_DIGITS)
      real(real64) :: val
      real(wp) :: uc, vc

      nx = min(size(h_layer, 1), size(u_face, 1) - 1, size(v_face, 1), size(areaT, 1))
      ny = min(size(h_layer, 2), size(u_face, 2), size(v_face, 2) - 1, size(areaT, 2))
      nz = min(size(h_layer, 3), size(u_face, 3), size(v_face, 3))
      i_lo = nghost + 1
      i_hi = nx - nghost
      j_lo = nghost + 1
      j_hi = ny - nghost
      call efp_summands_guard(i_hi - i_lo + 1, j_hi - j_lo + 1, "compute_total_ke_efp")

      total%v = 0_int64
      total%poison = 0_int64
      do k = 1, nz
         e1 = 0_int64
         e2 = 0_int64
         e3 = 0_int64
         e4 = 0_int64
         e5 = 0_int64
         e6 = 0_int64
         epoison = 0_int64
         !$acc parallel loop collapse(2) reduction(+:e1,e2,e3,e4,e5,e6,epoison) &
         !$acc&         private(val, uc, vc, d1, d2, d3, d4, d5, d6, dpoison) &
         !$acc&         present(h_layer, u_face, v_face, areaT)
         do j = j_lo, j_hi
            do i = i_lo, i_hi
               uc = 0.5_wp*(u_face(i, j, k) + u_face(i + 1, j, k))
               vc = 0.5_wp*(v_face(i, j, k) + v_face(i, j + 1, k))
               val = real(0.5_wp*h_layer(i, j, k)*(uc*uc + vc*vc)*areaT(i, j), real64)
               call efp_decompose_impl(val, d1, d2, d3, d4, d5, d6, dpoison)
               e1 = e1 + d1
               e2 = e2 + d2
               e3 = e3 + d3
               e4 = e4 + d4
               e5 = e5 + d5
               e6 = e6 + d6
               epoison = epoison + dpoison
            end do
         end do
         slab_e = [e1, e2, e3, e4, e5, e6]
         call efp_carry(slab_e)
         total%v = total%v + slab_e
         total%poison = total%poison + epoison
         call efp_carry(total%v)
      end do
   end function compute_total_ke_efp