      SUBROUTINE BURZ (ISYSTM,ISYMCE,IBRAVL,NG)
C-----ROUTINE TO INTERPRET HERMANN MAUGUIN SYMBOL FOR SPACE GROUP       BURZ0001
C-----THIS ROUTINE HAS BEEN ADAPTED FROM A PROGRAM SUPPLIED BY          BURZ0002
C-----PROF. BURZLAFF, UNIVERSITY OF ERLANGEN, GERMANY                   BURZ0003
C
C  ISYSTM is the integer which designates the crystal system which
C  is determined by this subroutine (if it was given in the
C  CELL card it will be over written).
C  SYS is the index for ISYS which stores the numbers for ISYSTM      

C modified by CPA for double precision

      implicit none
      include 'io_files.inc'
      
c...	common blocks
      double precision ts(24,3)
      INTEGER SS(24,3,3)
      COMMON /BURC/ TS,SS

      character*1 n3(20)
      COMMON /ND/N3

      double precision RN(3), RD(3), S1(3), S2(3), S3(3)
      COMMON /POSITNUM/ RN,RD,S1,S2,S3 

      character*45 nt
c01Dec      character*1 nt(45)
      common /POSITCHAR/ NT

cNotUsed      COMMON /UNITS/ NRD,NPT,ILU

c...	passed variables
      integer isystm, ISYMCE,NG
      character*1 ibravl

c...	local variables
      double precision te(3),tc,sh(3)
      INTEGER E(3,3), SYS
      integer NMA(3)
c0111      DIMENSION NT(45), NMA(3)
C      DIMENSION RN(3), RD(3), S1(3), S2(3), S3(3)
C      DIMENSION TE(3)
C      real ts(24,3)
      integer isys(7)
      character*1 ibra(7),kxk
      character*1 zei(3,4),mchar,nchar
      integer i,j,k,m
c0111      integer i,j,k,m,sys
      integer nbl, ns, nlq, ic, nbr, ma, L, ne, ind, id

C
C  NT carries the letters in the Hermann Mauguin symbol
C
C  1: monoclinic, 2: orthorhomic, 3: ? 4: tetragonal 5: cubic or isometric
C  6: hexagonal   7: triclinic
C
      DATA ISYS(1)/7/,ISYS(2)/1/,ISYS(3)/2/,ISYS(4)/4/,ISYS(5)/6/,ISYS(6
     1)/5/,ISYS(7)/3/
C
C  options for primitive, A-centred, B-centred, C-centred,
C  face-centred, body-centred, rhombohedral
C      
      DATA IBRA(1)/1HP/,IBRA(2)/1HA/,IBRA(3)/1HB/,IBRA(4)/1HC/,
     &     IBRA(5)/1HF/,IBRA(6)/1HI/,IBRA(7)/1HR/

      DATA NMA/3*0/,SH/3*0.25d0/

 1    NBL=-1           ! index for number of symmetry elements
      NG=1
      NS=1             ! a slash indicator, 1 for none, 0 for some

      DO 2 I=1,24
        DO 2 J=1,3
          TS(I,J)=0.0d0
          DO 2 K=1,3
            E(J,K)=0
            SS(I,J,K)=0
 2    CONTINUE

C  SS seems to be the equvilent of the FS matrix with 1st and 3rd indicies
C  switched, so this means X, Y, Z for the first position
      
      SS(1,1,1)=1
      SS(1,2,2)=1
      SS(1,3,3)=1

      DO 3 I=1,3
        TE(I)=0.0d0
        DO 3 J=1,4
 3        ZEI(I,J)=N3(17)        ! initialize with space characters

      DO 8 I=1,36
        KXK=NT(I:I)                ! move character to KXK
