C LAST UPDATE: C+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ C C**************************** C** KSM_READ_SYMM ** C**************************** C C SUBROUTINE KSM_READ_SYMM (IST, LSPGRP, NAMSPG, NAMPG, SYSTYP, + NSYMP, NSYM, ROTSYM, IERR, ERRSTR) C INCLUDE 'implicit_none.finc' C C Purpose: Read symmetry from CCP4's SYMOP file C C ***** 'KSM' SERVICE ROUTINE ONLY ***** C C Author: John W. Campbell, July 1995 (Based on CCP4'S MSYMLB) C C C Get symmetry operations for spacegroup LSPGRP from library file C on stream IST, logical name SYMOP. C C In the library file, the header for each entry is C C LSPGRP NLINS NLINP NAMSPG NAMPG C C where LSPGRP spacegroup number C NLINS total number of lines of symmetry operators. C NLINP number of LINES of primitive symmetry operators C NAMSPG spacegroup name C NAMPG name of corresponding pointgroup C SYSTYP system type name C C Arguments: C INTEGER IST INTEGER LSPGRP CHARACTER*(*) NAMSPG CHARACTER*(*) NAMPG CHARACTER*(*) SYSTYP INTEGER NSYMP INTEGER NSYM REAL ROTSYM(4,4,*) INTEGER IERR CHARACTER*(*) ERRSTR C IST (R) Stream number for reading SYMOP file C LSPGRP (R/W) Requested space group number (may be 0 if NAMSPG given) C NAMSPG (R/W) Requested space group name (may be ' ' if LSPGRP>0) C NAMPG (W) Returns point group name from SYMOP file C SYSTYP (W) Name of the crystal system from the SYMOP file C NSYMP (W) Number of primitive symmetry operators C NSYM (W) Total number of symmetry operators C ROTSYM( ) (W) NSYM symmetry matrices 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 INTEGER NXTTOK INTEGER LENSTR INTEGER KSM_INTFP C C====== LOCALS: C CHARACTER*120 LINE INTEGER I INTEGER IFAIL INTEGER NLIN INTEGER NLINS INTEGER ISG INTEGER IL INTEGER M1 INTEGER M2 INTEGER ND REAL FP C C------------------------------------------------------------------------------- C IERR = 0 ERRSTR = ' ' C C====== Open symmetry file C IFAIL = 1 CALL CCPDPN(-IST,'SYMOP','READONLY','F',0,IFAIL) IF (IFAIL.LT.0) THEN IERR = 1 ERRSTR = 'Error opening symmetry operators file (SYMOP)' RETURN END IF REWIND IST NSYM = 0 C C====== Find correct space-group in file. C Each space-group has header line of space-group number, C number of line of symmetry operations for non-primitive C and primitive cells. C 10 READ (IST,FMT='(A)',END=800) LINE C C====== Ignore blank or comment lines C IF (LENSTR(LINE) .EQ. 0 .OR. LINE(1:1) .EQ. '!') GO TO 10 CALL CCPUPC(LINE) C C====== Fields are space group number, C number of lines, C number of lines in primitive cell symmetry, C spacegroup name C pointgroup name C crystal system type C IL = 0 I = NXTTOK (LINE, ' ,',IL,M1,M2) IF (I.LE.0) GO TO 810 IF(KSM_INTFP (LINE(M1:M2),FP,ISG,ND).NE.1) GO TO 810 I = NXTTOK (LINE, ' ,',IL,M1,M2) IF (I.LE.0) GO TO 810 IF(KSM_INTFP (LINE(M1:M2),FP,NLIN,ND).NE.1) GO TO 810 I = NXTTOK (LINE, ' ,',IL,M1,M2) IF (I.LE.0) GO TO 810 IF(KSM_INTFP (LINE(M1:M2),FP,NLINS,ND).NE.1) GO TO 810 I = NXTTOK (LINE, ' ,',IL,M1,M2) IF (I.LE.0) GO TO 810 IF (LSPGRP.GT.0) THEN C C====== Check for spacegroup number given C IF (LSPGRP.EQ.ISG) GO TO 40 C C====== Check for spacegroup name given C ELSE IF (NAMSPG.EQ.LINE(M1:M2)) THEN GO TO 40 END IF C C====== Not this one, skip NLIN lines C DO 20 I = 1,NLIN READ (IST,FMT=*) 20 CONTINUE GO TO 10 C C====== Space-group found, convert NLIN lines of C symmetry operators to matrices C 40 LSPGRP = ISG NAMSPG = LINE(M1:M2) NAMPG = ' ' I = NXTTOK (LINE,' ,',IL,M1,M2) IF (I.GT.0) NAMPG = LINE(M1:M2) I = NXTTOK (LINE,' ,',IL,M1,M2) IF (I.GT.0) SYSTYP = LINE(M1:M2) DO 50 I = 1,NLINS READ (IST,FMT='(A)') LINE C C====== Convert line to matrices C NSYM = NSYM + 1 CALL KSM_SYMFR2(LINE,1,NSYM,ROTSYM,IERR,ERRSTR) IF (IERR.NE.0) RETURN 50 CONTINUE NSYMP = NSYM IF (NLIN.GT.NLINS) THEN DO 60 I = NLINS + 1, NLIN READ (IST,FMT='(A)') LINE NSYM = NSYM + 1 CALL KSM_SYMFR2(LINE,1,NSYM,ROTSYM,IERR,ERRSTR) IF (IERR.NE.0) RETURN 60 CONTINUE END IF CLOSE (IST) RETURN C C====== Error conditions C 800 IERR = 1 ERRSTR = 'No symmetry in SYMOP file for requested space group' RETURN 810 IERR = 1 ERRSTR = 'Error in format of SYMOP file' RETURN END