GENMOLPSYMREPS Subroutine

public subroutine GENMOLPSYMREPS()

Arguments

None

Contents

Source Code


Source Code

    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