	SUBROUTINE SYMMETRY(ierr)
c
c subroutine to interpret space group symbol
c rewritten 15-Jul-1992 by LWF to use space group generator
c    program SYMGEN by Burzlaff
c
	character latsym*1
	include 'single.inc'
	include 'symmetry.inc'
        common /burc/ ts,ss
        integer ss(24,3,3)
        real ts(24,3)
c
	ierr=0
c
c	convert 'spg' string to lower case
c
	do i=1,20
	  if(spg(i).ge.'A' .and. spg(i) .le.'Z')
     1		spg(i)=char(ichar(spg(i))+ichar('a')-ichar('A'))
	enddo
c
c now find lattice symbol
c
	do i=1,20
		if(spg(i) .ne. ' ')goto10
	enddo
c
c No symmetry entered - dummy in P 1
c
	spg(1) = 'p'
	spg(2) = ' '
	spg(3) = '1'
	i = 1
c
c assign lattice symbol to latstr
10	latsym=char(ichar(spg(i))-ichar('a')+ichar('A'))
c
c Generate the space group operations
c
      call symgen(isystm,icet,ibravl,mlt,spg)
c
c build lattice translations - skip 0,0,0
c
      nlat = 0
      if(latsym.eq.'A'.or.latsym.eq.'F') then
	nlat = nlat + 1
	alat(1,nlat) = 0.0
	alat(2,nlat) = 0.5
	alat(3,nlat) = 0.5
      endif
      if(latsym.eq.'B'.or.latsym.eq.'F') then
	nlat = nlat + 1
	alat(1,nlat) = 0.5
	alat(2,nlat) = 0.0
	alat(3,nlat) = 0.5
      endif
      if(latsym.eq.'C'.or.latsym.eq.'F') then
	nlat = nlat + 1
	alat(1,nlat) = 0.5
	alat(2,nlat) = 0.5
	alat(3,nlat) = 0.0
      endif
      if(latsym.eq.'I') then
	nlat = nlat + 1
	alat(1,nlat) = 0.5
	alat(2,nlat) = 0.5
	alat(3,nlat) = 0.5
      endif
      if(latsym.eq.'B'.or.latsym.eq.'F') then
	nlat = nlat + 1
	alat(1,nlat) = 0.5
	alat(2,nlat) = 0.0
	alat(3,nlat) = 0.5
      endif
      if(latsym.eq.'R') then
	nlat = nlat + 1
	alat(1,nlat) = 2./3.
	alat(2,nlat) = 1./3.
	alat(3,nlat) = 1./3.
	nlat = nlat + 1
	alat(1,nlat) = 1./3.
	alat(2,nlat) = 2./3.
	alat(3,nlat) = 2./3.
      endif
c
c copy translation and rotation operators to proper form
c
      do i = 1,mlt
	do j=1,3
	  cctrans(j,i) = ts(i,j)
	  do k=1,3
	    sym(k,j,i) = ss(i,k,j)
	  enddo
	enddo
      enddo
      nop = mlt
      ncent = icet
      return
      end
      function latabs(h)
c
c rewritten 15-Jul-1992 by LWF to use space group generator
c    program SYMGEN by Burzlaff
c
c checks for lattice absences.  latabs=0 if absent, 1 if present
c
      dimension h(3)
      include 'symmetry.inc'
      if (nlat .gt. 0) then
c lattice not primitive 
	do i = 1,nlat
	  sum = 0.0
	  do j = 1,3
	    sum = sum + h(j) * alat(j,i)
	  enddo
	  if (abs(amod(abs(sum)+0.01,1.)) .gt. 1.e-1) then
	    latabs = 0
	    return
	  endif
	enddo
      endif
c
c if we reach this point, reflection is not absent
c
      latabs=1
      return
      end
      function ispabs(h)
c
c rewritten 15-Jul-1992 by LWF to use space group generator
c    program SYMGEN by Burzlaff
c
c checks for space group absences.  ispabs=0 if absent, 1 if present
c
      real h(3),xp(3),x(3,3),ac,bs,sum,twopi
      include 'symmetry.inc'
      data x/0.090909,0.076923,0.058823
     1      ,0.076923,0.058823,0.090909
     2      ,0.058823,0.090909,0.076923/
      data twopi/6.283185/
