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 | Intent | Optional | 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(:,:) |
| 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 |
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