c01Dec        KXK=NT(I)                ! move character to KXK
        IF (KXK.NE.N3(17)) GO TO 4
        NLQ=0                    ! just a space or blank, keep going
        IC=0
        GO TO 8
 4      IF (NBL.GE.0) GO TO 7    ! this is not the first character
        DO 5 J=1,7               ! the first character must be 1 of the 7
          NBR=J
          IF (KXK.EQ.IBRA(J)) GO TO 6
 5      CONTINUE

 6      NBL=0                    ! set IBRAVL to the first character
        IBRAVL=KXK
        GO TO 8                  ! read in next character

 7      IF (NLQ.EQ.0) NBL=NBL+1  ! increase index if previous character
                                 ! was a space or blank
        IC=IC+1                  ! increase IC index for this element of
        ZEI(NBL,IC)=KXK          ! code, write the character in ZEI   
        NLQ=1                    ! next loop default non-space character
        IF (KXK.EQ.N3(15)) NS=0  ! check to see if this was a slash character
 8    CONTINUE

C so right now ZEI should contain the elements of code for the symmetry
C operators following the Bravais lattice indicator (up to 3)
C the second index refers to the character number in each element (up to
C 4 characters)
C IBL is the number of elements that follow the lattice indicator

c      write(7,111) 'Space group is ',ibravl,((zei(j,i),i=1,4),j=1,3)
      write (unitstruct, *) '>> burz():'
      write(unitstruct,111) 'Space group is ',ibravl,
     &		((zei(j,i),i=1,4),j=1,3)
111   format(a15,a1,1x,12a1)
      DO 9 I=1,4
        IF (ZEI(2,I).NE.N3(3)) GO TO 9  ! looking for 3-fold symmetry
                                        ! along the 111 direction implies
        SYS=6                           ! an isometric or cubic system
        GO TO 15
 9    CONTINUE

      DO 11 I=1,4
C  looking at the first symbol if it isn't 3 or 6
        IF (ZEI(1,I).NE.N3(3).AND.ZEI(1,I).NE.N3(6)) GO TO 10
        SYS=5                           ! hexagonal or trigonal                           
        GO TO 15
 10     IF (ZEI(1,I).NE.N3(4)) GO TO 11 ! not 4-fold either
        SYS=4                           ! tetragonal system
        GO TO 15
 11   CONTINUE                          ! keep checking characters

C if the number of elements is greater than 1 cannot be monoclinic
C or triclinic
      IF (NBL.GT.1) GO TO 14

C if the first character of the first element is not 1 or - (which
C preceeds the 1) then the system is monoclinic      
      IF (ZEI(1,1).NE.N3(1).AND.ZEI(1,1).NE.N3(16)) GO TO 12

C TRICLINIC: one symmetry element that is 1 or -1

      SYS=1
      GO TO 15

C MONOCLINIC

 12   SYS=2

C now doing a bit of reassignment to generate equivalent positions
C shift the symmetry symbol to the second row of ZEI
      DO 13 I=1,4
 13     ZEI(2,I)=ZEI(1,I)

C make the first character in the 1st and 3rd row a 1
      ZEI(1,1)=N3(1)
      ZEI(3,1)=N3(1)
C notice that we now continue into the orthorhombic system

C ORTHORHOMBIC
      
 14   SYS=3

C check that it isn't really monoclinic
      IF (ZEI(1,1).EQ.N3(1).OR.ZEI(2,1).EQ.N3(1)) SYS=2

 15   GO TO (16,17,22,46,58,68), SYS   ! Main branch

C-----TRICLINIC                                                         BURZ0079
 16   IF (ZEI(1,1).EQ.N3(16)) NS=0     ! P -1
      GO TO 76

C-----MONOCLINIC                                                        BURZ0082
 17   NG=2                  ! one equiv. pos. beyond inversion
C looking through the first characters of the elements
      DO 18 I=1,3
 18     IF (ZEI(I,1).NE.N3(1)) IND=I  ! record row of non-1 index

      ID=1                            ! default ID is 1
      IF (ZEI(IND,1).EQ.N3(2)) ID=-1  ! if element begins with 2

