subroutine SendProcExcDjs() ! In this routine the excitations are sent to the relevant processors. ! Sent with them will be the Di they were excited from and its sign. ! Each processor will receive nProcessor number of lists with different ! Di determinants. The original Di's will (I think) still be in the ! original InitSingExcSlots positions. This follows the ! directannihilation algorithm closely. use LoggingData, only: RDMExcitLevel use Parallel_neci, only: nProcessors, MPIArg, MPIAlltoAll, MPIAlltoAllv use rdm_data, only: Sing_ExcList, Doub_ExcList, OneEl_Gap, TwoEl_Gap use rdm_data, only: Sing_ExcDjs, Doub_ExcDjs, Sing_ExcDjs2, Doub_ExcDjs2 integer :: i, j 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) 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(Sing_ExcList(i) - (nint(OneEl_Gap * i) + 1), MPIArg) ! disps is the first slot for each processor - 1. disps(i + 1) = nint(OneEl_Gap * i, MPIArg) end do MaxSendIndex = Sing_ExcList(nProcessors - 1) - 1 ! We now need to calculate the recvcounts and recvdisps - ! this is a job for AlltoAll sing_recvcounts(1:nProcessors) = 0 call MPIAlltoAll(sendcounts, 1, sing_recvcounts, 1, error) ! We can now get recvdisps from recvcounts, since we want the data to ! be contiguous after the move. 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) ! 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(NIfTot + 1, MPIArg)) disps(i) = disps(i) * (int(NIfTot + 1, MPIArg)) sing_recvcounts(i) = sing_recvcounts(i) * (int(NIfTot + 1, MPIArg)) sing_recvdisps(i) = sing_recvdisps(i) * (int(NIfTot + 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:NIfTot, 1:MaxIndex) = Sing_ExcDjs(0:NIfTot, 1:MaxSendIndex) #endif call Sing_SearchOccDets(sing_recvcounts, sing_recvdisps) 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(NIfTot + 1, MPIArg)) disps(i) = disps(i) * (int(NIfTot + 1, MPIArg)) doub_recvcounts(i) = doub_recvcounts(i) * (int(NIfTot + 1, MPIArg)) doub_recvdisps(i) = doub_recvdisps(i) * (int(NIfTot + 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:NIfTot, 1:MaxIndex) = Doub_ExcDjs(0:NIfTot, 1:MaxSendIndex) #endif call Doub_SearchOccDets(doub_recvcounts, doub_recvdisps) end if end subroutine SendProcExcDjs