GENSYMTABLE Subroutine

public subroutine GENSYMTABLE()

Arguments

None

Contents

Source Code


Source Code

    SUBROUTINE GENSYMTABLE
        IMPLICIT NONE
        INTEGER I, J, K
        complex(dp) CHARS(NROT)
        TYPE(Symmetry) IDECOMP
        real(dp) CNORM
        character(*), parameter :: this_routine = 'GENSYMTABLE'
        allocate(SymTable(nSym, nSym))
        call LogMemAlloc('SymTable', nSym**2, SymmetrySize, this_routine, tagSymTable)
        allocate(SymConjTab(nSym))
        call LogMemAlloc('SymConjTab', nSym, 4, this_routine, tagSymConjTab)
        DO I = 1, NSYM
            DO K = 1, NROT
                CHARS(K) = CONJG(IRREPCHARS(K, I))
            end do
            IF (GETIRREPDECOMP(CHARS, IRREPCHARS, NSYM, NROT, IDECOMP, CNORM, TAbelian)) THEN
                write(stdout, *) "Conjugate of SYM ", I, " not reducible,"
                CALL writechars(stdout, CHARS, NROT, "REMAIN")
                call stop_all(this_routine, "Symmetry table element not conjugable")
            end if
            K = 0
            DO WHILE (.NOT. BTEST(IDECOMP%s, 0))
                K = K + 1
!RSHIFT(,1)
                IDECOMP%s = ISHFT(IDECOMP%s, -1)
            end do
            IF (IDECOMP%s /= 1) THEN
                write(stdout, *) "Conjugate of SYM ", I, " not a single SYM,"
                call stop_all(this_routine, 'Incorrect sym conjugate')
            end if
            SymConjTab(I) = K + 1
            DO J = I, NSYM
                DO K = 1, NROT
                    CHARS(K) = IRREPCHARS(K, I) * IRREPCHARS(K, J)
                end do
                IF (GETIRREPDECOMP(CHARS, IRREPCHARS, NSYM, NROT, IDECOMP, CNORM, TAbelian)) THEN
                    write(stdout, *) "Multiplication of SYMS ", I, J, " not reducible,"
                    CALL writechars(stdout, CHARS, NROT, "REMAIN")
                    call stop_all(this_routine, "Symmetry table element not reducible")
                end if
                SYMTABLE(I, J) = IDECOMP
                SYMTABLE(J, I) = IDECOMP
!               write(stdout,"(2I3,B12)") I,J,IDECOMP
            end do
        end do
        write(stdout, *) "Symmetry, Symmetry Conjugate"
        DO I = 1, NSYM
            write(stdout, *) I, SymConjTab(I)
        end do
    END SUBROUTINE GENSYMTABLE