C  construct the second symmetry element, if two-fold axis then change
C  the sign, otherwise leave it the same
      DO 19 I=1,3
 19     SS(2,I,I)=SS(1,I,I)*ID

      SS(2,IND,IND)=-SS(2,IND,IND)    ! reverse the sign for the unique axis

      DO 21 I=1,3
        IF (ZEI(I,1).EQ.N3(2).AND.ZEI(I,2).EQ.N3(1)) TS(2,I)=0.5d0
        DO 21 J=1,4
          IF (ZEI(I,J).EQ.N3(7)) TS(2,1)=0.5d0
          IF (ZEI(I,J).EQ.N3(8)) TS(2,2)=0.5d0
          IF (ZEI(I,J).EQ.N3(9)) TS(2,3)=0.5d0
          IF (ZEI(I,J).EQ.N3(12)) GO TO 20
          GO TO 21
 20       K=I+1
          IF (K.GT.3) K=K-3
          TS(2,K)=0.5d0
          TS(2,6-K-I)=0.5d0
 21   CONTINUE
      GO TO 76

C-----ORTHORHOMBIC                                                      BURZ0105
 22   NG=4
      IC=0
      IND=1
      IF (ZEI(1,1).NE.N3(2).AND.ZEI(2,1).NE.N3(2).AND.ZEI(3,1).NE.N3(2))
     1IND=-1
      IF (IND.EQ.-1) NS=0
      DO 24 I=1,3
      ID=1
      IF (ZEI(I,1).EQ.N3(2)) ID=-1
      DO 23 J=1,3
 23   SS(1+I,J,J)=SS(1,J,J)*ID*IND
 24   SS(1+I,I,I)=-SS(1+I,I,I)
      DO 28 I=1,3
      IF (ZEI(I,1).EQ.N3(2).AND.ZEI(I,2).EQ.N3(1)) TS(1+I,I)=0.5d0
      DO 28 J=1,4
      IF (ZEI(I,J).EQ.N3(7)) TS(1+I,1)=0.5d0
      IF (ZEI(I,J).EQ.N3(8)) TS(1+I,2)=0.5d0
      IF (ZEI(I,J).EQ.N3(9)) TS(1+I,3)=0.5d0
      IF (ZEI(I,J).EQ.N3(12).OR.ZEI(I,J).EQ.N3(10)) GO TO 25
      GO TO 28
 25   K=I+1
      IF (K.GT.3) K=K-3
      IF (ZEI(I,J).EQ.N3(10)) GO TO 26
      TS(1+I,K)=0.5d0
      TS(1+I,6-K-I)=0.5d0
      GO TO 28
 26   IC=1
      IF (NS.EQ.1) GO TO 27
      TS(1+I,K)=0.25d0
      TS(1+I,6-K-I)=0.25d0
      GO TO 28
 27   TS(1+I,1)=0.25d0
      TS(1+I,2)=0.25d0
      TS(1+I,3)=0.25d0
 28   CONTINUE
      IF (IC.EQ.1) GO TO 76
      IF (NS.EQ.1) GO TO 36
      DO 29 I=1,3
      K=1+I
      IF (K.GT.3) K=K-3
      TC=TS(1+K,I)+TS(1+6-I-K,I)
      IF (TC.EQ.1.0d0) TC=0.0d0
 29   TS(1+I,I)=TC
C-----SPECIAL TREATMENT OF C M M A, C M C A, I M M A                    BURZ0149
      IF (NBR.EQ.1.OR.NBR.EQ.5) GO TO 76
      MA=0
      DO 31 I=1,3
      DO 30 J=1,4
 30   IF (ZEI(I,J).EQ.N3(11)) NMA(I)=1
 31   MA=MA+NMA(I)
      IF (NBR.EQ.6.AND.MA.EQ.2) GO TO 33
      IF (MA.EQ.0.OR.MA.EQ.3.OR.NBR.EQ.6) GO TO 76
      DO 32 I=1,3
      IF (NMA(NBR-1).EQ.1) GO TO 76
 32   SH(NBR-1)=0.0d0
