CD-Title: KEYWORD SYMMETRY MODULE (KSM) ROUTINES
CD-end

CD-Intro:
C The Keyword Kymmetry Module (KSM) routines are a set of routines to handle
C the interpretation and storage of symmetry data. The symmetry data are
C interpreted from data lines introduced by the 'SYMMETRY' keyword. They
C may be used in conjuction with one or more sets of Keyword Data Module
C (KDM) routines. A set of higher level routines is also available for
C to handle the reading and writing of such data. The code is closely
C based on that used in the CCP4 symmetry handling routines. However, in
C contrast to these, no messages are written by the routines themselves but
C all error conditions etc. are flagged for the calling program to report them
C in a manner it chooses.
CD-end

CD-Section_order:
C 1 3 5 2 4 6 7 8
CD-end

CD-Section: Set 'KSM' Symmetry Data
C These routines handle the interpretation and storage of symmetry data.
CD-end

C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     KSM_SET_SYMM       **
C****************************
C
C
CD-Routine: Set symmetry - KSM_SET_SYMM
C The routine KSM_SET_SYMM is used to set symmetry data in the Keyword
C Symmetry Module.
CD-end
CD-Fortran:
      SUBROUTINE KSM_SET_SYMM (VALSTR, IERR, ERRSTR)
CD-end:
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set value of SYMMETRY 
C
C Author:  John W. Campbell, July 1995 (from LDM ldm_set_symm)
C
C Arguments:
C
      CHARACTER*(*) VALSTR
      INTEGER IERR
      CHARACTER*(*) ERRSTR

CD-Parameters:
C  VALSTR    c  (R)   String. This may be one of the following:
C                     CLEAR           Clears the current symmetry data
C                     nspg            Space group code number
C                     op1, op2, ...   Add the symmetry operations given
C                                     to the current list of stored
C                                     symmetry operators.
C                     Note: The space group code and symmetry operation
C                           definitions are those used in the CCP4 program
C                           suite.
C  IERR      i  (W)   Error flag =0 OK
C                                =1 Invalid code or syntax error in string
C  ERRSTR    c  (W)   Error description string if error found
CD-end
C
C====== GLOBALS:
C
      INCLUDE 'ksm_data.finc'
      EXTERNAL KSM_BDAT
      INTEGER MAXR,MAXB,ISLOW,INTER,IFAST,KLASS,ICENTR,ISCREW,IVERSN
      REAL    CELL
      COMMON /MDFPAR/MAXR,MAXB,CELL(6),ISLOW,INTER,IFAST,KLASS,ICENTR,
     +     ISCREW(3),IVERSN
      SAVE /MDFPAR/
C
C====== FUNCTION TYPES:
C
      INTEGER KSM_INTFP
      INTEGER NXTTOK
C
C====== LOCALS:
C
      CHARACTER*120 STR
      INTEGER IL
      INTEGER I
      INTEGER J
      INTEGER K
      INTEGER M1
      INTEGER M2
      INTEGER M3
      INTEGER M4
      INTEGER IV
      INTEGER ND
      INTEGER NSYM_SAV
      INTEGER ILATT
      INTEGER LATT(7)
      REAL    FP

C     CHARACTER*120 STR      !String holdin operator (upper cased)
C     INTEGER IL             !Last character accessed in string
C     INTEGER I              !Temp/loop variable
C     INTEGER J              !Temp/loop variable
C     INTEGER K              !Temp/loop variable
C     INTEGER M1             !Start character of token
C     INTEGER M2             !End character of token
C     INTEGER M3             !Start character of token
C     INTEGER M4             !End character of token
C     INTEGER IV             !Integer value decoded
C     INTEGER ND             !No. of decimal placeds
C     INTEGER NSYM_SAV       !Save value of NSYM (No. of symmetry operators)
C     INTEGER ILATT          !Lattice type flag
C     INTEGER LATT(7)        !Conversions from ICENTR to ILATT
C     REAL    FP             !Real value decoded
C
      DATA LATT/1,2,3,4,6,5,7/
C
C-------------------------------------------------------------------------------
C
      IERR = 0
      ERRSTR = ' '
