XbcSendRecv Subroutine

  subroutine XbcSendRecv()
    use mpimod
    implicit none
    integer :: i,j,k,n

    single: if (ntiles(1) == 1) then
      ! Local-only: compute halos on device
!$omp target teams distribute parallel do collapse(3)
      do k=1,kn-1
      do j=1,jn-1
      do i=1,mgn
        select case(boundary_xin)
        case(periodicb)
          BrXstt(i,j,k,1:nbc) = BsXend(i,j,k,1:nbc)
        case(reflection)
          BrXstt(i,j,k,1:nbc) = BsXstt(mgn-i+1,j,k,1:nbc)
          BrXstt(i,j,k,nv1) = -BrXstt(i,j,k,nv1)
        case(outflow)
          BrXstt(i,j,k,1:nbc) = BsXstt(1,j,k,1:nbc)
        end select

        select case(boundary_xout)
        case(periodicb)
          BrXend(i,j,k,1:nbc) = BsXstt(i,j,k,1:nbc)
        case(reflection)
          BrXend(i,j,k,1:nbc) = BsXend(mgn-i+1,j,k,1:nbc)
          BrXend(i,j,k,nv1) = -BrXend(i,j,k,nv1)
        case(outflow)
          BrXend(i,j,k,1:nbc) = BsXend(mgn,j,k,1:nbc)
        end select
      end do
      end do
      end do
   
      return
    end if single
    
    ! Ensure host has latest send buffers
!$omp target update from(BsXstt, BsXend)

    ! Post receives/sends where neighbors exist. Physical BC when MPI_PROC_NULL.
    if (n1m /= MPI_PROC_NULL) then
      call MPI_IRECV(BrXstt, size(BrXstt), MPI_DOUBLE_PRECISION, n1m, 1100, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
      call MPI_ISEND(BsXstt, size(BsXstt), MPI_DOUBLE_PRECISION, n1m, 1200, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
    else
      if (boundary_xin == reflection) then
!$omp target teams distribute parallel do collapse(3)
        do k=1,kn-1; do j=1,jn-1; do i=1,mgn
          BrXstt(i,j,k,1:nbc) = BsXstt(mgn-i+1,j,k,1:nbc)
          BrXstt(i,j,k,nv1) = -BrXstt(i,j,k,nv1)
        end do; end do; end do
      else if (boundary_xin == outflow) then
!$omp target teams distribute parallel do collapse(3)
        do k=1,kn-1; do j=1,jn-1; do i=1,mgn
          BrXstt(i,j,k,1:nbc) = BsXstt(1,j,k,1:nbc)
        end do; end do; end do
      end if
    end if

    if (n1p /= MPI_PROC_NULL) then
      call MPI_IRECV(BrXend, size(BrXend), MPI_DOUBLE_PRECISION, n1p, 1200, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
      call MPI_ISEND(BsXend, size(BsXend), MPI_DOUBLE_PRECISION, n1p, 1100, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
    else
      if (boundary_xout == reflection) then
!$omp target teams distribute parallel do collapse(3)
        do k=1,kn-1; do j=1,jn-1; do i=1,mgn
          BrXend(i,j,k,1:nbc) = BsXend(mgn-i+1,j,k,1:nbc)
          BrXend(i,j,k,nv1) = -BrXend(i,j,k,nv1)
        end do; end do; end do
      else if (boundary_xout == outflow) then
!$omp target teams distribute parallel do collapse(3)
        do k=1,kn-1; do j=1,jn-1; do i=1,mgn
          BrXend(i,j,k,1:nbc) = BsXend(mgn,j,k,1:nbc)
        end do; end do; end do
      end if
    end if

    if (nreq /= 0) then
      call MPI_WAITALL(nreq, req, stat, ierr)
      ! Push only faces that came from MPI
      if (n1m /= MPI_PROC_NULL) then
!$omp target update to(BrXstt)
      end if
      if (n1p /= MPI_PROC_NULL) then
!$omp target update to(BrXend)
      end if
      nreq = 0
    end if

  end subroutine XbcSendRecv