C-----ORIGIN SHIFT                                                      BURZ0161
 33   DO 35 I=1,NG
      DO 35 J=1,3
      DO 34 K=1,3
      ID=1
      IF (J.NE.K) ID=0
 34   TS(I,J)=TS(I,J)+dble(ID-SS(I,J,K))*SH(K)
      IF (TS(I,J).GT.1.0d0) TS(I,J)=TS(I,J)-1.0d0
 35   IF (TS(I,J).LT.1.0d0) TS(I,J)=TS(I,J)+1.0d0
      GO TO 76
 36   IC=0
      DO 37 I=1,3
 37   IF (SS(1+I,1,1)*SS(1+I,2,2)*SS(1+I,3,3).EQ.-1) IC=1
      IF (IC.EQ.1) GO TO 41
      TC=TS(2,1)+TS(3,2)+TS(4,3)
      IF (TC.EQ.0.0d0) GO TO 76
      DO 40 I=1,3
      K=I+1
      IF (K.GT.3) K=K-3
      IF (TC.GT.0.5d0) GO TO 38
      IF (TS(1+I,I).EQ.0.0d0) GO TO 40
      M=I-1
      IF (M.EQ.0) M=M+3
      TS(1+M,I)=0.5d0
      GO TO 40
 38   IF (TC.GT.1.0d0) GO TO 39
      IF (TS(1+I,I).NE.0.0d0) GO TO 40
      L=K+1
      IF (L.GT.3) L=L-3
      TS(1+K,L)=0.5d0
      TS(1+L,K)=0.5d0
      GO TO 40
 39   TS(1+I,K)=0.5d0
 40   CONTINUE
      GO TO 76
 41   DO 42 I=1,3
 42   IF (SS(1+I,1,1)*SS(1+I,2,2)*SS(1+I,3,3).EQ.1) ID=I
      DO 45 I=1,3
      TC=TS(2,I)+TS(3,I)+TS(4,I)
      IF (TC.EQ.0.0d0.OR.TC.EQ.1.0d0) GO TO 45
      IF (ZEI(1,1).EQ.N3(11).AND.ZEI(2,1).EQ.N3(12).OR.ZEI(2,1).EQ.
     1N3(11).AND.ZEI(3,1).EQ.N3(12).OR.ZEI(3,1).EQ.N3(11).AND.ZEI(1,1)
     2.EQ.N3(12)) GO TO 44
      DO 43 J=1,3
      IF (ID.EQ.J) GO TO 43
      IF (TS(1+J,I).EQ.0.5d0) GO TO 43
      TS(1+J,I)=0.5d0
 43   CONTINUE
      GO TO 45
 44   K=I-1
      IF (K.EQ.0) K=K+3
      TS(1+K,I)=0.5d0
 45   CONTINUE
      GO TO 76

C-----TETRAGONAL                                                        BURZ0215
 46   NG=4
      IF (NBL.EQ.3) NG=8
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,3,3)=1
C
C  Try replacing obvious character variables with mchar and nchar
C
      MCHAR=ZEI(1,1)
      NCHAR=ZEI(1,2)
