ZbcSendRecv Subroutine

public subroutine ZbcSendRecv()

Uses

  • proc~~zbcsendrecv~~UsesGraph proc~zbcsendrecv ZbcSendRecv module~mpimod mpimod proc~zbcsendrecv->module~mpimod module~config config module~mpimod->module~config mpi mpi module~mpimod->mpi

Arguments

None

Calls

proc~~zbcsendrecv~~CallsGraph proc~zbcsendrecv ZbcSendRecv mpi_irecv mpi_irecv proc~zbcsendrecv->mpi_irecv mpi_isend mpi_isend proc~zbcsendrecv->mpi_isend mpi_waitall mpi_waitall proc~zbcsendrecv->mpi_waitall

Called by

proc~~zbcsendrecv~~CalledByGraph proc~zbcsendrecv ZbcSendRecv proc~boundarycondition BoundaryCondition proc~boundarycondition->proc~zbcsendrecv program~main main program~main->proc~boundarycondition

Source Code

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

    if (ntiles(3) == 1) then
!$omp target teams distribute parallel do collapse(3)
      do j=1,jn-1
      do i=1,in-1
      do k=1,mgn
        select case(boundary_zin)
        case(periodicb)
          BrZstt(i,j,k,1:nbc) = BsZend(i,j,k,1:nbc)
        case(reflection)
          BrZstt(i,j,k,1:nbc) = BsZstt(i,j,mgn-k+1,1:nbc)
          BrZstt(i,j,k,nv3) = -BrZstt(i,j,k,nv3)
        case(outflow)
          BrZstt(i,j,k,1:nbc) = BsZstt(i,j,1,1:nbc)
        end select

        select case(boundary_zout)
        case(periodicb)
          BrZend(i,j,k,1:nbc) = BsZstt(i,j,k,1:nbc)
        case(reflection)
          BrZend(i,j,k,1:nbc) = BsZend(i,j,mgn-k+1,1:nbc)
          BrZend(i,j,k,nv3) = -BrZend(i,j,k,nv3)
        case(outflow)
          BrZend(i,j,k,1:nbc) = BsZend(i,j,mgn,1:nbc)
        end select
      end do
      end do
      end do
      return
    end if

!$omp target update from(BsZstt, BsZend)

    if (n3m /= MPI_PROC_NULL) then
      call MPI_IRECV(BrZstt, size(BrZstt), MPI_DOUBLE_PRECISION, n3m, 3100, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
      call MPI_ISEND(BsZstt, size(BsZstt), MPI_DOUBLE_PRECISION, n3m, 3200, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
    else
      if (boundary_zin == reflection) then
!$omp target teams distribute parallel do collapse(3)
        do j=1,jn-1; do i=1,in-1; do k=1,mgn
          BrZstt(i,j,k,1:nbc) = BsZstt(i,j,mgn-k+1,1:nbc)
          BrZstt(i,j,k,nv3) = -BrZstt(i,j,k,nv3)
        end do; end do; end do
      else if (boundary_zin == outflow) then
!$omp target teams distribute parallel do collapse(3)
        do j=1,jn-1; do i=1,in-1; do k=1,mgn
          BrZstt(i,j,k,1:nbc) = BsZstt(i,j,1,1:nbc)
        end do; end do; end do
      end if
    end if

    if (n3p /= MPI_PROC_NULL) then
      call MPI_IRECV(BrZend, size(BrZend), MPI_DOUBLE_PRECISION, n3p, 3200, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
      call MPI_ISEND(BsZend, size(BsZend), MPI_DOUBLE_PRECISION, n3p, 3100, comm3d, req(nreq+1), ierr)
      nreq = nreq + 1
    else
      if (boundary_zout == reflection) then
!$omp target teams distribute parallel do collapse(3)
        do j=1,jn-1; do i=1,in-1; do k=1,mgn
          BrZend(i,j,k,1:nbc) = BsZend(i,j,mgn-k+1,1:nbc)
          BrZend(i,j,k,nv3) = -BrZend(i,j,k,nv3)
        end do; end do; end do
      else if (boundary_zout == outflow) then
!$omp target teams distribute parallel do collapse(3)
        do j=1,jn-1; do i=1,in-1; do k=1,mgn
          BrZend(i,j,k,1:nbc) = BsZend(i,j,mgn,1:nbc)
        end do; end do; end do
      end if
    end if

    if (nreq /= 0) then
      call MPI_WAITALL(nreq, req, stat, ierr)
      if (n3m /= MPI_PROC_NULL) then
!$omp target update to(BrZstt)
      end if
      if (n3p /= MPI_PROC_NULL) then
!$omp target update to(BrZend)
      end if
      nreq = 0
    end if

  end subroutine ZbcSendRecv