MPIMortarExchangeAsync_MappedVector3D Subroutine

public subroutine MPIMortarExchangeAsync_MappedVector3D(this, mesh)

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

Arguments

TypeIntentOptionalAttributesName
class(MappedVector3D), intent(inout) :: this
type(Mesh3D), intent(inout) :: mesh

Calls

proc~~mpimortarexchangeasync_mappedvector3d~~CallsGraph proc~mpimortarexchangeasync_mappedvector3d MPIMortarExchangeAsync_MappedVector3D mpi_irecv mpi_irecv proc~mpimortarexchangeasync_mappedvector3d->mpi_irecv mpi_isend mpi_isend proc~mpimortarexchangeasync_mappedvector3d->mpi_isend

Contents


Source Code

  subroutine MPIMortarExchangeAsync_MappedVector3D(this,mesh)
    !! GPU-resident analogue of the base-class vector mortar message posting;
    !! messages are posted on device memory (GPU-aware MPI).
    implicit none
    class(MappedVector3D),intent(inout) :: this
    type(Mesh3D),intent(inout) :: mesh
    ! Local
    integer :: m,q,ivar,idir
    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,this%interp%N+1,6,this%nelem,this%nvar,3])
    call c_f_pointer(this%mortarBuff_gpu,mortarBuff, &
                     [this%interp%N+1,this%interp%N+1,8,mesh%nMortars,this%nvar,3])

    do idir = 1,3
      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 q = 1,4

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

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

              msgCount = msgCount+1
              call MPI_IRECV(mortarBuff(:,:,4+q,m,ivar,idir), &
                             (this%interp%N+1)*(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,idir), &
                             (this%interp%N+1)*(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(:,:,q,m,ivar,idir), &
                             (this%interp%N+1)*(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,idir), &
                             (this%interp%N+1)*(this%interp%N+1), &
                             mesh%decomp%mpiPrec, &
                             rB,tag, &
                             mesh%decomp%mpiComm, &
                             mesh%decomp%requests(msgCount),iError)

            endif

          enddo
        enddo
      enddo
    enddo

    mesh%decomp%msgCount = msgCount

  endsubroutine MPIMortarExchangeAsync_MappedVector3D