SymGenExcitIt_GenSingle Subroutine

Subroutine SymGenExcitIt_GenSingle(iRet, iSpn, iFrom, iTo, iCC, I, J, K, L, tDebugPrint, iMaxElec1, iC, nI, nK, nEl)
    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
    use constants, only: maxExcit, stdout
    use util_mod, only: stop_all
    use excit_mod, only: FindExcitDet

    IMPLICIT NONE
    INTEGER nEl, nI(nEl)

    INTEGER I, J, K, L
    INTEGER nK(nEl)
    INTEGER iFrom, iTo, iSpn
    INTEGER ICC(4)

    INTEGER IFROMSL, ITOSL
    LOGICAL L1, L2, TParity
!.. 1,1= 1B, 1,2=1A; 2,1=2B, 2,2=2A.

    INTEGER iC, ExcitMat(2, maxExcit)
    LOGICAL tDebugPrint
    INTEGER iMaxElec1

    INTEGER iRet
    character(*), parameter:: this_routine = 'SymGenExcitIt_GenSingle'

!.. singles
!.. We always need a new K.  K and L run in parallel
    K = K + 1
!.. We've stored IFROMSL in ICC1
    IFROMSL = ICC(1)
!.. For each K, we check to see if it's valid
    IF (K >= SYMLABELCOUNTS(2, ITO)) THEN
!.. no more possible K, so we get a new I
        K = -1
        L = 0
!.. I and J run in parallel, and for each J, we check whether it's in
!.. the det.  If it is, then we carry on.
!.. SYMLABELLIST holds a list of states grouped under symmlabel, and ordered within that symlabel
!.. SYMLABELCOUNTS(1,J) is the index within SYMLABELLIST of the first state of symlabel J
!.. SYMLABELCOUNTS(2,J) is the number of states with symlabel J
!..  J runs along the symlabel looking for states of that symmetry
!..  I runs along the determinant comparing against electrons of that symmetry.
!..  We're looking for electrons in the det which are also in the SYMLABELLIST, and we run I and J
!..   in parallel along each to keep the search efficient.
!  instead of NEL, we have iMaxElec1
        L2 = I < iMaxElec1
        L1 = .TRUE.
!  This loop, dependent on L2 gets a new I
        DO WHILE (L2)
            I = I + 1
            L1 = J < SYMLABELCOUNTS(2, IFROM)
!  This loop dependent on L1 gets a new J
            DO WHILE (L1)
                IFROMSL = (SYMLABELLIST(SYMLABELCOUNTS(1, IFROM) + J) * 2 + ISPN)
                ICC(1) = IFROMSL
!                     WRITE(stdout,*) I,NI(I),J,IFROM,IFROMSL
!  If J points to an electron lower than the current in the det, inc J
                IF (IFROMSL < NI(I)) J = J + 1
!  If J was a lower elec, and there are more J to get, then carry on in this loop
                L1 = IFROMSL < NI(I) .AND. J < SYMLABELCOUNTS(2, IFROM)
            END DO
!.. see if we need a new I because NI(I)<IFROMSL which is the current electron corresponging to J.
!  Instead of NEL we have iMaxElec1
            L2 = IFROMSL /= NI(I) .AND. I < iMaxElec1
!  If I.EQ.NEL, then we're run out of electrons, because the next electron we get will be in pos NEL+1
        END DO
!.. If we've gone too far, signal a new excit
!  If L1 is true then we never made it into the get new J loop because L2 was FALSE because there were no more electrons to get in the det. Alternatively we've hit the last electron in the det, and not found a correspondence in the sym excit list.  Either way we signal to give up on this set of excitations, as we cannot find a valid I.
!  Instead of NEL we use iMaxElec1
        IF (L1 .OR. (I == iMaxElec1 .AND. IFROMSL /= NI(I))) I = -1

!  Cycle back to the beginning with our new valid I (or invalid I signalling find a new excit type), and look for a K
        iRet = 1
        RETURN
    END IF
!.. it's a valid K, but is it in the det already?
!.. ITOSL is the orb it corresponds to
    ITOSL = 2 * SYMLABELLIST(SYMLABELCOUNTS(1, ITO) + K) + ISPN
!.. Check if it's in the det
    L2 = .TRUE.
!            WRITE(stdout,*) SYMLABELCOUNTS(2,ITO),ITOSL
    DO WHILE (L2)
        L = L + 1
        L2 = .false.
        if (L <= nel) then
            if (nI(L) < iToSL) L2 = .true.
        end if
    END DO
    IF (L <= NEL) then
    if (NI(L) == ITOSL) THEN
!.. We've found an L in the det which is the same as ITOSL.
!.. we go round again, getting another K
        iRet = 1
        RETURN
    end if
    END IF
    L = L - 1
!.. hoorah!  We've got an I in the det, and a K not in the det.  Create an excitation
    IF (tStoreAsExcitations) THEN
!The excitation storage starts with -1.  The next number is the excitation level,L .  Next is the parity of the permutation required to lineup occupied->excited.  Then follows a list of the indexes of the L occupied orbitals within the HFDET, and then L virtual spinorbitals.
        NK(1) = -1
        NK(2) = 1
        NK(3) = 0
        NK(4) = NI(I)
        NK(5) = ITOSL
        call stop_all(this_routine, 'tStoreAsExcitations not tested for singles.')
    ELSE
!            CALL NECI_ICOPY(NEL,NI,1,NK,1)
        NK(1:NEL) = NI(1:NEL)
        IF (tDebugPrint) WRITE(stdout, *) "[", NK(I), "->", ITOSL, "]"
        ExcitMat(1, 1) = I
        ExcitMat(2, 1) = ITOSL
!            NK(I)=ITOSL
!            CALL NECI_SORTI(NEL,NK)
        CALL FindExcitDet(ExcitMat, NK, 1, TParity)
        IC = 1
    END IF
!.. quit the do loop
    iRet = 2
    RETURN
End Subroutine SymGenExcitIt_GenSingle