C LAST UPDATE: 
C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
C
C****************************
C**     LDM_SET_SYMM       **
C****************************
C
C
CD-Doc:
C SYMMetry         SUBROUTINE LDM_SET_SYMM (VALSTR, IERR, ERRSTR)
CD-end
      SUBROUTINE LDM_SET_SYMM (VALSTR, IERR, ERRSTR)
C
      INCLUDE 'implicit_none.finc'
C
C Purpose: Set value of SYMMETRY 
C
C Author:  John W. Campbell, June 1993
C
C Arguments:
C
      CHARACTER*(*) VALSTR
      INTEGER IERR
      CHARACTER*(*) ERRSTR

C  VALSTR    (R)   String 
C  IERR      (W)   Error flag =0 OK
C                             =1 Invalid code or syntax error in string
C  ERRSTR    (W)   Error description string if error found
C
C====== GLOBALS:
C
      INCLUDE 'ldm_data.finc'
      INCLUDE 'ldm_derived.finc'
      EXTERNAL LDM_BDAT
C
C====== FUNCTION TYPES:
C
      INTEGER LDM_INTFP
      INTEGER NXTTOK
C
C====== LOCALS:
C
      CHARACTER*1 DUMSTR
      CHARACTER*120 STR
      INTEGER KERR
      INTEGER IL
      INTEGER I
      INTEGER M1
      INTEGER M2
      INTEGER M3
      INTEGER M4
      INTEGER IV
      INTEGER ND
      INTEGER NSYM_SAV
      REAL    FP

C     CHARACTER*1 DUMSTR     !Dummy for error string return from LDM_RESET
C     CHARACTER*120 STR      !String holdin operator (upper cased)
C     INTEGER KERR           !Dummy for error flag return from LDM_RESET
C     INTEGER IL             !Last character accessed in string
C     INTEGER I              !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     REAL    FP             !Real value decoded
C
C-------------------------------------------------------------------------------
C
      IERR = 0
      ERRSTR = ' '
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 (LDM_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 LDM_READ_SYMM (15,NSPGRP,SPGNAM,PGNAM,NSYMP,NSYM,ROTSYM,
     +                        IERR, ERRSTR)
         IF (IERR.NE.0) THEN
            CALL LDM_RESET ('SYMMETRY', 0, 0, KERR, DUMSTR)
            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 LDM_SYMFR2 (STR, 1, NSYM, ROTSYM, IERR, ERRSTR)
         IF (IERR.NE.0) THEN
            NSYM = NSYM_SAV
            RETURN
         END IF
         NSPGRP = 0
         SPGNAM = ' '
         PGNAM = ' '
      END IF
      IS_SYMM = 1
      CH_SYMM = CH_MASK
      CALL LDM_CLR_GEN (-1, -1, 2)
C
C====== Get derived parameters; inverted symmetry matrices
C   
      IF (NSYM.GT.0) THEN
         DO 100 I = 1, NSYM
            CALL INVSYM(ROTSYM(1,1,I),RSMINV(1,1,I))
100      CONTINUE
         CALL PGDEFN (PGNAM, NSYMP, NSYM, ROTSYM, 0)
      END IF
      RETURN
      END