C      M=ZEI(1,1)
C      N=ZEI(1,2)
      DO 47 I=1,3
      DO 47 J=1,3
 47   IF (MCHAR.EQ.N3(16)) SS(2,I,J)=-SS(2,I,J)
      IF (MCHAR.EQ.N3(16)) GO TO 50
      IF (NCHAR.EQ.N3(1)) TS(2,3)=0.25d0
      IF (NCHAR.EQ.N3(2)) TS(2,3)=0.5d0
      IF (NCHAR.EQ.N3(3)) TS(2,3)=0.75d0
      IF (ZEI(1,3).EQ.N3(12).OR.(ZEI(1,4).EQ.N3(12).AND.NBL.EQ.3))
     1TS(2,1)=0.5d0
      IF ((ZEI(1,4).EQ.N3(12).AND.NBL.EQ.1).OR.(NCHAR.EQ.N3(1).AND.
     1NS.EQ.1.AND.NBR.EQ.6)) TS(2,2)=0.5d0
      IF (NCHAR.EQ.N3(1).AND.NS.EQ.0.AND.NBR.EQ.6) GO TO 48
      IF (ZEI(2,2).EQ.N3(1).OR.(ZEI(1,4).NE.N3(12).AND.ZEI(2,1).EQ.
     1N3(12).AND.ZEI(3,1).EQ.N3(11))) GO TO 49
      GO TO 50
 48   TS(2,1)=0.25d0
      TS(2,2)=0.75d0
      IF (NBL.EQ.1) TS(2,1)=0.75d0
      IF (NBL.EQ.1) TS(2,2)=0.25d0
      GO TO 50
 49   TS(2,1)=0.5d0
      TS(2,2)=0.5d0
 50   SS(3,1,1)=-1
      SS(3,2,2)=-1
      SS(3,3,3)=1
      TS(3,1)=dble(SS(2,1,2))*TS(2,2)+TS(2,1)
      TS(3,2)=dble(SS(2,2,1))*TS(2,1)+TS(2,2)
      TS(3,3)=dble(SS(2,3,3))*TS(2,3)+TS(2,3)
      DO 51 I=1,3
 51   IF (NBR.EQ.6.AND.TS(3,1).EQ.0.5.AND.TS(3,2).EQ.0.5.AND.TS(3,3).EQ.
     10.5) TS(3,I)=0.0d0
      DO 52 I=1,3
      TS(4,I)=TS(2,I)
      DO 52 J=1,3
      TS(4,I)=TS(4,I)+dble(SS(2,I,J))*TS(3,J)
      DO 52 K=1,3
 52   SS(4,I,J)=SS(4,I,J)+SS(2,I,K)*SS(3,K,J)
      IF (NBL.EQ.1) GO TO 76
      IF (NS.EQ.0) GO TO 56
      MCHAR=ZEI(2,1)
      NCHAR=ZEI(3,1)
      IF (MCHAR.NE.N3(2).AND.NCHAR.NE.N3(2)) GO TO 55
      IF (MCHAR.EQ.N3(2).AND.NCHAR.EQ.N3(2)) GO TO 54
      IF (MCHAR.EQ.N3(2)) GO TO 53
      IF (MCHAR.EQ.N3(9).OR.MCHAR.EQ.N3(12)) TE(3)=0.5d0
      E(1,1)=-1
      E(2,2)=1
      E(3,3)=1
      IF (MCHAR.NE.N3(12).AND.MCHAR.NE.N3(8)) GO TO 57
      TE(1)=0.5d0
      TE(2)=0.5d0
      GO TO 57
 53   E(1,1)=1
      E(2,2)=-1
      E(3,3)=-1
      IF (NCHAR.EQ.N3(9)) TE(3)=0.5d0
      IF (NCHAR.EQ.N3(10)) TE(3)=0.25d0
      IF (NCHAR.EQ.N3(10)) TE(2)=0.5d0
      IF (ZEI(2,2).NE.N3(1)) GO TO 57
      TE(1)=0.5d0
      TE(2)=0.5d0
      GO TO 57
 54   E(1,2)=1
      E(2,1)=1
      E(3,3)=-1
C  Changed a .ne.0 to a ne.n3(17)
      IF (ZEI(2,2).NE.N3(17).OR.NBR.EQ.6.OR.ZEI(1,2).EQ.
     1N3(17)) GO TO 57
      IF (ZEI(1,2).EQ.N3(1)) TE(3)=0.75d0
      IF (ZEI(1,2).EQ.N3(2)) TE(3)=0.5d0
      IF (ZEI(1,2).EQ.N3(3)) TE(3)=0.25d0
      GO TO 57
 55   MCHAR=ZEI(2,1)
      E(1,1)=-1
      E(2,2)=1
      E(3,3)=1
      IF (MCHAR.EQ.N3(9).OR.MCHAR.EQ.N3(12)) TE(3)=0.5d0
      IF (MCHAR.EQ.N3(12).OR.MCHAR.EQ.N3(8)) TE(1)=0.5d0
      IF (MCHAR.EQ.N3(12).OR.MCHAR.EQ.N3(8)) TE(2)=0.5d0
      GO TO 57
 56   E(1,1)=-1
      E(2,2)=1
      E(3,3)=1
      IF (ZEI(2,1).EQ.N3(9).OR.ZEI(2,1).EQ.N3(12)) TE(3)=0.5d0
      IF (ZEI(2,1).EQ.N3(8).OR.ZEI(2,1).EQ.N3(12)) TE(2)=0.5d0
      IF (ZEI(2,1).EQ.N3(8).OR.ZEI(2,1).EQ.N3(12)) TE(1)=0.5d0
      IF (ZEI(1,3).EQ.N3(12).OR.ZEI(1,4).EQ.N3(12)) TE(1)=TE(1)+0.5d0
 57   NE=4
      GO TO 74

