      PROGRAM SPGR
C THIS MAIN PROGRAM IS DESIGNED TO TEST THE FUNCTIONS OF THE GENERAL
C SPACE GROUP SYMMETRY HANDLING ROUTINE - SGSM -
C IN ADDITION IT MAY BE USED INTERACTIVELY FOR SYMMETRY RELATED
C EXERCISES
C A.L.SPEK, UNIVERSITY OF UTRECHT, THE NETHERLANDS
      DIMENSION X(12), FN(20), CRD(192), ICRD(192)
      DIMENSION TM1(3,3), OSHFT(3)
      CHARACTER LINE*80, IFL(20)*6, IFL21*4 
      ITRNS = 0
      IOUT = 6
      WRITE (IOUT, 99993)
      JARG = IARGC()
      LINE(1:4) = 'LATT'
      KL = 1
      GO TO 30
   20 IF (JARG .GT. 0) THEN
        CALL GETARG(1, LINE(6:80))
        LINE(1:5) = 'SPGR '
        JARG = -1
      ELSE IF (JARG .LT. 0) THEN
        LINE( 1:20) = 'LIST                '
        LINE(21:40) = '                    '
        LINE(41:60) = '                    '
        LINE(61:80) = '                    '
        JARG = 0
      ELSE
        WRITE (IOUT, 99992)
        READ (5, '(A)') LINE
      ENDIF
      ISW = 0
      ISWX = 1
      CALL FRDA(LINE, IFL, FN, KL, KN)
      IF (LINE(1:4) .EQ. 'HELP') THEN
        CALL SGSM(LINE, 5, X, IOUT, 14, IERR)
        GO TO 20
      ELSE IF (LINE(1:4) .EQ. 'SYMM' .AND. KN .EQ. 12) THEN
        CALL SGSM (LINE, 0, FN, IOUR, 15, IERR)
        GOTO 20
      ELSE IF (LINE(1:4) .EQ. 'INFO') THEN
        CALL SGSM(LINE, 0, X, IOUT, 18, IERR)
        WRITE(6, '(A, /, 12F5.0)') LINE, (X(I), I = 1, 12)
        GOTO 20
      ELSE IF (LINE(1:4) .EQ. 'SITE') THEN
        X(1)  = FN(1)
        X(2)  = FN(2)
        X(3)  = FN(3)
        X(10) = FN(4)
        CALL SGSM(LINE, 0, X, IOUT, 19, IERR)
        WRITE(IOUT, 6000) LINE(1:5), NINT(X(11)), X(9)
 6000   FORMAT('site: ', A, I10, ' mult ', F10.4)
      ELSE IF (LINE(1:3) .EQ. 'END') THEN
        GO TO 150
      ELSE IF (LINE(1:4) .EQ. 'STOP') THEN
        GO TO 150
      ELSE IF (LINE(1:4) .EQ. 'QUIT') THEN
        GO TO 150
      ELSE IF (LINE(1:4) .EQ. 'TRNS' .OR.
     1         LINE(1:4) .EQ. 'TRMX') THEN
        K = 0
        DO 5000 I = 1, 3
          OSHFT(I) = FN(I + 9)
          DO 5010 J = 1, 3
            K = K + 1
            TM1(I, J) = FN(K)
 5010     CONTINUE
 5000   CONTINUE
        ITRNS = 1 
        GOTO 20
      ENDIF 
C LAUE/PATT
      IFL21 = IFL(2)(1:4)
      IF ((IFL21 .EQ. 'PATT' .OR. IFL21 .EQ. 'LAUE').AND.
     1 KL .GT. 1) ISWX = -1
      NRSM = FN(1)
   30 IF (LINE(1:4) .EQ. 'LATT' .AND. KN .EQ. 0 .AND. KL.EQ.1) ISW = 1
      IF (LINE(1:4) .EQ. 'LIST')  ISW = 2 * ISWX
      IF (LINE(1:4) .EQ. 'DMAT') ISW = 6
      IF (LINE(1:4) .EQ. 'GSNR') ISW = 7
      IF (LINE(1:4) .EQ. 'MULT') ISW = 8
      IF (LINE(1:4) .EQ. 'INVT') ISW = 9
      IF (LINE(1:4) .EQ. 'ATOM') ISW = 3 * ISWX
      IF (LINE(1:4) .EQ. 'VECT') ISW = -3
      IF (LINE(1:4) .EQ. 'RLST') ISW = 4 * ISWX
      IF (LINE(1:3) .EQ. 'HKL')  ISW = 5 * ISWX
      IF ((LINE(1:4) .EQ. 'ATOM') .OR. (LINE(1:4) .EQ. 'VECT') .OR. 
     1    (LINE(1:3) .EQ. 'HKL')) THEN
        CALL SGSM(LINE, 0, X, IOUT, 18, IERR)
        NSYMP = X(4)
        ICNTR = X(5)
        IBV   = X(6)
        DO 70 I = 1, 6
          X(I) = 0
          IF (I .GT. KN) GO TO 70
          X(I) = FN(I)
   70   CONTINUE
        NSYMR = NSYMP * ICNTR
        IF (IABS(ISW) .LT. 4) NSYMR = NSYMR * IBV
        IF (ICNTR .EQ. 1 .AND. ISW .LT. 0) NSYMR = NSYMR * 2
        IF (IABS(ISW) .NE. 5) THEN
          DO 75 I = 1, NSYMR
            CRD(I)  = 0
            ICRD(I) = I
            CALL SGSM(LINE, I, X, IOUT, ISW, IERR)
            DO 76 J = 7, 9
              CRD(I) = CRD(I) + MOD(X(J) + 10.0, 1.0) * 100**(9-J)
   76       CONTINUE
   75     CONTINUE
          CALL SORT(CRD, ICRD, 1, NSYMR)
          DO 80 K = 1, NSYMR
            I = ICRD(K)
            CALL SGSM(LINE, I, X, IOUT, ISW, IERR)
            DO 85 J = 7, 9
              X(J) = MOD(X(J) + 10.0, 1.0)
   85       CONTINUE
            CALL SGSM(LINE, I, X, 0, 2, IERR)
            WRITE (IOUT, 99989) I, X(7), X(8), X(9), LINE(1:45)
   80     CONTINUE
        ELSE
          DO 100 I = 1, NSYMR
            CALL SGSM(LINE, I, X, IOUT, ISW, IERR)
            WRITE (IOUT, 99988) I, X(7), X(8), X(9), X(10) 
  100     CONTINUE
        ENDIF
        GO TO 20
      ENDIF
C SHELX-TYPE SYMM
      IF (LINE(1:4) .EQ. 'SHEL') THEN
        ISM = FN(1)
        CALL SGSM(LINE, ISM, X, IOUT, 17, IERR)
        GOTO 20
      ENDIF 
C RTM
      IF (LINE(1:3) .EQ. 'RTM') ISW = 15
C LATT/SYMM/LIST/RLST/SPGR/DMAT/GSNR INSTRUCTION
      IF (ISW .LT. 7) GO TO 50
      DO 40 I = 1, 12
         IF (I .GT. KN) FN(I) = 0.0
         X(I) = FN(I)
   40 CONTINUE
   50 IF (LINE(1:4) .EQ. 'LATT' .OR. LINE(1:4) .EQ. 'SPGR'
     1   .OR. LINE(1:4) .EQ. 'SYMM' .OR. LINE(1:4) .EQ. 'HALL') THEN
        IF (ITRNS .EQ. 1) THEN
          ISW = 16
          K = 0
          DO 5020 I = 1, 3
            X(I + 9) = OSHFT(I)
            DO 5021 J = 1, 3
              K = K + 1
              X(K) = TM1(I, J)
 5021       CONTINUE
 5020     CONTINUE
        ENDIF
      ENDIF
C SPGR
      IF (LINE(1:4) .EQ. 'SPGR') THEN
        IF (KL .EQ. 1 .AND. KN .EQ. 0) GO TO 20
      ENDIF
      CALL SGSM(LINE, NRSM, X, IOUT, ISW, IERR)
      IF (ISW .EQ. 6) WRITE (IOUT, 99990)
     1 (X(J), J = 1, 3), X(10), (X(J), J = 4, 6),
     2 X(11), (X(J), J = 7, 9), X(12)
      IF (ISW .GT. 6 .AND. ISW .LT. 15)
     1  WRITE(IOUT, 99998) NINT(X(9)), X(10), X(11), X(12) 
      GO TO 20
  150 STOP ' '
