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