C-----HEXAGONAL                                                         BURZ0310
 58   NG=3
      MCHAR=ZEI(1,1)
      NCHAR=ZEI(1,2)
      IF (MCHAR.EQ.N3(16).AND.NCHAR.EQ.N3(3)) NS=0
      IF (MCHAR.EQ.N3(6)) GO TO 61
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,2,2)=-1
      SS(2,3,3)=1
      IF (NCHAR.EQ.N3(1)) TS(2,3)=1.0d0/3.0d0
      IF (NCHAR.EQ.N3(2)) TS(2,3)=2.0d0/3.0d0
      SS(3,1,1)=-1
      SS(3,2,1)=-1
      SS(3,1,2)=1
      SS(3,3,3)=1
      TS(3,3)=2.0d0*TS(2,3)
      IF (TS(3,3).GE.1.0d0) TS(3,3)=TS(3,3)-1.0d0
      IF (NBL.EQ.1.AND.NCHAR.NE.N3(6)) GO TO 76
      IF (NCHAR.NE.N3(6)) GO TO 60
      NG=NG+NG
      DO 59 I=1,3
      DO 59 J=1,3
      DO 59 K=1,3
      SS(3+I,J,K)=SS(I,J,K)
 59   SS(3+I,3,3)=-1
 60   IF (NBL.EQ.1) GO TO 76
      IF (ZEI(2,1).NE.N3(9).AND.ZEI(3,1).NE.N3(9)) GO TO 63
      TS(4,3)=0.5d0
      TS(5,3)=0.5d0
      TS(6,3)=0.5d0
      GO TO 63
 61   NG=NG+NG
      SS(2,1,1)=1
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,3,3)=1
      IF (NCHAR.EQ.N3(1)) TS(2,3)=1.0d0/6.0d0
      IF (NCHAR.EQ.N3(2)) TS(2,3)=2.0d0/6.0d0
      IF (NCHAR.EQ.N3(3)) TS(2,3)=3.0d0/6.0d0
      IF (NCHAR.EQ.N3(4)) TS(2,3)=4.0d0/6.0d0
      IF (NCHAR.EQ.N3(5)) TS(2,3)=5.0d0/6.0d0
      DO 62 I=1,4
      DO 62 J=1,3
      TS(2+I,J)=TS(2,J)
      DO 62 K=1,3
      TS(2+I,J)=TS(2+I,J)+dble(SS(2,J,K))*TS(1+I,K)
      IF (TS(2+I,J).GT.1.0d0) TS(2+I,J)=TS(2+I,J)-1.0d0
      DO 62 L=1,3
 62   SS(2+I,J,K)=SS(2+I,J,K)+SS(2,J,L)*SS(1+I,L,K)
      IF (NBL.EQ.1) GO TO 76
 63   NG=NG+NG
      MCHAR=ZEI(2,1)
      NCHAR=ZEI(3,1)
      IF (MCHAR.EQ.N3(1)) GO TO 65
      IF (MCHAR.EQ.N3(2)) GO TO 64
      E(1,2)=-1
      E(2,1)=-1
      E(3,3)=1
      IF (MCHAR.EQ.N3(9)) TE(3)=0.5d0
      GO TO 67
 64   E(1,2)=1
      E(2,1)=1
      E(3,3)=-1
      TE(3)=2.0d0*TS(2,3)
C-----GROUP P 31 I 2 AND P 32 I 2                                       BURZ0375
      IF (ZEI(1,1).EQ.N3(3).AND.(ZEI(1,2).EQ.N3(1).OR.ZEI(1,2).EQ.
     1N3(2))) TE(3)=0.0d0
      GO TO 67
 65   IF (NCHAR.EQ.N3(2)) GO TO 66
      E(1,2)=1
      E(2,1)=1
      E(3,3)=1
      IF (NCHAR.EQ.N3(9)) TE(3)=0.5d0
      GO TO 67
 66   E(1,2)=-1
      E(2,1)=-1
      E(3,3)=-1
      TE(3)=2.0d0*TS(2,3)
      IF (TE(3).GT.1.0d0) TE(3)=TE(3)-1.0d0
 67   NE=6
      IF (ZEI(1,1).EQ.N3(3).OR.(ZEI(1,2).EQ.N3(3).AND.ZEI(1,1).EQ.
     1N3(16))) NE=3
      GO TO 74

