      subroutine rfspgr(icent,icell,nsym,rmat,trans)
      include 'rfine.prm'
      include 'e.inc'
      include 'cnstrs.inc'
      real rmat(3,3,24),trans(3,24),rot(3,3,192),xtns(3,192)
      equivalence (aa,rot),(aa(2000),xtns)
      character*1 spg(20),latsym
      common /apgcom/spg
      data spg/'P',' ','-','1',16*' '/
c
      read(in,2)spg
2     format(20a1)
c
      call spaceg(rot,xtns,nsym,icent,latsym,iout)
      icent=1-icent
c copy translation and rotation
      do 120 i=1,nsym
        do 110 j=1,3
          trans(j,i)=xtns(j,i)
          do 100 k=1,3
            rmat(k,j,i)=rot(k,j,i)
100       continue
110     continue
120   continue
      icell=-1
      if(latsym.eq.'P')icell = 0
      if(latsym.eq.'I')icell = 4
      if(latsym.eq.'F')icell = 5
      if(latsym.eq.'C')icell = 3
      if(latsym.eq.'B')icell = 2
      if(latsym.eq.'A')icell = 1
      if(latsym.eq.'R')icell = 6
      if(icell.lt.0)then
        write(iout,10)
10      format (' Lattice type not recognized: Set to primitive')
        icell=0
      end if
      return
      end
      SUBROUTINE SPACEG(ROT,TRANS,MLT,ICET,LATSYM,io2)
C
C ROUTINE TO LINK TO SPACE GROUP ROUTINES FROM PROGRAM DBW4.0
C
C-  MLT = MULTIPLICITY OF THE SPACE GROUP
C-  ICET = CENTER OF SYMMETRY INDICATOR: 0 - ACENTRIC, 1 - CENTRIC
C-  LATSYM = LATTICE CENTERING SYMBOL
C
      include 'e.inc'
      CHARACTER TNS(7)*3,ROTAL(2,3)*2,OUTT(3)*3,OUTR(2,3)*2
     1,SPG(20)*1,LATSYM*1,LATCHR(7)*1
      DIMENSION LATPNT(7,2), TNSLAT(3,6)
      REAL XTNS(7),XROT(3),ROT(3,3,192),TRANS(3,192)
      common /apgcom/spg
      DATA XTNS/0.5,0.33333,0.66667,0.25,0.75,0.16667,0.83333/
      DATA TNS/'1/2','1/3','2/3','1/4','3/4','1/6','5/6'/
      DATA ROTAL/'+x','-x','+y','-y','+z','-z'/
      DATA LATCHR/'P','A','B','C','I','F','R'/
      DATA LATPNT/0,1,1,1,1,3,2,0,1,2,3,4,1,5/
      DATA TNSLAT/0.0,0.5,0.5, 0.5,0.0,0.5, 0.5,0.5,0.0, 0.5,0.5,0.5
     1, 0.33333,0.66667,0.66667, 0.66667,0.33333,0.33333/
C
C CONVERT SPACE GROUP STRING TO UPPER CASE
C
	DO 100 I=1,20
	  IF(SPG(I).GE.'a')SPG(I)=CHAR(ICHAR(SPG(I))
     1    -ICHAR('a')+ICHAR('A'))
100	CONTINUE
	CALL SPGP(LATSYM)
	CALL RTMT(MLT,ROT,TRANS)
C-
	DO 102 I=1,7
	  IF(LATCHR(I).EQ.LATSYM)THEN
	    JLAT=I
	    GO TO 104
	  ENDIF
102	CONTINUE
      JLAT=1
104   ICET=0
C-
C--  SEARCH FOR INVERSION AND LATTICE CENTERING RELATIONS
C-
      DO 280 NN1=1,MLT-1
	IF(TRANS(1,NN1).EQ.999.9)GO TO 280
          DO 281 NN2=NN1+1,MLT
	    IF(TRANS(1,NN2).EQ.999.9)GO TO 281
	    DO 270 NJ=1,3
              TEMP=AMOD(TRANS(NJ,NN1)+TRANS(NJ,NN2),1.0)
	      IF(ABS(TEMP).GT.1.0E-4)GO TO 281
	      DO 260 NK=1,3
	        IF(ABS(ROT(NJ,NK,NN1)+ROT(NJ,NK,NN2))
	1	    .GT.1.0E-4)GO TO 281
260	      CONTINUE
270	    CONTINUE
C CENTER OF INVERSION
	    ICET=1
	    TRANS(1,NN2)=999.9
	    GO TO 280
281       CONTINUE
280     CONTINUE
        IF(LATPNT(JLAT,1).EQ.0)GO TO 289
        DO 286 NN1=1,MLT-1
	  IF(TRANS(1,NN1).EQ.999.9)GO TO 286
          DO 287 NN2=NN1+1,MLT
	    IF(TRANS(1,NN2).EQ.999.9)GO TO 287
	    DO 282 NJ=1,3
	      DO 284 NK=1,3
	        IF(ABS(ROT(NJ,NK,NN1)-ROT(NJ,NK,NN2))
	1	    .GT.1.0E-4)GO TO 287
284	      CONTINUE
282	    CONTINUE
C ROTATION PART SAME AS ANOTHER - MAY BE MULTIPLE LATTICE POINT
            DO 2822 NK=1,LATPNT(JLAT,1)
              NKK=LATPNT(JLAT,2)+NK-1
	      DO 2824 NJ=1,3
	        IF(AMOD(ABS(TRANS(NJ,NN1)-TRANS(NJ,NN2)
	1         +TNSLAT(NJ,NKK)),1.0).GT.1.0E-4)GO TO 2822
2824          CONTINUE
	      TRANS(1,NN2)=999.9
2822        CONTINUE
287	  CONTINUE
286     CONTINUE
C
C SQUEEZE OUT DISCARDED OPERATIONS
C
289	N=0
	DO 1000 I=1,MLT
	  IF(TRANS(1,I).EQ.999.9)GO TO 1000
	  N=N+1
	  IF(I.EQ.N)GO TO 1000
	  DO 1010 J=1,3
	    TRANS(J,N)=TRANS(J,I)
	    DO 1020 K=1,3
	      ROT(J,K,N)=ROT(J,K,I)
1020        CONTINUE
1010	  CONTINUE
1000	CONTINUE
	MLT=N
	WRITE(io2,2)MLT,ICET,LATSYM
2	FORMAT(/I3,' Space Group Operations, Centric Flag =',I2
	1,', Lattice Symbol = ',A1/)
	DO 160 I=1,MLT
	  DO 120 J=1,3
	    DO 110 K=1,2
	      OUTR(K,J)='  '
110	    CONTINUE
	    OUTT(J)='   '