c
      ac = 0.0
      bc = 0.0
c loop through positions
      do l=1,3
c loop over symmetry operaotrs
        do i = 1,nop
	  do j=1,3
	    xp(j) = cctrans(j,i)
	    do k=1,3
	      xp(j) = xp(j) + sym(j,k,i)*x(k,l)
	    enddo
	  enddo
	  sum = 0.0
	  do j = 1,3
	    sum = sum + h(j) * xp(j)
	  enddo
	  ac = ac + cos(twopi*sum)
	  if (ncent.eq.0)bc = bc + sin(twopi*sum)
        enddo
        if((ac**2 + bc**2) .gt. 1.0e-3) then
	  ispabs=1
	  return
	endif
      enddo
c If this point reached, structure factor is zero for all positions -
c    i.e. reflection extinct
      ispabs = 0
      return
      end
      SUBROUTINE SYMGEN (ISYSTM,ISYMCE,IBRAVL,NG,symbol)
c
C-----ROUTINE TO INTERPRET HERMANN MAUGUIN SYMBOL FOR SPACE GROUP
C-----THIS ROUTINE HAS BEEN ADAPTED FROM A PROGRAM SUPPLIED BY
C-----PROF. BURZLAFF, UNIVERSITY OF ERLANGEN, GERMANY
C-----Adapted from LAZY-PULVERIX System by L.W.Finger 4/92
C
      COMMON /BURC/ TS,SS
      INTEGER E(3,3),SS(24,3,3),SYS
      DIMENSION NT(45), IBRA(7), NMA(3), SH(3)
      DIMENSION RN(3), RD(3), S1(3), S2(3), S3(3)
      DIMENSION TS(24,3), TE(3)
      DIMENSION ISYS(7)
      character*1 symbol(20),spg(3,4)
      DATA ISYS(1)/7/,ISYS(2)/1/,ISYS(3)/2/,ISYS(4)/4/,ISYS(5)/6/,ISYS(6
     1)/5/,ISYS(7)/3/
      DATA IBRA(1)/1HP/,IBRA(2)/1HA/,IBRA(3)/1HB/,IBRA(4)/1HC/,IBRA(5)/1
     1HF/,IBRA(6)/1HI/,IBRA(7)/1HR/,NMA/3*0/,SH/3*0.25/
c
      NBL=-1
      NG=1
      NS=1
      DO 120 I=1,24
          DO 110 J=1,3
              TS(I,J)=0.0
              DO 100 K=1,3
                  E(J,K)=0
                  SS(I,J,K)=0
100           CONTINUE
110       continue
120   continue
      SS(1,1,1)=1
      SS(1,2,2)=1
      SS(1,3,3)=1
      DO 140 I=1,3
          TE(I)=0.0
          DO 130 J=1,4
              spg(I,J)=' '
130       CONTINUE
140   continue
      DO 160 I=1,20
      IF (symbol(i).EQ.' ') THEN
          NLQ=0
          IC=0
      else
          IF (NBL.LT.0) THEN
              DO 150 J=1,7
                  IF ((symbol(i).EQ.char(IBRA(J))) .or.
     1			(symbol(i).EQ.char(IBRA(J)+32))) NBR=J
150           CONTINUE
              NBL=0
              IBRAVL=ichar(symbol(i))
          ELSE
	      IF (NLQ.EQ.0) NBL=NBL+1
              IC=IC+1
              spg(NBL,IC)=symbol(i)
              NLQ=1
              IF (symbol(i).EQ.'/') NS=0
	  endif
      endif
160   CONTINUE
      DO 170 I=1,4
      IF (spg(2,I).EQ.'3') THEN
          SYS=6
          GO TO 220
      endif
170   CONTINUE
      DO 180 I=1,4
      IF (spg(1,I).EQ.'3'.OR.spg(1,I).EQ.'6') then
          SYS=5
          GO TO 220
      endif
      IF (spg(1,I).EQ.'4') THEN
          SYS=4
          GO TO 220
      endif
