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