120	  CONTINUE
	  DO 150 J=1,3
	    IF(TRANS(J,I).NE.0)THEN
	      DO 130 K=1,7
	        IF(ABS(TRANS(J,I)-XTNS(K)).LT.1.0E-4)OUTT(J)=TNS(K)
130	      CONTINUE
	    END IF
	    JPNT=1
	    DO 140 K=1,3
	      IF(ROT(J,K,I).EQ.0)GO TO 140
	      L=IFIX(ROT(J,K,I)*0.5+0.6)
	      OUTR(JPNT,J)=ROTAL(2-L,K)
	      JPNT=2
140	    CONTINUE
150	  CONTINUE
	  WRITE(io2,4)(OUTT(J),(OUTR(K,J),K=1,2),J=1,3)
4	  FORMAT(5X,3(A3,2A2,2X))
160	CONTINUE
	RETURN
	END
      SUBROUTINE RTMT(MLT,ROT,TRANS)
C-
C THIS SUBROUTINE GENERATES ROTATION MATRICES AND TRANSLATION VECTORS
C    FROM THE OPERATORS TO FORM THE GROUP.
C-
C-  MLT = MULTIPLICITY OF THE SPACE GROUP
C-  ROT(3,3,96) = ROTATION MATRICES
C-  TRANS(3,96) = TRANSLATION MATRICES
C-
      COMMON/BLNK1/ N,NMAX,MULTX,Y(192,3),XLT,IXB,FILL(192)
      COMMON/SPGCOM/ NXX(14),MULT
      DIMENSION ROT(3,3,1),TRANS(3,1)
      DIMENSION VCTR(3,4), IVCTR(3)
      NOPR=0
C-
      Y(1,1) = 2.0 / 108.0
      Y(1,2) = 3.0 / 108.0
      Y(1,3) = 4.0 / 108.0
      CALL SYMOPR
      MULT = MULTX - 1
C-
C-  REPEAT FOR EACH OF THE GENERAL SYMMETRY OPERATORS
      DO 400 I=1,MULT
      NVECPT = NVECPT + 1
C-
C-  REPEAT FOR EACH OF THE THREE AXES
      DO 320 K=1,3
      IX = Y(I,K) * 108.0 + 0.1
      VCTR(K,4) = REAL( (IX+4)/9 ) / 12.0
      VCTR(K,4) = AMOD( VCTR(K,4), 1.0 )
      IY = MOD(IX+4,9) - 4
      IZ = IABS( IY )
      GO TO (220,230,240,250),IZ
220   VCTR(K,1) = -REAL( ISIGN(1,IY) )
      VCTR(K,2) =  REAL( ISIGN(1,IY) )
      VCTR(K,3) =  0.0
      GO TO 310
230   VCTR(K,1) =  REAL( ISIGN(1,IY) )
      VCTR(K,2) =  0.0
      VCTR(K,3) =  0.0
      GO TO 310
240   VCTR(K,1) =  0.0
      VCTR(K,2) =  REAL( ISIGN(1,IY) )
      VCTR(K,3) =  0.00
      GO TO 310
250   VCTR(K,1) =  0.0
      VCTR(K,2) =  0.0
      VCTR(K,3) =  REAL( ISIGN(1,IY) )
310   CONTINUE
320   CONTINUE
      NOPR=NOPR+1
      DO 290 JJJ=1,3
        TRANS(JJJ,NOPR)=VCTR(JJJ,4)
        DO 290 KKK=1,3
          ROT(JJJ,KKK,NOPR)=VCTR(JJJ,KKK)
290   CONTINUE
C-
400   CONTINUE
C-
      MLT = NOPR
      RETURN
      END
      SUBROUTINE SYMOPR
C
C                             THIS SR TAKES A POINT XYZ, DETERMINES THE
C                           SITE MULTIPLICITY, THE SITE SYMMETRY, AND
C                           THE SYMMETRY CONSTRAINTS ON THE POSITIONAL
C                           AND THERMAL PARAMETERS.
C
      COMMON/BLNK1/ N(2),L,X(192),Y(192),Z(192),XLT,KXB,NCTR(192)
      COMMON/SPGCOM/NSP(2),M(10),FILL(3)
      ISCK = 0
103   L = 2
      ISRH = 0
      KXB = 0
      XLT = 1.0
      J = 1
      CALL CEL000
      L1=J
      DO 100 I=1,8
      IOP = 0
      IF ( M(I).EQ.0 ) GO TO 104
1     DO 99 L2=J,L1
      L3=L-1
      IF ( M(I)-8192 ) 4,5,4
5     X(L)=X(L2)+1.0/3.0
      Y(L)=Y(L2)+2.0/3.0
      Z(L)=Z(L2)+2.0/3.0
      X(L+1)=X(L2)+2.0/3.0
      Y(L+1)=Y(L2)+1.0/3.0
      Z(L+1)=Z(L2)+1.0/3.0
      L=L+1
      CALL CEL000
      L=L+1
      CALL CEL000
      GO TO 6
4     CALL OPERTR(I,L2)
6     L5=L
      L6=M(I)
7     L = L3+1
8     L4 = 1
      IF ( ABS(X(L)-X(L4))-0.0001 ) 2,2,90
2     IF ( ABS(Y(L)-Y(L4))-0.0001 ) 3,3,90
3     IF ( ABS(Z(L)-Z(L4))-0.0001 ) 91,91,90
91    CONTINUE
      IF ( NCTR(L)-8192 ) 92,94,93
92    KX = MOD(NCTR(L),4)+1
      KY = MOD(NCTR(L)/16,4)+1
      KZ = MOD(NCTR(L)/256,2)
      IF ( IOP.EQ.0 ) XLT=XLT/2.0
      IOP = 1
      GO TO (920,930,940,950),KX
      CALL GOTOER
920   GO TO (921,1000,922,1000),KY
      CALL GOTOER
921   IF ( KZ.EQ.0 ) GO TO 1000
      KXB = IOR(KXB,2621450)
      GO TO 90
922   CONTINUE
      IF ( KZ.EQ.0 ) KXB=IOR(KXB,2228292)
      IF ( KZ.EQ.1 ) KXB=IOR(KXB, 655432)
      GO TO 90
930   KXB = IOR(KXB,32768)
      GO TO (1000,931,1000,932),KY
      CALL GOTOER
931   CONTINUE
      IF ( KZ.EQ.0 ) KXB=IOR(KXB, 4194464)
      IF ( KZ.EQ.1 ) KXB=IOR(KXB,12583048)
      GO TO 90
932   KXB = IOR(KXB,2753088)
      IF ( KZ.EQ.1 ) KXB = IOR(KXB,8)
      GO TO 90
940   KXB = IOR(KXB,512)
      GO TO (941,1000,942,1000),KY
      CALL GOTOER
