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