SymSetupExcitsAb_StoreSing Subroutine

subroutine SymSetupExcitsAb_StoreSing(nExcitTypes, nCl, Classes, ThisClassCount, ExcitTypes)

Arguments

Type IntentOptional Attributes Name
integer :: nExcitTypes
integer :: nCl
type(SymClass) :: Classes(nCl)
integer :: ThisClassCount(2,*)
integer :: ExcitTypes(5,*)

Contents


Source Code

Subroutine SymSetupExcitsAb_StoreSing(nExcitTypes, nCl, Classes, ThisClassCount, ExcitTypes)
    use SystemData, only: Symmetry
    use SymData, only: SymClass, SymLabelCounts, nSymLabels, SymLabels
    IMPLICIT NONE
    INTEGER nCl
    INTEGER nExcitTypes
    INTEGER ThisClassCount(2, *)
    Type(SymClass) Classes(nCl)
    INTEGER I, ICC
    INTEGER ExcitTypes(5, *)
!nExcitTypes is reset to zero before this routine - the nExcitTypes will be incremented for doubles later.
!Loop over all symmetry classes of your electrons
    DO I = 1, nCl

!First deal with alpha spins - there are ThisClassCount(1,I) alpha spins in this determinant.
!We need to know how many unoccupied alpha spins with the same symmetry there are.
!There are SymLabelCounts(1,Classes(I)%SymLab) total alpha spin-orbitals with the same symmetry.
!SymLabelCounts(2,Classes(I)%SymLab)-ThisClassCount(1,I) indicates the number of unoccupied alpha orbitals with the required symmetry.
!Each electron can excite to each unoccupied orbital, giving us the number of single excitations for this symmetry and spin
        IF (ThisClassCount(1, I) /= 0) THEN
!Aren't going to be any singles if there are no electrons of that spin in the symmetry...
            ICC = (SymLabelCounts(2, Classes(I)%SymLab) - ThisClassCount(1, I)) * ThisClassCount(1, I)
            IF (ICC /= 0) THEN
!We have found some alpha->alpha single excitations of a new 'type'
                nExcitTypes = nExcitTypes + 1
!Put information on these type of excitation into the excittypes array
                ExcitTypes(1, nExcitTypes) = 1     !Its a single
                ExcitTypes(2, nExcitTypes) = 1     !Its an alpha->alpha excitation
                ExcitTypes(3, nExcitTypes) = I     !Symmetry class of occupied orbital
                ExcitTypes(4, nExcitTypes) = Classes(I)%SymLab
!Symmetry class of virtual orbital (the same!)
!However, it wants to be the symmetry class from all
!symmetry classes
                ExcitTypes(5, nExcitTypes) = ICC   !Number of this type of excitation
            END IF

        END IF

!Now do the same for beta spins
        IF (ThisClassCount(2, I) /= 0) THEN
            ICC = (SymLabelCounts(2, Classes(I)%SymLab) - ThisClassCount(2, I)) * ThisClassCount(2, I)
            IF (ICC /= 0) THEN
!We have found some beta single excitations of a new 'type'
                nExcitTypes = nExcitTypes + 1
!Put information on these type of excitation into the excittypes array
                ExcitTypes(1, nExcitTypes) = 1     !Its a single
                ExcitTypes(2, nExcitTypes) = 2     !Its an beta->beta excitation
                ExcitTypes(3, nExcitTypes) = I     !Symmetry class of occupied orbital
                ExcitTypes(4, nExcitTypes) = Classes(I)%SymLab
!Symmetry class of virtual orbital (the same!)
!However, it wants to be the symmetry class from all
!symmetry classes
                ExcitTypes(5, nExcitTypes) = ICC   !Number of this type of excitation
            END IF
        END IF

    END DO

End Subroutine SymSetupExcitsAb_StoreSing