941   KXB = IOR(KXB,131072)
      IF ( KZ.EQ.1 ) GO TO 943
      KXB = IOR(KXB,525312)
      GO TO 90
942   KXB = IOR(KXB,64)
      IF ( KZ.EQ.1 ) GO TO 944
      KXB = IOR(KXB,2623488)
      GO TO 90
943   KXB = IOR(KXB,2097152)
944   KXB = IOR(KXB,8)
      GO TO 90
950   KXB = IOR(KXB,32768)
      GO TO (1000,951,1000,952),KY
      CALL GOTOER
951   KXB = IOR(KXB,2753088)
      IF ( KZ.EQ.1 ) KXB = IOR(KXB,8)
      GO TO 90
952   IF ( KZ.EQ.0 ) KXB = IOR(KXB,8388864)
      IF ( KZ.EQ.1 ) KXB = IOR(KXB,4194568)
      GO TO 90
93    CONTINUE
      IF ( MOD(NCTR(L),16384).EQ.0 ) GO TO 95
      ISRH = 1
      IF ( IAND(307,NCTR(L)-M(I)).EQ.0 ) GO TO 92
      GO TO 90
94    KXB = IOR(KXB,2916928)
      XLT = XLT/3.0
      GO TO 99
95    KXB = IOR(KXB,17924240)
      XLT = XLT/3.0
      GO TO 99
90    CONTINUE
      IF ( L6-8192 ) 99, 98,98
98    L6=1
      L = L+1
       GO TO 8
99    L=L5
100   L1=L-1
104   CONTINUE
      IF ( ISRH.EQ.0 ) GO TO 200
      IF ( ISCK.GT.1 ) GO TO 2000
      ISCK = ISCK+1
      DO 1010 J=1,I
      IF ( M(J).EQ.16384 ) GO TO 1011
1010  CONTINUE
      DO 101 L2 = 1,L1
      IF ( ABS(X(L2)-Y(L2)).LE.0.0001 ) GO TO 102
      IF ( ABS(X(L2)+Y(L2)-1.0).LE.0.0002 ) GO TO 102
101   CONTINUE
      ISCK = 2
      GO TO 200
1011  CONTINUE
      IF ( ABS(X(1)-Y(1)).LT.0.0001 ) GO TO 120
      X3 = X(1)
      X(1) = Y(1)
      Y(1) = Z(1)
      Z(1) = X3
      GO TO 103
110   FORMAT(/,' NO X,X,Z OR X,-X,Z SET WAS FOUND FOR ',4F8.5)
102   IF ( L2.EQ.1 ) GO TO 120
111   FORMAT(/,' THE ATOM AT ',3F8.5,' WAS PUT AT ',3F8.5)
      X(1) = X(L2)
      Y(1) = Y(L2)
      Z(1) =Z(L2)
      GO TO 103
1000  CONTINUE
      STOP ' --SYMMETRY OPERATOR WRONG.'
2000  CONTINUE
120   IF ( ABS(X(1)-Y(1))+ABS(X(1)-Z(1)).LE.0.0002 ) GO TO 200
      DO 130 L2=2,L1
      IF ( ABS(X(L2)-Y(L2))+ABS(X(L2)-Z(L2)).LE.0.0002 ) GO TO 102
130   CONTINUE
200   CONTINUE
      KXB = MAX0(IAND(KXB,18874367),IAND(KXB,16777215))
      IF ( IAND(KXB,384).EQ.384 ) KXB=IOR(KXB,512)
      RETURN
      END
      SUBROUTINE CEL000
C
C                             THIS SR IS USED TO FORCE A POINT XYZ TO
C                           LIE IN THE UNIT CELL AT 000.
C
      COMMON/BLNK1/ N(2),L,X(192),Y(192),Z(192),XLT,IXB,FILL(192)
      X(L-1) = AMOD(X(L-1)+8.0,1.0)
      IF ( X(L-1)-.99999 ) 2,1,1
1     X(L-1) = 0.0
2     Y(L-1) = AMOD(Y(L-1)+8.0,1.0)
      IF ( Y(L-1)-.99999 ) 4,3,3
3     Y(L-1) = 0.0
4     Z(L-1) = AMOD(Z(L-1)+8.0,1.0)
      IF ( Z(L-1)-.99999 ) 6,5,5
5     Z(L-1) = 0.0
6     RETURN
      END
      SUBROUTINE OPERTR(I,L2)
C
C                             THIS SR GENERATES THE SYMMETRY EQUIVALENT
C                           POSITIONS. IT IS CALLED BY SYMOPR.
C
      COMMON/BLNK1/ N(2),L,X(192),Y(192),Z(192),XLT,IXB,FILL2(192)
      COMMON/SPGCOM/NSP(2),M(10),FILL(3)
      I1 = MOD(M(I),4)+1
      I2 = MOD(M(I)/4,4)+1
      I3 = MOD(M(I)/16,4)+1
      I4 = MOD(M(I)/64,4)+1
      I5 = MOD(M(I)/256,2)
      I6 = MOD(M(I)/512,4)+1
      I7 = MOD(M(I)/2048,4)+1
      I8 = M(I)/8192+1
      GO TO (100,200,300),I8
      CALL GOTOER
100   GO TO (101,102,103,104),I1
      CALL GOTOER
101   X(L) = X(L2)
      GO TO 105
102   X(L) = Y(L2)
      GO TO 105
103   X(L) = -X(L2)
      GOTO 105
104   X(L) = -Y(L2)
105   GO TO (110,107,108,106),I2
      CALL GOTOER
106   X(L) = X(L)+0.25
107   X(L) = X(L)+0.25
108   X(L) = X(L)+0.25
110   GO TO (111,112,113,114),I3
      CALL GOTOER
111   Y(L) = Y(L2)
      GO TO 115
112   Y(L) = X(L2)
      GO TO 115
113   Y(L) = -Y(L2)
      GOTO 115
114   Y(L) = -X(L2)
115   GO TO (120,117,118,116),I4
      CALL GOTOER
116   Y(L) = Y(L)+0.25
117   Y(L) = Y(L)+0.25
118   Y(L) = Y(L)+0.25
120   Z(L) = Z(L2)*FLOAT(1-2*I5)
      GO TO (125,122,123,121),I6
      CALL GOTOER
121   Z(L) = Z(L)+0.25
122   Z(L) = Z(L)+0.25
123   Z(L) = Z(L)+0.25
125   GO TO (130,127,126),I7
      CALL GOTOER
126   Z(L) = Z(L)+0.333333333
127   Z(L) = Z(L)+0.333333333
130   L = L+1
      CALL CEL000
      RETURN