180   CONTINUE
      IF (NBL.GT.1) GO TO 210
      IF (spg(1,1).NE.'1'.AND.spg(1,1).NE.'-') GO TO 190
      SYS=1
      GO TO 220
190   SYS=2
      DO 200 I=1,4
      spg(2,I)=spg(1,I)
200   spg(1,I)=' '
      spg(1,1)='1'
      spg(3,1)='1'
210   SYS=3
      IF (spg(1,1).EQ.'1'.OR.spg(2,1).EQ.'1') SYS=2
220   GO TO (230,240,280,490,600,700), SYS
C-----TRICLINIC
230   IF (spg(1,1).EQ.'-') NS=0
      GO TO 780
C-----MONOCLINIC
240   NG=2
      DO 250 I=1,3
250   IF (spg(I,1).NE.'1') IND=I
      ID=1
      IF (spg(IND,1).EQ.'2') ID=-1
      DO 260 I=1,3
260   SS(2,I,I)=SS(1,I,I)*ID
      SS(2,IND,IND)=-SS(2,IND,IND)
      DO 270 I=1,3
      IF (spg(I,1).EQ.'2'.AND.spg(I,2).EQ.'1') TS(2,I)=0.5
      DO 270 J=1,4
      IF (spg(I,J).EQ.'a') TS(2,1)=0.5
      IF (spg(I,J).EQ.'b') TS(2,2)=0.5
      IF (spg(I,J).EQ.'c') TS(2,3)=0.5
      IF (spg(I,J).NE.'n') GO TO 270
      K=I+1
      IF (K.GT.3) K=K-3
      TS(2,K)=0.5
      TS(2,6-K-I)=0.5
270   CONTINUE
      GO TO 780
C-----ORTHORHOMBIC
280   NG=4
      IC=0
      IND=1
      IF (spg(1,1).NE.'2'.AND.spg(2,1).NE.'2'.AND.spg(3,1).NE.'2')
     1IND=-1
      IF (IND.EQ.-1) NS=0
      DO 300 I=1,3
      ID=1
      IF (spg(I,1).EQ.'2') ID=-1
      DO 290 J=1,3
290   SS(1+I,J,J)=SS(1,J,J)*ID*IND
300   SS(1+I,I,I)=-SS(1+I,I,I)
      DO 310 I=1,3
      IF (spg(I,1).EQ.'2'.AND.spg(I,2).EQ.'1') then
	  TS(1+I,I)=0.5
C **** FIX BUG in original Code for P m n 21 et al. ***** LWF 4/92
	  K = MOD(I,3)+1
	  L = MOD(K,3)+1
	  IF (SPG(K,1).EQ.'m'.AND.SPG(L,1).EQ.'n')THEN
	      TS(I+1,K)=0.5
	      GO TO 305
	  ENDIF
	  IF (SPG(L,1).EQ.'m'.AND.SPG(K,1).EQ.'n')THEN
	      TS(I+1,L)=0.5
	      GO TO 305
	  ENDIF
C **** FIX BUG in original Code for P n a 21 et al. ***** LWF 5/92
	  IF (SPG(L,1).EQ.'n'.OR.SPG(K,1).EQ.'n') THEN
	      TS(K+1,K) = 0.5
	      TS(L+1,L) = 0.5
	  ENDIF
c **** End of BUG Fix
      ENDIF
305   DO 310 J=1,4
          IF (spg(I,J).EQ.'a') TS(1+I,1)=0.5
          IF (spg(I,J).EQ.'b') TS(1+I,2)=0.5
          IF (spg(I,J).EQ.'c') TS(1+I,3)=0.5
          IF (spg(I,J).NE.'n'.AND.spg(I,J).NE.'d') GO TO 310
          K=mod(I,3)+1
          IF (spg(I,J).NE.'d') THEN
              TS(1+I,K)=0.5
              TS(1+I,6-K-I)=0.5
	  ELSE
	      IC=1
              IF (NS.NE.1) THEN
                  TS(1+I,K)=0.25
                  TS(1+I,6-K-I)=0.25
	      else
		  TS(1+I,1)=0.25
      		  TS(1+I,2)=0.25
      		  TS(1+I,3)=0.25
	      endif
	  endif	
