SymSetupExcitsAb_CountSing Subroutine

subroutine SymSetupExcitsAb_CountSing(nSing, nCl, nExcitTypes, ThisClassCount, Classes)

Arguments

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

Contents


Source Code

Subroutine SymSetupExcitsAb_CountSing(nSing, nCl, nExcitTypes, ThisClassCount, Classes)
    use SystemData, only: Symmetry
    use SymData, only: SymClass, SymLabelCounts, nSymLabels, SymLabels
    IMPLICIT NONE
    INTEGER nSing
    INTEGER nCl
    INTEGER nExcitTypes
    INTEGER ThisClassCount(2, *)
    Type(SymClass) Classes(nCl)
    INTEGER I, ICC
    nSing = 0
!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
                nSing = nSing + ICC
                nExcitTypes = nExcitTypes + 1
            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 single excitations
                nSing = nSing + ICC
                nExcitTypes = nExcitTypes + 1
            END IF
        END IF

    END DO

End Subroutine SymSetupExcitsAb_CountSing