halo_exchange_begin Subroutine

public subroutine halo_exchange_begin(ha, h, hu, hv, b_fld)

Pack and post non-blocking MPI sends/recvs for all 4 fields

After this returns, the interior cells (not touching ghost cells) can be computed while the exchange is in flight.

Buffers are module-level arrays (ha_buf_*) so that OpenACC can resolve present() lookups without derived-type traversal.

Arguments

Type IntentOptional Attributes Name
type(halo_async_t), intent(inout) :: ha
real(kind=wp), intent(in) :: h(:,:)
real(kind=wp), intent(in) :: hu(:,:)
real(kind=wp), intent(in) :: hv(:,:)
real(kind=wp), intent(in) :: b_fld(:,:)

Calls

proc~~halo_exchange_begin~~CallsGraph proc~halo_exchange_begin halo_exchange_begin comm_irecv_real_sp_array_n comm_irecv_real_sp_array_n proc~halo_exchange_begin->comm_irecv_real_sp_array_n comm_isend_real_sp_array_n comm_isend_real_sp_array_n proc~halo_exchange_begin->comm_isend_real_sp_array_n proc~comm_env_compute_comm comm_env_compute_comm proc~halo_exchange_begin->proc~comm_env_compute_comm comm_world comm_world proc~comm_env_compute_comm->comm_world

Variables

Type Visibility Attributes Name Initial
integer, private :: base
type(comm_t), private :: comm
integer, private :: i
integer, private :: j
integer, private :: k
integer, private :: ng
integer, private :: nxl
integer, private :: nxt
integer, private :: nyl
integer, private :: nyt

Source Code

   subroutine halo_exchange_begin(ha, h, hu, hv, b_fld)
      !! Pack and post non-blocking MPI sends/recvs for all 4 fields
      !!
      !! After this returns, the interior cells (not touching ghost cells)
      !! can be computed while the exchange is in flight.
      !!
      !! Buffers are module-level arrays (ha_buf_*) so that OpenACC can
      !! resolve present() lookups without derived-type traversal.
      type(halo_async_t), intent(inout) :: ha
      real(wp), intent(in) :: h(:, :), hu(:, :), hv(:, :), b_fld(:, :)

      type(comm_t) :: comm
      integer :: i, j, k, base
      integer :: ng, nxl, nyl, nxt, nyt

      comm = comm_env_compute_comm()
      ng = ha%nghost
      nxl = ha%nx_local
      nyl = ha%ny_local
      nxt = ha%nx_total
      nyt = ha%ny_total
      ha%nreq = 0

      ! --- Pack all 4 fields into combined buffers on device ---
      if (.not. ha%decomp%has_west) then
         !$acc parallel loop collapse(2)
         do j = 1, nyt
            do k = 1, ng
               base = (j - 1)*ng + k
               ha_buf_send_west(base) = h(ng + k, j)
               ha_buf_send_west(base + ng*nyt) = hu(ng + k, j)
               ha_buf_send_west(base + 2*ng*nyt) = hv(ng + k, j)
               ha_buf_send_west(base + 3*ng*nyt) = b_fld(ng + k, j)
            end do
         end do
      end if

      if (.not. ha%decomp%has_east) then
         !$acc parallel loop collapse(2)
         do j = 1, nyt
            do k = 1, ng
               base = (j - 1)*ng + k
               ha_buf_send_east(base) = h(ng + nxl - ng + k, j)
               ha_buf_send_east(base + ng*nyt) = hu(ng + nxl - ng + k, j)
               ha_buf_send_east(base + 2*ng*nyt) = hv(ng + nxl - ng + k, j)
               ha_buf_send_east(base + 3*ng*nyt) = b_fld(ng + nxl - ng + k, j)
            end do
         end do
      end if

      if (.not. ha%decomp%has_south) then
         !$acc parallel loop collapse(2)
         do k = 1, ng
            do i = 1, nxt
               base = (k - 1)*nxt + i
               ha_buf_send_south(base) = h(i, ng + k)
               ha_buf_send_south(base + nxt*ng) = hu(i, ng + k)
               ha_buf_send_south(base + 2*nxt*ng) = hv(i, ng + k)
               ha_buf_send_south(base + 3*nxt*ng) = b_fld(i, ng + k)
            end do
         end do
      end if

      if (.not. ha%decomp%has_north) then
         !$acc parallel loop collapse(2)
         do k = 1, ng
            do i = 1, nxt
               base = (k - 1)*nxt + i
               ha_buf_send_north(base) = h(i, ng + nyl - ng + k)
               ha_buf_send_north(base + nxt*ng) = hu(i, ng + nyl - ng + k)
               ha_buf_send_north(base + 2*nxt*ng) = hv(i, ng + nyl - ng + k)
               ha_buf_send_north(base + 3*nxt*ng) = b_fld(i, ng + nyl - ng + k)
            end do
         end do
      end if

      ! --- Post MPI Isend/Irecv with device pointers ---
      if (.not. ha%decomp%has_west) then
         !$acc host_data use_device(ha_buf_send_west, ha_buf_recv_west)
         ha%nreq = ha%nreq + 1
         call HALO_ISEND_N(comm, ha_buf_send_west, ha%strip_ew, ha%rank_west, 1, ha%reqs(ha%nreq))
         ha%nreq = ha%nreq + 1
         call HALO_IRECV_N(comm, ha_buf_recv_west, ha%strip_ew, ha%rank_west, 2, ha%reqs(ha%nreq))
         !$acc end host_data
      end if

      if (.not. ha%decomp%has_east) then
         !$acc host_data use_device(ha_buf_send_east, ha_buf_recv_east)
         ha%nreq = ha%nreq + 1
         call HALO_ISEND_N(comm, ha_buf_send_east, ha%strip_ew, ha%rank_east, 2, ha%reqs(ha%nreq))
         ha%nreq = ha%nreq + 1
         call HALO_IRECV_N(comm, ha_buf_recv_east, ha%strip_ew, ha%rank_east, 1, ha%reqs(ha%nreq))
         !$acc end host_data
      end if

      if (.not. ha%decomp%has_south) then
         !$acc host_data use_device(ha_buf_send_south, ha_buf_recv_south)
         ha%nreq = ha%nreq + 1
         call HALO_ISEND_N(comm, ha_buf_send_south, ha%strip_sn, ha%rank_south, 3, ha%reqs(ha%nreq))
         ha%nreq = ha%nreq + 1
         call HALO_IRECV_N(comm, ha_buf_recv_south, ha%strip_sn, ha%rank_south, 4, ha%reqs(ha%nreq))
         !$acc end host_data
      end if

      if (.not. ha%decomp%has_north) then
         !$acc host_data use_device(ha_buf_send_north, ha_buf_recv_north)
         ha%nreq = ha%nreq + 1
         call HALO_ISEND_N(comm, ha_buf_send_north, ha%strip_sn, ha%rank_north, 4, ha%reqs(ha%nreq))
         ha%nreq = ha%nreq + 1
         call HALO_IRECV_N(comm, ha_buf_recv_north, ha%strip_sn, ha%rank_north, 3, ha%reqs(ha%nreq))
         !$acc end host_data
      end if

   end subroutine halo_exchange_begin