310   CONTINUE
      IF (IC.EQ.1) GO TO 780
      IF (NS.EQ.1) GO TO 390
      DO 320 I=1,3
      K=1+mod(I,3)
      TC=TS(1+K,I)+TS(1+6-I-K,I)
      IF (TC.EQ.1.0) TC=0.0
320   TS(1+I,I)=TC
C-----SPECIAL TREATMENT OF C M M A, C M C A, I M M A
      IF (NBR.EQ.1.OR.NBR.EQ.5) GO TO 780
      MA=0
      DO 340 I=1,3
      DO 330 J=1,4
330   IF (spg(I,J).EQ.'m') NMA(I)=1
340   MA=MA+NMA(I)
      IF (NBR.EQ.6.AND.MA.EQ.2) GO TO 360
      IF (MA.EQ.0.OR.MA.EQ.3.OR.NBR.EQ.6) GO TO 780
      DO 350 I=1,3
      IF (NMA(NBR-1).EQ.1) GO TO 780
350   SH(NBR-1)=0.
C-----ORIGIN SHIFT
360   DO 380 I=1,NG
      DO 380 J=1,3
      DO 370 K=1,3
      ID=1
      IF (J.NE.K) ID=0
370   TS(I,J)=TS(I,J)+(ID-SS(I,J,K))*SH(K)
      IF (TS(I,J).GT.1.) TS(I,J)=TS(I,J)-1.
380   IF (TS(I,J).LT.1.0) TS(I,J)=TS(I,J)+1.
      GO TO 780
390   IC=0
      DO 400 I=1,3
      IF (SS(1+I,1,1)*SS(1+I,2,2)*SS(1+I,3,3).EQ.-1) IC=1
400   continue
      IF (IC.EQ.1) GO TO 440
      TC=TS(2,1)+TS(3,2)+TS(4,3)
      IF (TC.EQ.0.0) GO TO 780
      DO 430 I=1,3
      K=mod(I,3)+1
      IF (TC.GT.0.5) GO TO 410
      IF (TS(1+I,I).EQ.0.0) GO TO 430
      M=I-1
      IF (M.EQ.0) M=M+3
      TS(1+M,I)=0.5
      GO TO 430
410   IF (TC.GT.1.0) GO TO 420
      IF (TS(1+I,I).NE.0.0) GO TO 430
      L=K+1
      IF (L.GT.3) L=L-3
      TS(1+K,L)=0.5
      TS(1+L,K)=0.5
      GO TO 430
420   TS(1+I,K)=0.5
430   CONTINUE
      GO TO 780
440   DO 450 I=1,3
      IF (SS(1+I,1,1)*SS(1+I,2,2)*SS(1+I,3,3).EQ.1) ID=I
450   continue
      DO 480 I=1,3
      TC=TS(2,I)+TS(3,I)+TS(4,I)
      IF (TC.EQ.0.0.OR.TC.EQ.1.0) GO TO 480
      IF (spg(1,1).EQ.'m'.AND.spg(2,1).EQ.'n'.OR.spg(2,1).EQ.
     1'm'.AND.spg(3,1).EQ.'n'.OR.spg(3,1).EQ.'m'.AND.spg(1,1)
     2.EQ.'n') GO TO 470
      DO 460 J=1,3
      IF (ID.EQ.J) GO TO 460
      IF (TS(1+J,I).EQ.0.5) GO TO 460
      TS(1+J,I)=0.5
460   CONTINUE
      GO TO 480
470   K=I-1
      IF (K.EQ.0) K=K+3
      TS(1+K,I)=0.5
480   CONTINUE
      GO TO 780
