CreateRandomExcitLevDet Subroutine

public subroutine CreateRandomExcitLevDet(iExcitLevTest, FDet, FDetiLut, iLut, ExcitLev, Attempts)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: iExcitLevTest
integer, intent(in) :: FDet(NEl)
integer(kind=n_int), intent(in) :: FDetiLut(0:NIfTot)
integer(kind=n_int), intent(out) :: iLut(0:NIfTot)
integer, intent(out) :: ExcitLev
integer, intent(out) :: Attempts

Contents


Source Code

    SUBROUTINE CreateRandomExcitLevDet(iExcitLevTest, FDet, FDetiLut, iLut, ExcitLev, Attempts)
        use SystemData, only: nEl, G1, nBasis
        use SystemData, only: tUEG, tHPHF, tHub
        use SystemData, only: tFixLz
        use dSFMT_interface
        use bit_rep_data, only: NIfTot
        use DetBitOps, only: IsAllowedHPHF
        integer, intent(in) :: iExcitLevTest, FDet(NEl)
        integer, intent(out) :: ExcitLev, Attempts
        integer(n_int), intent(out) :: iLut(0:NIfTot)
        integer(n_int), intent(in) :: FDetiLut(0:NIfTot)
        logical :: tSymAllowedDet, tNotAllowed
        integer :: TotalSym, TotalMom, TotalMs, Momx, Momy, Momz, j, Elec, Orb, Hole
        real(dp) :: r

        Attempts = 0 !Count the number of attempts needed to generate the sym-allowed determinant.

        tSymAllowedDet = .false.
        do while (.not. tSymAllowedDet)

            TotalSym = 0
            TotalMom = 0
            TotalMs = 0
            Momx = 0
            Momy = 0
            Momz = 0
            ExcitLev = 0
            iLut(:) = FDetiLut(:)

            !Create random determinant
            !Loop over holes in occupied space
            do j = 1, iExcitLevTest

                tNotAllowed = .true.
                do while (tNotAllowed)  !Loop until we have created an allowed hole.
                    r = genrand_real2_dSFMT()
                    Elec = int(NEl * r) + 1
                    Orb = FDet(Elec)

                    !Electron picked must not be one which has been picked before
                    !i.e. it must be occupied in iLut
                    if (IsOcc(iLut, Orb)) then
                        !Clear orbital to indicate it is gone.
                        clr_orb(iLut, Orb)
                        tNotAllowed = .false.
                        !Deal with totting up the symmetry for the now unocc orbital
                        TotalSym = IEOR(TotalSym, int((G1(Orb)%Sym%S)))
                        TotalMom = TotalMom + G1(Orb)%Ml
                        TotalMs = TotalMs + G1(Orb)%Ms
                        IF (tUEG .or. tHub) THEN
                            Momx = Momx + G1(Orb)%k(1)
                            Momy = Momy + G1(Orb)%k(2)
                            Momz = Momz + G1(Orb)%k(3)
                        end if
                    end if
                end do
            end do

            !Loop over electrons in the unoccupied space
            do j = 1, iExcitLevTest

                tNotAllowed = .true.
                do while (tNotAllowed)  !Loop until we have created an allowed electron
                    r = genrand_real2_dSFMT()
                    Hole = int(nBasis * r) + 1

                    if (IsNotOcc(iLut, Hole)) then
                        !Set orbital to indicate it is now occupied
                        set_orb(iLut, Hole)
                        tNotAllowed = .false.
                        !Increase excitation level
                        if (IsNotOcc(FDetiLut, Hole)) ExcitLev = ExcitLev + 1
                        !Deal with totting up the symmetry for the now occ orbital
                        TotalSym = IEOR(TotalSym, int((G1(Hole)%Sym%S)))
                        TotalMom = TotalMom - G1(Hole)%Ml
                        TotalMs = TotalMs - G1(Hole)%Ms
                        if (tUEG .or. tHub) then
                            Momx = Momx - G1(Hole)%k(1)
                            Momy = Momy - G1(Hole)%k(2)
                            Momz = Momz - G1(Hole)%k(3)
                        end if
                    end if
                end do
            end do

            if ((TotalSym == 0) .and. (TotalMom == 0) .and. (Momx == 0) .and. (Momy == 0) .and. (Momz == 0) .and. (TotalMs == 0)) then
                !Created determinant is symmetry allowed.
                if (tHPHF) then
                    if (IsAllowedHPHF(iLut)) tSymAllowedDet = .true.
                else
                    tSymAllowedDet = .true.
                end if
            end if

            Attempts = Attempts + 1

        end do

    END SUBROUTINE CreateRandomExcitLevDet