subroutine SendProcNewParts(MaxIndex, tSingleProc)
! This routine is used for sending the determinants to the correct
! processors.
integer, intent(out) :: MaxIndex
logical, intent(in) :: tSingleProc
integer :: i, error
integer(MPIArg), dimension(nProcessors) :: sendcounts, disps, &
recvcounts, recvdisps
integer :: MaxSendIndex
integer(MPIArg) :: SpawnedPartsWidth
if (tSingleProc) then
! Put all particles and gap on one proc.
! ValidSpawnedList(0:nNodes-1) indicates the next free index for each
! processor (for spawnees from this processor) i.e. the list of spawned
! particles has already been arranged so that newly spawned particles are
! grouped according to the processor they go to.
! sendcounts(1:) indicates the number of spawnees to send to each processor.
! disps(1:) is the index into the spawned list of the beginning of the list
! to send to each processor (0-based).
sendcounts(1) = int(ValidSpawnedList(0) - 1, MPIArg)
disps(1) = 0
if (nNodes > 1) then
sendcounts(2:nNodes) = 0
! n.b. work around PGI bug.
do i = 2, nNodes
disps(i) = int(ValidSpawnedList(1), MPIArg)
end do
!disps(2:nNodes)=int(ValidSpawnedList(1),MPIArg)
end if
else
! Distribute the gaps on all procs.
do i = 0, nProcessors - 1
if (NodeRoots(ProcNode(i)) == i) then
sendcounts(i + 1) = int(ValidSpawnedList(ProcNode(i)) - &
InitialSpawnedSlots(ProcNode(i)), MPIArg)
! disps is zero-based, but InitialSpawnedSlots is 1-based.
disps(i + 1) = int(InitialSpawnedSlots(ProcNode(i)) - 1, MPIArg)
else
sendcounts(i + 1) = 0
disps(i + 1) = disps(i)
end if
end do
end if
MaxSendIndex = ValidSpawnedList(nNodes - 1) - 1
! We now need to calculate the recvcounts and recvdisps - this is a
! job for AlltoAll
recvcounts(1:nProcessors) = 0
call MPIBarrier(error)
call set_timer(Comms_Time, 30)
call MPIAlltoAll(sendcounts, 1, recvcounts, 1, error)
! Set this global data - the total number of spawned determants.
nspawned = sum(recvcounts)
! We can now get recvdisps from recvcounts, since we want the data to
! be contiguous after the move.
recvdisps(1) = 0
do i = 2, nProcessors
recvdisps(i) = recvdisps(i - 1) + recvcounts(i - 1)
end do
MaxIndex = recvdisps(nProcessors) + recvcounts(nProcessors)
SpawnedPartsWidth = int(size(SpawnedParts, 1), MPIArg)
do i = 1, nProcessors
recvdisps(i) = recvdisps(i) * SpawnedPartsWidth
recvcounts(i) = recvcounts(i) * SpawnedPartsWidth
sendcounts(i) = sendcounts(i) * SpawnedPartsWidth
disps(i) = disps(i) * SpawnedPartsWidth
end do
! Max index is the largest occupied index in the array of hashes to be
! ordered in each processor
if (MaxIndex > (0.9_dp * MaxSpawned)) then
#ifdef DEBUG_
write(stdout, *) MaxIndex, MaxSpawned
#else
write(stdout, *) 'On task ', iProcIndex, ': ', MaxIndex, MaxSpawned
#endif
call Warning_neci("SendProcNewParts", "Maximum index of newly-spawned array is " &
& //"close to maximum length after annihilation send. Increase MemoryFacSpawn")
end if
call MPIAlltoAllv(SpawnedParts, sendcounts, disps, SpawnedParts2, recvcounts, recvdisps, error)
call halt_timer(Comms_Time)
end subroutine SendProcNewParts