FindHighPopDet Subroutine

public subroutine FindHighPopDet(TotWalkersNew)

Arguments

Type IntentOptional Attributes Name
integer :: TotWalkersNew

Contents

Source Code


Source Code

    SUBROUTINE FindHighPopDet(TotWalkersNew)

        ! Found the highest population on each processor, need to find out
        ! which of these has the highest of all.

        INTEGER(n_int) :: DetPos(0:NIfTot), DetNeg(0:NIfTot)
        INTEGER :: TotWalkersNew
        real(dp) :: HighPopInNeg(2), HighPopInPos(2), HighPopoutNeg(2), HighPopoutPos(2)
        real(dp) :: TempSign(lenof_sign)

        IF (TotWalkersNew > 0) THEN
            call extract_sign(CurrentDets(:, HighPopNeg), TempSign)
        ELSE
            TempSign(:) = 0.0_dp
        end if

        HighPopInNeg(1) = TempSign(1)
        HighPopInNeg(2) = real(iProcIndex, dp)

        CALL MPIAllReduceDatatype(HighPopinNeg, 1, MPI_MINLOC, MPI_2DOUBLE_PRECISION, HighPopoutNeg)

        IF (TotWalkersNew > 0) THEN
            call extract_sign(CurrentDets(:, HighPopPos), TempSign)
        ELSE
            TempSign(:) = 0.0_dp
        end if

        HighPopInPos(1) = TempSign(1)
        HighPopInPos(2) = real(iProcIndex, dp)

        CALL MPIAllReduceDatatype(HighPopinPos, 1, MPI_MAXLOC, MPI_2DOUBLE_PRECISION, HighPopoutPos)

        ! Now, on all processors, HighPopoutPos(1) is the highest positive
        ! population, and HighPopoutNeg(1) is the highest negative population.
        ! HighPopoutPos(2) is the processor the highest population came from.

        if (abs(iProcIndex - HighPopOutNeg(2)) < 1.0e-12_dp) DetNeg(:) = CurrentDets(:, HighPopNeg)
        if (abs(iProcIndex - HighPopOutPos(2)) < 1.0e-12_dp) DetPos(:) = CurrentDets(:, HighPopPos)

        ! This is a horrible hack, because the process argument should be of
        ! type 'integer' - whatever that is, but the highpopoutneg is
        ! explicitly an int(4), so that it works with MPI_2INTEGER. Because
        ! of the explicit interfaces, we need to do this.
        CALL MPIBcast(DetNeg, NIfTot + 1, int(HighPopOutNeg(2)))
        CALL MPIBcast(DetPos, NIfTot + 1, int(HighPopOutPos(2)))

        if (iProcIndex == 0) then
            write(stdout, '(a,f12.5,a)') 'The most highly populated determinant &
                                  & with the opposite sign to the HF has ', &
                                  HighPopoutNeg(1), ' walkers.'
            call WriteBitDet(stdout, DetNeg, .true.)

            write(stdout, '(a,f12.5,a9)') 'The most highly populated determinant &
                                  & with the same sign as the HF has ', &
                                  HighPopoutPos(1), ' walkers.'
            call WriteBitDet(stdout, DetPos, .true.)
        end if

        tPrintHighPop = .false.

    END SUBROUTINE FindHighPopDet