subroutine send_proc_ex_djs()
! i also need a specific routint to send the excitations for
! the GUGA RDMs, otherwise this clutters up the det-based routines
! this routine is very similar to SendProcExcDjs in the rdm_explicit
! module. see there for comments
integer :: i
integer :: error, MaxSendIndex, MaxIndex
integer(MPIArg) :: sendcounts(nProcessors), disps(nProcessors)
integer(MPIArg) :: sing_recvcounts(nProcessors)
integer(MPIArg) :: sing_recvdisps(nProcessors)
integer(MPIArg) :: doub_recvcounts(nProcessors), doub_recvdisps(nProcessors)
if (RDMExcitLevel == 1 .or. RDMExcitLevel == 3) then
do i = 0, nProcessors - 1
sendcounts(i + 1) = int(Sing_ExcList(i) - (nint(OneEl_Gap * i) + 1), MPIArg)
disps(i + 1) = nint(OneEl_Gap * i, MPIArg)
end do
MaxSendIndex = Sing_ExcList(nProcessors - 1) - 1
sing_recvcounts(1:nProcessors) = 0
call MPIAlltoAll(sendcounts, 1, sing_recvcounts, 1, error)
sing_recvdisps(1) = 0
do i = 2, nProcessors
sing_recvdisps(i) = sing_recvdisps(i - 1) + sing_recvcounts(i - 1)
end do
MaxIndex = sing_recvdisps(nProcessors) + sing_recvcounts(nProcessors)
do i = 1, nProcessors
sendcounts(i) = sendcounts(i) * (int(GugaBits%len_tot + 1, MPIArg))
disps(i) = disps(i) * (int(GugaBits%len_tot + 1, MPIArg))
sing_recvcounts(i) = sing_recvcounts(i) * (int(GugaBits%len_tot + 1, MPIArg))
sing_recvdisps(i) = sing_recvdisps(i) * (int(GugaBits%len_tot + 1, MPIArg))
end do
#ifdef USE_MPI
call MPIAlltoAllv(Sing_ExcDjs(:, 1:MaxSendIndex), sendcounts, disps, &
Sing_ExcDjs2, sing_recvcounts, sing_recvdisps, error)
#else
Sing_ExcDjs2(0:GugaBits%len_tot, 1:MaxIndex) = Sing_ExcDjs(0:GugaBits%len_tot, 1:MaxSendIndex)
#endif
! and also write a new routine for the search of occ. dets
call singles_search_guga(sing_recvcounts, sing_recvdisps)
end if
if (RDMExcitLevel /= 1) then
do i = 0, nProcessors - 1
! Sendcounts is the number of singly excited determinants we
! want to send for each processor (but goes from 1, not 0).
sendcounts(i + 1) = int(Doub_ExcList(i) - (nint(TwoEl_Gap * i) + 1), MPIArg)
! disps is the first slot for each processor - 1.
disps(i + 1) = nint(TwoEl_Gap * i, MPIArg)
end do
MaxSendIndex = Doub_ExcList(nProcessors - 1) - 1
! We now need to calculate the recvcounts and recvdisps -
! this is a job for AlltoAll
doub_recvcounts(1:nProcessors) = 0
call MPIAlltoAll(sendcounts, 1, doub_recvcounts, 1, error)
! We can now get recvdisps from recvcounts, since we want the data
! to be contiguous after the move.
doub_recvdisps(1) = 0
do i = 2, nProcessors
doub_recvdisps(i) = doub_recvdisps(i - 1) + doub_recvcounts(i - 1)
end do
MaxIndex = doub_recvdisps(nProcessors) + doub_recvcounts(nProcessors)
! But the actual number of integers we need to send is the
! calculated values * NIfTot+1.
do i = 1, nProcessors
sendcounts(i) = sendcounts(i) * (int(GugaBits%len_tot + 1, MPIArg))
disps(i) = disps(i) * (int(GugaBits%len_tot + 1, MPIArg))
doub_recvcounts(i) = doub_recvcounts(i) * (int(GugaBits%len_tot + 1, MPIArg))
doub_recvdisps(i) = doub_recvdisps(i) * (int(GugaBits%len_tot + 1, MPIArg))
end do
! This is the main send of all the single excitations to the
! corresponding processors.
#ifdef USE_MPI
call MPIAlltoAllv(Doub_ExcDjs(:, 1:MaxSendIndex), sendcounts, disps, &
Doub_ExcDjs2, doub_recvcounts, doub_recvdisps, error)
#else
Doub_ExcDjs2(0:GugaBits%len_tot, 1:MaxIndex) = Doub_ExcDjs(0:GugaBits%len_tot, 1:MaxSendIndex)
#endif
call doubles_search_guga(doub_recvcounts, doub_recvdisps)
end if
end subroutine send_proc_ex_djs