function communicate_read_walkers_buff(sendcounts, gdata_comm, &
gdata_loc) result(num_received)
integer(MPIArg), intent(in) :: sendcounts(0:nProcessors - 1)
integer(hsize_t), intent(inout) :: gdata_comm(:, :)
integer(hsize_t), allocatable, intent(inout) :: gdata_loc(:, :)
integer :: num_received
integer(int64) :: lnum_received
integer(MPIArg) :: recvcounts(0:nProcessors - 1), recvcountsScaled(0:nProcessors - 1)
integer(MPIArg) :: disps(0:nProcessors - 1), recvdisps(0:nProcessors - 1)
integer(MPIArg) :: dispsScaled(0:nProcessors - 1), recvdispsScaled(0:nProcessors - 1)
integer(MPIArg) :: sendcountsScaled(0:nProcessors - 1)
integer :: j, ierr, gdata_size
!offsets for data to the different procs
disps(0) = 0
do j = 1, nProcessors - 1
disps(j) = disps(j - 1) + sendcounts(j - 1)
end do
! Communicate the number of particles that need to go to each proc
call MPIAllToAll(sendcounts, 1, recvcounts, 1, ierr)
! We want the data to be contiguous after the move. So calculate the
! offsets
recvdisps(0) = 0
do j = 1, nProcessors - 1
recvdisps(j) = recvdisps(j - 1) + recvcounts(j - 1)
end do
num_received = recvdisps(nProcessors - 1) + recvcounts(nProcessors - 1)
lnum_received = recvdisps(nProcessors - 1) + recvcounts(nProcessors - 1)
gdata_size = size(gdata_loc, 1)
! Adjust offsets so that they match the size of the array
call scaleCounts(size(SpawnedParts, 1))
if (num_received > size(SpawnedParts2, 2)) then
! there could in principle be a memory problem because we are not limiting the
! size of receivebuff.
write(stdout, *) 'Allocating additional buffer for communication on Processor ', iProcIndex, 'with ', &
num_received * size(SpawnedParts, 1) * sizeof(SpawnedParts(1, 1)) / 1000000, 'MB'
allocate(receivebuff(size(SpawnedParts, 1), num_received))
call LogMemAlloc('receivebuff', size(receivebuff), int(sizeof(receivebuff(1, 1))), &
'communicate_read_walkers', receivebuff_tag, ierr)
call MPIAllToAllV(SpawnedParts, sendcountsScaled, dispsScaled, receivebuff, &
recvcountsScaled, recvdispsScaled, ierr)
! gdata communication for auto-adaptive shift mode
if (gdata_size > 0) then
if (allocated(gdata_loc)) deallocate(gdata_loc)
allocate(gdata_loc(gdata_size, num_received))
end if
else
call MPIAllToAllV(SpawnedParts, sendcountsScaled, dispsScaled, SpawnedParts2, &
recvcountsScaled, recvdispsScaled, ierr)
end if
call scaleCounts(gdata_size)
if (gdata_size > 0) then
call MPIAllToAllV(gdata_comm, sendcountsScaled, dispsScaled, gdata_loc, &
recvcountsScaled, recvdispsScaled, ierr)
end if
contains
subroutine scaleCounts(argSize)
implicit none
integer, intent(in) :: argSize
recvcountsScaled = recvcounts * argSize
recvdispsScaled = recvdisps * argSize
sendcountsScaled = sendcounts * argSize
dispsScaled = disps * argSize
end subroutine scaleCounts
end function communicate_read_walkers_buff