GPU-resident analogue of the base-class anisotropic mortar message posting; messages are posted on device memory (GPU-aware MPI).
| Type | Intent | Optional | Attributes | Name | ||
|---|---|---|---|---|---|---|
| class(MappedScalar3D), | intent(inout) | :: | this | |||
| type(Mesh3D), | intent(inout) | :: | mesh |
subroutine MPIAnisoMortarExchangeAsync_MappedScalar3D(this,mesh)
!! GPU-resident analogue of the base-class anisotropic mortar message posting;
!! messages are posted on device memory (GPU-aware MPI).
implicit none
class(MappedScalar3D),intent(inout) :: this
type(Mesh3D),intent(inout) :: mesh
! Local
integer :: m,h,ivar
integer :: eB,sB,rB,eS,sS,rS
integer :: globalSideId,tag
integer :: offset
integer :: iError
integer :: msgCount
real(prec),pointer :: boundary(:,:,:,:,:)
real(prec),pointer :: anisoMortarBuff(:,:,:,:,:)
! A send and a receive per rank-crossing half, per variable.
call mesh%decomp%ReserveMessages(2*this%nvar* &
mesh%decomp%CountRemoteMortarSides(mesh%anisoMortarInfo,mesh%nAnisoMortars,2))
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])
call c_f_pointer(this%anisoMortarBuff_gpu,anisoMortarBuff, &
[this%interp%N+1,this%interp%N+1,4,mesh%nAnisoMortars,this%nvar])
do ivar = 1,this%nvar
do m = 1,mesh%nAnisoMortars
eB = mesh%anisoMortarInfo(1,m)
sB = mesh%anisoMortarInfo(2,m)
rB = mesh%decomp%elemToRank(eB)
do h = 1,2
eS = mesh%anisoMortarInfo(2*h+1,m)
sS = mesh%anisoMortarInfo(2*h+2,m)/10
rS = mesh%decomp%elemToRank(eS)
globalSideId = mesh%anisoMortarInfo(6+h,m)
tag = globalSideId+mesh%nUniqueSides*(ivar-1)
if(rB == mesh%decomp%rankId .and. rS /= mesh%decomp%rankId) then
msgCount = msgCount+1
call MPI_IRECV(anisoMortarBuff(:,:,2+h,m,ivar), &
(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), &
(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(anisoMortarBuff(:,:,h,m,ivar), &
(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), &
(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
mesh%decomp%msgCount = msgCount
endsubroutine MPIAnisoMortarExchangeAsync_MappedScalar3D