SUBROUTINE GENIRREPS(TKP, IMPROPER_OP, NROTOP)
IMPLICIT NONE
INTEGER I, J, K
LOGICAL LDO, LDO2
TYPE(Symmetry) iDecomp
INTEGER NEXTSYMLAB
complex(dp) REPCHARS(NROT, NSYMLABELS * 10)
INTEGER NREPS, NROTOP
real(dp) NORM
LOGICAL TKP, INV, IMPROPER_OP(NROTOP)
character(*), parameter :: this_routine = 'GENIRREPS'
NREPS = 0
! Initialize the table with the totally symmetric rep.
INV = .FALSE.
DO I = 1, NROT
IRREPCHARS(I, 1) = 1
IF (IMPROPER_OP(MOD(I - 1, NROTOP) + 1) .and. .not. TKP) INV = .TRUE.
end do
NSYM = 1
IF (INV) THEN
write(stdout, *) "Inversion centre detected"
NSYM = NSYM + 1
! There's an inversion centre, so we can immediately create an A1u irrep
DO I = 1, NROT
IF (IMPROPER_OP(MOD(I - 1, NROTOP) + 1)) THEN
IRREPCHARS(I, NSYM) = -1
ELSE
IRREPCHARS(I, NSYM) = 1
end if
end do
! CALL writeirreptab(stdout,IRREPCHARS,NROT,NSYM)
end if
LDO = .TRUE.
NEXTSYMLAB = 1
LDO2 = .TRUE.
DO WHILE (LDO .OR. LDO2)
! CALL writeirreptab(stdout,IRREPCHARS,NROT,NSYM)
! write(stdout,*) NREPS," non-reducible"
! CALL writeirreptab(stdout,REPCHARS,NROT,NREPS)
! First see if all the products of chars are decomposable
LDO = .FALSE.
NREPS = 0
lp1: DO I = 1, NSYM
DO J = I, NSYM
NREPS = NREPS + 1
IF (NREPS > NSYMLABELS * 10) call stop_all(this_routine, 'TOO MANY REPS')
DO K = 1, NROT
REPCHARS(K, NREPS) = CONJG(IRREPCHARS(K, I)) * IRREPCHARS(K, J)
end do
! write(stdout,*) NREPS,"PROD",I,J
! CALL N_MEMORY_CHECK
! CALL writechars(stdout,REPCHARS(1,NREPS),NROT,"ADDPRD")
IF (GETIRREPDECOMP(REPCHARS(1, NREPS), IRREPCHARS, NSYM, NROT, IDECOMP, NORM, TAbelian)) THEN
! CHARWORK now contains the remainder, which will be a new irrep (or combination or irreps), which we need to add
IF (ABS(NORM - NROT) <= 1.0e-2_dp) THEN
! if it's an irrep
NSYM = NSYM + 1
IF (NSYM > 64) call stop_all(this_routine, "MORE than 64 irreps")
DO K = 1, NROT
IRREPCHARS(K, NSYM) = REPCHARS(K, NREPS)
end do
! CALL writeirreptab(stdout,IRREPCHARS,NROT,NSYM)
NREPS = NREPS - 1
LDO = .TRUE.
EXIT lp1
ELSE
! write(stdout,*) "IDECOMP:", IDECOMP,NORM,"SYMS:",NSYM
! CALL writechars(stdout,REPCHARS(1,NREPS),NROT,"REMAIN")
! It's not an irrep, but we cannot reduce it. Store only if we think we've got all the irreps.
! write(stdout,*) "NR",NREPS,LDO2
IF (LDO2) NREPS = NREPS - 1
! NREPS=NREPS-1
end if
ELSE
! write(stdout,*) "IDECOMP:", IDECOMP
NREPS = NREPS - 1
end if
END DO
END DO lp1
! write(stdout,*) LDO,NEXTSYMLAB,NSYMLABELS
IF (LDO) CYCLE
! Check to see if the next symlabel's char is decomposable
lp2: DO WHILE (NEXTSYMLAB <= NSYMLABELS)
NREPS = NREPS + 1
IF (NREPS > NSYMLABELS * 10) call stop_all(this_routine, 'TOO MANY REPS')
DO I = 1, NROT
REPCHARS(I, NREPS) = SYMLABELCHARS(I, NEXTSYMLAB)
end do
! CALL writechars(stdout,REPCHARS(1,NREPS),NROT,"ADDST ")
IF (GETIRREPDECOMP(REPCHARS(1, NREPS), IRREPCHARS, NSYM, NROT, IDECOMP, NORM, TAbelian)) THEN
! CHARWORK now contains the remainder, which will be a new irrep (or combination or irreps), which we need to add
IF (ABS(NORM - NROT) <= 1.0e-2_dp) THEN
! if it's an irrep
NSYM = NSYM + 1
IF (NSYM > 64) call stop_all(this_routine, "MORE than 64 irreps")
DO I = 1, NROT
IRREPCHARS(I, NSYM) = REPCHARS(I, NREPS)
end do
! CALL writeirreptab(stdout,IRREPCHARS,NROT,NSYM)
NREPS = NREPS - 1
LDO = .TRUE.
EXIT lp2
ELSE
! write(stdout,*) "IDECOMP:", IDECOMP,NORM,"SYMS:",NSYM
! CALL writechars(stdout,REPCHARS(1,NREPS),NROT,"REMAIN")
! It's not an irrep, but we cannot reduce it. Store only if we think we've got all the irreps.
IF (LDO2) NREPS = NREPS - 1
end if
ELSE
! write(stdout,*) "IDECOMP:", IDECOMP
NREPS = NREPS - 1
end if
NEXTSYMLAB = NEXTSYMLAB + 1
IF (.NOT. LDO) THEN
! We've not manage to add any more irreps, so we have achieved self-consistency.
!Do one more pass to check, saving all C.. non-reducible reps
LDO = .TRUE.
LDO2 = .FALSE.
NREPS = 0
end if
END DO lp2
end do
!
write(stdout, *) "IRREP TABLE"
CALL writeirreptab(stdout, IRREPCHARS, NROT, NSYM)
IF (NREPS > 0) THEN
write(stdout, *) NREPS, " non-reducible"
CALL writeirreptab(stdout, REPCHARS, NROT, NREPS)
! IF(NREPS.GT.1) THEN
call stop_all(this_routine, "More than 1 non-reducible reps found.")
! end if
! we can cope with a single reducible rep.
! NSYM=NSYM+1
! DO I=1,NROT
! IRREPCHARS(I,NSYM)=REPCHARS(I,NREPS)
! end do
end if
! Classify each of the symlabels with its decomposition into irreps
DO I = 1, NSYMLABELS
CALL DECOMPOSEREP(SYMLABELCHARS(1, I), IDECOMP)
SymLabels(I) = IDECOMP
end do
END SUBROUTINE GENIRREPS