MPIMortarExchangeAsync_MappedScalar2D Subroutine

public subroutine MPIMortarExchangeAsync_MappedScalar2D(this, mesh)

GPU-resident analogue of the base-class mortar message posting; messages are posted on device memory (GPU-aware MPI), following MPIExchangeAsync.

Arguments

TypeIntentOptionalAttributesName
class(MappedScalar2D), intent(inout) :: this
type(Mesh2D), intent(inout) :: mesh

Calls

proc~~mpimortarexchangeasync_mappedscalar2d~~CallsGraph proc~mpimortarexchangeasync_mappedscalar2d MPIMortarExchangeAsync_MappedScalar2D mpi_irecv mpi_irecv proc~mpimortarexchangeasync_mappedscalar2d->mpi_irecv mpi_isend mpi_isend proc~mpimortarexchangeasync_mappedscalar2d->mpi_isend

Contents


Source Code

  subroutine MPIMortarExchangeAsync_MappedScalar2D(this,mesh)
    !! GPU-resident analogue of the base-class mortar message posting; messages are
    !! posted on device memory (GPU-aware MPI), following MPIExchangeAsync.
    implicit none
    class(MappedScalar2D),intent(inout) :: this
    type(Mesh2D),intent(inout) :: mesh
    ! Local
    integer :: m,k,ivar
    integer :: eB,sB,rB,eS,sS,rS
    integer :: globalSideId,tag
    integer :: offset
    integer :: iError
    integer :: msgCount
    real(prec),pointer :: boundary(:,:,:,:)
    real(prec),pointer :: mortarBuff(:,:,:,:)

    msgCount = 0
    offset = mesh%decomp%offsetElem(mesh%decomp%rankId+1)
    call c_f_pointer(this%boundary_gpu,boundary,[this%interp%N+1,4,this%nelem,this%nvar])
    call c_f_pointer(this%mortarBuff_gpu,mortarBuff, &
                     [this%interp%N+1,4,mesh%nMortars,this%nvar])

    do ivar = 1,this%nvar
      do m = 1,mesh%nMortars

        eB = mesh%mortarInfo(1,m)
        sB = mesh%mortarInfo(2,m)
        rB = mesh%decomp%elemToRank(eB)

        do k = 1,2

          eS = mesh%mortarInfo(2*k+1,m)
          sS = mesh%mortarInfo(2*k+2,m)/10
          rS = mesh%decomp%elemToRank(eS)
          globalSideId = mesh%mortarInfo(6+k,m)
          tag = globalSideId+mesh%nUniqueSides*(ivar-1)

          if(rB == mesh%decomp%rankId .and. rS /= mesh%decomp%rankId) then

            msgCount = msgCount+1
            call MPI_IRECV(mortarBuff(:,2+k,m,ivar), &
                           (this%interp%N+1), &
                           mesh%decomp%mpiPrec, &
                           rS,tag, &
                           mesh%decomp%mpiComm, &
                           mesh%decomp%requests(msgCount),iError)

            msgCount = msgCount+1
            call MPI_ISEND(boundary(:,sB,eB-offset,ivar), &
                           (this%interp%N+1), &
                           mesh%decomp%mpiPrec, &
                           rS,tag, &
                           mesh%decomp%mpiComm, &
                           mesh%decomp%requests(msgCount),iError)

          elseif(rS == mesh%decomp%rankId .and. rB /= mesh%decomp%rankId) then

            msgCount = msgCount+1
            call MPI_IRECV(mortarBuff(:,k,m,ivar), &
                           (this%interp%N+1), &
                           mesh%decomp%mpiPrec, &
                           rB,tag, &
                           mesh%decomp%mpiComm, &
                           mesh%decomp%requests(msgCount),iError)

            msgCount = msgCount+1
            call MPI_ISEND(boundary(:,sS,eS-offset,ivar), &
                           (this%interp%N+1), &
                           mesh%decomp%mpiPrec, &
                           rB,tag, &
                           mesh%decomp%mpiComm, &
                           mesh%decomp%requests(msgCount),iError)

          endif

        enddo
      enddo
    enddo

    mesh%decomp%msgCount = msgCount

  endsubroutine MPIMortarExchangeAsync_MappedScalar2D