200   X(L) = -Y(L2)
      Y(L) = X(L2)-Y(L2)
      Z(L) = Z(L2)+0.333333333*FLOAT(I2-2)
      L = L+1
      CALL CEL000
      X(L) = -Y(L-1)
      Y(L) = -X(L2)
      Z(L) = Z(L2)-0.333333333*FLOAT(I2-2)
      GO TO 130
300   I1 = L2
301   X(L) = Z(I1)
      Y(L) = X(I1)
      Z(L) = Y(I1)
      IF ( I1-L2 ) 302,302,130
302   I1 = L
      L = L+1
      CALL CEL000
      GO TO 301
      END
      SUBROUTINE SPGP(LATSYM)
C
C   THIS SR INTERPRETS THE SPACE GROUP SYMBOL
C   AND GENERATES OPERATORS WHICH SYMOPR USES TO
C   GENERATE THE FULL SET OF EQUIVALENT
C   POSITIONS AND OP1 AND SMTRY2 USE TO GENERATE
C   THE FULL SET OF EQUIVALENT INDICES.
      CHARACTER*1 SPG(20),CHR(25),LATSYM
      DIMENSION L(4,4),ICO(6,15)
      COMMON/SPGCOM/NSP(2),NCONT(10),FILL(3)
      common /apgcom/spg
      DIMENSION NDAT(7)
      LODGDF(I,J) = IAND( IEOR(I,J),307)
      DATA NDAT(1),NDAT(2),NDAT(3),NDAT(4),NDAT(5),NDAT(6),NDAT(7)/
     *3,1,2,0,2,1,3/
      DATA CHR(1),CHR(2),CHR(3),CHR(4),CHR(5),CHR(6),CHR(7),CHR(8),
     *CHR(9),CHR(10),CHR(11),CHR(12),CHR(13),CHR(14),CHR(15),CHR(16),
     *CHR(17),CHR(18),CHR(19),CHR(20),CHR(21)/' ','C','B','A','P',
     *'F','I','R','M','N','D','1','2','3','4','5','6','-','/','H','.'/
C-
      DO 97 I=1,6
      DO 97 J=1,15
97    ICO(I,J)=0
      DO 98 I=1,4
      DO 98 J=1,4
98    L(I,J) = 0
      M2 = 0
      K = 1
      M = 1
      NSP(1) = 0
      NSP(2) = 0
      N = 0
      LATSYM=' '
      DO 110 J=1,20
	IF(LATSYM.EQ.' '.AND.SPG(J).NE.' ')LATSYM=SPG(J)
99    DO 100 I=1,21
      IF ( SPG(J).EQ.CHR(I) ) GO TO 101
100   CONTINUE
      GO TO 110
101   IF ( K+M+I.EQ.3 ) GO TO 110
      IF ( I.EQ.1 ) GO TO 108
      L(M,K) = I
      N = 0
      M = M+1
      IF ( M-4 ) 110,110,108
108   IF ( N.EQ.1 ) GO TO 110
      N = 1
      M = 1
      K = K+1
      IF ( K.GT.4 ) GO TO 200
110   CONTINUE
200   IF ( K.LE.2 ) GO TO 500
      IF ( L(1,1).GT.8 ) GO TO 500
      J = 1
      I = L(1,1)-1
      GO TO (203,202,201,119,204,205,206),I
      CALL GOTOER
201   NCONT(J) = 576
      GO TO 209
202   NCONT(J) = 516
      GO TO 209
203   NCONT(J) = 68
      GO TO 209
204   NCONT(J) = 576
      J = J+1
      GO TO 202
205   NCONT(J) = 580
      GO TO 209
207   K = K-1
      NSP(1) = K+3
      GO TO 210
206   IF ( L(1,3).EQ.8.OR.L(1,4).EQ.8 ) GO TO 207
      NCONT(J) = 8192
      IF ( L(1,K-1).EQ.20 ) K=K-1
      NSP(1) = K+5
      J = J+1
      GO TO 210
209   J = J+1
119   IF ( K-4 ) 120,130,140
120   IF ( L(1,2).EQ.18 ) GO TO 121
      IF ( L(1,2).EQ.17 ) GO TO 122
      IF ( L(1,2).EQ.14 ) GO TO 123
      IF ( L(1,2).EQ.15 ) GO TO 124
      IF ( L(1,2).EQ.12 ) GO TO 125
      NSP(1) = 2
      NSP(2) = 2
      GO TO 210
121   IF ( L(2,2).EQ.17 ) GO TO 122
      IF ( L(2,2).EQ.14 ) GO TO 123
      IF ( L(2,2).EQ.15 ) GO TO 124
      IF ( L(2,2).EQ.12 ) GO TO 125
      GO TO 500
122   NSP(1) = 11
      GO TO 210
123   NSP(1) = 8
      GO TO 210
124   NSP(1) = 4
      GO TO 210
125   NSP(1) = 1
      GO TO 210
130   IF ( L(1,3).NE.14 ) GO TO 500
      NSP(1) = 13
      GO TO 210
140   IF ( L(1,3).EQ.14 ) GO TO 151
      IF ( L(1,2).EQ.18 ) GO TO 152
      IF ( L(1,2).EQ.17 ) GO TO 153
      IF ( L(1,2).EQ.14 ) GO TO 154
      IF ( L(1,2).EQ.15 ) GO TO 155
      IF ( L(1,2).EQ.12 ) GO TO 141
      IF ( L(1,3).EQ.12 ) GO TO 142
      IF ( L(1,4).EQ.12 ) GO TO 500
      NSP(1) = 3
      GO TO 210
141   IF ( L(1,3).EQ.12 ) GO TO 143
      IF ( L(1,4).NE.12 ) GO TO 500
      NSP(1) = 2
      NSP(2) = 2
      GO TO 210
142   IF ( L(1,4).NE.12 ) GO TO 500
      NSP(1) = 2
      NSP(2) = 1
      GO TO 210
143   IF ( L(1,4).EQ.12 ) GO TO 500
      NSP(1) = 2
      NSP(2) = 3
      GO TO 210
151   NSP(1) = 14
      GO TO 210
152   IF ( L(2,2).EQ.17 ) GO TO 153
      IF ( L(2,2).EQ.14 ) GO TO 154
      IF ( L(2,2).EQ.15 ) GO TO 155
      GO TO 500
153   NSP(1) = 12
      GO TO 210
154   IF ( L(1,3).EQ.12 ) GO TO 156
      IF ( L(1,4).NE.12 ) GO TO 500
      NSP(1) = 9
      GO TO 210
155   NSP(1) = 5
      GO TO 210
156   IF ( L(1,4).EQ.12 ) GO TO 123
      NSP(1) = 10
210   K = K-1
      N = 1
      DO 300 M=2,K
      IF ( L(1,M).EQ.0 ) GO TO 500
