GENMOLPSYMTABLE Subroutine

public subroutine GENMOLPSYMTABLE(NSYMMAX, G1, NBASIS)

Arguments

Type IntentOptional Attributes Name
integer :: NSYMMAX
type(BasisFN) :: G1(*)
integer :: NBASIS

Contents

Source Code


Source Code

    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