C-----TETRAGONAL
490   NG=4
      IF (NBL.EQ.3) NG=8
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,3,3)=1
      IF (spg(1,1).EQ.'-')then
	DO I=1,3
	  DO J=1,3
	    SS(2,I,J)=-SS(2,I,J)
	  enddo
	enddo
      else
        IF (spg(1,2).EQ.'1') TS(2,3)=0.25
        IF (spg(1,2).EQ.'3') TS(2,3)=0.75
        IF (spg(1,2).EQ.'2') TS(2,3)=0.5
        IF ((spg(1,3).EQ.'n').OR.((spg(1,4).EQ.'n'.AND.NBL.EQ.3)))
     1		TS(2,1)=0.5
        IF (((spg(1,4).EQ.'n').AND.(NBL.EQ.1)).OR.((spg(1,2).EQ.'1')
     1		.AND.(NS.EQ.1).AND.(NBR.EQ.6))) TS(2,2)=0.5
        IF ((spg(1,2).EQ.'1').AND.(NS.EQ.0).AND.(NBR.EQ.6)) then
	  IF (NBL.EQ.1) then
	    TS(2,1)=0.75
	    TS(2,2)=0.25
	  else
	    TS(2,1)=0.25
	    TS(2,2)=0.75
	  endif
	else
          IF ((spg(2,2).EQ.'1').OR.((spg(1,4).NE.'n').AND.
     1	    (spg(2,1).EQ.'n').AND.(spg(3,1).EQ.'m'))) then
	    TS(2,1)=0.5
            TS(2,2)=0.5
	  endif
	endif
      endif
      SS(3,1,1)=-1
      SS(3,2,2)=-1
      SS(3,3,3)=1
      TS(3,1)=SS(2,1,2)*TS(2,2)+TS(2,1)
      TS(3,2)=SS(2,2,1)*TS(2,1)+TS(2,2)
      TS(3,3)=SS(2,3,3)*TS(2,3)+TS(2,3)
c ******* Bug Fix  4/24/92  LWF  - Error for Acentric tetragonal with I41 x x
c      DO 51 I=1,3
c 51   IF (NBR.EQ.6.AND.TS(3,1).EQ.0.5.AND.TS(3,2).EQ.0.5.AND.TS(3,3).EQ.
c     10.5) TS(3,I)=0.0
      if((nbr.eq.6).and.(ns.eq.1).and.(spg(1,2).eq.'1'))ts(3,3)=0.5
c******* End of Bug Fix
      DO I=1,3
        TS(4,I)=TS(2,I)
        DO J=1,3
          TS(4,I)=TS(4,I)+SS(2,I,J)*TS(3,J)
          DO K=1,3
	    SS(4,I,J)=SS(4,I,J)+SS(2,I,K)*SS(3,K,J)
	  enddo
	enddo
      enddo
      IF (NBL.EQ.1) GO TO 780
      do i=1,3
	te(i) = 0.0
	do j=1,3
	  e(j,i) = 0
	enddo
      enddo
      IF (NS.EQ.0) then
	E(1,1)=-1
        E(2,2)=1
        E(3,3)=1
        IF ((spg(2,1).EQ.'c').OR.(spg(2,1).EQ.'n')) TE(3)=0.5
        IF ((spg(2,1).EQ.'b').OR.(spg(2,1).EQ.'n')) then
          TE(2)=0.5
          TE(1)=0.5
        endif
        IF ((spg(1,3).EQ.'n').OR.(spg(1,4).EQ.'n')) TE(1)=TE(1)+0.5
      else
        IF (spg(2,1).NE.'2'.AND.spg(3,1).NE.'2') then
	  E(1,1)=1
          E(2,2)=-1
          E(3,3)=1
          IF (spg(2,1).EQ.'c'.OR.spg(2,1).EQ.'n') TE(3)=0.5
          IF (spg(2,1).EQ.'n'.OR.spg(2,1).EQ.'b') then
            TE(1)=0.5
            TE(2)=0.5
          endif
	else
          IF (spg(2,1).EQ.'2'.AND.spg(3,1).EQ.'2') then
	    E(1,2)=1
	    E(2,1)=1
            E(3,3)=-1
            IF ((spg(2,2).EQ.' '.AND.NBR.NE.6).AND.spg(1,2).NE.' ')THEN
      		IF (spg(1,2).EQ.'1') TE(3)=0.75
      		IF (spg(1,2).EQ.'2') TE(3)=0.5
      		IF (spg(1,2).EQ.'3') TE(3)=0.25
      	    endif
	  else
            IF (spg(2,1).EQ.'2') then
	      E(1,1)=1
              E(2,2)=-1
              E(3,3)=-1
              IF (spg(3,1).EQ.'c') TE(3)=0.5
              IF (spg(3,1).EQ.'d') then
                TE(3)=0.25
                TE(2)=0.5
	      endif
              IF (spg(2,2).eq.'1') then
      	        TE(1)=0.5
      		TE(2)=0.5
              endif
	    else
              IF (spg(2,1).EQ.'c'.OR.spg(2,1).EQ.'n') TE(3)=0.5
      	      E(1,1)=-1
      	      E(2,2)=1
	      E(3,3)=1
      	      IF (spg(2,1).EQ.'n'.OR.spg(2,1).EQ.'b') then
      		TE(1)=0.5
      		TE(2)=0.5
	      endif
	    endif
	  endif
	endif
      endif
