SUBROUTINE GENMOLPSYMTABLE(NSYMMAX, G1, NBASIS)
IMPLICIT NONE
INTEGER NSYMMAX, nSymGen
INTEGER I, ILABEL
TYPE(BasisFN) G1(*)
INTEGER NBASIS
character(*), parameter :: this_routine = 'GenMolPSymTable'
TAbelian = .true.
nSymGen = INT(log(NSYMMAX + 0.0_dp) / log(2.0_dp) + .4_dp)
write(stdout, "(A,I3,A)") " Generating abelian symmetry table with", &
nSymGen, " generators"
write(stdout, '(A,'//int_fmt(nSymMax)//')') &
" Number of symmetry classes: ", nSymMax
! We actually use momentum conservation directly for the UEG and
! Hubbard mode so just fake the symmetry information here.
! WARNING: do *not* use SymConj etc for these systems without fixing
! this---functions which rely upon the wavevectors being encoded into
! a symmetry integer will not work.
if (TwoCycleSymGens .or. tUEG .or. tHUB) then
! Set propogation information.
! If not TwoCycleSymGens we assume the user has already
! done so...
nprop = 1
nprop(1:min(nSymGen, 3)) = 2
end if
! Now generate a list of sym labels.
NSYMLABELS = NSYMMAX
if (.not. allocated(SymLabels)) allocate(SymLabels(nSymLabels))
call LogMemAlloc('SymLabels', nSymLabels, SymmetrySize, this_routine, tagSymLabels)
if (.not. associated(SymClasses)) allocate(SymClasses(nBasis))
call LogMemAlloc('SymClasses', nBasis, 4, this_routine, tagSymClasses)
if (.not. allocated(SymConjTab)) allocate(SymConjTab(nSymlabels))
call LogMemAlloc('SymConjTab', nSymlabels, 4, this_routine, tagSymConjTab)
if (TwoCycleSymGens .or. tUEG) then
DO I = 1, NBASIS, 2
! place the sym label of each state in SymClasses(ISTATE). For molp sym, this is
! the log_2 of the symmetry bit string
IF (G1(I)%Sym%s == 0) THEN
! we don't have symmetry, so fake it.
SymClasses((I + 1) / 2) = 1
ELSE
SymClasses((I + 1) / 2) = int(G1(I)%Sym%s) + 1
end if
end do
! list the symmetry string of each sym label
DO I = 1, NSYMLABELS
SYMLABELS(I)%s = I - 1
! Abelian representations are self-inverses if the group is
! real.
SymConjTab(I) = I
end do
#ifdef DEBUG_
write(stdout, *) "Label, Sym, SymConjLabel, SymConj, SymProd"
do i = 1, nsymlabels
write(stdout, "(5I12)") i, symlabels(i), SymConjTab(i), symlabels(SymConjTab(i)), &
SYMPROD(symlabels(i), symlabels(SymConjTab(i)))
end do
#endif
else if (.not. tHUB .or. treal) then
! Hubbard symmetry info set up in GenHubMomIrrepsSymTable.
! except for the real-space lattice!
symlabels(:)%s = -1
do i = 1, nbasis, 2
do ilabel = 1, nsymlabels
if (symlabels(ilabel)%s == g1(i)%sym%s) then
! Already found this symmetry label.
symclasses((i + 1) / 2) = ilabel
exit
else if (symlabels(ilabel)%s == -1) then
! Have not found this label...
symclasses((i + 1) / 2) = ilabel
symlabels(ilabel)%s = g1(i)%sym%s
exit
end if
end do
end do
! Find inverses.
do ilabel = 1, nsymlabels
do i = 1, nsymlabels
if (SymEq(symlabels(i), SymConj(symlabels(ilabel)))) then
SymConjTab(ilabel) = i
exit
end if
end do
end do
#ifdef DEBUG_
write(stdout, *) "Label, Sym, SymConjLabel, SymConj, SymProd"
do i = 1, nsymlabels
write(stdout, "(5I12)") i, symlabels(i), SymConjTab(i), symlabels(SymConjTab(i)), &
SYMPROD(symlabels(i), symlabels(SymConjTab(i)))
end do
#endif
end if
END SUBROUTINE GENMOLPSYMTABLE