C
C====== Set mask if not already set
C
      IF (SYMM_CH_MASK.EQ.0) THEN
         DO 5 I = 0, 15
            CALL STBITS (SYMM_CH_MASK,I,1,1)
 5       CONTINUE
      END IF
C
C====== Look at next field on line: this can be
C       (a) a space-group number
C       (b) a space-group name, ie a string beginning P,I,R,F,A,B or C
C       (c) a symmetry operation (anything else)
C     
C       for cases (a) & (b), this is a single field:
C       case (c) is more than 1 field
C
      IL = 0
      I = NXTTOK (VALSTR,' ,',IL,M1,M2)
      IF (I.LE.0) THEN
         IERR = 1
         ERRSTR = 'No symmetry data given'
         RETURN
      END IF
      I = NXTTOK (VALSTR,' ,',IL,M3,M4)
      IF (I.EQ.-1) THEN
C
C====== Single token was given; see if number or name
C
         IF (KSM_INTFP(VALSTR(M1:M2),FP,IV,ND).EQ.1) THEN
            NSPGRP = IV
            SPGNAM = ' '
         ELSE
            SPGNAM = VALSTR (M1:M2)
            CALL CCPUPC (SPGNAM)
            NSPGRP = 0
         END IF
         CALL KSM_READ_SYMM (15,NSPGRP,SPGNAM,PGNAM,SYSTYP,NSYMP,
     +                       NSYM,ROTSYM,IERR,ERRSTR)
         IF (IERR.NE.0) THEN
            SPGNAM = ' '
            PGNAM = ' '
            SYSTYP = ' '
            NSPGRP = 0
            NSYMP = 0
            NSYM = 0
            DO 30 K = 1, 192
               DO 20 J = 1, 4
                  DO 10 I = 1,4
                     ROTSYM(I,J,K) = 0.0
10                CONTINUE
20             CONTINUE
30          CONTINUE
            IS_SYMM = 0
            CH_SYMM = SYMM_CH_MASK
            RETURN
         END IF
      ELSE
C
C====== More than one field; interpret as symmetry operator
C
         NSYM_SAV = NSYM
         NSYM = NSYM + 1
         NSYMP = NSYM
         STR = VALSTR
         CALL CCPUPC (STR)
         CALL KSM_SYMFR2 (STR, 1, NSYM, ROTSYM, IERR, ERRSTR)
         IF (IERR.NE.0) THEN
            NSYM = NSYM_SAV
            RETURN
         END IF
         NSPGRP = 0
         SPGNAM = ' '
         PGNAM = ' '
         SYSTYP = ' '
      END IF
      IS_SYMM = 1
      CH_SYMM = SYMM_CH_MASK
C
C====== Get derived parameters; inverted symmetry matrices
C   
      ISYS = 0
      KSYS(1) = 0
      KSYS(2) = 0
      KSYS(3) = 0
      IF (NSYM.GT.0) THEN
         CALL PGDEFN (PGNAM, NSYMP, NSYM, ROTSYM, 0)
         DO 100 I = 1, NSYM
            CALL INVSYM(ROTSYM(1,1,I),RSMINV(1,1,I))
100      CONTINUE
         ILATT = LATT(ICENTR+1)
         ISYS = 0
         KSYS(1) = 0
         KSYS(2) = 0
         KSYS(3) = 0
         IF (ILATT.EQ.1) THEN
            ISYS = 0
         ELSE IF (ILATT.EQ.2) THEN
            ISYS = 2
            KSYS(2) = 1
            KSYS(3) = 1
         ELSE IF (ILATT.EQ.3) THEN
            ISYS = 2
            KSYS(1) = 1
            KSYS(3) = 1
         ELSE IF (ILATT.EQ.4) THEN
            ISYS = 2
            KSYS(1) = 1
            KSYS(2) = 1
         ELSE IF (ILATT.EQ.5) THEN
            ISYS = 2
            KSYS(1) = 1
            KSYS(2) = 1
            KSYS(3) = 1
         ELSE IF (ILATT.EQ.6) THEN
            ISYS = 4
         ELSE IF (ILATT.EQ.7) THEN
            ISYS = 3
            KSYS(1) = -1
            KSYS(2) = 1
            KSYS(3) = 1
         END IF
      END IF
      RETURN
      END