590   NE=4
      GO TO 760
C-----HEXAGONAL
600   NG=3
      IF (spg(1,1).EQ.'-'.AND.spg(1,2).EQ.'3') NS=0
      IF (spg(1,1).EQ.'6') GO TO 630
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,2,2)=-1
      SS(2,3,3)=1
      IF (spg(1,2).EQ.'1') TS(2,3)=1.0/3.0
      IF (spg(1,2).EQ.'2') TS(2,3)=2.0/3.0
      SS(3,1,1)=-1
      SS(3,2,1)=-1
      SS(3,1,2)=1
      SS(3,3,3)=1
      TS(3,3)=2.0*TS(2,3)
      IF (TS(3,3).GE.1.0) TS(3,3)=TS(3,3)-1.0
      IF (NBL.EQ.1.AND.spg(1,2).NE.'6') GO TO 780
      IF (spg(1,2).NE.'6') GO TO 620
      NG=NG+NG
      DO 610 I=1,3
      DO 610 J=1,3
      DO 610 K=1,3
      SS(3+I,J,K)=SS(I,J,K)
610   SS(3+I,3,3)=-1
620   IF (NBL.EQ.1) GO TO 780
      IF (spg(2,1).NE.'c'.AND.spg(3,1).NE.'c') GO TO 650
      TS(4,3)=0.5
      TS(5,3)=0.5
      TS(6,3)=0.5
      GO TO 650
630   NG=2*NG
      SS(2,1,1)=1
      SS(2,1,2)=-1
      SS(2,2,1)=1
      SS(2,3,3)=1
      IF (spg(1,2).EQ.'1') TS(2,3)=1.0/6.0
      IF (spg(1,2).EQ.'2') TS(2,3)=2.0/6.0
      IF (spg(1,2).EQ.'3') TS(2,3)=3.0/6.0
      IF (spg(1,2).EQ.'4') TS(2,3)=4.0/6.0
      IF (spg(1,2).EQ.'5') TS(2,3)=5.0/6.0
      DO 640 I=1,4
      DO 640 J=1,3
      TS(2+I,J)=TS(2,J)
      DO 640 K=1,3
      TS(2+I,J)=TS(2+I,J)+SS(2,J,K)*TS(1+I,K)
      IF (TS(2+I,J).GT.1.0) TS(2+I,J)=TS(2+I,J)-1.0
      DO 640 L=1,3
640   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 780
650   NG=2*NG
      IF (spg(2,1).EQ.'1') GO TO 670
      IF (spg(2,1).EQ.'2') GO TO 660
      E(1,2)=-1
      E(2,1)=-1
      E(3,3)=1
      IF (spg(2,1).EQ.'c') TE(3)=0.5
      GO TO 690
660   E(1,2)=1
      E(2,1)=1
      E(3,3)=-1
      TE(3)=2.0*TS(2,3)
C-----GROUP P 31 I 2 AND P 32 I 2
      IF (spg(1,1).EQ.'3'.AND.(spg(1,2).EQ.'1'.OR.spg(1,2).EQ.
     1'2')) TE(3)=0.
      GO TO 690
