Send_Hist_ProcExcDjs Subroutine

public subroutine Send_Hist_ProcExcDjs()

Arguments

None

Contents

Source Code


Source Code

    subroutine Send_Hist_ProcExcDjs()

        ! 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_Hist_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_Hist_SearchOccDets(doub_recvcounts, doub_recvdisps)

        end if

    end subroutine Send_Hist_ProcExcDjs