218   I = IABS(L(1,M)-5)
219   IF ( I.LE.0.OR.I.GT.15 ) GO TO 500
C              A   B   C   M   N   D   1   2   3   4   5   6   -   /
      GO TO (220,220,220,220,220,245,250,255,260,265,500,270,275,300,
     1 300),I
      CALL GOTOER
C        H
220   GO TO (500,221,222,223),M
      CALL GOTOER
221   IF ( L(1,3).EQ.14 ) GO TO 2230
      IF ( L(1,2).EQ.15 ) GO TO 2230
      IF ( L(1,2).EQ.17 ) GO TO 2230
      IF ( K.EQ.2 ) GO TO 2220
2210  ICO(1,N) = 2
      ICO(2,N) = 0
      ICO(3,N) = 0
      ICO(4,N) = 4
      IF ( I.EQ.2.OR.I.EQ.5 ) ICO(5,N) = 1
      IF ( I.EQ.3.OR.I.EQ.5 ) ICO(6,N) = 1
2211  N = N+1
      IF ( L(1,2).NE.15 ) GO TO 300
      ICO(1,N) = ICO(2,N-1)
      ICO(2,N) = ICO(1,N-1)
      ICO(3,N) = ICO(3,N-1)
      ICO(4,N) = ICO(5,N-1)
      ICO(5,N) = ICO(4,N-1)
      ICO(6,N) = ICO(6,N-1)
      N= N+1
      GO TO 300
222   IF ( L(1,2).EQ.14.OR.L(1,2).EQ.17 ) GO TO 225
      IF ( L(1,2).EQ.15 ) GO TO 2210
2220  ICO(1,N) = 0
      ICO(2,N) = 2
      ICO(3,N) = 0
      ICO(5,N) = 4
      IF ( I.EQ.1.OR.I.EQ.5 ) ICO(4,N) = 1
      IF ( I.EQ.3.OR.I.EQ.5 ) ICO(6,N) = 1
      N = N+1
      GO TO 300
223   IF ( L(1,3).EQ.14.OR.L(1,2).EQ.15 ) GO TO 224
      IF ( L(1,2).EQ.14.OR.L(1,2).EQ.17 ) GO TO 224
2230  ICO(1,N) = 0
      ICO(2,N) = 0
      ICO(3,N) = 2
      ICO(6,N) = 4
      IF ( I.EQ.1.OR.I.EQ.5 ) ICO(4,N) = 1
      IF ( I.EQ.2.OR.I.EQ.5 ) ICO(5,N) = 1
      N = N+1
      IF ( M.EQ.2.AND.L(1,2).EQ.15.AND.I.EQ.5 ) ICO(4,N-3)=1
      IF ( M.NE. 2.OR.L(1,2).NE.17) GO TO 300
      IF ( L(1,3).EQ.2 ) ICO(6,N-1)=1
      IF ( L(1,4).EQ.2 ) ICO(6,N-1)=MOD(ICO(6,N-1)+1,2)
      GO TO 300
224   ICO(1,N) = 1
      ICO(2,N) = 1
      ICO(3,N) = 0
      ICO(4,N) = 4
      ICO(5,N) = 4
      IF ( I.EQ.3.OR.I.EQ.5 ) ICO(6,N) = 1
      IF ( NSP(1).EQ.7.AND.I.EQ.3 ) GO TO 2240
      IF ( I.NE.5 ) GO TO 226
2240  ICO(4,N) = 5
      ICO(5,N) = 5
      N = N+1
      GO TO 300
225   IF ( NSP(1).EQ.7 ) GO TO 224
      ICO(1,N) = 3
      ICO(2,N) = 3
      ICO(3,N) = 0
      ICO(4,N) = 4
      ICO(5,N) = 4
      IF ( I.EQ.3 ) ICO(6,N) = 1
226   N = N+1
      GO TO 300
C    D TYPE MIRROR
245   GO TO (500,246,247,248),M
      CALL GOTOER
246   IF ( K.EQ.2 ) GO TO 247
      ICO(1,N) = 2
      ICO(2,N) = 0
      ICO(3,N) = 0
      ICO(4,N) = 6
      ICO(5,N) = 6
      ICO(6,N) = 6
      N = N+1
      GO TO 300
247   ICO(1,N) = 0
      ICO(2,N) = 2
      ICO(3,N) = 0
      ICO(4,N) = 6
      ICO(5,N) = 6
      ICO(6,N) = 6
      N = N+1
      GO TO 300
248   IF ( L(1,2).EQ.15.OR.L(1,3).EQ.14 ) GO TO 249
      ICO(1,N) = 0
      ICO(2,N) = 0
      ICO(3,N) = 2
      ICO(4,N) = 6
      ICO(5,N) = 6
      ICO(6,N) = 6
      N = N+1
      GO TO 300
249   ICO(1,N) = 1
      ICO(2,N) = 1
      ICO(3,N) = 0
      ICO(4,N) = 6
      ICO(5,N) = 6
      ICO(6,N) = 6
      IF (L(1,3).NE.13) GO TO 226
      ICO(4,N) = 0
      ICO(5,N) = 1
      N = N+1
      GO TO 300
C    1 FOLD ROTATION
250   IF ( L(2,M).NE.3 ) GO TO 300
      ICO(1,N) = 2
      ICO(2,N) = 2
      ICO(3,N) = 2
      ICO(4,N) = 4
      ICO(5,N) = 4
      ICO(6,N) = 4
      N = N+1
      GO TO 300
255   GO TO (500,256,257,258),M
      CALL GOTOER
C    2 FOLD ROTATION
256   IF ( K.EQ.2 ) GO TO 2571
2561  ICO(1,N) = 0
      ICO(2,N) = 2
      ICO(3,N) = 2
      ICO(4,N) = 0
      ICO(5,N) = 4
      ICO(6,N) = 4
      IF ( IABS(L(2,M)-13).EQ.1 ) ICO(4,N) = 1
2560  N = N+1
      DO 2562 I=2,4
      IF ( L(I,M).EQ.19 ) GO TO 2563
2562  CONTINUE
      GO TO 300
2563  IF ( L(I+1,M).LE.1 ) GO TO 500
      I = IABS(L(I+1,M)-5)
      GO TO 219
257   IF ( L(1,2).EQ.14.OR.L(1,2).EQ.17 ) GO TO 259
2571  ICO(1,N) = 2
      ICO(2,N) = 0
      ICO(3,N) = 2
      ICO(4,N) = 4
      ICO(5,N) = 0
      ICO(6,N) = 4
      IF ( L(2,M).EQ.12 ) ICO(5,N)=1
      IF ( L(1,2).EQ.15 ) GO TO 2211
      GO TO 2560