670   IF (spg(3,1).EQ.'2') GO TO 680
      E(1,2)=1
      E(2,1)=1
      E(3,3)=1
      IF (spg(3,1).EQ.'c') TE(3)=0.5
      GO TO 690
680   E(1,2)=-1
      E(2,1)=-1
      E(3,3)=-1
      TE(3)=2.0*TS(2,3)
      IF (TE(3).GT.1.0) TE(3)=TE(3)-1.0
690   NE=6
      IF (spg(1,1).EQ.'3'.OR.(spg(1,2).EQ.'3'.AND.spg(1,1).EQ.
     1'-')) NE=3
      GO TO 760
C-----CUBIC
700   NG=12
      do i=1,3
	te(i) = 0.0
      enddo
      IF (NBL.EQ.3) NG=24
      IF (spg(1,1).NE.'2'.AND.spg(1,1).NE.'4'.AND.spg(1,1).NE.
     1'-') NS=0
      DO I=1,3
        DO J=1,3
          SS(1+I,J,J)=1
          IF (I.NE.J) THEN
            SS(1+I,J,J)=-1
            IF (spg(1,1).EQ.'n') TS(1+I,J)=0.5
            IF (spg(1,1).EQ.'d') TS(1+I,J)=0.25
	  endif
	ENDDO
      ENDDO
      IF (((spg(1,1).EQ.'a').OR.(spg(3,1).EQ.'d').OR.
     1 (spg(1,2).EQ.'3').OR.(spg(1,2).EQ.'1')).AND.(NBR.NE.5)) THEN
	DO I=1,3
	  TS(1+I,I)=0.5
	  K=I+1
	  IF (K.EQ.4) K=1
	  TS(1+I,K)=0.5
	ENDDO
      endif
      DO I=1,4
        DO J=1,3
          DO 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)
            TS(8+I,J)=TS(I,M)
          ENDDO
        ENDDO
      ENDDO
      IF (NG.EQ.12) GO TO 780
      NE=12
      DO I=1,3
	TE(I) = 0.0
	DO J=1,3
	  E(J,I) = 0.0
	ENDDO
      ENDDO
      E(1,2)=1
      E(2,1)=1
      E(3,3)=1
      IF (spg(3,1).EQ.'2') E(3,3)=-1
      IF (spg(3,1).EQ.'c') TE(3)=0.5
      DO I=1,3
        IF (spg(3,1).EQ.'n'.OR.spg(1,2).EQ.'2') TE(I)=0.5
        IF (spg(1,2).EQ.'3'.OR.spg(1,2).EQ.'1') TE(I)=0.25
	IF (spg(3,1).EQ.'d')TE(I)=0.75
      enddo
      IF (spg(1,2).EQ.'1'.AND.NBR.EQ.1) TE(1)=0.75
      IF (((spg(1,2).EQ.'1').AND.(NBR.EQ.6)).OR.
     1		((spg(1,2).EQ.'3').AND.(NBR.EQ.1))) THEN
          TE(2)=0.75
          TE(3)=0.75
      endif
760   DO I=1,NE
	DO J=1,3
	  TS(NE+I,J)=TE(J)
	  DO K=1,3
	    TS(NE+I,J)=TS(NE+I,J)+E(J,K)*TS(I,K)
	    DO L=1,3
	     SS(NE+I,J,K)=SS(NE+I,J,K)+E(J,L)*SS(I,L,K)
	    ENDDO
	  ENDDO
	ENDDO
      ENDDO
780   DO 830 I=1,NG
      DO 830 J=1,3
790   IF (TS(I,J).GE.1.0) GO TO 800
      GO TO 810
800   TS(I,J)=TS(I,J)-1.0
      GO TO 790
810   IF (TS(I,J).LT.0.0) GO TO 820
      GO TO 830
820   TS(I,J)=TS(I,J)+1.0
      GO TO 810
830   CONTINUE
      ISYSTM=ISYS(SYS)
      IF (NS.EQ.0) ISYMCE=1
      IF (NS.EQ.1) ISYMCE=0
      RETURN
      END
