CountExcitations3 Subroutine

public subroutine CountExcitations3(nI, exflag, nSingleExcits, nDoubleExcits)


Type IntentOptional Attributes Name
integer :: nI(NEl)
integer :: exflag
integer :: nSingleExcits
integer :: nDoubleExcits


Source Code

Source Code

    SUBROUTINE CountExcitations3(nI, exflag, nSingleExcits, nDoubleExcits)
! This routine simply counts the excitations in terms of single and doubles from the nI determinant.
! The exflag sent through indicates which should be counted - exflag=1 means only singles, exflag=2 means
! only doubles, and anything else both are counted.
        USE SymData, only: nSymLabels
        USE SystemData, only: ElecPairs, tFixLz, iMaxLz
        USE GenRandSymExcitNUMod, only: PickElecPair, construct_class_counts, ClassCountInd, ScratchSize
        INTEGER :: nSingleExcits, nDoubleExcits, Symi, i, Spini, nI(NEl)
        INTEGER :: iSpn, Elec1Ind, Elec2Ind, SymProduct, exflag
        INTEGER :: Syma, Symb, Spina, Spinb, StartSpin, EndSpin
        INTEGER :: ClassCount2(ScratchSize), SumMl
        INTEGER :: ClassCountUnocc2(ScratchSize)
        INTEGER :: StartMl, EndMl, Mla, Mlb

        CALL construct_class_counts(nI, ClassCount2, ClassCountUnocc2)
! This sets up arrays containing the number of occupied and unoccupied in each symmetry.
! ClassCounts2(1,:)=No alpha occupied, ClassCounts2(2,:)=No Beta occupied.
! ClassCountsUnocc2(1,:)=No alpha unocc, ClassCounts2Unocc2(2,:)=No Beta unocc.
! The second index of these arrays referrs to the symmetry (0 -> 7).

! Only counting.  Run through each occupied orbital, and count the number of spin and symmetry allowed orbitals it
! may be excited to.
        nSingleExcits = 0
        nDoubleExcits = 0

        IF (exflag /= 2) THEN
! Count the singles.
! Take each electron and find out the number of symmetry allowed orbitals it may be excited to.
            do i = 1, NEl
                Symi = SpinOrbSymLabel(nI(i))
                IF ((G1(nI(i))%Ms) == -1) Spini = 2        ! G1(i)%Ms is -1 for beta, and 1 for alpha.
                IF ((G1(nI(i))%Ms) == 1) Spini = 1         ! Translate this into 1 for alpha and 2 for beta
                ! for the ClassCount arrays.
                IF (tFixLz) THEN
                    Mla = G1(nI(i))%Ml
                    Mla = 0
                end if

! This electron in orbital of SymI and SpinI can only be excited to orbitals with the same spin and symmetry.
! Then add in the number of unoccupied orbitals with the same spin and symmetry to which each electron may be excited.

                nSingleExcits = nSingleExcits + ClassCountUnocc2(ClassCountInd(Spini, Symi, Mla))

            end do
        end if

! This is the end of the singles.
!            write(stdout,*) 'Number of singles',nSingleExcits

! For the doubles, first pick an electron pair i,j.
! Based on these orbitals, run through each spin and each symmetry - take this to be orbital a.
! Multiply the number with these symmetries by the number of possible b orbitals which correspond.
! Do this for all a and then all i,j pairs.

        IF (exflag /= 1) THEN
            do i = 1, ElecPairs

! iSpn=2 for alpha beta pair, ispn=3 for alpha alpha pair and ispn=1 for beta beta pair.
                CALL PickElecPair(nI, Elec1Ind, Elec2Ind, SymProduct, iSpn, SumMl, i)

                StartSpin = 1
                EndSpin = 2
                IF (iSpn == 3) EndSpin = 1
                IF (iSpn == 1) StartSpin = 2
                do Spina = StartSpin, EndSpin            ! Run through both spins, orbital a may be alpha or beta.
                    IF (iSpn == 2) THEN
! Spin of orbital b should be opposite to orbital a.
                        IF (Spina == 1) Spinb = 2
                        IF (Spina == 2) Spinb = 1
! Spin of orbital b should be the same as orbital a.
                        IF (Spina == 1) Spinb = 1
                        IF (Spina == 2) Spinb = 2
                    end if

                    do Syma = 0, nSymLabels - 1

! Need to work out the symmetry of b, given the symmetry of a (Sym).
                        Symb = IEOR(Syma, SymProduct)

                        IF (tFixLz) THEN
                            StartMl = -iMaxLz
                            EndMl = iMaxLz
                            StartMl = 0
                            EndMl = 0
                        end if

                        do Mla = StartMl, EndMl

                            Mlb = SumMl - Mla   !Will be 0 if no Lz, otherwise we need Mla + Mlb = Mli + Mlj = SumMl

                            IF (ABS(Mlb) <= iMaxLz) THEN
                                IF ((Spina == Spinb) .and. (Syma == Symb) .and. (Mla == Mlb)) THEN
                                    ! If the spin and spatial symmetries of a and b are the same
                                    ! there will exist a case where Orba = Orbb, want to remove this.
                                    nDoubleExcits = nDoubleExcits + (ClassCountUnocc2(ClassCountInd(Spina, Syma, Mla)) &
                                                                     * (ClassCountUnocc2(ClassCountInd(Spinb, Symb, Mlb)) - 1))
                                    nDoubleExcits = nDoubleExcits + (ClassCountUnocc2(ClassCountInd(Spina, Syma, Mla)) &
                                                                     * ClassCountUnocc2(ClassCountInd(Spinb, Symb, Mlb)))
                                end if
                            end if
                        end do

                    end do

                end do
            end do
            nDoubleExcits = nDoubleExcits / 2

        end if

    ENDSUBROUTINE CountExcitations3