SymGenExcitItOld_GenDouble Subroutine

Subroutine SymGenExcitItOld_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
    INTEGER NK(NEL)
    INTEGER IFROM, ITO, ISPN
    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
    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
        K = K + 1
        IF (K < 0 .OR. K >= SymPairProds(ITO)%nIndex + SymPairProds(ITO)%nPairs) THEN
!.. K is invalid.  Get a new I
            K = 1
            I = I + 1
            IF (I > SYMPRODIND(2, ISPN, IFROM)) THEN
!.. I is now invalid
                I = -1
                iRet = 1
                RETURN
            ELSE
!.. reset K
                K = SymPairProds(ITO)%nIndex
            END IF
        END IF
!.. We've got a new K, so we need to reset some variables
        ICC(1) = SymStatePairs(1, K) * 2 - 1
        ICC(2) = ICC(1) + 1
        ICC(3) = SymStatePairs(2, K) * 2 - 1
        ICC(4) = ICC(3) + 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 same 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 SymGenExcitItOld_GenDouble