C-----CUBIC                                                             BURZ0394
 68   NG=12
      IF (NBL.EQ.3) NG=24
      IF (ZEI(1,1).NE.N3(2).AND.ZEI(1,1).NE.N3(4).AND.ZEI(1,1).NE.
     1N3(16)) NS=0
      DO 69 I=1,3
      DO 69 J=1,3
      SS(1+I,J,J)=1
      IF (I.EQ.J) GO TO 69
      SS(1+I,J,J)=-1
      IF (ZEI(1,1).EQ.N3(12)) TS(1+I,J)=0.5d0
      IF (ZEI(1,1).EQ.N3(10)) TS(1+I,J)=0.25d0
 69   CONTINUE
      IF (ZEI(1,1).NE.N3(7).AND.ZEI(3,1).NE.N3(10).AND.ZEI(1,2).NE.N3(3)
     1.AND.ZEI(1,2).NE.N3(1).OR.NBR.EQ.5) GO TO 71
      DO 70 I=1,3
      TS(1+I,I)=0.5d0
      K=I+1
      IF (K.EQ.4) K=1
 70   TS(1+I,K)=0.5d0
 71   DO 72 I=1,4
      DO 72 J=1,3
      DO 72 K=1,3
      L=J+1
      IF (L.EQ.4) L=1
      M=J-1
      IF (M.EQ.0) M=3
      SS(4+I,J,K)=SS(I,L,K)
      SS(8+I,J,K)=SS(I,M,K)
      TS(4+I,J)=TS(I,L)
 72   TS(8+I,J)=TS(I,M)
      IF (NG.EQ.12) GO TO 76
      NE=12
      E(1,2)=1
      E(2,1)=1
      E(3,3)=1
      IF (ZEI(3,1).EQ.N3(2)) E(3,3)=-1
      IF (ZEI(3,1).EQ.N3(9)) TE(3)=0.5d0
      DO 73 I=1,3
      IF (ZEI(3,1).EQ.N3(12).OR.ZEI(1,2).EQ.N3(2)) TE(I)=0.5d0
 73   IF (ZEI(3,1).EQ.N3(10).OR.ZEI(1,2).EQ.N3(1).OR.ZEI(1,2).EQ.N3(3))
     1TE(I)=0.25d0
      IF (ZEI(1,2).EQ.N3(1).AND.NBR.EQ.1) TE(1)=0.75d0
      IF ((ZEI(1,2).NE.N3(1).OR.NBR.NE.6).AND.(ZEI(1,2).NE.N3(3).OR.NBR
     1.NE.1)) GO TO 74
      TE(2)=0.75d0
      TE(3)=0.75d0
 74   DO 75 I=1,NE
      DO 75 J=1,3
      TS(NE+I,J)=TE(J)
      DO 75 K=1,3
      TS(NE+I,J)=TS(NE+I,J)+dble(E(J,K))*TS(I,K)
      DO 75 L=1,3
 75   SS(NE+I,J,K)=SS(NE+I,J,K)+E(J,L)*SS(I,L,K)

C  loop through the equivalent positions to reduce the TS matrix

 76   DO 81 I=1,NG
        DO 81 J=1,3
 77       IF (TS(I,J).GE.1.0d0) GO TO 78
          GO TO 79
 78       TS(I,J)=TS(I,J)-1.0d0
          GO TO 77
 79       IF (TS(I,J).LT.0.0d0) GO TO 80
          GO TO 81
 80       TS(I,J)=TS(I,J)+1.0d0
          GO TO 79
 81   CONTINUE

      ISYSTM=ISYS(SYS)
      IF (NS.EQ.0) ISYMCE=1
      IF (NS.EQ.1) ISYMCE=0
      RETURN
      END
