CalcPGenHPHF Subroutine

public subroutine CalcPGenHPHF(nI, iLutnI, nJ, iLutnJ, ex, ClassCount, ClassCountUnocc, pDoubles, pGen, tSameFunc)

Arguments

Type IntentOptional Attributes Name
integer, intent(in) :: nI(nel)
integer(kind=n_int), intent(in) :: iLutnI(0:niftot)
integer, intent(in) :: nJ(nel)
integer(kind=n_int), intent(in) :: iLutnJ(0:niftot)
integer, intent(in) :: ex(2,maxExcit)
integer, intent(in) :: ClassCount(ScratchSize)
integer, intent(in) :: ClassCountUnocc(ScratchSize)
real(kind=dp), intent(in) :: pDoubles
real(kind=dp), intent(out) :: pGen
logical, intent(out) :: tSameFunc

Contents

Source Code


Source Code

    subroutine CalcPGenHPHF(nI, iLutnI, nJ, iLutnJ, ex, ClassCount, ClassCountUnocc, pDoubles, pGen, tSameFunc)
        integer, intent(in) :: nI(nel)
        integer(kind=n_int), intent(in) :: iLutnI(0:niftot), iLutnJ(0:niftot)
        integer, intent(in) :: ClassCount(ScratchSize), ClassCountUnocc(ScratchSize)
        integer, intent(in) :: nJ(nel), ex(2, maxExcit)
        real(dp), intent(in) :: pDoubles
        real(dp), intent(out) :: pGen
        logical, intent(out) :: tSameFunc
        logical :: tSign, tSwapped
        real(dp) :: pGen2
        integer :: ic
        integer :: Ex2(2, maxExcit), nJ_loc(nel), nJ2(nel)
        integer(kind=n_int) :: iLutnJ_loc(0:niftot), iLutnJ2(0:niftot)
#ifdef DEBUG_
        character(*), parameter :: this_routine = "CalcPGenHPHF"
#endif
        tSameFunc = .false.
        pGen = 0.0_dp

        IF(TestClosedShellDet(iLutnJ)) THEN
            !nJ is CS, therefore, only one way of generating it.
            ic = FindBitExcitLevel(iLutnI, iLutnJ, 2)
            if(ic == 0) then
                tSameFunc = .true.
                return
            end if
            if(ic <= max_ex_level) then
                call CalcNonUniPGen(nI, ilutnI, ex, ic, ClassCount, ClassCountUnocc, pDoubles, pGen)
            end if
        else
            !nJ is openshell. Add the probabilities of generating each pair (if both connected)
            nJ_loc = nJ
            iLutnJ_loc = iLutnJ
            CALL ReturnAlphaOpenDet(nJ_loc, nJ2, iLutnJ_loc, iLutnJ2, .true., .true., tSwapped)

            !First find nI -> nJ
            ic = FindBitExcitLevel(iLutnI, iLutnJ_loc, 2)
            if(ic == 0) then
                tSameFunc = .true.
                return
            end if
            if(ic <= max_ex_level) then
                if(.not. tSwapped) then
                    !ex is correct for this excitation
                    call CalcNonUnipGen(nI, ilutnI, ex, ic, ClassCount, ClassCountUnocc, pDoubles, pGen)
                else
                    Ex2(1, 1) = ic
                    call GetBitExcitation(iLutnI, iLutnJ_loc, Ex2, tSign)
                    call CalcNonUnipGen(nI, ilutnI, Ex2, ic, ClassCount, ClassCountUnocc, pDoubles, pGen)
                end if
            end if

            !Now consider nI -> nJ2 and add the probabilities
            ic = FindBitExcitLevel(iLutnI, iLutnJ2, 2)
            if(ic == 0) then
                tSameFunc = .true.
                return
            end if
            if(ic <= max_ex_level) then
                if(tSwapped) then
                    !ex is correct for this excitation
                    call CalcNonUnipGen(nI, ilutnI, ex, ic, ClassCount, ClassCountUnocc, pDoubles, pGen2)
                else
                    Ex2(1, 1) = ic
                    call GetBitExcitation(iLutnI, iLutnJ2, Ex2, tSign)
                    call CalcNonUnipGen(nI, ilutnI, Ex2, ic, ClassCount, ClassCountUnocc, pDoubles, pGen2)
                end if
                pGen = pGen + pGen2
            end if
        end if

    end subroutine CalcPGenHPHF