SUBROUTINE FindSymSizeofSpace(IUNIT)
use SymData, only: TwoCycleSymGens
use SystemData, only: nEl, G1, nBasis, nOccAlpha, nOccBeta
use DeterminantData, only: FDet
IMPLICIT NONE
INTEGER :: ClassCounts(2, 0:7)
INTEGER :: Lima(0:7), Limb(0:7), a0, a1, a2, a3, a4, a5, a6, a7, NAlph
INTEGER :: b0, b1, b2, b3, b4, b5, b6, b7, NBet, i, IUNIT, OverallSym
INTEGER :: FDetSym
real(dp) :: Space, SpaceGrow
LOGICAL :: Sym(0:7)
write(IUNIT, *) "Calculating exact size of symmetry-allowed determinant space..."
FDetSym = 0
do i = 1, NEl
FDetSym = IEOR(FDetSym, int(G1(FDet(i))%Sym%S))
end do
write(stdout, *) "Symmetry of HF determinant is: ", FDetSym
CALL neci_flush(IUNIT)
ClassCounts(:, :) = 0
!First, we need to find the number of spatial orbitals in each symmetry irrep.
do i = 1, nBasis, 1
IF (G1(i)%Ms == 1) THEN
ClassCounts(1, int(G1(i)%Sym%S)) = &
ClassCounts(1, int(G1(i)%Sym%S)) + 1
ELSE
ClassCounts(2, int(G1(i)%Sym%S)) = &
ClassCounts(2, int(G1(i)%Sym%S)) + 1
end if
end do
do i = 0, 7
IF (mod((ClassCounts(1, i) + ClassCounts(2, i)), 2) /= 0) THEN
write(stdout, *) 'WARNING: Different number of symmetries between the alpha and beta orbitals.'
end if
end do
Lima(0) = min(nOccAlpha, ClassCounts(1, 0))
Limb(0) = min(nOccBeta, ClassCounts(2, 0))
Lima(1) = min(nOccAlpha, ClassCounts(1, 1))
Limb(1) = min(nOccBeta, ClassCounts(2, 1))
Lima(2) = min(nOccAlpha, ClassCounts(1, 2))
Limb(2) = min(nOccBeta, ClassCounts(2, 2))
Lima(3) = min(nOccAlpha, ClassCounts(1, 3))
Limb(3) = min(nOccBeta, ClassCounts(2, 3))
Lima(4) = min(nOccAlpha, ClassCounts(1, 4))
Limb(4) = min(nOccBeta, ClassCounts(2, 4))
Lima(5) = min(nOccAlpha, ClassCounts(1, 5))
Limb(5) = min(nOccBeta, ClassCounts(2, 5))
Lima(6) = min(nOccAlpha, ClassCounts(1, 6))
Limb(6) = min(nOccBeta, ClassCounts(2, 6))
Lima(7) = min(nOccAlpha, ClassCounts(1, 7))
Limb(7) = min(nOccBeta, ClassCounts(2, 7))
Space = 0.0_dp
!Loop over each irrep twice, once for alpha electrons and once for beta.
do a0 = 0, Lima(0)
do b0 = 0, Limb(0)
IF (mod(a0 + b0, 2) == 1) THEN
Sym(0) = .true.
ELSE
Sym(0) = .false.
end if
do a1 = 0, Lima(1)
do b1 = 0, Limb(1)
IF (mod(a1 + b1, 2) == 1) THEN
Sym(1) = .true.
ELSE
Sym(1) = .false.
end if
do a2 = 0, Lima(2)
do b2 = 0, Limb(2)
IF (mod(a2 + b2, 2) == 1) THEN
Sym(2) = .true.
ELSE
Sym(2) = .false.
end if
do a3 = 0, Lima(3)
do b3 = 0, Limb(3)
IF (mod(a3 + b3, 2) == 1) THEN
Sym(3) = .true.
ELSE
Sym(3) = .false.
end if
do a4 = 0, Lima(4)
do b4 = 0, Limb(4)
IF (mod(a4 + b4, 2) == 1) THEN
Sym(4) = .true.
ELSE
Sym(4) = .false.
end if
do a5 = 0, Lima(5)
do b5 = 0, Limb(5)
IF (mod(a5 + b5, 2) == 1) THEN
Sym(5) = .true.
ELSE
Sym(5) = .false.
end if
do a6 = 0, Lima(6)
do b6 = 0, Limb(6)
IF (mod(a6 + b6, 2) == 1) THEN
Sym(6) = .true.
ELSE
Sym(6) = .false.
end if
do a7 = 0, Lima(7)
do b7 = 0, Limb(7)
IF (mod(a7 + b7, 2) == 1) THEN
Sym(7) = .true.
ELSE
Sym(7) = .false.
end if
OverallSym = 0
do i = 0, 7
IF (Sym(i)) THEN
OverallSym = IEOR(OverallSym, i)
end if
end do
IF (OverallSym == FDetSym) THEN
NAlph = a0 + a1 + a2 + a3 + a4 + a5 + a6 + a7
NBet = b0 + b1 + b2 + b3 + b4 + b5 + b6 + b7
IF ((NAlph == NOccAlpha) .and. (NBet == NOccBeta)) THEN
SpaceGrow = 1.0_dp
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 0), a0)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 0), b0)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 1), a1)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 1), b1)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 2), a2)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 2), b2)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 3), a3)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 3), b3)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 4), a4)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 4), b4)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 5), a5)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 5), b5)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 6), a6)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 6), b6)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(1, 7), a7)
SpaceGrow = SpaceGrow * choose_i64(ClassCounts(2, 7), b7)
Space = Space + SpaceGrow
end if
end if
end do
end do
end do
end do
end do
end do
end do
end do
end do
end do
end do
end do
end do
end do
end do
end do
write(IUNIT, "(A,G25.16)") " *EXACT* size of symmetry allowed space of determinants is: ", Space
CALL neci_flush(IUNIT)
END SUBROUTINE FindSymSizeofSpace