C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     KSM_SYMFR2         **
C****************************
C
C
      SUBROUTINE KSM_SYMFR2 (ICOL, I1, NS, ROT, IERR, ERRSTR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Version of CCP4's SYMFR2 for KSM routines
C
C ***** 'KSM' SERVICE ROUTINE ONLY *****
C
C Author:  John W. Campbell, July 1993 (Based on CCP4'S SYMFR2)
C
C Arguments:
C
      CHARACTER*80 ICOL
      INTEGER I1
      INTEGER NS
      REAL ROT(4,4,*)
      INTEGER IERR
      CHARACTER*(*) ERRSTR

C  ICOL      (R)   String containing symmetry operator(s)
C  I1        (R)   First column to look at (after keyword)
C  NS        (R/W) Symmetry operators count
C  ROT       (R/W) Array for symmetry operators
C  IERR      (W)   Error flag =0 OK
C                             =1 Error in getting symmetry
C  ERRSTR    (W)   Error description string if error found
C
C====== GLOBALS:
C

C
C====== FUNCTION TYPES:
C

C
C====== LOCALS:
C
      REAL A,REAL,RECIP,S,T
      INTEGER I,ICOMST,IFOUND,IMAX,IP,ISL,J,K,NOP,NP,NS1,NSYM
      CHARACTER IBLANK*1,ICH*1,ICOMMA*1,IH*1,IK*1,IL*1,IMINUS*1,IPLUS*1,
     +          IPOINT*1,IS*1,ISLASH*1,ISTAR*1,IX*1,IY*1,IZ*1,JH*1,JK*1,
     +          JL*1,JS*1,JX*1,JY*1,JZ*1

      INTEGER NUM(10)
      CHARACTER INUM(10)*1

      DATA IS,IX,IY,IZ,IH,IK,IL,IPLUS,IMINUS,ISLASH,IPOINT,ICOMMA,ISTAR,
     +     IBLANK/'S','X','Y','Z','H','K','L','+','-','/','.',',','*',
     +     ' '/
      DATA JS,JX,JY,JZ,JH,JK,JL/'s','x','y','z','h','k','l'/
      DATA NUM/1,2,3,4,5,6,7,8,9,0/
      DATA INUM/'1','2','3','4','5','6','7','8','9','0'/
C
C-------------------------------------------------------------------------------
C
      IERR = 0
      ERRSTR = ' '
C
C====== Initialisations
C
      IMAX = 80
      IERR = 0
      NS1 = NS
      I = I1 - 1
      NS = NS - 1
C
C====== Interpret symmetry
C
30    CONTINUE
      NS = NS + 1
      REAL = 0.0
      RECIP = 0.0
      NOP = 1

      DO 50 J = 1,4
         DO 40 K = 1,4
            ROT(J,K,NS) = 0.0
40      CONTINUE
50    CONTINUE

      ROT(4,4,NS) = 1.0
60    CONTINUE
      S = 1.0
C
C====== Set J=4 for translation vector
C
      J = 4
      T = 0.0
      IP = 0
      NP = 0
      ISL = 0
      IFOUND = 0
      ICOMST = 0
70    CONTINUE
      I = I + 1
      IF (I.LE.IMAX) THEN
        ICH = ICOL(I:I)
        IF (ICH.EQ.IBLANK) THEN
          GO TO 70
        ELSE IF (ICH.NE.ICOMMA .AND. ICH.NE.ISTAR) THEN
          IFOUND = 1
          IF (ICH.EQ.IX .OR. ICH.EQ.JX .OR. ICH.EQ.IH .OR.
     +        ICH.EQ.JH) THEN
            IF (ICH.EQ.IX .OR. ICH.EQ.JX) REAL = REAL + 1.0
            IF (ICH.EQ.IH .OR. ICH.EQ.JH) RECIP = RECIP + 1.0
            J = 1
            IF (T.EQ.0.0) T = S
            GO TO 70
          ELSE IF (ICH.EQ.IY .OR. ICH.EQ.JY .OR. ICH.EQ.IK .OR.
     +             ICH.EQ.JK) THEN
            IF (ICH.EQ.IY .OR. ICH.EQ.JY) REAL = REAL + 1.0
            IF (ICH.EQ.IK .OR. ICH.EQ.JK) RECIP = RECIP + 1.0
            J = 2
            IF (T.EQ.0.0) T = S
            GO TO 70
          ELSE IF (ICH.EQ.IZ .OR. ICH.EQ.JZ .OR. ICH.EQ.IL .OR.
     +             ICH.EQ.JL) THEN
            IF (ICH.EQ.IZ .OR. ICH.EQ.JZ) REAL = REAL + 1.0
            IF (ICH.EQ.IL .OR. ICH.EQ.JL) RECIP = RECIP + 1.0
            J = 3
            IF (T.EQ.0.0) T = S
            GO TO 70
          ELSE IF (ICH.EQ.IPLUS) THEN
            S = 1.0
            IF (T.EQ.0.0 .AND. J.EQ.4) THEN
              GO TO 70
            ELSE
              GO TO 100
            END IF
          ELSE IF (ICH.EQ.IMINUS) THEN
            S = -1.0
            IF (T.EQ.0.0 .AND. J.EQ.4) THEN
              GO TO 70
            ELSE
              GO TO 100
            END IF
          ELSE IF (ICH.EQ.ISLASH) THEN
            ISL = 1
            GO TO 70
          ELSE IF (ICH.EQ.IPOINT) THEN
            IP = 1
            GO TO 70
          ELSE
            DO 80 K = 1,10
              IF (ICH.EQ.INUM(K)) GO TO 90
80          CONTINUE
            IERR = 1
            ERRSTR = 'Symmetry error - invalid character'
            RETURN
90          A = NUM(K)
            IF (ISL.EQ.1) THEN
              T = T/A
            ELSE IF (IP.EQ.1) THEN
              NP = NP + 1
              T = S*A/10**NP + T
            ELSE
              T = 10.0*T + A*S
            END IF
            GO TO 70
          END IF
        END IF
      END IF
      IF (T.EQ.0.0 .AND. J.EQ.4) THEN
        GO TO 110
      ELSE
        ICOMST = 1
      END IF
100   ROT(NOP,J,NS) = T
      J = 4
      T = 0.0
      IP = 0
      NP = 0
      ISL = 0

      IF (ICOMST.EQ.0) GO TO 70
      IF (IFOUND.EQ.0 .AND. I.LE.IMAX) THEN
         IERR = 1
         ERRSTR = 'Symmetry error - blank operator'
         RETURN
      END IF

      IF (I.LE.IMAX) THEN
        NOP = NOP + 1
        IF (NOP.LE.3) THEN
          GO TO 60
        ELSE
          GO TO 30
        END IF
      ELSE
        GO TO 120
      END IF
110   IERR = 1
      ERRSTR = 'Symmetry error - no operator'
      RETURN
120   IF (NOP.NE.1 .OR. IFOUND.NE.0) THEN
        IF (NOP.EQ.3 .AND. IFOUND.EQ.1) THEN
          GO TO 130
        ELSE
          IERR = 1
          ERRSTR = 'Symmetry error - incomplete operator'
          RETURN
        END IF
      END IF
      NS = NS - 1
130   NSYM = NS
      IF (REAL.LT.3.0 .AND. RECIP.LT.3.0) THEN
         IERR = 1
         ERRSTR = 'Symmetry error - incomplete definition'
         RETURN
      END IF
      IF (RECIP.GE.3.0) NSYM = - NSYM
      RETURN
      END