99998 FORMAT ('SYMM NR', I4, ' UNIT TRANSL.', 3F5.0)
99993 FORMAT ('=== SPACE GROUP EXERCISE PROGRAM ===',/1X, 40('-')
     1 //'TYPE <HELP> FOR HELP OR INSTRUCTION'/)
99992 FORMAT (/,'>>',$)
99990 FORMAT (2X, 3F10.0, F10.5)
99989 FORMAT (I4, 3(F8.4), 2X, A)
99988 FORMAT (I5, 6X, F10.0, 3(7X, F10.0))
      END
      SUBROUTINE SORT(DATC, IATC, N1, N)
      DIMENSION IATC(*), DATC(*)
      NEL = N - N1 + 1
      IF (NEL .GT. 1) THEN
        NN           = ALOG(FLOAT(NEL)) / ALOG(2.0)
        ND           = 2**NN - 1
   10   IF (ND .LE. 0) RETURN
        I            = N1
   20   J            = I
        Y            = DATC(I + ND)
        NZ           = IATC(I + ND)
   30   IF (Y .GE. DATC(J)) GO TO 40
        DATC(J + ND) = DATC(J)
        IATC(J + ND) = IATC(J)
        J            = J - ND
        IF (J .GE. N1) GO TO 30
   40   DATC(J + ND) = Y
        IATC(J + ND) = NZ
        I            = I + 1
        IF (I + ND .LE. N) GO TO 20
        ND           = (ND - 1) / 2
        GO TO 10
      ENDIF
      RETURN
      END
      SUBROUTINE SGSM (LIN, NRSYM, X, IOUT, ISWITS, IERROR)
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
C **********************************************************************
C *                   (C) 1980 - 1998, A.L.Spek                        *
C **********************************************************************
C *                            A.L.SPEK,                               *
C *             BIJVOET CENTRE FOR BIOMOLECULAR RESEARCH,               *
C *         LABORATORIUM VOOR KRISTAL- EN  STRUCTUURCHEMIE,            *
C *                      UNIVERSITEIT UTRECHT,                         *
C *                        THE NETHERLANDS.                            *
C **********************************************************************
C *          CYBER       IMPLEMENTATION             AUG 1980           *
C *          MICROVAX-II IMPLEMENTATION             AUG 1986           *
C *          UNIX        IMPLEMENTATION                 1990           *
C *          DEC5000     IMPLEMENTATION                 1991           *
C *                                                                    *
C *          VERSION   11-03-1998                                      *
C **********************************************************************
C * ISW = 0  - ACTUAL SWITCH DERIVED FROM KEYWORD IN LINE              *
C * ISW = 1  - LATTICE INIT INSTRUCTION "LATT P A"                     *
C * ISW = 2  - LOAD SYMM.CODE IN STRING LINE FOR PRINTING OF SYMM OPER.*
C * ISW = 3  - TRANSFORM X,Y,Z WITH SPECIFIED SYMMETRY OPERATION       *
C * ISW = 4  - RECIPROCAL SPACE SYMMETRY LISTING                       *
C * ISW = 5  - TRANSFORM SPECIFIED H,K,L AND PHI FOLLOWING SYMM. NUMBER*
C *            INPUT:  X(1),X(2),X(3),X(4)                             *
C *            OUTPUT: X(7),X(8),X(9),X(10)                            *
C * ISW = 6  - OUTPUT SYMMETRY OPERATION IN (R/T) FORMAT IN ARRAY X    *
C * ISW = 7  - GET SYMMETRY NUMBER + TRANSLATION FOR THAT SPECIFIED IN *
C *            X(1),X(2),X(3) TO X(9)-RESULT IN X(9),X(10),X(11),X(12) *
C *            e.g. 1 -X, X + Y, 1/2 - z =>> -1 1 3 0 2 0 12 0 6       *
C * ISW = 8  - MULTIPLY SYMM (R'/T') IN X(1),X(2),X(3),X(4)            *
C *            WITH (R/T) IN  X(5),X(6),X(7),X(8)                      *
C *            RESULT IN X(9),X(10),X(11),X(12)                        *
C * ISW = 9  - INVERT SYMM (R/T) IN X(1),X(2),X(3),X(4)                *
C *            RESULT  IN X(9),X(10),X(11),X(12)                       *
C * ISW = 10 - LATT CARD HANDLING                                      *
C * ISW = 11 - SYMM CARD HANDLING                                      *
C * ISW = 12 - SPGR CARD HANDLING                                      *
C * ISW = 13 - (ERROR) RETURN                                          *
C * ISW = 14 - HELP + LIST INTERNALLY KNOWN SPACE GROUPS ON UNIT IOUT  *
C * ISW = 15 - INPUT R/T MATRIX TROUGH X (R(1,2) = X(2), T(2) = X(11) )*
C * ISW = 16 - SPGR/LATT/SYMM WITH VALID TRANSFORMATION IN X           *
C * ISW = 17 - SAME AS ISW = 2 APART FROM SHELX-TYPE                   *
C * ISW = 18 - SPACE-GROUP INFO IN X (SG-NUMBER,CRYST-SYST, ..)        *
C *            CHARACTER DATA IN LINE                                  *
C * ISW = 19 - ANALYSE FOR SPECIAL POSITION X(1),X(2),X(3)             *
C * ISW = 20 - ISW(2) + TRANSLATION IN X(4), X(5), X(6)                *
C * ISW = 21 - HALL SYMBOL PARSING                                     *
C *                                                                    *
C * ISW =      NEGATIVE: LAUE/PATT SYMMETRY                            *
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      COMMON /SLAUE/ LGR, XSYST, IBVL(8), SITE(NSITE)
      CHARACTER SG2(NRSPGR)*41, LINE*80, LIN*(*), SGC*1,
     1 NONST(354)*9, NOSTP(6)*4, YSPG*9, ZSPG*7, LGR(14)*5, XSYST(8)*12,
     2 ACENT*2, SG210*7, ICH*1, IBVL*1, SGSMC*52, SITE*5,
     3 NONSTJ*7, XSPG*10, BLT*1,
     4 IBRAV*1, XCHAR*1, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      DIMENSION X(12)
      IER   = 0
      IUIT  = IOUT
      LINE  = LIN
      NSM   = NRSYM
      ISW   = ISWITS
      NIC   = 3
      NICM  = 3
      FLT   = 0.0
      ILAUE = 1
      N     = 195
      ISWD  = 1
      ITRNS = 0
      NTRNS = 0
      ISHEL = 0
      ITRL  = 0
      DET   = 0.0
      ISNN  = 0
      IN    = 0
      TRDET = 1.0
C * HANDLE SPECIAL SWITCHES FIRST
      IF (ISW .EQ. 16) THEN
        ISW   = 0
        ITRNS = 1
      ELSE IF (ISW .EQ. 17) THEN
        ISW   = 2
        ISHEL = 1
      ELSE IF (ISW .EQ. 20) THEN
        ISW  = 2
        ITRL = 12
      ENDIF
      IF (ISW .EQ. 0) THEN
        CALL GEN020 (1, LINE, 1, 80)
        IF (LINE(1:4) .EQ. 'LATT') THEN
          CALL GEN038 (SGSMC, 1, 52)
          ISW   = 10
        ELSE IF (LINE(1:4) .EQ. 'SYMM') THEN
          CALL GEN047 (LINE,   4, 80)
          CALL GEN038 (SGSMC,  1, 11)
          CALL GEN038 (SGSMC, 15, 47)
          ISW   = 11
        ELSE IF (LINE(1:4) .EQ. 'SPGR') THEN
          ISW   = 12
        ELSE IF (LINE(1:4) .EQ. 'HALL') THEN
          ISW   = 21
        ELSE
          ISW   = 13
        ENDIF
      ELSE IF (ISW .LT. 0) THEN
        ILAUE = - 1
        ISW   = - ISW
      ENDIF
      GOTO (30, 150, 240, 150, 240, 310, 360, 410, 530, 540, 680,
     1 880, 1720, 940, 950, 1720, 1720, 1010, 1230, 1720, 1750), ISW
C * ISW = 1, (GENERAL) LATTICE INIT ETC.
   30 CALL SG03 (X, TRDET)
      CALL SG04
      GOTO 1720
C * ISW = 2 & 4 (& 17 & 20) : PRINT SYMM (X,Y,Z OR H,K,L) LINES
  150 GOTO 1020
  160 NRSM = NSM
      IF (NRSM .LT. 0) THEN
        NWLM = MOD(- NRSM, 100)
        NWLN = - NRSM / 100
        NRSM = 0
      ELSE
        NWLM = 999
        NWLN = 0
      ENDIF
      ISWD = 3 - ISW
      NSTT = NST
      IF (ISWD .LT. 0) NSTT = NSTT / IBV
      IF (NRSM .GT. NSTT) NRSM = MOD(NRSM, NSTT)
      NSL = 0
      IF (NRSM .NE. 0) THEN
        NSL  = NRSM - 1
        NSTT = NRSM
        GOTO 170
      ENDIF
      IF (ICNTRX .EQ. 2 .OR. ILAUE .LT. 0) THEN
        ACENT = ' C'
      ELSE
        ACENT = 'Ac'
      ENDIF
      IF (SGSMC(8:8) .NE. ' ') SGSMC(43:47) = ':'//SGSMC(8:11)
      IF (LAUE .EQ. 14) LAUE = JLAUE
      WRITE (IUIT, 99999) SGSMC(1:7), SGSMC(8:11), YSPG, ISGNR,
     1  LGR(LAUE), SGSMC(31:47), SGSMC(12:13),
     2  ACENT, XSYST(IKLS), NSTX, NSYMP, SGSMC(25:30)
      NWLN = NWLN + 6
      IF (ICNTR .NE. ICNTRX) THEN
        WRITE (IUIT, 99982) OCNT(1), OCNT(2), OCNT(3)
        NWLN = NWLN + 2
      ENDIF
      IF (ILAUE .GT. 0) THEN
        IF (ICNTR .EQ. 1) THEN
          IF (IMPROP .GT. 0) THEN
            WRITE (IUIT, 99995) 'CHIRAL '
          ELSE
            WRITE (IUIT, 99995) 'ACHIRAL'
          ENDIF
          NWLN = NWLN + 2
        ENDIF
        WRITE (IUIT, 99998)
      ELSE
        WRITE (IUIT, 99997)
      ENDIF
  170 IF (ISW .EQ. 4) THEN
        ICHS = 26
      ELSE
        ICHS = 11
      ENDIF
  180 NSL = NSL + 1
      IF (NSL .GT. NSTT) GOTO 1720
      N = 195
      CALL SG05 (N, X)
      IF (IER .NE. 0) GOTO 1720
      CALL GEN038 (LINE, 1, 80)
      DO 210 I = 1, 3
        IND = 17 * I - 6 + ISHEL * 4
        IF (I .LT. 3) LINE(IND + 2:IND + 2) = ','
        M = IR(2, I, N)
        IF (M .NE. 0) THEN
          LINE(IND:IND) = ICH(IABS(M) + ICHS)
          IF (M .LT. 0) THEN
            LINE(IND - 2:IND - 2) = '-'
          ELSE
            LINE(IND - 2:IND - 2) = '+'
          ENDIF
          IND = IND - 4
        ENDIF
        LINE(IND:IND) = ICH(IABS(IR(1, I, N)) + ICHS)
        IF (IR(1, I, N) .LT. 0) LINE(IND - 2:IND - 2) = '-'
        M = IR(3, I, N) + ITRL * NINT(X(I + 3))
        IF (M .NE. 0) THEN
          IF (IR(1, I, N) .GT. 0) LINE(IND - 2:IND - 2) = '+'
          IF (ISHEL .EQ. 0) THEN
            IF (M .LT. 0) THEN
              M = - M
              LINE(IND - 8 : IND - 6) = '- -'
            ENDIF
            IF (MOD(M, 12) .EQ. 0) THEN
              M0 = 12
            ELSE IF (MOD(M, 6) .EQ. 0) THEN
              M0 = 6
            ELSE IF (MOD(M, 4) .EQ. 0) THEN
              M0 = 4
            ELSE IF (MOD(M, 3) .EQ. 0) THEN
              M0 = 3
            ELSE IF (MOD(M, 2) .EQ. 0) THEN
              M0 = 2
            ENDIF
            IF (M0 .NE. 12) THEN
              LINE(IND - 6:IND - 4) = ICH(M / M0)//'/'//ICH(12 / M0)
            ELSE
              LINE(IND - 4:IND - 4) = ICH(M / M0)
              IF (IND .GT. 8) LINE(IND - 8:IND - 8) = ' '
            ENDIF
          ELSE
            TRV = FLOAT(IR(3, I, N)) / 12.0
            WRITE (LINE(IND - 10:IND - 4), '(F7.5)') TRV
          ENDIF
        ENDIF
  210 CONTINUE
      IF (ITRL .NE. 0) CALL GEN047 (LINE, 1, 50)
      IF (IUIT .GT. 0) THEN
        NWLN = NWLN + 1
        IF(NWLN .GT. NWLM) THEN
          WRITE (IUIT, '(A)') CHAR(12)
          NWLN = 2
        ENDIF
        WRITE (IUIT, 99996) NSL, LINE(1:60)
      ENDIF
      LIN = LINE
      GOTO 180
C * ISW = 3 & 5: COORDINATE OR HKL TRANSFORMATION
  240 ISWD = 4 - ISW
      CALL SG09 (X, NSM)
      GOTO 1720
C * ISW = 6 : LOAD ROTATION MATRIX IN X(1:9) AND TRANSLATION VECTOR
C *           IN X(10:12)
  310 NSL = NSM
      CALL SG05 (N, X)
      IF (IER .NE. 0) GOTO 1720
      DO 330 I = 1, 12
        IF (I .GT. 9) THEN
          X(I) = IR(3, I - 9, N) / 12.0
        ELSE
          X(I) = 0.0
        ENDIF
  330 CONTINUE
      DO 350 I = 1, 2
        DO 340 K = 1, 3
          IRIK = IR(I, K, N)
          IF (IRIK .NE. 0) THEN
            ISIK = 1
            IF (IRIK .LT. 0) ISIK = -1
            X((K - 1) * 3 + IABS(IRIK)) = ISIK
          ENDIF
  340   CONTINUE
  350 CONTINUE
      GOTO 1720
C * ISW = 7 : GET SYMMOP NR + UNITCELL TRANSLATIONS FOR GIVEN OPERATOR
  360 NSL = NST
      N   = 195
  370 CALL SG05 (N, X)
      IF (IER .NE. 0) GOTO 1720
      IJ = 0
      DO 390 I = 1, 3
        DO 380 J = 1, 3
          IJ = IJ + 1
          IDIF = IFIX(X(IJ)) - IR(I, J, N)
          IF (I .EQ. 3) THEN
            X(9 + J) = FLOAT(IDIF / 12)
            IDIF     = MOD(IDIF, 12)
          ENDIF
          IF (IDIF .NE. 0) THEN
            NSL = NSL - 1
            IF(NSL .GT. 0) THEN
              GOTO 370
            ELSE
              GOTO 400
            ENDIF
          ENDIF
  380   CONTINUE
  390 CONTINUE
  400 X(9) = NSL
      GOTO 1720
C * ISW = 8 : MULTIPLY EXTERNALLY SUPPLIED SYMM OP AND RETURN SYMM NR
C *           AND UNIT TRL
  410 N   = 193
      NSL = NINT(X(1))
      CALL SG05 (N, X)
      IF (IER .NE. 0) GOTO 1720
      DO 430 K = 1, 3
        IR(3, K, 193) = IR(3, K, 193) + NINT(X(K + 1)) * 12
  430 CONTINUE
      N   = 194
  440 NSL = NINT(X(5))
      CALL SG05 (N, X)
      IF (IER .NE. 0) GOTO 1720
      IF (ISW .NE. 9) THEN
        DO 460 K = 1, 3
          IR(3, K, 194) = IR(3, K, 194) + NINT(X(5 + K)) * 12
  460   CONTINUE
      ENDIF
      CALL SG06
      IF (ISW .EQ. 9) THEN
        DO 490 K = 1, 3
          IF (IR(1, K, 195) .NE. K) GOTO 500
          IF (IR(2, K, 195) .NE. 0) GOTO 500
          IF (MOD(IABS(IR(3, K, 195)), 12) .NE. 0) GOTO 500
          ITS = - IR(3, K, 194)
          DO 480 I = 1, 2
            ISJ = IR(I, K, 194)
            IF (ISJ .NE. 0) THEN
              ISS = IR(3, IABS(ISJ), 193)
              IF (ISJ .LT. 0) ISS = - ISS
              ITS = ITS - ISS
            ENDIF
  480     CONTINUE
          X(9 + K) = FLOAT(ITS / 12)
  490   CONTINUE
        X(9) = X(5)
        GOTO 1720
  500   X(5) = X(5) - 1
        IF (X(5) .GT. 0) THEN
          GOTO 440
        ELSE
          WRITE (IUIT, '(A)') 'ERROR AT LABEL 500  (SGSM)'
          IER = 1
          GOTO 1720
        ENDIF
      ENDIF
      IJ = 0
      DO 520 I = 1, 3
        DO 510 J = 1, 3
          IJ = IJ + 1
          X(IJ) = IR(I, J, 195)
  510   CONTINUE
  520 CONTINUE
      GOTO 360
C * ISW = 9 : CALCULATE INVERSE OPERATION FOR GIVEN OPERATION
C * IN (X(1), ... X(4))
  530 X(5) = NST
      GOTO 410
C * ISW = 10 : LATTICE CARD
  540 CALL SG03 (X, TRDET)
      CALL SG04
      IF (IER .NE. 0) GOTO 1720
      JJ = 0
      DO 570 I = 5, 80
        IF (LINE(I:I) .NE. ' ' .AND. LINE(I:I) .NE. '-') THEN
          DO 560 LL = 1, 7
            IF (LINE(I:I) .EQ. CHAR(ICHAR('0') + LL)) THEN
              SGSMC(13:13) = ICH(36 + LL)
              IF (LINE(I - 1:I - 1) .NE. '-') SGSMC(14:14) = 'C'
              GOTO 670
            ENDIF
  560     CONTINUE
          JJ = JJ + 1
          SGSMC(JJ + 12:JJ + 12) = LINE(I:I)
        ENDIF
  570 CONTINUE
  670 IF (ITRNS .NE. 0) CALL SG08 (TRDET)
      CALL SG04
      GOTO 1720
C * ISW = 11 : READ SYMMETRY
  680 IABC(4) = 1
      IABC(5) = 1
      IABC(6) = 1
      JABC(4) = 1
      JABC(5) = 2
      JABC(6) = 3
      IF (NST .EQ. 1) THEN
        CALL SG03 (X, TRDET)
        IF (IER .NE. 0) GOTO 1720
      ENDIF
      JB    = 5
      JE    = 80
      JSWD  = 0
      GOTO 710
C * ISW = 12 : SEARCH FOR GENERATORS FOR SPECIFIED SPACE GROUP
  880 DO 890 I = 5, 80
        IF (LINE(I:I) .EQ. ICH(20) .OR. LINE(I:I) .EQ. ICH(21)) THEN
          LINE(I:I) = ' '
           ITRNS = 0
           NTRNS = 0
        ENDIF
  890 CONTINUE
      CALL SG03 (X, TRDET)
      CALL SG04
      IF (IER .NE. 0) GOTO 1720
  900 JJ  = 0
      KK  = 0
      IMD = 0
      CALL GEN038 (SGSMC, 1, 11)
      DO 920 I = 5, 80
        IF (LINE(I:I) .EQ. '.') THEN
          IMD  = 1
          ISGN = 1
        ELSE IF (LINE(I:I) .NE. ' ') THEN
          IF (IMD .EQ. 0) THEN
            IF (LINE(I:I) .NE. '(' .AND. LINE(I:I) .NE. ')' .AND.
     1          LINE(I:I) .NE. '~') THEN
              JJ = JJ + 1
              IF (JJ .GT. 7) GOTO 930
              SGSMC(JJ:JJ) = LINE(I:I)
              IF (JJ .EQ. 1) THEN
                SGSMC(13:13) = SGSMC(1:1)
                GOTO 920
              ELSE
                IF (SGSMC(JJ:JJ) .EQ. 'R') SGSMC(13:13) = 'P'
              ENDIF
            ENDIF
          ELSE
            KK = KK + 1
            IF (KK .GT. 4) GOTO 930
            SGSMC(KK + 7:KK + 7) = LINE(I:I)
            IF (LINE(I:I) .EQ. '-') ISGN = -1
            DO 910 L0 = 1, 3
              IF (LINE(I:I) .EQ. CHAR(ICHAR('A') - 1 + L0)) THEN
                IABC(L0 + 3) = ISGN
                JABC(L0 + 3) = IMD
                IMD          = IMD + 1
                ISGN         = 1
              ENDIF
  910       CONTINUE
            IF (IMD .EQ. 4) GOTO 930
          ENDIF
        ENDIF
  920 CONTINUE
  930 ZSPG = SGSMC(1:7)
      IF (ITRNS .EQ. 1) THEN
        CALL GEN038 (SGSMC,  1, 11)
        CALL GEN038 (SGSMC, 15, 30)
      ELSE
        IF (SGSMC(1:1) .EQ. 'A') THEN
          SGSMC(13:13) = CHAR(ICHAR('A') + JABC(4) - 1)
        ELSE IF (SGSMC(1:1) .EQ. 'B') THEN
          SGSMC(13:13) = CHAR(ICHAR('A') + JABC(5) - 1)
        ELSE IF (SGSMC(1:1) .EQ. 'C') THEN
          SGSMC(13:13) = CHAR(ICHAR('A') + JABC(6) - 1)
        ENDIF
      ENDIF
      IF (ITRNS .NE. 0) CALL SG08 (TRDET)
      GOTO 1420
C * ISW = 14 : HELP OPTION
  940 WRITE (IUIT, 99987)
      IF (NRSYM .GT. 0) THEN
        WRITE (IUIT, 99992)
        READ  (NRSYM, '(A)') XCHAR
      ENDIF
      WRITE (IUIT, 99986)
      WRITE (IUIT, 99985)
      IF (NRSYM .GT. 0) THEN
        WRITE (IUIT, 99992)
        READ  (NRSYM, '(A)') XCHAR
      ENDIF
      WRITE (IUIT, 99984)
      WRITE (IUIT, 99991) (SG2(I)(1:10),   I = 1, NRSPGR)
      IF (NRSYM .GT. 0) THEN
        WRITE (IUIT, 99992)
        READ  (NRSYM, '(A)') XCHAR
      ENDIF
      WRITE (IUIT, 99989) (NOSTP(I), I = 1, 6)
      WRITE (IUIT, 99988) (NONST(I), I = 1, 354)
      GOTO 1720
C * ISW = 15 : HANDLE R/T - MATRIX INPUT THROUGH X
  950 DO 960 I = 1, 3
        R0(1, I) = X(I)
        R0(2, I) = X(I + 3)
        R0(3, I) = X(I + 6)
        T0(I)    = X(I + 9)
  960 CONTINUE
      JB = 1
      JE = 20
      CALL SG02 (JB)
      IF (IER .NE. 0) GOTO 1720
      IABC(4) = 1
      IABC(5) = 1
      IABC(6) = 1
      JABC(4) = 1
      JABC(5) = 2
      JABC(6) = 3
      JSWD    = 0
      GOTO 710
C * ISW = 18
C * INFO OPTION: SPACE GROUP NUMBER, CRYSTAL SYSTEM, LAUE GROUP NUMBER
C *              NSYMP, ICNTR, IBV
C *              SPACEGROUP NAME (1:11),
 1010 CONTINUE
 1020 IF (SGSMC(1:1) .NE. ' ') GOTO 1130
      IF (ICNTR .NE. ICNTRX) GOTO 1130
      ISWD  = 1
      NTRNS = 0
      N     = 0
 1030 N     = N + 1
      NSL   = N
      CALL SG05 (N, X)
      IF (IER .NE. 0) GOTO 1720
      IF (N .LT. NST) GOTO 1030
      JSWD  = ISWD
      JS    = JSMX + 1
 1050 JS    = JS   - 1
      IF (JS .LT. JSMI) GOTO 1130
      NSLP  = 0
      NICM  = 3
      NIC   = NICM
      IF (SG2(JS)(20:20) .EQ. '-') THEN
        SGC = 'C'
      ELSE
        SGC = 'A'
      ENDIF
      IF (SGC .NE. SGSMC(14:14)) GOTO 1050
      IBRAV = SGSMC(13:13)
 1060 NSLP = NSLP + 1
      IF (NSLP .GT. NSLPM) GOTO 1050
      SGSMC(13:13) = IBRAV
      IMD  = 1
      ISGN = 1
      DO 1080 KK = 1, 4
        XCHAR = NOSTP(NSLP)(KK:KK)
        IF (XCHAR .EQ. '-') THEN
          ISGN = -1
        ELSE
          DO 1070 L0 = 1, 3
            IF (XCHAR .EQ. CHAR(ICHAR('A') - 1 + L0)) THEN
              IABC(L0 + 3) = ISGN
              JABC(L0 + 3) = IMD
              IMD          = IMD + 1
              ISGN         = 1
            ENDIF
 1070     CONTINUE
        ENDIF
 1080 CONTINUE
      READ (SG2(JS)(11:13), '(I3)') NUMS
      IF (NSLP .EQ. 1) THEN
        BLT = SG2(JS)(1:1)
        IF (BLT .EQ. 'R') THEN
          DO 1090 JSI = 2, 10
            IF (SG2(JS)(JSI:JSI) .EQ. 'R') THEN
              BLT = 'P'
              GOTO 1100
            ENDIF
 1090     CONTINUE
 1100     CONTINUE
        ENDIF
      ELSE
        BLT = NONST((NUMS - 16) * 6 + NSLP)(1:1)
      ENDIF
      IF (BLT .NE. SGSMC(13:13)) GOTO 1060
      WRITE (LINE, '(4X, A, 59X)') SG2(JS)(20:36)
      CALL SG01
      IF (IER .NE. 0) GOTO 1720
      ASSIGN 1110 TO LRET9
      GOTO 1680
 1110 ISGNR = NUMS
      SGSMC(15:24) = SG2(JS)(1:10)
      SGSMC(25:47) = SG2(JS)(14:36)
      IF (NSLP .GT. 1) SGSMC(8:11) = NOSTP(NSLP)
      JLAUE = 8
      L0    = 0
      DO 1120 L = 1, 10
        IF (SG2(JS)(L + 20:L + 20) .EQ. '"') JLAUE = 7
        IF (SG2(JS)(L:L) .NE. ' ') THEN
          L0 = L0 + 1
          SGSMC(L0:L0) = SG2(JS)(L:L)
        ENDIF
 1120 CONTINUE
 1130 IF (SGSMC(8:8) .NE. ' ') THEN
        DO 1150 I = 2, 6
          IF (SGSMC(8:11) .EQ. NOSTP(I)) THEN
            K = 1
            CALL GEN038 (ZSPG, 1, 9)
            DO 1140 J = 1, 9
              ZSPG(K:K) = NONST((ISGNR - 16) * 6 + I)(J:J)
              IF (ZSPG(K:K) .NE. ' ') K = K + 1
 1140       CONTINUE
            YSPG(1:9) = '['//ZSPG//']'
            SGSMC(13:13) = YSPG(2:2)
            GOTO 1160
          ENDIF
 1150   CONTINUE
      ENDIF
 1160 CALL GEN020 (-1, SGSMC, 2, 11)
      CALL GEN020 (-1, YSPG,  3, 8)
      IF (ISW .NE. 18) GOTO 160
      IF (LAUE .EQ. 14) LAUE = JLAUE
      NRSM  = NSM
      X(1)  = ISGNR
      X(2)  = IKLS
      X(3)  = LAUE
      X(4)  = NSYMP
      X(5)  = ICNTR
      X(6)  = IBV
      X(9)  = NST
      DO 1200 I = 1, 7
        IF (SGSMC(13:13) .EQ. ICH(29 + I)) X(7) = I
        IF (SGSMC(13:13) .EQ. ICH(36 + I)) X(8) = I
 1200 CONTINUE
      IF (SGSMC(14:14) .EQ. 'A') X(8) = - X(8)
      LIN = SGSMC(1:24)//XSYST(IKLS)//LGR(LAUE)//SGSMC(31:52)
      DO 1220 J = 1, 3
        X(J + 9) = 0.0
        IF (ICNTR .EQ. 1) THEN
          DO 1210 I = 1, 3
            IF (IORG(I, J) .NE. 0) X(J + 9) = X(J + 9) + 2 ** (I - 1)
 1210     CONTINUE
        ENDIF
 1220 CONTINUE
      GOTO 1720
C * ISW = 19 : FIND OUT ABOUT SPECIAL POSITION
 1230 ISWD = 1
      ISYM = 0
      IF (X(10) .GT. 0.0) THEN
        TOL = X(10)
      ELSE
        TOL = 0.005
      ENDIF
      X(4) = 0.0
      X(5) = 0.0
      X(6) = 0.0
      NSP  = 1
      NSM  = 1
 1240 NSM  = NSM + 1
      IF (NSM .GT. NST) GOTO 1300
      CALL SG09 (X, NSM)
      IF (IER .NE. 0) GOTO 1720
      DO 1260 I = 1, 3
        DIFF = MOD(100.0 + X(6 + I) - X(I), 1.0)
        IF (DIFF .GT. 0.5) DIFF = 1.0 - DIFF
        IF (DIFF .GT. TOL) GOTO 1240
 1260 CONTINUE
      NSP = NSP + 1
      K   = 0
      IRT = 0
      DO 1280 I = 1, 2
        DO 1270 J = 1, 3
          IRT = IRT + IR(I, J, NSM) * 7**K
          K   = K + 1
 1270   CONTINUE
 1280 CONTINUE
      DO 1290 J = 1, NOPR
        IF (IRT .EQ. IOPR(J)) THEN
          ISYM = ISYM + 2**(J - 1)
          GOTO 1240
        ENDIF
 1290 CONTINUE
      GOTO 1240
 1300 DO 1310 I = 1, NSITE
        IF (ISYM .EQ. KSITE(I)) GOTO 1320
 1310 CONTINUE
      I     = 1
 1320 X(12) = I
      X(11) = ISYM
      X(9)  = 1.0 / NSP
      IF (IKLS .EQ. 4) THEN
        IF (I .EQ. 3) THEN
          I = 12
        ELSE IF (I .EQ. 4) THEN
          I = 9
        ELSE IF (I .EQ. 5) THEN
          I = 15
        ELSE IF (I .EQ. 12) THEN
          I = 7
        ENDIF
      ENDIF
      LIN(1:5) = SITE(I)
      GOTO 1720
 1420 DO 1440 JJ = 1, NRSPGR
        XSPG       = SG2(JJ)(1:10)
        CALL GEN038 (SG210, 1, 7)
        ISG2       = 0
        DO 1430 I = 1, 10
          IF (XSPG(I:I) .NE. ' ') THEN
            ISG2 = ISG2 + 1
            SG210(ISG2:ISG2) = XSPG(I:I)
          ENDIF
 1430   CONTINUE
        IF (ZSPG .EQ. SG210) THEN
          IF (SGSMC(15:15) .EQ. ' ') THEN
            SGSMC(15:47) = XSPG//SG2(JJ)(14:36)
          ELSE
            SGSMC(31:42) = SG2(JJ)(20:31)
          ENDIF
          READ (SG2(JJ)(11:41), '(I3, 23X, A)') ISGNR, SGSMC(48:52)
          WRITE (LINE, '(4X, A, 59X)') SG2(JJ)(20:36)
          IF (ITRNS .EQ. 1) THEN
            IKLS  = 8
            ISGNR = 0
          ENDIF
          CALL SG01
          IF (IER .NE. 0) GOTO 1720
          ASSIGN 2675 TO LRET9
          GOTO 1680
        ENDIF
 1440 CONTINUE
      DO 1450 JJ = 1, NTRL
        IF (ZSPG .EQ. TRLTA(JJ)) THEN
          ZSPG       = TRLTB(JJ)
          SGSMC(1:7) = ZSPG
          GOTO 1420
        ENDIF
 1450 CONTINUE
      YSPG(1:9) = '['//ZSPG//']'
      DO 1470 J = 1, 354
        IN1    = 0
        NONSTJ = '       '
        DO 1460 I = 1, 9
          IF (NONST(J)(I:I) .NE. ' ') THEN
            IN1             = IN1 + 1
            NONSTJ(IN1:IN1) = NONST(J)(I:I)
          ENDIF
 1460   CONTINUE
        IF (ZSPG .EQ. NONSTJ) THEN
          SGSMC(15:24) = NONST(J)//' '
          JA = ((J - 1) / 6) * 6
          WRITE (LINE, 99983) NONST(JA + 1), NOSTP(J - JA)
          GOTO 900
        ENDIF
 1470 CONTINUE
      IF (IUIT .NE. 0) WRITE (IUIT, 99994) SGSMC(1:11)
      NST = 0
      GOTO 1720
C * ISW = 21 : PARSE HALL-SYMBOL
 1750 CALL SG03 (X, TRDET)
      CALL SG04
      IF (IER .NE. 0) GOTO 1720
      CALL SG01
      IF (IER .NE. 0) GOTO 1720
      ASSIGN 2675 TO LRET9
 1680 JB  = -19
 1700 JB  = JB + 20
      JE  = JB + 19
      NIC = NICM
      IF (JB .GT. 60 .OR. LINE(JB:JB) .EQ. ' ') GOTO LRET9, (2675, 1110)
  710 NTRNS = ITRNS
  715 IC    = 0
      I     = JB - 1
      NCOM  = 0
  720 IF (IC .GT. 0) THEN
        KABC = JABC(IC + NIC)
        IF (IN .EQ. 2) THEN
          IR(2, KABC, 195) = 0
        ELSE IF (IN .GT. 2) THEN
          IF (IABS(IR(1, KABC, 195)) .GT.
     1        IABS(IR(2, KABC, 195))) THEN
               ISAVE            = IR(1, KABC, 195)
               IR(1, KABC, 195) = IR(2, KABC, 195)
               IR(2, KABC, 195) = ISAVE
          ENDIF
        ENDIF
        FFLT = MOD(ISNN * FLT * 12.0, 12.0)
        IF (FFLT .LT. 0.0) FFLT = FFLT + 12.0
        NFLT = NINT(FFLT)
        IF (NFLT .EQ. 1  .OR. NFLT .EQ. 5 .OR. NFLT .EQ. 7 .OR.
     1      NFLT .EQ. 11 .OR. ABS(FFLT - NFLT) .GT. 0.01) GOTO 1710
        IR(3, JABC(IC + NIC), 195) = MOD(IABC(IC + NIC)
     1      * NFLT + 12, 12)
      ENDIF
      IC   =  IC + 1
      IN   =  1
      ITRV = -1
      IFLT =  0
      FLT  =  0.0
      IFRC =  0
      ISNN =  1
      ISN  =  1
  730 I = I + 1
      IF (I - JE .LT. 1) THEN
        DO 740 K = 1, 21
          IF (LINE(I:I) .EQ. ICH(K)) GOTO 750
  740   CONTINUE
        GOTO 1710
  750   IF (K .EQ. 20 .OR. K .EQ. 21) THEN
          ITRNS = 0
          NTRNS = 0
        ELSE IF (K .LT. 10) THEN
          IF (IFLT .EQ. 0) THEN
            IF (ITRV .NE. 0) THEN
              IF (ITRV .LT. 0) THEN
                ITRV = K
                KTRV = K
              ENDIF
              ISNN = ISN
              IF (KTRV  .GT. K) ITRV = MOD(KTRV, K)
              INM = K
              FLT  = FLOAT(ITRV) / FLOAT(INM)
              IFRC = IFRC + 1
              IF (IFRC .GT. 2) GOTO 1710
            ENDIF
          ELSE
            FLT  = FLT  + K * 10.0**IFLT
            IFLT = IFLT - 1
            ISNN = ISN
          ENDIF
        ELSE IF (K .EQ. 11) THEN
          IFLT = IFLT - 1
          ISNN = ISN
        ELSE IF (K .GT. 11 .AND. K .LT. 15) THEN
          KM11 = K - 11
          IR(IN, JABC(IC + NIC), 195) =
     1      IABC(IC + NIC) * ISN * JABC(KM11 + NIC) * IABC(KM11 + NIC)
          IN   = IN + 1
          ISN  = 1
        ELSE IF (K .EQ. 16) THEN
          NCOM = NCOM + 1
          GOTO 720
        ELSE IF (K .EQ. 17) THEN
          ISN = 1
        ELSE IF (K .EQ. 18) THEN
          ISN = - 1
        ENDIF
        GOTO 730
      ELSE IF (I - JE .EQ. 1) THEN
        GOTO 720
      ELSE
        IF (IC .LT. 3 .OR. (IC .EQ. 3 .AND. IN .LT. 2) .OR.
     1      NCOM .NE. 2) GOTO 1710
        DO 780 III = 1, 3
          DO 760 JJJ = 1, 3
            R3(III, JJJ) = 0.0
  760     CONTINUE
          DO 770 KKK = 1, 2
            N = IR(KKK, III, 195)
            IF (N .NE. 0) R3(III, IABS(N)) = SIGN(1.0, FLOAT(N))
  770     CONTINUE
          T3(III) = FLOAT(IR(3, III, 195)) / 12.0
  780   CONTINUE
        IF (ISW .EQ. 11 .OR. ISW .EQ. 12 .OR. ISW .EQ. 21) THEN
          RDET =
     1        R3(1, 1) * (R3(2, 2) * R3(3, 3) - R3(2, 3) * R3(3, 2))
     2      - R3(1, 2) * (R3(2, 1) * R3(3, 3) - R3(2, 3) * R3(3, 1))
     3      + R3(1, 3) * (R3(2, 1) * R3(3, 2) - R3(2, 2) * R3(3, 1))
          IMPROP = MIN(IMPROP, NINT(RDET))
        ENDIF
        IF (NTRNS .GT. 0) THEN
          NTRNS = 0
          CALL GEN004 (R3, R1, R0)
          CALL GEN004 (R2, R0, R0)
          CALL GEN002 (1, R2, T3, T0, XLNG)
          DO 840 III = 1, 3
            T0(III) = T0(III) + OSFT(III)
            DO 830 JJJ = 1, 3
              T0(III) = T0(III) - R0(III, JJJ) * OSFT(JJJ)
  830       CONTINUE
  840     CONTINUE
          NIC        = 0
          SGSMC(1:1) = ' '
          CALL GEN038 (YSPG, 1, 9)
          CALL SG02 (JB)
          IF (IER .NE. 0) GOTO 1720
          IABC(4) = 1
          IABC(5) = 1
          IABC(6) = 1
          JABC(4) = 1
          JABC(5) = 2
          JABC(6) = 3
          JSWD    = 0
          GOTO 715
        ENDIF
        IF (ISW .NE. 2 .AND. ISW .NE. 18) THEN
          CALL SG07
          IF (IER .NE. 0) GOTO 1720
          IF (NSYMP .GE. 24) GOTO 2675
          IF (NSYMP .LT. 2) GOTO 2670
          II  = 2
 1340     I   = II
          JM  = 2 * II - 2
          JJ  = 2
          N   = 194
          NSL = I
          CALL SG05 (N, X)
          IF (IER .NE. 0) GOTO 1720
 1350     J   = JJ
          IF (JJ .LE. II) GOTO 1360
          J   = II
          I   = 2 * II - JJ
          N   = 194
          NSL = I
          CALL SG05 (N, X)
          IF (IER .NE. 0) GOTO 1720
 1360     N   = 193
          NSL = J
          CALL SG05 (N, X)
          IF (IER .NE. 0) GOTO 1720
          CALL SG06
          DO 1390 K = 1, 3
            ITS = MOD(IR(3, K, 195), 12)
            IF (ITS .LT. 0) ITS = ITS + 12
            IR(3, K, 195) = ITS
 1390     CONTINUE
          CALL SG07
          IF (IER .NE. 0) GOTO 1720
          IF (NSYMP .GE. 24) GOTO 2675
          JJ = JJ + 1
          IF (JJ .LE. JM) GOTO 1350
          II = II + 1
          IF (II .LE. NSYMP) GOTO 1340
          GOTO 2670
        ELSE
          DO 870 I = 1, NST
            DO 860 JJ = 1, 3
              DO 850 KK = 1, 3
                IF (IR(JJ, KK, I) .NE. IR(JJ, KK, 195)) GOTO 870
  850         CONTINUE
  860       CONTINUE
            GOTO 2670
  870     CONTINUE
          GOTO 1060
        ENDIF
      ENDIF
 2670 IF (ISW .NE. 11 .AND. ISW .NE. 15) GOTO 1700
 2675 CALL SG04
      GOTO 1720
 1710 WRITE (IUIT, 99993) LINE(1:40)
      IER = 2
 1720 IERROR = IER
      RETURN
99999 FORMAT ('Space Group ', 3(A, 1X), 'No:', I4, ', Laue:', A,
     1 ' [Hall: ', A, ']', //, 'Lattice Type ', A, ', ', A,
     2 'entric, ', A, ', Order ' , I3, '(', I2, ')', ' [Shoenflies: ',
     3 A, 5X, ']', /)
99998 FORMAT (2X, 'Nr', 12X, '***** Symmetry Operation(s) *****', /)
99997 FORMAT (2X, 'Nr', 7X, 'Patterson/Laue Symmetry Operation', /)
99996 FORMAT (I4, 5X, A)
99995 FORMAT (A, ' - See P.G. Jones, Acta Cryst. ',
     1        '(1986), A42, 57.', /)
99994 FORMAT (//, ':: Space Group Symbol not Known ', //,
     1 ':: No GENERATORS for this non-standard Space Group ', A,
     2 ' available ...', //,
     3 ':: Please supply generators explicitly with LATT/SYMM',
     4 ' instructions.', /)
99993 FORMAT (/, ':: Error in SYMM line syntax !!, ',
     1        /, ':: Line ignored: ', A, /)
99992 FORMAT ('====>> Continue with <CR> <<====')
99991 FORMAT (72(7(1X, A)/))
99989 FORMAT (/, 'Nonstandard Settings with Cell Transformations',
     1 ' (see Internat. Tables, Vol A)', /,
     1 46('='), /, 6(A4, 7X), /, 66('-'))
99988 FORMAT (6(1X, A, 1X))
99987 FORMAT (/, 'General Space Group Symmetry Handler - Version:',
     1 ' 19-sep-1996', //, 'Note: only a subset may be accessible',
     2 //, 'There are Five  Groups of Instructions:', /,
     3 'A - Symmetry Specification with <SPGR>,<LATT>,<SYMM>', /,
     4 'B - Symmetry List Options  with <LIST> and <RLST>', /,
     5 'C - Actual Transformations with <ATOM> and <HKL>', /,
     6 'D - Output of R and T Matrices with <DMAT>', /,
     7 'E - Miscellaneous <TRNS>', //,
     8 '<SPGR> - Symmetry may be Specified as <P21/c>, P21.CAB, etc.'
     9 /,' <LATT> - Contains <P/A/B/C/I/F/R> and <C/A>', /
     * '<SYMM> - e.g. < 1/2-X,1/2+Y,1/2-Z>', /,
     1 '<LIST> - Gives a Listing of the Symmetry in X,Y,Z', /
     2 '<RLST> - Gives a Listing of the Symmetry in H,K,L', /,
     3 '<ATOM> - Specify Three Fractional Coordinates; The', /, 9X,
     4 'Program Generates Symm. Related Positions', /,
     5 '<VECT> - as <ATOM> but with Patterson Symmetry', /,
     6 '<HKL > - Specify H,K,L ; The Program Generates the', /, 9X,
     7 'Symm. Related Set. Specification of a Phase', /, 9X,
     6 'as a Fourth Item Gives Phase Values as Well')
99986 FORMAT ('<DMAT> - Specify Symmetry Number ; The Matrices R '/
     1 '         and T are Returned in Array X(1:12)'/,
     2 '<GSNR> - Specify Coded Symmetry Operation in X(1:9),',/
     3 '         Result: Symmetry Number + Unit Translations',/,
     4 '<MULT> - S1,TX1,TY1,TZ1,S2,TX2,TY2,TZ2',/,
     5 '         RESULT: S3,TX3,TY3,TZ3',/,
     6 '<INVT> - S1,TX1,TY1,TZ1 ; RESULT: S2,TX2,TY2,TZ2',/,
     7 '<TRNS> - T11,T12,..,T33,(S1,S2,S3) : Cell Transform+Shift',/,
     8 '<SITE> - X, Y, Z (Fract. TOL);Output Site Symm Nr in X(12)',/,
     9 '<END> or <STOP> Terminates the Program',/)
99985 FORMAT (/'Remarks:'/'1 - A <LATT> Card Initialises the Number',
     1 ' of Known'/4X,'Symmetry Operations to 1: X,Y,Z'/'2 - A <S',
     2 'YMM> Card is Interpreted as a Generator, so-'/4X,'that at ',
     3 'most 4 <SYMM> Cards are Needed'/'3 - The Program Contains ' ,
     4 'data for all Standard Space'/4X, 'Group Symbols (Including',
     5 ' Some Non-Standard Settings)',/,
     6 '4 - The Sub-word <PATT> Together with <LIST>,<ATOM>',
     7 /14X,'or <LAUE> Together with <RLST>,<HKL>',
     8 /4X,'Generates/Applies the Corresponding Symmetries'/)
99984 FORMAT (/, 4X, 'Space Group Names Known to the Program', //)
99983 FORMAT ('SPGR ',A, '.', A, 61X)
99982 FORMAT ('Shifted Inversion Centre at (', F6.3, ',', F6.3, ',',
     1        F6.3, ')', /)
      END
      SUBROUTINE SG01
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      CHARACTER SG2(NRSPGR)*41, LINE*80, LNI*1, LN0*1, ICH*1,
     1 NONST(354)*9, NOSTP(6)*4, XSPG*10, YSPG*9, ZSPG*7,
     2 SGSMC*52, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      SGSMC(14:14) = 'A'
      JB           = -19
      JE           = 0
      NLEV         = -1
      ISGN         = 1
      LPAR         = -1
      JLAUE        = 8
      CALL GEN020 (1, LINE, 1, 80)
      DO 50 I = 5, 80
        LN0 = LINE(I - 1: I - 1)
        LNI = LINE(I: I)
        IF (NLEV .EQ. -1) THEN
          IF (LNI .EQ. '-') THEN
            SGSMC(14:14) = 'C'
          ELSE
            DO 30 J = 1, 7
              IF (LNI .EQ. ICH(36 + J)) THEN
                IF (ZSPG(1:1) .EQ. ' ') SGSMC(13:13) = LNI
                DO 20 L = 1, 3
                  DO 10 K = 1, 9
                    IHALL(K, L) = 0
   10             CONTINUE
                  IHALL(2, L) = 1
   20           CONTINUE
                NLEV        = 0
                IHALL(1, 1) = 10
                ISTAT       = 1
                GOTO 40
              ENDIF
   30       CONTINUE
   40       CONTINUE
          ENDIF
        ELSE
          IF (LNI .EQ. '-') THEN
            IF (LPAR .GE. 0) THEN
              ISGN = -1
            ELSE
              NLEV  = NLEV + ISTAT
              ISTAT = 0
              IHALL(2, NLEV) = -1
            ENDIF
          ELSE IF (LNI .EQ. '(') THEN
            LPAR = 0
          ELSE IF (LNI .EQ. ')') THEN
          ELSE IF (LNI .EQ. '0') THEN
            IF (LPAR .GE. 0) THEN
              LPAR = LPAR + 1
            ENDIF
          ELSE IF (LNI .EQ. '1') THEN
            IF (LPAR .GE. 0) THEN
              LPAR = LPAR + 1
              IHALL(6 + LPAR, NLEV) = ISGN
              ISGN = 1
            ELSE IF (LN0 .EQ. '3') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) + 4
            ELSE IF (LN0 .EQ. '4') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) + 3
            ELSE IF (LN0 .EQ. '6') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) + 2
            ELSE
              NLEV  = NLEV + ISTAT
              ISTAT = 1
              IHALL(3, NLEV) = 0
            ENDIF
          ELSE IF (LNI .EQ. '2') THEN
            IF (LN0 .EQ. '3') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) + 8
            ELSE IF (LN0 .EQ. '6') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) + 4
            ELSE
              NLEV  = NLEV + ISTAT
              ISTAT = 1
              IF (NLEV .GT. 1) THEN
                IHX = IHALL(1, NLEV - 1) + IHALL(3, NLEV - 1)
              ELSE
                IHX = 0
              ENDIF
              IF (IHX .EQ. 2 .OR. IHX .EQ. 4) THEN
                IHALL(1, NLEV) = 15
                IHALL(3, NLEV) = 0
              ELSE IF (IHX .EQ. 7 .OR. IHX .EQ. 9) THEN
                IHALL(1, NLEV) = 15
                IHALL(3, NLEV) = 2
              ELSE IF (IHX .EQ. 12 .OR. IHX .EQ. 14 .OR.
     1                 IHX .EQ. 21) THEN
                IHALL(1, NLEV) = 15
                IHALL(3, NLEV) = 4
              ELSE
                IHALL(3, NLEV) = 1
              ENDIF
            ENDIF
          ELSE IF (LNI .EQ. '3') THEN
            IF (LN0 .EQ. '4') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) + 9
            ELSE
              NLEV  = NLEV + ISTAT
              ISTAT = 1
              IHALL(3, NLEV) = 2
              IF (NLEV .EQ. 3) THEN
                IHALL(1, NLEV) = 21
                IHALL(3, NLEV) = 0
              ENDIF
            ENDIF
          ELSE IF (LNI .EQ. '4') THEN
            IF (LN0 .EQ. '6') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) + 8
            ELSE
              NLEV  = NLEV + ISTAT
              ISTAT = 1
              IHALL(3, NLEV) = 3
            ENDIF
          ELSE IF (LNI .EQ. '5') THEN
            IF (LN0 .EQ. '6') THEN
              IHALL(6, NLEV) = IHALL(6, NLEV) +  10
            ENDIF
          ELSE IF (LNI .EQ. '6') THEN
            NLEV  = NLEV + ISTAT
            ISTAT = 1
            IHALL(3, NLEV) = 4
          ELSE IF (LNI .EQ. 'X') THEN
            IHALL(1, NLEV) = 0
          ELSE IF (LNI .EQ. 'Y') THEN
            IHALL(1, NLEV) = 5
          ELSE IF (LNI .EQ. 'Z') THEN
            IHALL(1, NLEV) = 10
          ELSE IF (LNI .EQ. '*') THEN
            IHALL(1, NLEV) = 21
            IHALL(3, NLEV) = 0
          ELSE IF (LNI .EQ. '''') THEN
            IHALL(1, NLEV) = 15
            IHX = IHALL(1, NLEV - 1)
            IF (IHX .EQ. 0) THEN
              IHALL(3, NLEV) = 0
            ELSE IF (IHX .EQ. 5) THEN
              IHALL(3, NLEV) = 2
            ELSE
              IHALL(3, NLEV) = 4
            ENDIF
          ELSE IF (LNI .EQ. '"') THEN
            JLAUE = 7
            IHALL(1, NLEV) = 15
            IHX = IHALL(1, NLEV - 1)
            IF (IHX .EQ. 0) THEN
              IHALL(3, NLEV) = 1
            ELSE IF (IHX .EQ. 5) THEN
              IHALL(3, NLEV) = 3
            ELSE
              IHALL(3, NLEV) = 5
            ENDIF
          ELSE IF (LNI .EQ. '*') THEN
          ELSE IF (LNI .EQ. 'A') THEN
            IHALL(4, NLEV) = IHALL(4, NLEV) + 6
          ELSE IF (LNI .EQ. 'B') THEN
            IHALL(5, NLEV) = IHALL(5, NLEV) + 6
          ELSE IF (LNI .EQ. 'C') THEN
            IHALL(6, NLEV) = IHALL(6, NLEV) + 6
          ELSE IF (LNI .EQ. 'N') THEN
            IHALL(4, NLEV) = IHALL(4, NLEV) + 6
            IHALL(5, NLEV) = IHALL(5, NLEV) + 6
            IHALL(6, NLEV) = IHALL(6, NLEV) + 6
          ELSE IF (LNI .EQ. 'U') THEN
            IHALL(4, NLEV) = IHALL(4, NLEV) + 3
          ELSE IF (LNI .EQ. 'V') THEN
            IHALL(5, NLEV) = IHALL(5, NLEV) + 3
          ELSE IF (LNI .EQ. 'W') THEN
            IHALL(6, NLEV) = IHALL(6, NLEV) + 3
          ELSE IF (LNI .EQ. 'D') THEN
            IHALL(4, NLEV) = IHALL(4, NLEV) + 3
            IHALL(5, NLEV) = IHALL(5, NLEV) + 3
            IHALL(6, NLEV) = IHALL(6, NLEV) + 3
          ENDIF
        ENDIF
   50 CONTINUE
      CALL SG04
      IF (IER .NE. 0) GOTO 1680
      DO 1805 K = 1, 80
        LINE(K:K) = ' '
 1805 CONTINUE
      LH = 0
 1810 LH = LH + 1
      IF (LH .GT. NLEV) GOTO 1680
      JB = JB + 20
      JE = JE + 20
      M = (IHALL(1, LH) + IHALL(3, LH)) * 9
      DO 1825 K0 = 1, 3
        DO 1826 L0 = 1, 3
          K = (K0 - 1) * 3 + L0
          R0(L0, K0) = NHRM(M + K) * IHALL(2, LH)
 1826   CONTINUE
 1825 CONTINUE
      DO 1830 K = 1, 3
        T0(K) = (IHALL(3 + K, LH) + IHALL(6 + K, LH)) / 12.0
 1830 CONTINUE
      DO 1835 J0 = 1, 3
        DO 1840 K0 = 1, 3
          T0(J0) = T0(J0) - R0(J0, K0) * IHALL(6 + K0, LH) / 12.0
 1840   CONTINUE
 1835 CONTINUE
      NTRNS = ITRNS
      CALL SG02 (JB)
      IF (IER .NE. 0) GOTO 1680
      GOTO 1810
 1680 RETURN
      END
      SUBROUTINE SG02 (JB)
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      CHARACTER SG2(NRSPGR)*41, LINE*80, ICH*1,
     1 NONST(354)*9, NOSTP(6)*4, XSPG*10, YSPG*9, ZSPG*7,
     2 SGSMC*52, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      CALL GEN038 (LINE, JB, JB + 19)
      K = JB
      DO 40 I = 1, 3
        TRV  = AMOD(T0(I) * 12.0, 12.0)
        NTRV = NINT(TRV)
        IF (ABS(TRV - NTRV) .GT. 0.1) THEN
          WRITE (IUIT, 99999) (T0(K), K = 1, 3)
          IER = 25
          GOTO 50
        ENDIF
        NTRVN = 12
        IF (NTRV .NE. 0) THEN
          IF (NTRV .LT. 0) NTRV = NTRV + 12
          IF (NTRV .GT. 0) THEN
   20       IF (MOD(NTRV, 2) .EQ. 0 .AND. MOD(NTRVN, 2) .EQ. 0) THEN
              NTRV  = NTRV / 2
              NTRVN = NTRVN / 2
              GOTO 20
            ENDIF
            IF (MOD(NTRV, 3) .EQ. 0 .AND. MOD(NTRVN, 3) .EQ. 0) THEN
              NTRV  = NTRV / 3
              NTRVN = NTRVN / 3
              GOTO 20
            ENDIF
            LINE(K:K+2) = ICH(NTRV)//'/'//ICH(NTRVN)
            K = K + 3
          ENDIF
        ENDIF
        DO 30 J = 1, 3
          IF (ABS(R0(I, J)) .GT. 0.9) THEN
            NR0 = NINT(R0(I, J))
            IF (NR0 .GT. 0) THEN
              LINE(K:K) = '+'
            ELSE
              LINE(K:K) = '-'
            ENDIF
            LINE(K + 1:K + 1) = ICH(11 + J)
            K = K + 2
          ENDIF
   30   CONTINUE
        IF (I .LT. 3) THEN
          LINE(K:K) = ','
          K = K + 1
        ENDIF
   40 CONTINUE
   50 RETURN
99999 FORMAT ('E: SYMM TRANSLATION N.A.:', 3F8.3)
      END
      SUBROUTINE SG03 (X, DET)
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      COMMON /SLAUE/ LGR, XSYST, IBVL(8), SITE(NSITE)
      CHARACTER SG2(NRSPGR)*41, LINE*80,
     1 NONST(354)*9, NOSTP(6)*4, YSPG*9, LGR(14)*5, XSYST(8)*12,
     2 ICH*1, IBVL*1, SGSMC*52, SITE*5, ZSPG*7,
     3 XSPG*10, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      DIMENSION X(12)
      K    = 0
      DO 50 I = 1, 3
        IF (ITRNS .EQ. 0) THEN
          OSFT(I) = 0.0
        ELSE
          OSFT(I) = - X(I + 9)
        ENDIF
        DO 40 J = 1, 3
          IF (ITRNS .EQ. 0) THEN
            IF (I .EQ. J) THEN
              XVAL = 1.0
            ELSE
              XVAL = 0.0
            ENDIF
          ELSE
            K    = K   + 1
            XVAL = X(K)
          ENDIF
          R1(J, I) = XVAL
   40   CONTINUE
   50 CONTINUE
      CALL GEN003 (R1, R2, DET, 0)
      IF (ABS(DET) .LT. 0.3) THEN
        WRITE (IUIT, 99999) ((R1(I, J), I = 1, 3), J = 1, 3)
        IER = 11
        GOTO 100
      ENDIF
      IF (ISW .NE. 11) THEN
        DO 90 I = 1, 3
          IABC(I)     = 1
          IABC(I + 3) = 1
          JABC(I)     = I
          JABC(I + 3) = I
          DO 80 J = 1, 3
            IF (I .EQ. 1) THEN
              ISS = J
            ELSE
              ISS = 0
            ENDIF
            IS (I, J, 1) = ISS
            IF (I .EQ. J) THEN
              ISS = I
            ELSE
              ISS = 0
            ENDIF
            IORG(I, J) = ISS
   80     CONTINUE
   90   CONTINUE
        CALL GEN038 (YSPG, 1, 9)
        CALL GEN038 (SGSMC,  1, 12)
        SGSMC(13:14) = 'PA'
        CALL GEN038 (SGSMC, 15, 47)
        NSYMP       = 1
        JSWD        = 0
        IKLS        = 8
        ISGNR       = 0
        IAXM        = 0
        IMPROP      = 1
      ENDIF
  100 RETURN
99999 FORMAT (':: Transformation Matrix with Determinant = 0 !', /,
     1 3(3F10.3, /))
      END
      SUBROUTINE SG04
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      COMMON /SLAUE/ LGR, XSYST, IBVL(8), SITE(NSITE)
      CHARACTER SG2(NRSPGR)*41, LINE*80,
     1 NONST(354)*9, NOSTP(6)*4, YSPG*9, LGR(14)*5, XSYST(8)*12,
     2 ICH*1, IBVL*1, SGSMC*52, SITE*5, ZSPG*7,
     3 XSPG*10, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      IF (SGSMC(14:14) .EQ. 'C') THEN
        ICNTR = 2
      ELSE
        ICNTR = 1
      ENDIF
      ICNTRX = ICNTR
      DO 10 I = 1, 7
        IF (SGSMC(13:13) .EQ. ICH(I + 29)) GOTO 20
   10 CONTINUE
      WRITE (IUIT, 99978)
      IER = 10
      GOTO 100
   20 IBV  = IBV0(I)
      IBVP = IBV1(I)
      DO 40 J = 1, IBV
        DO 30 I = 1, 3
          IF (J .EQ. 1) THEN
            ISBRV(J, I) = 0
          ELSE
            ISBRV(J, I) = IBV2(IBVP)
            IBVP        = IBVP + 1
          ENDIF
   30   CONTINUE
   40 CONTINUE
      IF (ILAUE .LT. 0) THEN
        IINV = 2
      ELSE
        IINV = ICNTR
      ENDIF
      NST  = NSYMP * IBV * IINV
      NSTX = NST
      IF (ILAUE .LT. 0 .AND. ICNTR .NE. 2) NSTX = NSTX * 2
      LAUE = 13
      NSLPM = 1
      IF (NSYMP .EQ. 1) THEN
        IKLS = 1
        LAUE = 1
      ELSE IF (NSYMP .EQ. 2) THEN
        IKLS = 2
        LAUE = 2
      ELSE IF (IAXM .EQ. 6) THEN
        IKLS = 6
        IF (NSYMP .EQ. 6) THEN
          LAUE = 9
        ELSE
          LAUE = 10
        ENDIF
      ELSE IF (NSYMP .GE. 12) THEN
        IKLS = 7
        IF (NSYMP .EQ. 12) THEN
          LAUE = 11
        ELSE
          LAUE = 12
        ENDIF
      ELSE IF (IAXM .EQ. 4) THEN
        IKLS = 4
        IF (NSYMP .EQ. 4) THEN
          LAUE = 4
        ELSE
          LAUE = 5
        ENDIF
      ELSE IF (IAXM .EQ. 3) THEN
        IKLS = 5
        IF (NSYMP .EQ. 3) THEN
          LAUE = 6
        ELSE
          LAUE = 14
        ENDIF
      ELSE
        IKLS  = 3
        LAUE  = 3
        NSLPM = 6
      ENDIF
      JSMI = NSG(2 * LAUE - 1)
      JSMX = NSG(2 * LAUE)
      IF(IKLS .EQ. 5 .AND. IABS(IS(1, 3, 2)) .EQ. 3) THEN
        SGSMC(12:12) = IBVL(6)
      ELSE
        SGSMC(12:12) = IBVL(IKLS)
      ENDIF
      ICNTRX = ICNTR
      IF (ICNTR .EQ. 1 .AND. NSYMP .GT. 1) THEN
        DO 60 I = 2, NSYMP
          DO 50 K = 1, 3
            IF (IS(2, K, I) .NE. 0) GOTO 60
            IF (IS(1, K, I) .NE. - K) GOTO 60
            OCNT(K) = FLOAT(IS(3, K, I)) / 24
   50     CONTINUE
          ICNTRX = 2
          GOTO 70
   60   CONTINUE
   70   CONTINUE
      ENDIF
  100 RETURN
99978 FORMAT (':: Unknown LATTICE Type')
      END
      SUBROUTINE SG05 (N, X)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      DIMENSION X(12)
      NS0 = (IABS(NSL) - 1) / NSYMP
      NS  =  IABS(NSL) - NS0 * NSYMP
      IF (NS .LT. 1) THEN
        IF (IUIT .GT. 0) THEN
          WRITE (IUIT,
     1 '('' NSL, NSYMP, NS0, NS, ISW = '', 5I10, /, 12F6.3, //)')
     2      NSL, NSYMP, NS0, NS, ISW , (X(J), J = 1, 12)
        ENDIF
        WRITE (IUIT, '(A)') 'NS .LT. 1 ERROR IN (SGSM)'
        IER = 5
        GOTO 100
      ENDIF
      IF (ILAUE .LT. 0) THEN
        IINV = 2
      ELSE
        IINV = ICNTR
      ENDIF
      NS2 = NS0 / IINV
      NS1 = NS0 + 1 - NS2 * IINV
      NS2 = NS2 + 1
      IF (NS2 .LT. 1 .OR. NS2 .GT. 4) THEN
        WRITE (IUIT, '(A)') 'NS2 < 1 OR NS2 > 4'
        IER = 4
        GOTO 100
      ENDIF
      IF (N .LT. 1 .OR. N .GT. 195) THEN
        WRITE (IUIT, '(6I10, /)') NS, NS0, NS1, NS2, IINV, N
        IER = 3
        GOTO 100
      ENDIF
      DO 10 I = 1, 3
        IR(1, I, N) = 0
        IR(2, I, N) = 0
   10 CONTINUE
      DO 30 I = 1, 3
        DO 20 K = 1, 3
          INH = IS(K, I, NS)
          IF (NS1 .EQ. 2) INH = - INH
          IF (K .EQ. 3) THEN
            IF (ILAUE .GT. 0) THEN
              INH = MOD(INH + ISBRV(NS2, I), 12)
              IF (INH .LT. 0) INH = INH + 12
              IR(K, I, N) = INH
            ELSE
              IR(K, I, N) = 0
            ENDIF
          ELSE IF (ISWD .GT. 0) THEN
            IR(K, I, N) = INH
          ELSE IF (INH .NE. 0) THEN
            IF (INH .LT. 0) THEN
              INHD = - I
              INH  = - INH
            ELSE
              INHD =  I
            ENDIF
            IF (IR(1, INH, N) .EQ. 0) THEN
              IR(1, INH, N) = INHD
            ELSE
              IR(2, INH, N) = INHD
            ENDIF
          ENDIF
   20   CONTINUE
   30 CONTINUE
  100 RETURN
      END
      SUBROUTINE SG06
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      DO 50 K = 1, 3
        DO 10 M = 1, 3
          ISV(M) = 0
   10   CONTINUE
        ITS = IR(3, K, 193)
        DO 30 L = 1, 2
          ISJ = IR(L, K, 193)
          IF (ISJ .NE. 0) THEN
            ISS = IR(3, IABS(ISJ), 194)
            IF (ISJ .LT. 0) ISS = - ISS
            ITS = ITS + ISS
            DO 20 M = 1, 2
              ISX = IR(M, IABS(ISJ), 194)
              IF (ISJ .LT. 0) ISX = - ISX
              IF (ISX .NE. 0) THEN
                ISY = IABS(ISX)
                ISV(ISY) = ISV(ISY) + ISX
              ENDIF
   20       CONTINUE
          ENDIF
   30   CONTINUE
        IR(2, K, 195) = 0
        MM = 0
        DO 40 M = 1, 3
          IF (ISV(M) .NE. 0) THEN
            MM             = MM + 1
            IR(MM, K, 195) = ISV(M)
          ENDIF
   40   CONTINUE
        IR(3, K, 195) = ITS
   50 CONTINUE
      RETURN
      END
      SUBROUTINE SG07
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      COMMON /SLAUE/ LGR, XSYST, IBVL(8), SITE(NSITE)
      CHARACTER SG2(NRSPGR)*41, LINE*80,
     1 NONST(354)*9, NOSTP(6)*4, YSPG*9, LGR(14)*5, XSYST(8)*12,
     2 ICH*1, IBVL*1, SGSMC*52, SITE*5, ZSPG*7,
     3 XSPG*10, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      DO 30 LL = 1, 3, 2
        DO 20 L = 1, NSYMP
          ISN  = 2 - LL
          IDIF = 0
          IDT  = 0
          IDV2 = 0
          DO 10 K = 1, 3
            IDIF = IDIF + IABS(IS(1, K, L) - ISN * IR(1, K, 195))
     1                  + IABS(IS(2, K, L) - ISN * IR(2, K, 195))
            IDV  = MOD(IABS(IS(3, K, L) - ISN * IR(3, K, 195)), 12)
            IF (IDV .EQ. 4 .OR. IDV .EQ. 8) THEN
              IDT = IDT + IDV * 10**(3 - K)
            ELSE IF (IDV .EQ. 6) THEN
              IDT = IDT + 2**(3 - K)
            ENDIF
            IDV2 = IDV2 + IDV
   10     CONTINUE
          IF (IDIF .EQ. 0) THEN
            IF (IDV2 .GT. 0 .AND. IDT .NE. 3 .AND. IDT .LT. 5) GOTO 20
            IF (ISN .LT. 0) SGSMC(14:14) = 'C'
            IF (IDT .GT. 2 .AND. IDT .NE. 4) THEN
              IF (IDT .LT. 8 .AND. SGSMC(13:13) .NE. 'F'
     1                       .AND. SGSMC(13:13) .NE. 'I') THEN
                IF (SGSMC(13:13) .EQ. 'P') THEN
                  SGSMC(13:13) = ICH(IDT + 19)
                ELSE IF (SGSMC(13:13) .NE. ICH(IDT + 19)) THEN
                  SGSMC(13:13) = 'F'
                ENDIF
              ELSE IF (IDT .EQ. 488 .OR. IDT .EQ. 844) THEN
                SGSMC(13:13) = 'R'
              ENDIF
            ENDIF
            GOTO 80
          ENDIF
   20   CONTINUE
   30 CONTINUE
      IF (NSYMP .LT. 24) THEN
        NSYMP = NSYMP + 1
        DO 50 L = 1, 3
          DO 40 K = 1, 3
            ISLK            = IR(L, K, 195)
            IS(L, K, NSYMP) = ISLK
            IF (L .LT. 3 .AND. ISLK .NE. 0) THEN
              IORG(IABS(ISLK), K) = IORG(IABS(ISLK), K) + ISLK
            ENDIF
   40     CONTINUE
   50   CONTINUE
        IF (IS(1, 3, NSYMP) .GT. 0) THEN
          ISN =  100000
        ELSE
          ISN = -100000
        ENDIF
        ISCOD = 555555
        DO 70 K = 1, 3
          DO 60 L = 1, 2
            ISCOD = ISCOD + ISN * IS(L, K, NSYMP)
            ISN = ISN / 10
   60     CONTINUE
   70   CONTINUE
        IF (ISCOD .EQ. 356385 .OR. ISCOD .EQ. 856575) THEN
          IAX = 3
        ELSE IF (ISCOD .EQ. 356585) THEN
          IAX = 4
        ELSE IF (ISCOD .EQ. 636585) THEN
          IAX = 6
        ELSE
          IAX = 0
        ENDIF
        IAXM = MAX(IAXM, IAX)
      ELSE
        WRITE (IUIT, 99980)
        IER = 6
        RETURN
      ENDIF
   80 RETURN
99980 FORMAT (':: Attempt to generate more than 24 ''non-LATT'' ',
     1        'operations', /, '   ** Please check symmetry operations'
     2        , /, '   ** No additional operations accepted!')
      END
      SUBROUTINE SG08 (DET)
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      COMMON /SLAUE/ LGR, XSYST, IBVL(8), SITE(NSITE)
      CHARACTER SG2(NRSPGR)*41, LINE*80,
     1 NONST(354)*9, NOSTP(6)*4, YSPG*9, LGR(14)*5, XSYST(8)*12,
     2 ICH*1, IBVL*1, SGSMC*52, SITE*5, ZSPG*7,
     3 XSPG*10, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      DO 10 I = 1, 7
        IF (SGSMC(13:13) .EQ. ICH(I + 29)) GOTO 20
   10 CONTINUE
      WRITE (IUIT, 99999) SGSMC(13:13)
      RETURN
   20 IDET = NINT(IBV0(I) * DET)
      IF (IDET .EQ. 4) THEN
        SGSMC(13:13) = 'F'
      ELSE IF (IDET .EQ. 3) THEN
        SGSMC(13:13) = 'R'
      ELSE IF (IDET .EQ. 2) THEN
        IBVX = 3
        IF (I .GT. 1) THEN
          IBVP = IBV1(I) - 1
          DO 40 J = 1, 3
            R2(J, 4) = 0.0
            DO 30 K = 1, 3
              R2(J, 4) = R2(J, 4) + R2(J, K) * IBV2(IBVP + K) / 12.0
   30       CONTINUE
   40     CONTINUE
          IBVX = 4
        ENDIF
        DO 60 J = 1, IBVX
          K = 0
          DO 50 I = 1, 3
            IF (ABS(0.5 - ABS(AMOD(R2(I, J), 1.0))) .LT. 0.1)
     1        K = K + 2**(I - 1)
   50     CONTINUE
          IF (K .GT. 2 .AND. K .NE. 4) GOTO 70
   60   CONTINUE
   70   IF (K .EQ. 6) THEN
          SGSMC(13:13) = 'A'
        ELSE IF (K .EQ. 5) THEN
          SGSMC(13:13) = 'B'
        ELSE IF (K .EQ. 3) THEN
          SGSMC(13:13) = 'C'
        ELSE IF (K .EQ. 7) THEN
          SGSMC(13:13) = 'I'
        ENDIF
      ELSE
        SGSMC(13:13) = 'P'
      ENDIF
      IF (SGSMC(14:14) .EQ. 'C') THEN
        DO 80 I = 1, 3
          L = NINT(AMOD(ABS(2.0 * OSFT(I)), 1.0) * 12.0)
          IF (L .NE. 0 .AND. L .NE. 6) THEN
            WRITE (IUIT, 99998)
            SGSMC(14:14) = 'A'
          ENDIF
   80   CONTINUE
      ENDIF
      RETURN
99999 FORMAT (':: Cannot Transform Lattice: ', A)
99998 FORMAT (':: Origin shift not compatible with inversion on 0,0,0')
      END
      SUBROUTINE SG09 (X, NSM)
      PARAMETER (NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      DIMENSION X(12)
      IF (ISWD .EQ. JSWD) GOTO 280
      N   = 0
  260 N   = N + 1
      NSL = N
      CALL SG05 (N, X)
      IF (IER .NE. 0) GOTO 350
      IF (N .LT. NST) GOTO 260
      JSWD = ISWD
  280 N    = IABS(NSM)
      IF (N .LT. 1 .OR. N .GT. 195)
     1 WRITE (IUIT, '(3I10)') NST, N, ISW
      DO 300 J = 1, 3
        IF (NSM .GT. 0) THEN
          IF (ISWD .LT. 0) THEN
            X(J + 6) = 0.0
            IF (J .EQ. 1) X(10) = X(4) / 360.0
            X(10) = X(10) - IR(3, J, N) * X(J) / 12.0
          ELSE
            X(J + 6) = IR(3, J, N) / 12.0 + X(J + 3)
          ENDIF
        ELSE
          X(J + 6) = 0.0
        ENDIF
        DO 290 I = 1, 2
          ISJ = IR(I, J, N)
          IF (ISJ .NE. 0) THEN
            XISJ = X(IABS(ISJ))
            IF (ISJ .LT. 0 .AND. NSM .GE. 0) XISJ = - XISJ
            X(J + 6) = X(J + 6) + XISJ
          ENDIF
  290   CONTINUE
  300 CONTINUE
      IF (ISWD .LT. 0) THEN
        X10 = MOD(X(10), 1.0)
        IF (X10 .GT. 0.5) THEN
          X10 = X10 - 1.0
        ELSE IF (X10 .LE. -0.5) THEN
          X10 = X10 + 1.0
        ENDIF
        X(10) = X10 * 360.0
      ENDIF
  350 RETURN
      END
      BLOCK DATA SGSMD
      PARAMETER (NRSPGR = 279, NTRL = 86, NOPR = 18, NSITE = 70)
      COMMON /CSPGR/ IS(3, 3, 24), ISBRV(4, 3), ISGNR, NSYMP, ICNTR,
     1 IBV, IKLS, LAUE, IR(3, 3, 195), ISV(3), IABC(6), JABC(6), NSTX,
     2 R0(3, 3), R1(3, 3), R2(3, 4), R3(3, 3), T0(3), T3(3), OSFT(3),
     3 IINV, ISW, IBV0(7), IBV1(7), IBV2(18), ILAUE, IAXM, KSITE(NSITE),
     4 IOPR(NOPR), IORG(3, 3), JSMI, JSMX, NSLPM, NST, JSWD, NSG(28),
     5 ITRNS, ICNTRX, IMPROP, IUIT, OCNT(3), NHRM(198), IHALL(9, 3),
     6 NTRNS, JLAUE, IER, NSL, ISWD
      COMMON /CSGSM/ ICH(43), SG2, NONST, NOSTP, SGSMC, XSPG, YSPG,
     1 ZSPG, TRLTA, TRLTB, LINE
      COMMON /SLAUE/ LGR, XSYST, IBVL(8), SITE(NSITE)
      CHARACTER SG2(NRSPGR)*41, LINE*80, NONST(354)*9, NOSTP(6)*4,
     1 LGR(14)*5, XSYST(8)*12, ICH*1, IBVL*1, SGSMC*52, YSPG*9, SITE*5 ,
     2 XSPG*10, ZSPG*7, TRLTA(NTRL)*7, TRLTB(NTRL)*7
      DATA LGR /
     1  '   -1', '  2/m', '  mmm', '  4/m', '4/mmm', '   -3', ' -3m1',
     2  ' -31m', '  6/m', '6/mmm', '  m-3', ' m-3m', '     ', '  -3m'/
      DATA XSYST /'   Triclinic', '  Monoclinic', 'Orthorhombic',
     1            '  Tetragonal', '    Trigonal', '   Hexagonal',
     2            '       Cubic', '            '/
      DATA SITE /
     1 '    1', '   -1', '  ..2', '  ..m', '..2/m', '  .m.', '  .2.',
     2 '.2/m.', '  m..', '  mm2', '  m2m', '  2..', '  2mm', '  222',
     3 '2/m..', '  mmm', '   m-', '   2-', ' 2/m-', '   m+', 'mm2+-',
     4 ' m2m-', '   2+', ' m2m+', '222+-', ' 2/m+', 'mmm+-', '  4..',
     5 '  4mm', '  422', ' -4..', ' -42m', ' -4m2', '4/m..', '4/mmm',
     6 '  .3.', ' .-3.', '   23', '   m3', '   3m', '  .32', '  -3m',
     7 '  432', ' -43m', '  m3m', '  3..', ' -3..', '  6..', ' -6..',
     8 '  6/m', '  3.m', '  3.2', ' -3.m', '  3m.', '  6mm', ' -6m2',
     9 '  32.', ' -62m', '  622', ' -3m.', '6/mmm', '  .3.', '  .32',
     * ' .-3.', '  .3.', '  .32', ' .-3.', '  .3.', '  .32', ' .-3.'/
      DATA KSITE/
     1      0,       1,       2,       4,       7,       8,      16,
     2     25,      32,      42,      52,      64,      76,      82,
     3     97,     127,     128,     256,     385,     512,     642,
     4    772,    1024,    1156,    1282,    1537,    1927,    2050,
     5   2730,    3410,    4098,    4818,    5418,    6151,    8191,
     6   8192,    8193,    8274,    8319,    8320,    8448,    8577,
     7  11602,   13010,   16383,   16384,   16385,   16386,   16388,
     8  16391,   16512,   16640,   16769,   16896,   17026,   17156,
     9  17408,   17540,   17666,   17921,   18311,   32768,   33024,
     *  32769,   65536,   65792,   65537,  131072,  131328,  131073/
      DATA IOPR /-162,  132, -132,  134, -134,   160, -160, 156, -156,
     1            138, -138,  152, -142,   72, -4650,  -68, -30,   26/
      DATA NOSTP /'ABC ', 'BA-C', 'CAB ', '-CBA', 'BCA ', 'A-CB'/
      DATA IBV0 /1, 2, 2, 2, 4, 2, 3/
      DATA IBV1 /0, 1, 4, 7, 1, 10, 13/
      DATA IBV2 /0, 6, 6, 6, 0, 6, 6, 6, 0, 6, 6, 6, 4, 8, 8, 8, 4, 4/
      DATA IBVL /'a', 'm', 'o', 't', 'r', 'h', 'c', ' '/
      DATA ICH /'1','2','3','4','5','6','7','8','9','0','.','X','Y','Z',
     1  ' ',',','+','-','/','[',']','A',' ','B','C','I','H','K','L','P',
     2  'A','B','C','F','I','R','P','I','R','F','A','B','C'/
      DATA (NHRM(I), I = 1, 198)/
     1  1, 0,  0,  0,  1, 0, 0,  0,  1,  1, 0,  0,  0, -1, 0, 0,  0, -1,
     2  1, 0,  0,  0,  0, 1, 0, -1, -1,  1, 0,  0,  0,  0, 1, 0, -1,  0,
     3  1, 0,  0,  0,  1, 1, 0, -1,  0,  1, 0,  0,  0,  1, 0, 0,  0,  1,
     4 -1, 0,  0,  0,  1, 0, 0,  0, -1, -1, 0, -1,  0,  1, 0, 1,  0,  0,
     5  0, 0, -1,  0,  1, 0, 1,  0,  0,  0, 0, -1,  0,  1, 0, 1,  0,  1,
     6  1, 0,  0,  0,  1, 0, 0,  0,  1, -1, 0,  0,  0, -1, 0, 0,  0,  1,
     7  0, 1,  0, -1, -1, 0, 0,  0,  1,  0, 1,  0, -1,  0, 0, 0,  0,  1,
     8  1, 1,  0, -1,  0, 0, 0,  0,  1, -1, 0,  0,  0,  0,-1, 0, -1,  0,
     9 -1, 0,  0,  0,  0, 1, 0,  1,  0,  0, 0, -1,  0, -1, 0,-1,  0,  0,
     *  0, 0,  1,  0, -1, 0, 1,  0,  0,  0,-1,  0, -1,  0, 0, 0,  0, -1,
     1  0, 1,  0,  1,  0, 0, 0,  0, -1,  0, 1,  0,  0,  0, 1, 1,  0,  0/
      DATA (NSG(I), I = 1, 28) /1, 7, 8, 57, 58, 116, 117, 130, 131,
     1 184, 185, 192, 193, 216, 193, 216, 217, 225, 226, 243, 244, 255,
     2 256, NRSPGR, 1, NRSPGR, 193, 216/
      DATA (SG2(I), I = 1, 19)/
     1 'P 1         1C1^1   P 1               799',
     2 'P -1        2Ci^1  -P 1             15327',
     3 'A -1        2Ci^1  -A 1             15327',
     4 'B -1        2Ci^1  -B 1             15327',
     5 'C -1        2Ci^1  -C 1             15327',
     6 'I -1        2Ci^1  -I 1             15327',
     7 'F -1        2Ci^1  -F 1             15327',
     8 'P 2         3C2^1   P 2y               20',
     9 'P 1 1 2     3C2^1   P 2                20',
     * 'P 21        4C2^2   P 2yb            5116',
     1 'P 1 1 21    4C2^2   P 2c             5116',
     2 'C 2         5C2^3   C 2y              763',
     3 'A 2         5C2^3   A 2y              763',
     4 'I 2         5C2^3   I 2y              763',
     5 'B 1 1 2     5C2^3   B 2               763',
     6 'P M         6Cs^1   P -2y               3',
     7 'P 1 1 M     6Cs^1   P -2                3',
     8 'P C         7Cs^2   P -2yc            325',
     9 'P A         7Cs^2   P -2ya            325'/
      DATA (SG2(I), I = 20, 38)/
     1 'P N         7Cs^2   P -2yac           325',
     2 'P 1 1 B     7Cs^2   P -2b             325',
     3 'C M         8Cs^3   C -2y              53',
     4 'A M         8Cs^3   A -2y              53',
     5 'B 1 1 M     8Cs^3   B -2               53',
     6 'C C         9Cs^4   C -2yc            844',
     7 'I C         9Cs^4   I -2yc            844',
     8 'I A         9Cs^4   I -2ya            844',
     9 'A A         9Cs^4   A -2ya            844',
     * 'B 1 1 B     9Cs^4   B -2b             844',
     1 'P 2/M      10C2h^1 -P 2y               15',
     2 'P 1 1 2/M  10C2h^1 -P 2                15',
     3 'P 21/M     11C2h^2 -P 2yb             596',
     4 'P 1 1 21/M 11C2h^2 -P 2c              596',
     5 'C 2/M      12C2h^3 -C 2y              471',
     6 'A 2/M      12C2h^3 -A 2y              471',
     7 'B 1 1 2/M  12C2h^3 -B 2               471',
     8 'I 1 2/M 1  12C2h^3 -I 2y              471',
     9 'I 2/M      12C2h^3 -I 2y              471'/
      DATA (SG2(I), I = 39, 57)/
     1 'I 1 1 2/B  12C2h^3 -I 2b              471',
     2 'I 1 1 2/A  12C2h^3 -I 2a              471',
     3 'P 2/C      13C2h^4 -P 2yc             434',
     4 'P 2/A      13C2h^4 -P 2ya             434',
     5 'P 2/N      13C2h^4 -P 2yac            434',
     6 'P 1 1 2/B  13C2h^4 -P 2b              434',
     7 'P 21/C     14C2h^5 -P 2ybc          30824',
     8 'P 21/A     14C2h^5 -P 2yab          30824',
     9 'P 1 1 21/A 14C2h^5 -P 2ac           30824',
     * 'P 1 1 21/B 14C2h^5 -P 2bc           30824',
     1 'P 21/N     14C2h^5 -P 2yn           30824',
     2 'P 1 1 21/N 14C2h^5 -P 2n            30824',
     3 'P 21/N 1 1 14C2h^5 -P 2xn           30824',
     4 'C 2/C      15C2h^6 -C 2yc            5965',
     5 'A 2/A      15C2h^6 -A 2ya            5965',
     6 'C 2/N      15C2h^6 -C 2ybc           5965',
     7 'I 2/C      15C2h^6 -I 2yc            5965',
     8 'I 2/A      15C2h^6 -I 2ya            5965',
     9 'B 1 1 2/B  15C2h^6 -B 2b             5965'/
      DATA (SG2(I), I = 58, 76)/
     1 'P 2 2 2    16D2^1   P 2 2               6',
     2 'P 2 2 21   17D2^2   P 2c 2              6',
     3 'P 21 21 2  18D2^3   P 2 2ab           426',
     4 'P 21 21 21 19D2^4   P 2ac 2ab        8608',
     5 'C 2 2 21   20D2^5   C 2c 2            185',
     6 'C 2 2 2    21D2^6   C 2 2               7',
     7 'F 2 2 2    22D2^7   F 2 2               3',
     8 'I 2 2 2    23D2^8   I 2 2              18',
     9 'I 21 21 21 24D2^9   I 2b 2c             3',
     * 'P M M 2    25C2v^1  P 2 -2              1',
     1 'P M C 21   26C2v^2  P 2c -2            31',
     2 'P C C 2    27C2v^3  P 2 -2c             5',
     3 'P M A 2    28C2v^4  P 2 -2a             1',
     4 'P C A 21   29C2v^5  P 2c -2ac         636',
     5 'P N C 2    30C2v^6  P 2 -2bc           13',
     6 'P M N 21   31C2v^7  P 2ac -2           76',
     7 'P B A 2    32C2v^8  P 2 -2ab           25',
     8 'P N A 21   33C2v^9  P 2c -2n         1404',
     9 'P N N 2    34C2v^10 P 2 -2n            31'/
      DATA (SG2(I), I = 77, 95)/
     1 'C M M 2    35C2v^11 C 2 -2              2',
     2 'C M C 21   36C2v^12 C 2c -2           140',
     3 'C C C 2    37C2v^13 C 2 -2c            10',
     4 'A M M 2    38C2v^14 A 2 -2              4',
     5 'A B M 2    39C2v^15 A 2 -2c             8',
     6 'A M A 2    40C2v^16 A 2 -2a            22',
     7 'A B A 2    41C2v^17 A 2 -2ac           80',
     8 'F M M 2    42C2v^18 F 2 -2             14',
     9 'F D D 2    43C2v^19 F 2 -2d           293',
     * 'I M M 2    44C2v^20 I 2 -2             11',
     1 'I B A 2    45C2v^21 I 2 -2c            79',
     2 'I M A 2    46C2v^22 I 2 -2a            12',
     3 'P M M M    47D2h^1 -P 2 2               1',
     4 'P N N N    48D2h^2 -P 2ab 2bc           5',
     5 'P C C M    49D2h^3 -P 2 2c              1',
     6 'P B A N    50D2h^4 -P 2ab 2b            5',
     7 'P M M A    51D2h^5 -P 2a 2a             8',
     8 'P N N A    52D2h^6 -P 2a 2bc           73',
     9 'P M N A    53D2h^7 -P 2ac 2            13'/
      DATA (SG2(I), I = 96, 114)/
     1 'P C C A    54D2h^8 -P 2a 2ac           33',
     2 'P B A M    55D2h^9 -P 2 2ab            29',
     2 'P C C N    56D2h^10-P 2ab 2ac         309',
     4 'P B C M    57D2h^11-P 2c 2b           135',
     5 'P N N M    58D2h^12-P 2 2n             79',
     6 'P M M N    59D2h^13-P 2ab 2a           50',
     7 'P B C N    60D2h^14-P 2n 2ab          811',
     8 'P B C A    61D2h^15-P 2ac 2ab        3481',
     9 'P N M A    62D2h^16-P 2ac 2n         1465',
     * 'C M C M    63D2h^17-C 2c 2            127',
     1 'C M C A    64D2h^18-C 2bc 2           160',
     2 'C M M M    65D2h^19-C 2 2               6',
     3 'C C C M    66D2h^20-C 2 2c             11',
     4 'C M M A    67D2h^21-C 2b 2              4',
     5 'C C C A    68D2h^22-C 2b 2bc           30',
     6 'F M M M    69D2h^23-F 2 2               9',
     7 'F D D D    70D2h^24-F 2uv 2vw          68',
     8 'I M M M    71D2h^25-I 2 2               9',
     9 'I B A M    72D2h^26-I 2 2c             57'/
      DATA (SG2(I), I = 115, 133)/
     1 'I B C A    73D2h^27-I 2b 2c            22',
     2 'I M M A    74D2h^28-I 2b 2             11',
     3 'P 4        75C4^1   P 4                 7',
     4 'P 41       76C4^2   P 4w              187',
     5 'P 42       77C4^3   P 4c                8',
     6 'P 43       78C4^4   P 4cw            -187',
     7 'I 4        79C4^5   I 4                22',
     8 'I 41       80C4^6   I 4bw              22',
     9 'P -4       81S4^1   P -4               23',
     * 'I -4       82S4^2   I -4              136',
     1 'P 4/M      83C4h^1 -P 4                 4',
     2 'P 42/M     84C4h^2 -P 4c               13',
     3 'P 4/N      85C4h^3 -P 4a               88',
     4 'P 42/N     86C4h^4 -P 4bc             128',
     5 'I 4/M      87C4h^5 -I 4                58',
     6 'I 41/A     88C4h^6 -I 4ad             279',
     7 'P 4 2 2    89D4^1   P 4 2               2',
     8 'P 4 21 2   90D4^2   P 4ab 2ab           8',
     9 'P 41 2 2   91D4^3   P 4w 2c            11'/
      DATA (SG2(I), I = 134, 148)/
     1 'P 41 21 2  92D4^4   P 4abw 2nw        378',
     2 'P 42 2 2   93D4^5   P 4c 2              2',
     3 'P 42 21 2  94D4^6   P 4n 2n            20',
     4 'P 43 2 2   95D4^7   P 4cw 2c          -11',
     5 'P 43 21 2  96D4^8   P 4nw 2abw       -378',
     6 'I 4 2 2    97D4^9   I 4 2               3',
     7 'I 41 2 2   98D4^10  I 4bw 2bw           3',
     9 'P 4 M M    99C4v^1  P 4 -2              0',
     * 'P 4 B M   100C4v^2  P 4 -2ab            0',
     1 'P 42 C M  101C4v^3  P 4c -2c            2',
     2 'P 42 N M  102C4v^4  P 4n -2n            5',
     3 'P 4 C C   103C4v^5  P 4 -2c             0',
     4 'P 4 N C   104C4v^6  P 4 -2n            12',
     5 'P 42 M C  105C4v^7  P 4c -2             1',
     6 'P 42 B C  106C4v^8  P 4c -2ab           7'/
      DATA (SG2(I), I = 149, 167)/
     1 'I 4 M M   107C4v^9  I 4 -2              7',
     2 'I 4 C M   108C4v^10 I 4 -2c             6',
     3 'I 41 M D  109C4v^11 I 4bw -2           10',
     4 'I 41 C D  110C4v^12 I 4bw -2c          36',
     5 'P -4 2 M  111D2d^1  P -4 2              3',
     6 'P -4 2 C  112D2d^2  P -4 2c             0',
     7 'P -4 21 M 113D2d^3  P -4 2ab           42',
     8 'P -4 21 C 114D2d^4  P -4 2n           139',
     9 'P -4 M 2  115D2d^5  P -4 -2             2',
     * 'P -4 C 2  116D2d^6  P -4 -2c            3',
     1 'P -4 B 2  117D2d^7  P -4 -2ab           7',
     2 'P -4 N 2  118D2d^8  P -4 -2n           24',
     3 'I -4 M 2  119D2d^9  I -4 -2             8',
     4 'I -4 C 2  120D2d^10 I -4 -2c            4',
     5 'I -4 2 M  121D2d^11 I -4 2             31',
     6 'I -4 2 D  122D2d^12 I -4 2bw           42',
     7 'P 4/M M M 123D4h^1 -P 4 2               4',
     8 'P 4/M C C 124D4h^2 -P 4 2c             15',
     9 'P 4/N B M 125D4h^3 -P 4 2a 2b           1'/
      DATA (SG2(I), I = 168, 178)/
     1 'P 4/N N C 126D4h^4 -P 4a 2bc           16',
     2 'P 4/M B M 127D4h^5 -P 4 2ab             6',
     3 'P 4/M N C 128D4h^6 -P 4 2n              5',
     4 'P 4/N M M 129D4h^7 -P 4a 2a            18',
     5 'P 4/N C C 130D4h^8 -P 4a 2ac           34',
     6 'P 42/M M C131D4h^9 -P 4c 2              3',
     7 'P 42/M C M132D4h^10-P 4c 2c             1',
     8 'P 42/N B C133D4h^11-P 4ac 2b            4',
     9 'P 42/N N M134D4h^12-P 4ac 2bc           6',
     * 'P 42/M B C135D4h^13-P 4c 2ab            6',
     1 'P 42/M N M136D4h^14-P 4n 2n            24'/
      DATA (SG2(I), I = 179, 197)/
     1 'P 42/N M C137D4h^15-P 4ac 2a           16',
     2 'P 42/N C M138D4h^16-P 4ac 2ac           6',
     3 'I 4/M M M 139D4h^17-I 4 2              18',
     4 'I 4/M C M 140D4h^18-I 4 2c              6',
     5 'I 41/A M D141D4h^19-I 4bd 2            15',
     6 'I 41/A C D142D4h^20-I 4bd 2c           40',
     7 'P 3       143C3^1   P 3                27',
     8 'P 31      144C3^2   P 31              106',
     9 'P 32      145C3^3   P 32             -106',
     * 'R 3       146C3^4   R 3               115',
     1 'R 3 R     146C3^4   P 3*              115',
     2 'P -3      147C3i^1 -P 3                84',
     3 'R -3      148C3i^2 -R 3               365',
     4 'R -3 R    148C3i^2 -P 3*              365',
     5 'P 3 1 2   149D3^1   P 3 2               0',
     6 'P 3 2 1   150D3^2   P 3 2"              8',
     7 'P 31 1 2  151D3^3   P 31 2c (0 0 1)     4',
     8 'P 31 2 1  152D3^4   P 31 2"           133',
     9 'P 32 1 2  153D3^5   P 32 2c (0 0 -1)   -4'/
      DATA (SG2(I), I = 198, 208)/
     1 'P 32 2 1  154D3^6   P 32 2"          -133',
     2 'R 3 2     155D3^7   R 3 2"             35',
     3 'R 3 2 R   155D3^7   P 3* 2             35',
     4 'P 3 M 1   156C3v^1  P 3 -2"             1',
     5 'P 3 1 M   157C3v^2  P 3 -2              2',
     6 'P 3 C 1   158C3v^3  P 3 -2"c            8',
     7 'P 3 1 C   159C3v^4  P 3 -2c            15',
     8 'R 3 M     160C3v^5  R 3 -2"            37',
     9 'R 3 M R   160C3v^5  P 3* -2            37',
     * 'R 3 C     161C3v^6  R 3 -2"c          101',
     1 'R 3 C R   161C3v^6  P 3* -2n          101'/
      DATA (SG2(I), I = 209, 227)/
     1 'P -3 1 M  162D3d^1 -P 3 2               2',
     2 'P -3 1 C  163D3d^2 -P 3 2c             31',
     3 'P -3 M 1  164D3d^3 -P 3 2"             11',
     4 'P -3 C 1  165D3d^4 -P 3 2"c            41',
     5 'R -3 M    166D3d^5 -R 3 2"             32',
     6 'R -3 M R  166D3d^5 -P 3* 2             32',
     7 'R -3 C    167D3d^6 -R 3 2"c           102',
     8 'R -3 C R  167D3d^6 -P 3* 2n           102',
     9 'P 6       168C6^1   P 6                 2',
     * 'P 61      169C6^2   P 61              106',
     1 'P 65      170C6^3   P 65             -106',
     2 'P 62      171C6^4   P 62                6',
     3 'P 64      172C6^5   P 64               -6',
     4 'P 63      173C6^6   P 6c               59',
     5 'P -6      174C3h^1  P -6                3',
     6 'P 6/M     175C6h^1 -P 6                 1',
     7 'P 63/M    176C6h^2 -P 6c              164',
     8 'P 6 2 2   177D6^1   P 6 2               0',
     9 'P 61 2 2  178D6^2   P 61 2 (0 0 -1)    16'/
      DATA (SG2(I), I = 228, 238)/
     1 'P 65 2 2  179D6^3   P 65 2 ( 0 0 1)     5',
     2 'P 62 2 2  180D6^4   P 62 2c (0 0 1)     7',
     3 'P 64 2 2  181D6^5   P 64 2c (0 0 -1)   -7',
     4 'P 63 2 2  182D6^6   P 6c 2c             4',
     5 'P 6 M M   183C6v^1  P 6 -2              2',
     6 'P 6 C C   184C6v^2  P 6 -2c             0',
     7 'P 63 C M  185C6v^3  P 6c -2             4',
     8 'P 63 M C  186C6v^4  P 6c -2c           24',
     9 'P -6 M 2  187D3h^1  P -6 2              0',
     * 'P -6 C 2  188D3h^2  P -6c 2             0',
     1 'P -6 2 M  189D3h^3  P -6 -2             4'/
      DATA (SG2(I), I = 239, 257)/
     1 'P -6 2 C  190D3h^4  P -6c -2c          13',
     2 'P 6/M M M 191D6h^1 -P 6 2               3',
     3 'P 6/M C C 192D6h^2 -P 6 2c              7',
     4 'P 63/M C M193D6h^3 -P 6c 2              1',
     5 'P 63/M M C194D6h^4 -P 6c 2c            20',
     6 'P 2 3     195T^1    P 2 2 3             0',
     7 'F 2 3     196T^2    F 2 2 3             2',
     8 'I 2 3     197T^3    I 2 2 3             6',
     9 'P 21 3    198T^4    P 2ac 2ab 3        58',
     * 'I 21 3    199T^5    I 2b 2c 3           1',
     1 'P M -3    200Th^1  -P 2 2 3             3',
     2 'P N -3    201Th^2  -P 2ab 2bc 3         3',
     3 'F M -3    202Th^3  -F 2 2 3             4',
     4 'F D -3    203Th^4  -F 2uv 2vw 3         3',
     5 'I M -3    204Th^5  -I 2 2 3             9',
     6 'P A -3    205Th^6  -P 2ac 2ab 3        88',
     7 'I A -3    206Th^7  -I 2b 2c 3           8',
     8 'P 4 3 2   207O^1    P 4 2 3             2',
     9 'P 42 3 2  208O^2    P 4n 2 3            0'/
      DATA (SG2(I), I = 258, 267)/
     1 'F 4 3 2   209O^3    F 4 2 3             2',
     2 'F 41 3 2  210O^4    F 4d 2 3            1',
     3 'I 4 3 2   211O^5    F 4d 2 3            0',
     4 'P 43 3 2  212O^6    P 4acd 2ab 3        5',
     5 'P 41 3 2  213O^7    P 4bd 2ab 3        -5',
     6 'I 41 3 2  214O^8    I 4bd 2c 3          0',
     7 'P -4 3 M  215Td^1   P -4 2 3            8',
     8 'F -4 3 M  216Td^2   F -4 2 3            7',
     9 'I -4 3 M  217Td^3   I -4 2 3           25',
     * 'P -4 3 N  218Td^4   P -4n 2 3          15'/
      DATA (SG2(I), I = 268, NRSPGR)/
     1 'F -4 3 C  219Td^5   F -4c 2 3           8',
     2 'I -4 3 D  220Td^6   I -4bd 2c 3        15',
     3 'P M -3 M  221Oh^1  -P 4 2 3            10',
     4 'P N -3 N  222Oh^2  -P 4a 2bc 3          9',
     5 'P M -3 N  223Oh^3  -P 4n 2 3            5',
     6 'P N -3 M  224Oh^4  -P 4bc 2bc 3         4',
     7 'F M -3 M  225Oh^5  -F 4 2 3            24',
     8 'F M -3 C  226Oh^6  -F 4c 2 3            2',
     9 'F D -3 M  227Oh^7  -F 4vw 2vw 3        16',
     * 'F D -3 C  228Oh^8  -F 4cvw 2vw 3        7',
     1 'I M -3 M  229Oh^9  -I 4 2 3            20',
     2 'I A -3 D  230Oh^10 -I 4bd 2c 3          1'/
      DATA (NONST(I), I = 1, 76)/
     1 'P 2 2 2  ', 'P 2 2 2  ', 'P 2 2 2  ', 'P 2 2 2  ',
     2 'P 2 2 2  ', 'P 2 2 2  ', 'P 2 2 21 ', 'P 2 2 21 ',
     3 'P 21 2 2 ', 'P 21 2 2 ', 'P 2 21 2 ', 'P 2 21 2 ',
     4 'P 21 21 2', 'P 21 21 2', 'P 2 21 21', 'P 2 21 21',
     5 'P 21 2 21', 'P 21 2 21', '         ', '         ',
     6 '         ', '         ', '         ', '         ',
     7 'C 2 2 21 ', 'C 2 2 21 ', 'A 21 2 2 ', 'A 21 2 2 ',
     8 'B 2 21 2 ', 'B 2 21 2 ', 'C 2 2 2  ', 'C 2 2 2  ',
     9 'A 2 2 2  ', 'A 2 2 2  ', 'B 2 2 2  ', 'B 2 2 2  ',
     * 'F 2 2 2  ', 'F 2 2 2  ', 'F 2 2 2  ', 'F 2 2 2  ',
     1 'F 2 2 2  ', 'F 2 2 2  ', 'I 2 2 2  ', 'I 2 2 2  ',
     2 'I 2 2 2  ', 'I 2 2 2  ', 'I 2 2 2  ', 'I 2 2 2  ',
     3 '         ', '         ', ',        ', ',        ',
     4 '         ', '         ', 'P M M 2  ', 'P M M 2  ',
     5 'P 2 M M  ', 'P 2 M M  ', 'P M 2 M  ', 'P M 2 M  ',
     6 'P M C 21 ', 'P C M 21 ', 'P 21 M A ', 'P 21 A M ',
     7 'P B 21 M ', 'P M 21 B ', 'P C C 2  ', 'P C C 2  ',
     8 'P 2 A A  ', 'P 2 A A  ', 'P B 2 B  ', 'P B 2 B  ',
     9 'P M A 2  ', 'P B M 2  ', 'P 2 M B  ', 'P 2 C M  '/
      DATA (NONST(I), I = 77, 152)/
     1 'P C 2 M  ', 'P M 2 A  ', 'P C A 21 ', 'P B C 21 ',
     2 'P 21 A B ', 'P 21 C A ', 'P C 21 B ', 'P B 21 A ',
     3 'P N C 2  ', 'P C N 2  ', 'P 2 N A  ', 'P 2 A N  ',
     4 'P B 2 N  ', 'P N 2 B  ', 'P M N 21 ', 'P N M 21 ',
     5 'P 21 M N ', 'P 21 N M ', 'P N 21 M ', 'P M 21 N ',
     6 'P B A 2  ', 'P B A 2  ', 'P 2 C B  ', 'P 2 C B  ',
     7 'P C 2 A  ', 'P C 2 A  ', 'P N A 21 ', 'P B N 21 ',
     8 'P 21 N B ', 'P 21 C N ', 'P C 21 N ', 'P N 21 A ',
     9 'P N N 2  ', 'P N N 2  ', 'P 2 N N  ', 'P 2 N N  ',
     * 'P N 2 N  ', 'P N 2 N  ', 'C M M 2  ', 'C M M 2  ',
     1 'A 2 M M  ', 'A 2 M M  ', 'B M 2 M  ', 'B M 2 M  ',
     2 'C M C 21 ', 'C C M 21 ', 'A 21 M A ', 'A 21 A M ',
     3 'B B 21 M ', 'B M 21 B ', 'C C C 2  ', 'C C C 2  ',
     4 'A 2 A A  ', 'A 2 A A  ', 'B B 2 B  ', 'B B 2 B  ',
     5 'A M M 2  ', 'B M M 2  ', 'B 2 M M  ', 'C 2 M M  ',
     6 'C M 2 M  ', 'A M 2 M  ', 'A B M 2  ', 'B M A 2  ',
     7 'B 2 C M  ', 'C 2 M B  ', 'C M 2 A  ', 'A C 2 M  ',
     8 'A M A 2  ', 'B B M 2  ', 'B 2 M B  ', 'C 2 C M  ',
     9 'C C 2 M  ', 'A M 2 A  ', 'A B A 2  ', 'B B A 2  '/
      DATA (NONST(I), I = 153, 228)/
     1 'B 2 C B  ', 'C 2 C B  ', 'C C 2 A  ', 'A C 2 A  ',
     2 'F M M 2  ', 'F M M 2  ', 'F 2 M M  ', 'F 2 M M  ',
     3 'F M 2 M  ', 'F M 2 M  ', 'F D D 2  ', 'F D D 2  ',
     4 'F 2 D D  ', 'F 2 D D  ', 'F D 2 D  ', 'F D 2 D  ',
     5 'I M M 2  ', 'I M M 2  ', 'I 2 M M  ', 'I 2 M M  ',
     6 'I M 2 M  ', 'I M 2 M  ', 'I B A 2  ', 'I B A 2  ',
     7 'I 2 C B  ', 'I 2 C B  ', 'I C 2 A  ', 'I C 2 A  ',
     8 'I M A 2  ', 'I B M 2  ', 'I 2 M B  ', 'I 2 C M  ',
     9 'I C 2 M  ', 'I M 2 A  ', 'P M M M  ', 'P M M M  ',
     * 'P M M M  ', 'P M M M  ', 'P M M M  ', 'P M M M  ',
     1 'P N N N  ', 'P N N N  ', 'P N N N  ', 'P N N N  ',
     2 'P N N N  ', 'P N N N  ', 'P C C M  ', 'P C C M  ',
     3 'P M A A  ', 'P M A A  ', 'P B M B  ', 'P B M B  ',
     4 'P B A N  ', 'P B A N  ', 'P N C B  ', 'P N C B  ',
     5 'P C N A  ', 'P C N A  ', 'P M M A  ', 'P M M B  ',
     6 'P B M M  ', 'P C M M  ', 'P M C M  ', 'P M A M  ',
     7 'P N N A  ', 'P N N B  ', 'P B N N  ', 'P C N N  ',
     8 'P N C N  ', 'P N A N  ', 'P M N A  ', 'P N M B  ',
     9 'P B M N  ', 'P C N M  ', 'P N C M  ', 'P M A N  '/
      DATA (NONST(I), I = 229, 304)/
     1 'P C C A  ', 'P C C B  ', 'P B A A  ', 'P C A A  ',
     2 'P B C B  ', 'P B A B  ', 'P B A M  ', 'P B A M  ',
     3 'P M C B  ', 'P M C B  ', 'P C M A  ', 'P C M A  ',
     4 'P C C N  ', 'P C C N  ', 'P N A A  ', 'P N A A  ',
     5 'P B N B  ', 'P B N B  ', 'P B C M  ', 'P C A M  ',
     6 'P M C A  ', 'P M A B  ', 'P B M A  ', 'P C M B  ',
     7 'P N N M  ', 'P N N M  ', 'P M N N  ', 'P M N N  ',
     8 'P N M N  ', 'P N M N  ', 'P M M N  ', 'P M M N  ',
     9 'P N M M  ', 'P N M M  ', 'P M N M  ', 'P M N M  ',
     * 'P B C N  ', 'P C A N  ', 'P N C A  ', 'P N A B  ',
     1 'P B N A  ', 'P C N B  ', 'P B C A  ', 'P C A B  ',
     2 'P B C A  ', 'P C A B  ', 'P B C A  ', 'P C A B  ',
     3 'P N M A  ', 'P M N B  ', 'P B N M  ', 'P C M N  ',
     4 'P M C N  ', 'P N A M  ', 'C M C M  ', 'C C M M  ',
     5 'A M M A  ', 'A M A M  ', 'B B M M  ', 'B M M B  ',
     6 'C M C A  ', 'C C M B  ', 'A B M A  ', 'A C A M  ',
     7 'B B C M  ', 'B M A B  ', 'C M M M  ', 'C M M M  ',
     8 'A M M M  ', 'A M M M  ', 'B M M M  ', 'B M M M  ',
     9 'C C C M  ', 'C C C M  ', 'A M A A  ', 'A M A A  '/
      DATA (NONST(I), I = 305, 354)/
     1 'B B M B  ', 'B B M B  ', 'C M M A  ', 'C M M B  ',
     2 'A B M M  ', 'A C M M  ', 'B M C M  ', 'B M A M  ',
     3 'C C C A  ', 'C C C B  ', 'A B A A  ', 'A C A A  ',
     4 'B B C B  ', 'B B A B  ', 'F M M M  ', 'F M M M  ',
     5 'F M M M  ', 'F M M M  ', 'F M M M  ', 'F M M M  ',
     6 'F D D D  ', 'F D D D  ', 'F D D D  ', 'F D D D  ',
     7 'F D D D  ', 'F D D D  ', 'I M M M  ', 'I M M M  ',
     8 'I M M M  ', 'I M M M  ', 'I M M M  ', 'I M M M  ',
     9 'I B A M  ', 'I B A M  ', 'I M C B  ', 'I M C B  ',
     * 'I C M A  ', 'I C M A  ', 'I B C A  ', 'I C A B  ',
     1 'I B C A  ', 'I C A B  ', 'I B C A  ', 'I C A B  ',
     2 'I M M A  ', 'I M M B  ', 'I B M M  ', 'I C M M  ',
     3 'I M C M  ', 'I M A M  '/
      DATA (TRLTA(I), TRLTB(I), I = 1, 54)/
     1 'P121   ','P2     ','P1211  ','P21    ','C121   ','C2     ',
     2 'P1M1   ','PM     ','P1C1   ','PC     ','C1M1   ','CM     ',
     3 'C1C1   ','CC     ','P12/M1 ','P2/M   ','P121/M1','P21/M  ',
     4 'C12/M1 ','C2/M   ','P12/C1 ','P2/C   ','P121/C1','P21/C  ',
     5 'C12/C1 ','C2/C   ','PM3    ','PM-3   ','PN3    ','PN-3   ',
     6 'FM3    ','FM-3   ','FD3    ','FD-3   ','IM3    ','IM-3   ',
     7 'PA3    ','PA-3   ','IA3    ','IA-3   ','PM3M   ','PM-3M  ',
     8 'PN3N   ','PN-3N  ','PM3N   ','PM-3N  ','PN3M   ','PN-3M  ',
     9 'FM3M   ','FM-3M  ','FM3C   ','FM-3C  ','FD3M   ','FD-3M  ',
     * 'FD3C   ','FD-3C  ','IM3M   ','IM-3M  ','IA3D   ','IA-3D  ',
     1 'FM3-M  ','FM-3M  ','F4-3C  ','F-43C  ','IA3-   ','IA-3   ',
     2 'FD3-   ','FD-3   ','FM3-   ','FM-3   ','F4-3M  ','F-43M  ',
     3 'IM3-M  ','IM-3M  ','FM3-C  ','FM-3C  ','IA3-D  ','IA-3D  ',
     4 'IM3-   ','IM-3   ','I4-C2  ','I-4C2  ','I4-2M  ','I-42M  ',
     5 'PM3-N  ','PM-3N  ','PN3-M  ','PN-3M  ','PN3-N  ','PN-3N  ',
     6 'P3-M1  ','P-3M1  ','P4-C2  ','P-4C2  ','I4-M2  ','I-4M2  ',
     7 'I4-3D  ','I-43D  ','PA3-   ','PA-3   ','PM3-   ','PM-3   ',
     8 'P1-    ','P-1    ','P3-    ','P-3    ','P3-1C  ','P-31C  '/
      DATA (TRLTA(I), TRLTB(I), I = 55, NTRL)/
     1 'P4-    ','P-4    ','P4-M2  ','P-4M2  ','I4-    ','I-4    ',
     2 'I4-2D  ','I-42D  ','I4-3M  ','I-43M  ','PM3-M  ','PM-3M  ',
     3 'PN3-   ','PN-3   ','P3-C1  ','P-3C1  ','P3-1M  ','P-31M  ',
     4 'P4-B2  ','P-4B2  ','P4-N2  ','P-4N2  ','P4-2C  ','P-42C  ',
     5 'P4-21M ','P-421M ','P6-M2  ','P-6M2  ','R3-R   ','R-3R   ',
     6 'P4-2M  ','P-42M  ','P4-3M  ','P-43M  ','P6-    ','P-6    ',
     7 'P6-2C  ','P-62C  ','R3-    ','R-3    ','R3-C   ','R-3C   ',
     8 'R3-MR  ','R-3MR  ','P4-21C ','P-421C ','P4-3N  ','P-43N  ',
     9 'P6-C2  ','P-6C2  ','P6-2M  ','P-62M  ','P1N1   ','PN     ',
     * 'P12/N1 ','P2/N   ','P121/N1','P21/N  ','P1A1   ','PA     ',
     1 'P12/A1 ','P2/A   ','P121/A1','P21/A  '/
      END
      SUBROUTINE GEN002 (MODE, A, B, C, XLNG)
      DIMENSION A(3, 3), B(3), C(3), V(3)
      XLNG = 0.0
      DO 30 I = 1, 3
        V(I) = 0.0
        IF (MODE .GT. 0) THEN
          DO 10 J = 1, 3
            V(I) = V(I) + A(I, J) * B(J)
   10     CONTINUE
        ELSE
          DO 20 J = 1, 3
            V(I) = V(I) + B(J) * A(J, I)
   20     CONTINUE
        ENDIF
   30 CONTINUE
      DO 40 I = 1, 3
        C(I) = V(I)
   40 CONTINUE
      IF (IABS(MODE) .EQ. 2) THEN
        XLNG = SQRT(GEN009(C, C))
        IF (XLNG .GT. 1.E-5) THEN
          DO 50 I = 1, 3
            C(I) = C(I) / XLNG
   50     CONTINUE
        ELSE
          XLNG = 0.0
        ENDIF
      ENDIF
      RETURN
      END
      SUBROUTINE GEN003 (A, B, DET, MODE)
      DIMENSION A(3, 3), B(3, 3)
      CALL GEN008 (A(1, 2), A(1, 3), B(1, 1), 0)
      CALL GEN008 (A(1, 3), A(1, 1), B(1, 2), 0)
      CALL GEN008 (A(1, 1), A(1, 2), B(1, 3), 0)
      DET = GEN009 (A(1, 1), B(1, 1))
      IF (MODE .EQ. 0) THEN
        CALL GEN005 (B, B)
        DEEL = DET
      ELSE IF (MODE .EQ. 1) THEN
        DEEL = B(3, 3)
      ELSE
        DEEL = 0
      ENDIF
      IF (DEEL .NE. 0) THEN
        DO 20 I = 1, 3
          DO 10 J = 1, 3
            B(I, J) = B(I, J) / DEEL
   10     CONTINUE
   20   CONTINUE
      ENDIF
      RETURN
      END
      SUBROUTINE GEN004 (A, B, C)
      DIMENSION A(3, 3), B(3, 3), C(3, 3), V(3, 3)
      DO 30 I = 1, 3
        DO 20 J = 1, 3
          V(I, J) = 0.0
          DO 10 K = 1, 3
            V(I, J) = V(I, J) + A(I, K) * B(K, J)
   10     CONTINUE
   20   CONTINUE
   30 CONTINUE
      DO 50 I = 1, 3
        DO 40 J = 1, 3
          C(I, J) = V(I, J)
   40   CONTINUE
   50 CONTINUE
      RETURN
      END

      SUBROUTINE GEN005 (T, TR)
      DIMENSION T(3, 3), TR(3, 3), X(3, 3)
      DO 20 I = 1, 3
        DO 10 J = 1, 3
          X(J, I) = T(I, J)
   10   CONTINUE
   20 CONTINUE
      DO 40 I = 1, 3
        DO 30 J = 1, 3
          TR(I, J) = X(I, J)
   30   CONTINUE
   40 CONTINUE
      RETURN
      END
      SUBROUTINE GEN008 (A, B, C, MODE)
      DIMENSION A(3), B(3), C(3)
      C(1) = A(2) * B(3) - A(3) * B(2)
      C(2) = A(3) * B(1) - A(1) * B(3)
      C(3) = A(1) * B(2) - A(2) * B(1)
      IF (MODE .NE. 0) THEN
        DSQ = C(1) * C(1) + C(2) * C(2) + C(3) * C(3)
        IF (MODE .GT. 0) THEN
          IF (DSQ .GT. 0.00001) THEN
            D = SQRT(DSQ)
            C(1) = C(1) / D
            C(2) = C(2) / D
            C(3) = C(3) / D
          ENDIF
        ELSE
          C(1) = DSQ
        ENDIF
      ENDIF
      RETURN
      END
      FUNCTION GEN009 (X, Y)
      DIMENSION X(3), Y(3)
      GEN009 = X(1) * Y(1) + X(2) * Y(2) + X(3) * Y(3)
      RETURN
      END
      SUBROUTINE GEN020 (MODE, ICL, IMIN, IMAX)
      CHARACTER ICL*(*), ICH*1
      IF (IMAX .GE. IMIN) THEN
        IF (MODE .GT. 0) THEN
          DO 20 I = IMIN, IMAX
            ICH = ICL(I:I)
            IF (ICH .EQ. CHAR(9)) THEN
              ICL(I:I) = ' '
            ELSE
              DO 10 J = ICHAR('a'), ICHAR('z')
                IF (ICH .EQ. CHAR(J)) THEN
                  ICL(I:I) = CHAR(J + ICHAR('A') - ICHAR('a'))
                  GOTO 20
                ENDIF
   10         CONTINUE
            ENDIF
   20     CONTINUE
        ELSE
          DO 40 I = IMIN, IMAX
            ICH = ICL(I:I)
            DO 30 J = ICHAR('A'), ICHAR('Z')
              IF (ICH .EQ. CHAR(J)) THEN
                ICL(I:I) = CHAR(J - ICHAR('A') + ICHAR('a'))
                GOTO 40
              ENDIF
   30       CONTINUE
   40     CONTINUE
        ENDIF
      ENDIF
      RETURN
      END
      SUBROUTINE GEN038 (LINE, LO, LU)
      CHARACTER LINE*(*)
      DO 10 I = LO, LU
        LINE(I:I) = ' '
   10 CONTINUE
      RETURN
      END
      SUBROUTINE GEN047 (LINE, N, M)
      CHARACTER LINE*(*)
C * ELIMINATE BLANKS
      IND = N
      DO 10 I = N, M
        IF (LINE(I:I) .NE. ' ') THEN
          LINE(IND:IND) = LINE(I:I)
          IND = IND + 1
        ENDIF
   10 CONTINUE
      CALL GEN038 (LINE, IND, M)
      RETURN
      END

      SUBROUTINE FRDA(ICL, IFL, FN, KL, KN)
      CHARACTER ICL*80, IFL(20)*6, ICH*1
      DIMENSION FN(20)
C
C FREE FORMAT READ
C
      FN(1) = 0
      KN    = 0
      KL    = 0
C RETURN WITH KL = 0 AND KN = 0 WHEN FIRST COLUMN BLANK
      IF (ICL(1:1) .EQ. ' ') GOTO 120
C CONVERT TO UPPER-CASE
      DO 1 I = 1, 80
        ICH       = ICL(I:I)
        DO 2 J = ICHAR('a'), ICHAR('z')
          IF (ICH .EQ. CHAR(J)) THEN
            ICL(I:I) = CHAR(J - ICHAR('a') + ICHAR('A'))
            GOTO 1
          ENDIF
    2   CONTINUE
    1 CONTINUE     
      I = 0
C
C START OF A NEW FIELD
C LOOK FOR A NON-BLANK COLUMN
C
  109 A  = 0.0
      IP = 0
      NP = 0
      L  = 0
      S  = 1.0
  110 I  = I + 1
      IF (I .GT. 80)  GOTO 108
  111 ICH = ICL(I:I)
      IF (L .EQ. 0 .AND. ICH .EQ. ' ') GOTO 110
C
C START OF A FIELD
C
      L = L + 1
      DO 100 J = 1, 10
        IF (ICH .EQ. CHAR(ICHAR('0') - 1 + J)) GOTO 101
  100 CONTINUE
      IF (ICH .EQ. '.') THEN
        IP = 1
      ELSE IF (ICH .EQ. '+') THEN
        IF (L .GT. 1) GOTO 105
        S = 1.0
      ELSE IF (ICH .EQ. '-') THEN
        IF (L .GT. 1) GOTO 105
        S = - 1.0
      ELSE
        IF (L .GT. 1) GOTO 105
        GOTO 150
      ENDIF
      GOTO 110
C START OF A LITERAL FIELD BY A CHARACTER WHICH IS OTHER THAN 0-9+-.
C
C NUMERIC FIELD FOUND
C
  101 IF (IP .EQ. 1) NP = NP + 1
      A = 10.0 * A + J - 1
      GOTO 110
  108 IF (L .GT. 0) GOTO 105
      GOTO 120
C END OF NUMERIC FIELD
  105 A      = S * A / 10.0**NP
      KN     = KN + 1
      FN(KN) = A
      IF (ICH .EQ. '+' .OR. ICH .EQ. '-') I = I - 1
      GOTO 109
C
C LITERAL FIELD
C
  150 KL              = KL + 1
      IFL(KL)         = '      '
  151 IFL(KL)(L:L)    = ICH
      L               = L + 1
  155 I = I + 1
      IF (I .GT. 80) GOTO 109
      ICH = ICL(I:I)
C END OF LITERAL FIELD DEFINED BY BLANK  OR COMMA
      IF (ICH .EQ. ' ' .OR. ICH .EQ. ',') GOTO 109
      IF (L - 6) 151, 151, 155
  120 RETURN
      END