258   IF ( L(1,2).GE.14   ) GO TO 2595
      IF ( L(1,3).EQ.14 ) GO TO 259
2581  ICO(1,N) = 2
      ICO(2,N) = 2
      ICO(3,N) = 0
      ICO(4,N) = 4
      ICO(5,N) = 4
      ICO(6,N) = 0
      IF ( IABS(L(2,M)-13).EQ.1 ) ICO(6,N) = 1
      IF (      L(2,M).EQ.16    ) ICO(6,N) = 1
      GO TO 2560
259   IF ( L(1,3).EQ.8.OR.L(1,4).EQ.8 ) GO TO 2595
      ICO(1,N) = 1
      ICO(2,N) = 1
      ICO(3,N) = 2
      ICO(4,N) = 0
      ICO(5,N) = 0
      ICO(6,N) = 4
      GO TO 2560
2595  IF ( L(1,2).EQ.15)GO TO 259
      ICO(1,N) = 3
      ICO(2,N) = 3
      ICO(3,N) = 2
      ICO(4,N) = 4
      ICO(5,N) = 4
      ICO(6,N) = 4
      GO TO 2560
C    3 FOLD ROTATION
260   GO TO (500,261,262,500),M
      CALL GOTOER
261   IF ( L(1,1).EQ.8.AND.J.EQ.1 ) GO TO 262
      IX = 0
      IF ( L(2,M).EQ.12 ) GO TO 2611
      IF ( L(2,M).EQ.13 ) GO TO 2612
2610  NCONT(J) = 8196
      GO TO 2613
2611  NCONT(J) = 8200
      IF ( L(1,4).NE.13 ) GO TO 2613
      J = J+1
      NCONT(J) = 2321
      IF ( L(1,2).EQ.14 ) NCONT(J)=4403
      L(1,3) = 12
      L(1,4) = 12
      GO TO 2613
2612  NCONT(J) = 8204
      IF ( L(1,4).NE.13 ) GO TO 2613
      J = J+1
      NCONT(J) = 4369
      IF ( L(1,2).EQ.14 ) NCONT(J)=2355
      L(1,3) = 12
      L(1,4) = 12
2613  J = J+1
      IF ( IX-1 ) 250,2581,2230
C    CUBIC OR RHOMBOHEDERAL
262   NCONT(J) = 16384
      IF (L(2,M).NE.3 ) GO TO 2620
      J = J+1
      NCONT(J) = 290
2620  J = J+1
      IF ( N.EQ.1 ) GO TO 300
      I = N-1
      IN1 = N
      IN2 = N+1
      ICO(1,IN1) = ICO(3,I)
      ICO(2,IN1) = ICO(1,I)
      ICO(3,IN1) = ICO(2,I)
      ICO(4,IN1) = ICO(6,I)
      ICO(5,IN1) = ICO(4,I)
      ICO(6,IN1) = ICO(5,I)
      ICO(1,IN2) = ICO(2,I)
      ICO(2,IN2) = ICO(3,I)
      ICO(3,IN2) = ICO(1,I)
      ICO(4,IN2) = ICO(5,I)
      ICO(5,IN2) = ICO(6,I)
263   ICO(6,IN2) = ICO(4,I)
      N = IN2+1
      GO TO 300
265   IF ( M.NE.2 ) GO TO 500
      ICO(1,N) = 3
      ICO(2,N) = 1
      ICO(3,N) = 0
      ICO(4,N) = 4
      ICO(5,N) = 4
      ICO(6,N) = 0
      IF ( L(2,2).EQ.12 ) ICO(6,N) = 2
      IF ( L(2,2).EQ.13 ) ICO(6,N) = 1
      IF ( L(2,2).EQ.14 ) ICO(6,N) = 3
      IF ( L(2,2).EQ. 3 ) ICO(3,N) = 2
      N = N+1
      IF ( L(2,2).EQ.3.AND.L(1,3).EQ.14.AND.L(1,4).EQ.11 ) GO TO 266
      IF ( L(1,3).EQ.14 ) GO TO 2561
      IF ( K.GT.2.OR.L(1,1).NE.7 ) GO TO 2581
      IF ( L(2,2)+L(3,2).NE.12 ) GO TO 2581
      L(2,2) = 0
      ICO(5,N-1) = 1
      GO TO 2581
266   IF ( L(1,1).NE.7.OR.L(1,2).NE.15 ) GO TO 500
      NCONT(J  ) = 16384
      NCONT(J+1) = 356
      NCONT(J+2) = 834
      NCONT(J+3) = 1177
      J = J+3
      GO TO 410
270   IF ( M.NE.2 ) GO TO 500
      IX = 1
      IF ( L(2,2).EQ.12 ) GO TO 2611
      IF ( L(2,2).EQ.13 ) GO TO 2612
      IF ( L(2,2).EQ.14 ) GO TO 2610
      IF ( L(2,2).EQ.15 ) GO TO 2611
      IF ( L(2,2).EQ.16 ) GO TO 2612
      IF ( L(2,2).EQ. 3 ) GO TO 271
      GO TO 2610
271   IX = 2
      GO TO 2610
275   IF ( M.NE.2 ) GO TO 500
      L(1,2) = L(2,2)
      L(2,2) = 3
      GO TO 218
300   CONTINUE
      N = N-1
      IJ = J
      IF ( N.GT.0 ) GO TO 301
      J = J-1
      GO TO 410
301   DO 305 I=1,N
      NCONT(J) = ICO(1,I)+16*ICO(2,I)+128*ICO(3,I)+4*MOD(ICO(4,I),4)
     1 +64*MOD(ICO(5,I),4)+ 512*MOD(ICO(6,I),4)
305   J = J+1
306   J = J-1
310   DO 400 I=IJ,J
      NCI = I-IJ+1
      ICO4 = MOD(ICO(4,NCI),4)
      ICO5 = MOD(ICO(5,NCI),4)
      ICO6 = MOD(ICO(6,NCI),4)
      NI4 = NDAT(ICO4+4)
      NI5 = NDAT(ICO5+4)
      NI6 = NDAT(ICO6+4)
      KJ = I+1
      IF ( IAND(NCONT(I),307)-290 ) 320,315,320
315   IF ( IAND(NCONT(I),7884) ) 316,318,316
C   A CENTER IS PRESENT, NOT AT 0,0,0
316   CONTINUE
      GO TO 320
