SymGenExcitIt_GenDouble Subroutine

Subroutine SymGenExcitIt_GenDouble(iRet, SPP, I, K, L, iTo, iSpn, iFrom, iCC, iLUT, LS, OrbPairs, SymProdInd, nI, nK, nEl, iC, tDebugPrint)
    use SystemData, only: TSTOREASEXCITATIONS
    use SystemData, only: Symmetry, SymmetrySize, SymmetrySizeB
    use SystemData, only: BasisFN, BasisFNSize, BasisFNSizeB
    use SymData, only: SymLabelCounts, SymStatePairs, SymClass
    use SymData, only: SymLabelList, SymPairProds
    IMPLICIT NONE
    INTEGER NEL, NI(NEL)

    INTEGER I, K, L, iTo, iFrom, iSpn
    INTEGER NK(NEL)
    TYPE(Symmetry) SPP
    INTEGER ICC(4)
!.. 1,1= 1B, 1,2=1A; 2,1=2B, 2,2=2A.
    LOGICAL LS(2, 2)

    INTEGER ORBPAIRS(2, *)
    INTEGER ILUT(0:*)
    INTEGER SYMPRODIND(2, 3, 1:*)
    INTEGER IC
    LOGICAL tDebugPrint

    INTEGER iRet
    INTEGER iLooped
    INTEGER iTo1, iTo2
    iRet = 0
!.. doubles
    SPP = SymPairProds(ITO)%Sym
!.. See if we need a new K.  L is the spin label, and goes from 1..4.
    IF (L > 4) THEN
        L = 1
        Call SymGenExcitIt_GetNextPair(K, iTo, iLooped, iTo1, iTo2, tDebugPrint)
        IF (iLooped /= 0) THEN
!.. K is invalid.  Get a new I
            I = I + 1
            IF (I > SYMPRODIND(2, ISPN, IFROM)) THEN
!.. I is now invalid
                I = -1
                iRet = 1
                RETURN
            END IF
        END IF
!.. We've got a new K, so we need to reset some variables
        ICC(1) = iTo1
        ICC(2) = iTo1 + 1
        ICC(3) = iTo2
        ICC(4) = iTo2 + 1
!                     WRITE(stdout,*) ORBPAIRS(1,SYMPRODIND(1,ISPN,IFROM)+I),
!     &                      ORBPAIRS(2,SYMPRODIND(1,ISPN,IFROM)+I)
!                     WRITE(stdout,*) ISPN,ICC(1),ICC(3)
        LS(1, 1) = BTEST(ILUT((ICC(1) - 1) / 32), MOD(ICC(1) - 1, 32))
        LS(1, 2) = BTEST(ILUT((ICC(2) - 1) / 32), MOD(ICC(2) - 1, 32))
        LS(2, 1) = BTEST(ILUT((ICC(3) - 1) / 32), MOD(ICC(3) - 1, 32))
        LS(2, 2) = BTEST(ILUT((ICC(4) - 1) / 32), MOD(ICC(4) - 1, 32))
    END IF
!.. Now check for an excitation
    IF (L == 1) THEN
        L = 2
        IF (ISPN == 1 .AND. ICC(1) /= ICC(3) .AND. .NOT.(LS(1, 1) .OR. LS(2, 1))) THEN
            Call SymGenExcitIt_MakeDouble( &
                ORBPAIRS(1, SYMPRODIND(1, ISPN, IFROM) + I), &
                ORBPAIRS(2, SYMPRODIND(1, ISPN, IFROM) + I), &
                ICC(1), ICC(3), nI, nK, nEl, tDebugPrint)
            IC = 2
            iRet = 2
            RETURN
        END IF
    END IF
    IF (L == 2) THEN
        L = 3
        IF (ISPN == 2) THEN
!.. If neither virtuals are in NI, then allow
            IF (.NOT.(LS(1, 1) .OR. LS(2, 2))) THEN
                Call SymGenExcitIt_MakeDouble( &
                    ORBPAIRS(1, SYMPRODIND(1, ISPN, IFROM) + I), &
                    ORBPAIRS(2, SYMPRODIND(1, ISPN, IFROM) + I), &
                    ICC(1), ICC(4), nI, nK, nEl, tDebugPrint)
                IC = 2
                iRet = 2
                RETURN
            END IF
        END IF
    END IF
    IF (L == 3) THEN
        L = 4
        IF (ISPN == 2) THEN
!.. If neither virtuals are in NI, and they're not the same(which would give
!.. us the same excitation as previously), then allow
            IF (.NOT.(LS(1, 2) .OR. LS(2, 1)) .AND. ICC(1) /= ICC(3)) THEN
                Call SymGenExcitIt_MakeDouble( &
                    ORBPAIRS(1, SYMPRODIND(1, ISPN, IFROM) + I), &
                    ORBPAIRS(2, SYMPRODIND(1, ISPN, IFROM) + I), &
                    ICC(2), ICC(3), nI, nK, nEl, tDebugPrint)
                IC = 2
                iRet = 2
                RETURN
            END IF
        END IF
    END IF
    IF (L == 4) THEN
        L = 5
        IF (ISPN == 3) THEN
!.. If both virtuals aren't the samem and neither are in NI, then allow
            IF (ICC(1) /= ICC(3) .AND. .NOT.(LS(1, 2) .OR. LS(2, 2))) THEN
                Call SymGenExcitIt_MakeDouble( &
                    ORBPAIRS(1, SYMPRODIND(1, ISPN, IFROM) + I), &
                    ORBPAIRS(2, SYMPRODIND(1, ISPN, IFROM) + I), &
                    ICC(2), ICC(4), nI, nK, nEl, tDebugPrint)
                IC = 2
                iRet = 2
                RETURN
            END IF
        END IF
    END IF
End Subroutine SymGenExcitIt_GenDouble