SymGenExcitIt_MakeDouble Subroutine

subroutine SymGenExcitIt_MakeDouble(iFrom1, iFrom2, iTo1, iTo2, nI, nK, nEl, tDebugPrint)

Arguments

Type IntentOptional Attributes Name
integer :: iFrom1
integer :: iFrom2
integer :: iTo1
integer :: iTo2
integer :: nI(nEl)
integer :: nK(nEl)
integer :: nEl
logical :: tDebugPrint

Contents


Source Code

Subroutine SymGenExcitIt_MakeDouble(iFrom1, iFrom2, iTo1, iTo2, nI, nK, nEl, tDebugPrint)
    use SystemData, only: TSTOREASEXCITATIONS
    use constants, only: maxExcit, stdout
    use excit_mod, only: FindExcitDet

    IMPLICIT NONE
    INTEGER iFrom1, iFrom2
    INTEGER iTo1, iTo2, ExcitMat(2, maxExcit)
    INTEGER nEl, nI(nEl), nK(nEl)
    LOGICAL tDebugPrint, TParity
    INTEGER J
    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) = 2
        NK(3) = 1
        NK(4) = iFrom1
        NK(5) = iFrom2
        NK(6) = iTo1
        NK(7) = iTo2
    ELSE
!            CALL NECI_ICOPY(NEL,NI,1,NK,1)
        NK(1:NEL) = NI(1:NEL)
        DO J = 1, NEL
        IF (NI(J) == iFrom1) THEN
            IF (tDebugPrint) WRITE(stdout, "(A,I3,A,I3,A)", advance='no') "[", iFrom1, "->", iTo1, ","
            ExcitMat(1, 1) = J
            ExcitMat(2, 1) = iTo1
!                  NK(J)=iTo1
        END IF
        IF (NI(J) == iFrom2) THEN
            IF (tDebugPrint) WRITE(stdout, *) iFrom2, "->", iTo2, "]"
            ExcitMat(1, 2) = J
            ExcitMat(2, 2) = iTo2
!                  NK(J)=iTo2
        END IF
        END DO
!                     CALL WRITEDET(6,NK,NEL,.TRUE.)
!            CALL NECI_SORTI(NEL,NK)
        CALL FindExcitDet(ExcitMat, NK, 2, TParity)
    END IF
End Subroutine SymGenExcitIt_MakeDouble