C   A CENTER AT 0,0,0 IS PRESENT
318   CONTINUE
320   IF ( KJ.GT.J ) GO TO 400
      DO 390 K=KJ,J
      NCK = K-IJ+1
      KCO4 = MOD(ICO(4,NCK),4)
      KCO5 = MOD(ICO(5,NCK),4)
      KCO6 = MOD(ICO(6,NCK),4)
      NK4 = NDAT(KCO4+4)
      NK5 = NDAT(KCO5+4)
      NK6 = NDAT(KCO6+4)
      NXC = MOD(NI4+NK4,4)
      NYC = MOD(NI5+NK5,4)
      NZC = MOD(NI6+NK6,4)
      MJ = K+1
      LOD = LODGDF(NCONT(K),NCONT(I))
      IF ( LOD.NE.290 ) GO TO 330
C   A CENTER IS GENERATED
      IF ( NXC+NYC+NZC.EQ.0 ) GO TO 330
      IF ( L(1,2).EQ.15.AND.I.EQ.IJ+1 ) GO TO 324
321   IF ( NXC.EQ.0 ) GO TO 322
      IF ( ICO(4,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NXC)*4
      IF ( ICO(4,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NXC)*4
322   IF ( NYC.EQ.0 ) GO TO 323
      IF ( ICO(5,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NYC)*64
      IF ( ICO(5,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NYC)*64
323   IF ( NZC.EQ.0 ) GO TO 325
      IF ( ICO(6,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NZC)*512
      IF ( ICO(6,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NZC)*512
      GO TO 325
324   L(1,2) = 30
      NIJ = ICO(6,1)
      NIJ = NDAT(NIJ+4)
      NJX = MOD(NIJ+NXC,4)
      NCONT(IJ) = IAND(NCONT(IJ),2035)+NDAT(NJX+4)*4
      NCONT(IJ) = IAND(NCONT(IJ),1855)+NDAT(NIJ+4)*64
      GO TO 321
325   CONTINUE
      ICO(4,NCI) = 0
      ICO(4,NCK) = 0
      ICO(5,NCK) = 0
      ICO(5,NCI) = 0
      ICO(6,NCI) = 0
      ICO(6,NCK) = 0
330   CONTINUE
      ICO4 = MOD(NCONT(I)/4  ,4)
      IKO4 = MOD(NCONT(K)/4  ,4)
      ICO5 = MOD(NCONT(I)/64 ,4)
      IKO5 = MOD(NCONT(K)/64 ,4)
      ICO6 = MOD(NCONT(I)/512,4)
      IKO6 = MOD(NCONT(K)/512,4)
      NI4 = NDAT(ICO4+4)
      NK4 = NDAT(IKO4+4)
      NI5 = NDAT(ICO5+4)
      NK5 = NDAT(IKO5+4)
      NI6 = NDAT(ICO6+4)
      NK6 = NDAT(IKO6+4)
      IF ( MJ.GT.J ) GO TO 390
      DO 380 M=MJ,J
      NCM = M-IJ+1
      MCO4 = MOD(ICO(4,NCM),4)
      MCO5 = MOD(ICO(5,NCM),4)
      MCO6 = MOD(ICO(6,NCM),4)
      NM4 = NDAT(MCO4+4)
      NM5 = NDAT(MCO5+4)
      NM6 = NDAT(MCO6+4)
      LOD1 = LODGDF(LOD,NCONT(M))
      NXC = MOD(NI4+NK4+NM4,4)
      NYC = MOD(NI5+NK5+NM5,4)
      NZC = MOD(NI6+NK6+NM6,4)
      IF ( LOD1.NE.290 ) GO TO 350
       IF  ( L(1,2).EQ.11 ) GO TO 334
      IF ( NXC+NYC+NZC.EQ.0 ) GO TO 380
      IF ( IJ.EQ.1 ) GO TO 331
      IF(NXC +NYC .EQ.0 )GO TO 333
      IF ( L(1,3).EQ.14 ) GO TO 331
      IF ( L(1,2).EQ.15 ) GO TO 331
      IF ( L(1,2).EQ.14 ) GO TO 331
      IF ( L(1,2).EQ.17 ) GO TO 331
      IF ( L(1,2)+L(1,3)+L(1,4).LT.18.AND.L(1,2).NE.9 ) GO TO 331
      NXC = MOD(NCONT(1)/2  +NXC,4)
      NYC = MOD(NCONT(1)/32 +NYC,4)
      NZC = MOD(NCONT(1)/256+NZC,4)
331   CONTINUE
      IF ( NXC.EQ.0 ) GO TO 332
      IF ( ICO(4,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NXC)*4
      IF ( ICO(4,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NXC)*4
      IF ( ICO(4,NCM).EQ.4 ) NCONT(M) = NCONT(M)+NDAT(NXC)*4
332   IF ( NYC.EQ.0 ) GO TO 333
      IF ( ICO(5,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NYC)*64
      IF ( ICO(5,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NYC)*64
      IF ( ICO(5,NCM).EQ.4 ) NCONT(M) = NCONT(M)+NDAT(NYC)*64
333   IF ( NZC.EQ.0 ) GO TO 335
      IF ( ICO(6,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NZC)*512
      IF ( ICO(6,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NZC)*512
      IF ( ICO(6,NCM).EQ.4 ) NCONT(M) = NCONT(M)+NDAT(NZC)*512
      GO TO 335
334   NCONT(I) = IAND(NCONT(I),2035)
      NCONT(K) = IAND(NCONT(K),1855)
      NCONT(M) = IAND(NCONT(M),511)
335   ICO(4,NCI) = 0
      ICO(5,NCI) = 0
      ICO(6,NCI) = 0
      ICO(4,NCK) = 0
      ICO(5,NCK) = 0
      ICO(6,NCK) = 0
      ICO(4,NCM) = 0
      ICO(5,NCM) = 0
      ICO(6,NCM) = 0
      GO TO 380
350   IF ( LOD1.NE.0 ) GO TO 380
      IF ( NXC+NYC+NZC.EQ.0 ) GO TO 359
      IF ( L(1,2).EQ.30 ) GO TO 3500
      IF ( L(1,2).EQ.15 ) GO TO 355
      IF ( L(1,2).EQ.17 ) GO TO 359
      IF ( L(1,2).EQ.13 ) GO TO 351
      IF ( L(1,3).EQ.13 ) GO TO 352
      IF ( L(1,4).EQ.13 ) GO TO 353
      GO TO 500
3500  IF ( NXC.EQ.0 ) GO TO 359
      IF ( L(4,2).EQ.4 ) GO TO 359
      IF ( NXC.EQ.NK4 ) GO TO 359
      NCONT(K) = IOR(NCONT(K),NDAT(NXC)*4)
      IF ( L(1,4).EQ.13.AND.L(2,4).EQ.0 ) GO TO 3580
      GO TO 359
351   NYC = MOD(NK5+NM5,4)
      NZC = MOD(NK6+NM6,4)
      IF ( L(1,3).EQ.13 ) GO TO 354
      IF ( L(1,3).EQ.14 ) GO TO 354
      IF ( L(1,4).EQ.13 ) GO TO 354
      M2 = I+1
3511  CONTINUE
      IF(L(2,2).EQ.12.AND.(L(1,3).EQ.9 .OR.L(1,4).EQ.9))  GO TO 360
      IF ( ICO(5,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NYC)*64
      IF ( ICO(5,NCM).EQ.4 ) NCONT(M) = NCONT(M)+NDAT(NYC)*64
3510  IF ( NZC.LE.0 ) GO TO 360
      IF ( ICO(6,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NZC)*512
      IF ( ICO(6,NCM).EQ.4 ) NCONT(M) = NCONT(M)+NDAT(NZC)*512
      GO TO 360
352   NXC = MOD(NI4+NM4,4)
      NZC = MOD(NI6+NM6,4)
      M2 = K+1
      IF(L(2,3).EQ.12 .AND.(L(1,2).EQ.9 .OR. L(1,4).EQ.9)) GO TO 360
      IF ( NXC.LE.0 ) GO TO 3520
      IF ( ICO(4,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NXC)*4
      IF ( ICO(4,NCM).EQ.4 ) NCONT(M) = NCONT(M)+NDAT(NXC)*4
3520  IF ( NZC.LE.0 ) GO TO 360
      IF ( ICO(6,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NZC)*512
      IF ( ICO(6,NCM).EQ.4 ) NCONT(M) = NCONT(M)+NDAT(NZC)*512
      GO TO 360
353   NXC = MOD(NI4+NK4,4)
      NYC = MOD(NI5+NK5,4)
      IF(L(2,4).EQ.12 .AND. ( L(1,2).EQ.9.OR.L(1,3).EQ.9)) GO TO 359
      IF ( NXC.LE.0 ) GO TO 3530
      IF ( ICO(4,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NXC)*4
      IF ( ICO(4,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NXC)*4
3530  IF ( NYC.LE.0 ) GO TO 359
      IF ( ICO(5,NCI).EQ.4 ) NCONT(I) = NCONT(I)+NDAT(NYC)*64
      IF ( ICO(5,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NYC)*64
      GO TO 359
354   IF ( NYC.LE.0 ) GO TO 3540
      IF ( IABS(L(2,2)-13).EQ.1 ) NCONT(I)=NCONT(I)+NDAT(NYC)*64
3540  IF ( NZC.LE.0 ) GO TO 3541
      IF ( ICO(6,NCK).EQ.4 ) NCONT(K) = NCONT(K)+NDAT(NZC)*512
3541  IF ( NXC.LE.0 ) GO TO 359
      IF ( L(1,4).EQ.0.OR.L(1,3).EQ.14 ) GO TO 359
      IF ( L(2,4).NE.12 ) NCONT(K)=NCONT(K)+NDAT(NXC)*4
      GO TO 359
355   L(1,2) = 30
      IF ( L(1,3).EQ.14 ) GO TO 370
      IF ( L(1,3).EQ.13.AND.L(2,3).EQ.12 ) GO TO 3561
      IF ( L(1,1).EQ. 7.AND.L(2,2).EQ.12 ) GO TO 357
      IF ( L(1,1).EQ. 7.AND.L(2,2).EQ.14 ) GO TO 357
      IF ( L(1,1).EQ. 6.AND.L(2,2).EQ.12 ) GO TO 358
      IF ( L(1,1).EQ. 6.AND.L(2,2).EQ.14 ) GO TO 358
      IF ( L(1,1).EQ.7.AND.L(1,3).EQ.13 ) GO TO 3581
      IF ( MOD(NCONT(I),1024).EQ.19 ) GO TO 350
      IF ( NXC+NYC.GT.0 ) GO TO 356
      IF ( NZC.NE.NM6 ) GO TO 359
      IF ( NZC.LE.0 ) GO TO 359
      NCONT(K) = NCONT(K)+NDAT(NZC)*512
      GO TO 359
356   IF ( L(3,2).EQ.10.OR.L(4,2).EQ.10 ) GO TO 359
      IF ( L(1,3).NE.10 ) GO TO 359
3561  IF ( L(2,2).EQ.3 ) GO TO 3560
      NCONT(I) = IOR(NCONT(I),68)
      GO TO 3580
3560  IF ( L(1,4).EQ.2 ) NCONT(K)=IOR(NCONT(K),512)
      GO TO 359
357   NCONT(I) = NCONT(I)+64
      IF ( L(3,2).NE.19 ) NCONT(I+1) = NCONT(I+1)-512
      IF ( L(1,4).EQ.11.AND.L(3,2).EQ.19 )NCONT(I) = NCONT(I)+588
      GO TO 3580
358   NCONT(I) = NCONT(I)+136
3580  IF ( L(1,3).NE.13 ) GO TO 359
3581  M2 = K+1
      GO TO 360
359   M2 = M+1
360   CONTINUE
      IF ( M2.GT.J ) GO TO 306
      DO 365 M1=M2,J
      NCONT(M1-1) = NCONT(M1)
      DO 365 M3=1,6
365   ICO(M3,M1-1) = ICO(M3,M1)
      GO TO 306
370   IF ( L(1,4).GT.12 ) GO TO 371
      M2 = I+1
      GO TO 360
371    CONTINUE
      L(1,2) = 13
      IF ( L(2,2).EQ.12.AND.L(1,1).EQ.5 ) NCONT(I) = NCONT(I)+200
      IF ( L(2,2).EQ.12.AND.L(1,1).EQ.6 ) NCONT(I) = NCONT(I)+136
      IF ( L(2,2).EQ.12.AND.L(1,1).EQ.7 ) NCONT(I) = NCONT(I)+652
      IF ( L(2,2).EQ.13 )                 NCONT(I) = NCONT(I)+68
      IF ( L(2,2).EQ.14 )                 NCONT(I) = NCONT(I)+140
      GO TO 359
380   CONTINUE
390   CONTINUE
400   CONTINUE
      LD = 0
      DO 405 I=1,J
405   LD = LODGDF(LD,NCONT(I))
      IF ( LD.NE.0 ) GO TO 410
      NCONT(J-1) = NCONT(J)
      J = J-1
410   CONTINUE
      NCONT(J+1) = 0
CDB 1
450   RETURN
500   WRITE(6,2) SPG
2     FORMAT(/,' DID YOU ENTER THE SPACE GROUP THE CARD CORRECTLY?',/,
     1 ' ERRORS OF SOME SORT WERE DETECTED.',//,
     2 ' THE SPACE GROUP WAS READ AS ',20A1)
      NSP(2) = 4
      GO TO 450
      END
      SUBROUTINE GOTOER
      WRITE(6,*)' A GOTO RAN OUT OF BOUNDS'
      RETURN
      END
