SUBROUTINE GENMOLPSYMREPS()
IMPLICIT NONE
INTEGER I, J
! TYPE(BasisFN) G1(NBASIS)
! INTEGER NBASIS,BRR(NBASIS)
! real(dp) ARR(NBASIS)
character(*), parameter :: this_routine = 'GENMOLPSYMREPS'
LOGICAL tNew
if (tKPntSym) then
!These symmetry routines only work for cases where all irreps are their
!own inverse. In systems with multiple kpoints, this will not be the
!case. Setup the symreps for non-abelian symmetries.
CALL GENSYMREPS(G1, NBASIS, ARR, 1.e-6_dp)
return
end if
! now work out which reps are degenerate and label them
allocate(SymReps(2, nBasis))
call LogMemAlloc('SymReps', 2 * nBasis, 4, this_routine, tagSymReps)
SymReps(:, :) = 0
J = 0
DO I = 1, NBASIS
! write(stdout,*) I,nbasis
tNew = .true.
IF (tSymIgnoreEnergies .AND. MOD(I, 2) == 0) THEN
!Pair even orbs up with the odd ones.
SYMREPS(2, J) = SYMREPS(2, J) + 1
tNew = .false.
else if (I > 1) THEN
IF ((ABS(ARR(I, 1) - ARR(I - 1, 1)) < 1.0e-5_dp) &
.AND. (G1(BRR(I))%Sym%s == G1(BRR(I - 1))%Sym%s)) THEN
! we have the same degenerate rep as the previous entry
SYMREPS(2, J) = SYMREPS(2, J) + 1
tNew = .false.
end if
end if
IF (tNew) THEN
! we have a new rep
J = J + 1
SYMREPS(2, J) = 1
end if
SYMREPS(1, BRR(I)) = J
end do
! write(stdout,*) "Sym Reps MOLPRO"
! DO i=1,nbasis
! write(stdout,*) i,Symreps(1,i),Symreps(2,i)
! end do
END SUBROUTINE GENMOLPSYMREPS