C C *%%%%%* C *%%%%%%%%%%%* C *%%%%%/\|/\%%%%%* C *%%%%%%|--*--|%%%%%%* C Y C L O P S ...... STAR data name checker C *%%%%%\/|\/%%%%%* C *%%%%%%%%%%%* C *%%%%%* Mar 05 1993 C C C C CYCLOPS is a fortran program for checking STAR data names against a data C ------- name dictionary written in DDL-STAR format proposed by Tony Cook C of ORAC Ltd., Leeds. Data names may be checked in any text file. C C C The latest program source and information is available from: C C Em: syd@crystal.uwa.edu.au ,-_|\ Sydney R. Hall C sendcif@crystal.uwa.edu.au / \ Crystallography Centre C Fx: +61 9 380 1118 --> *_,-._/ University of Western Australia C Ph: +61 9 380 2725 v Nedlands 6009, AUSTRALIA C C C CYCLOPS reads the text containing data names from the standard input device C (normally* device 5). The STAR data name dictionary (in DDL format) is opened C as 'STARDICT'. Report on the data names is output to the file 'STARCHEK'. C Messages are output to the standard output device (normally device 6). C Note that the variable 'MAXTEX' should contain the maximum number of char- C acters contained on a single text line. The default value is 120. C C C .............................Installation notes............................. C C The data COMMON definitions for CYCLOPS are supplied as a separate sequence C of lines at the rear of this file. These must be removed with an editor C and named as 'cyclops.cmn' for insertion by the compiler via the 'include' C command (or your local equivalent). If your compiler does not support this C facility, use the editor to insert the COMMON lines in each subroutine C (and remove the 'include' line!). C C STAR dictionary STARDICT input on device 2 (opened in routine LOADDL) C Report on names STARCHEK output on device 4 (opened in routine REPORT) C Text checked [*STARTEXT]input on device 5 ('stdin') [*opened CHEKDN] C Message device output on device 6 ('stdout') C C * the need to open 'stdin' may apply to non-Unix machines (e.g. Vax/VMS) C C*************************************************************************** C C **** PROGRAM CYCLOPS C include 'cyclops.cmn' C VERS='(Mar 5 93)' WRITE(*,'(/34H STAR data name checker ,A)') VERS WRITE(*,'(1X,43(1H-),/)') C C v----------------------max chars input text file MAXTEX=120 CASE=ICHAR('a')-ICHAR('A') TAB=CHAR(05) IF(CASE.LT.0) GOTO 100 TAB=CHAR(09) C 100 CALL LOADDL CALL CHEKDN CALL REPORT C END C C*************************************************************************** C LOADDL gets and stores data names from STARDICT. GETNAM extracts the C data names following the '_name' signal and returns them in NAME. C*************************************************************************** C SUBROUTINE LOADDL include 'cyclops.cmn' INTEGER I,J C C-------------------------------------- open dictionary/ reset counts NDEV=2 IEOF=0 NCNT=0 FLAG=0 LINE=0 OPEN(2,FILE='STARDICT',STATUS='OLD',FORM='FORMATTED') MAXC=80 ICHR=MAXC STRI=' ' DICT=' ' NAME=' ' DO 10 I=1,1000 LNAM(I)=0 10 DNAM(I)=' ' C-------------------------------------- get dict name and check 20 CALL GETNAM IF(IEOF.NE.0) GOTO 100 C DO 40 I=1,NCNT IF(NAME.NE.DNAM(I)) GOTO 40 CALL ERR(1,'Duplicate data name in dictionary',NAME) 40 CONTINUE NCNT=NCNT+1 IF(NCNT.LE.1000) GOTO 50 CALL ERR(1,'Data name table exceeded. Current max is','1000') 50 DNAM(I)=NAME LNAM(I)=NCHR-2 DO 60 J=1,100 60 NPOS(NCNT,J)=0 GOTO 20 C 100 CLOSE(2) RETURN END C C*************************************************************************** C CHEKDN checks the input text file on the standard input file for data C names and checks them against the stored dictionary names in DNAM(). C If it is not present the data name is added to the end of DNAM(). The C line numbers are added to NPOS(). GETSTR supplies strings as the C variable 'stri' of length 'nchr'. NTYP=1 for a data name. C*************************************************************************** C SUBROUTINE CHEKDN include 'cyclops.cmn' INTEGER I,J,N C CHARACTER HEAD*12,TAIL*17,C*1 DATA HEAD/' ,.:([{/-=|" '/ CHARACTER*20 DICNAM(30) INTEGER NAMLEN(30) DATA DICNAM / * '_name ','_type ', * '_definition ','_list ', * '_list_identifier ','_list_link_name ', * '_enumeration ','_enumeration_range ', * '_enumeration_default','_enumeration_detail ', * '_esd ','_esd_default ', * '_example ','_example_detail ', * '_units ','_units_extension ', * '_units_description ','_units_conversion ', * '_compliance ','_update_history ', * '_pm ','_nm ', * '_c ','_sec ', * '_hr ','_cm ', * '_gpa ',' ', * ' ',' '/ DATA NAMLEN/5,5,11,5,16,15,12,18,20,19,4,12,8,15,6,16,18,17,11,15, * 3,3,2,4,3,3,4,0,0,0/ C HEAD(1:1)='''' HEAD(12:12)=TAB TAIL(1:1)='''' TAIL(17:17)=TAB NDEV=5 MCNT=NCNT+1 LINE=0 IEOF=0 C*vax OPEN(5,FILE='STARTEXT',STATUS='OLD',FORM='FORMATTED') MAXC=MAXTEX ICHR=MAXC STRI=' ' C 10 CALL GETSTR IF(IEOF.NE.0) GOTO 200 I=1 J=NCHR IF(NTYP.EQ.1) GOTO 20 IF(NTYP.NE.4) GOTO 10 C -------------------------------------- look for data name in string DO 15 I=1,NCHR IF(STRI(I:I).EQ.'_') GOTO 20 15 CONTINUE GOTO 10 C 20 IF(I.EQ.1) GOTO 22 IF(INDEX(HEAD,STRI(I-1:I-1)).EQ.0) GOTO 10 22 DO 25 J=NCHR,I,-1 IF(INDEX(TAIL,STRI(J:J)).EQ.0) GOTO 30 25 CONTINUE 30 NCHR=J-I+1 C -------------------------------------- identify mode of search 35 IF(NCHR.LT.2) GOTO 10 IF(NCHR.GT.32)CALL ERR(0,'Data name in text is > 32 chars', * STRI(I:J)) NAME=STRI(I:J) DO 37 N=1,NCHR C=NAME(N:N) IF(C.GE.'A'.AND.C.LE.'Z') NAME(N:N)=CHAR(ICHAR(C)+CASE) 37 CONTINUE IF(STRI(J:J).EQ.'_') GOTO 50 IF(I.EQ.1) GOTO 40 IF(STRI(I-1:I-1).EQ.'*') GOTO 60 C --------------------------------------- search for full data name 40 DO 45 I=1,NCNT IF(NAME.EQ.DNAM(I)) GOTO 170 45 CONTINUE GOTO 100 C ---------------------------------------- search for group data name 50 DO 55 I=1,NCNT IF(NAME(1:NCHR).EQ.DNAM(I)(1:NCHR)) GOTO 170 55 CONTINUE GOTO 100 C ---------------------------------------- search for end-part data name 60 DO 65 I=1,NCNT N=LNAM(I) IF(NCHR.GT.N) GOTO 65 IF(NAME(1:NCHR).EQ.DNAM(I)(N-NCHR+1:N)) GOTO 170 65 CONTINUE C ---------------------------------------- new data name add to list 100 DO 120 I=1,30 IF(NAMLEN(I).NE.NCHR) GOTO 120 IF(DICNAM(I).EQ.NAME(1:20)) GOTO 10 120 CONTINUE NCNT=NCNT+1 IF(NCNT.LE.1000) GOTO 150 CALL ERR(1,'Data name table exceeded. Current max is','1000') 150 DNAM(NCNT)=NAME LNAM(NCNT)=NCHR DO 160 J=1,100 160 NPOS(NCNT,J)=0 I=NCNT C --------------------------------------- add line numbers to npos() 170 IF(NPOS(I,1).EQ.99) GOTO 10 NPOS(I,1)=NPOS(I,1)+1 N=NPOS(I,1) IF(N.NE.99) GOTO 180 WRITE(*,'(A,A)') 'Warning: Line table truncated for ',NAME 180 NPOS(I,N+1)=LINE GO TO 10 C 200 RETURN END C C*************************************************************************** C REPORT prints a summary of the line occurrences for each data name C in the dictionary and the text file itself (if it does not appear C in the dictionary). This summary is output as the file STARCHEK. C*************************************************************************** C SUBROUTINE REPORT include 'cyclops.cmn' INTEGER I,J,N C OPEN(4,FILE='STARCHEK',STATUS='NEW',FORM='FORMATTED') WRITE(4,'(//,20X,18HCYCLOPS Check List,/,20x,18(1H-),//)') WRITE(4,'(15X,25H Dictionary data names =,I5)') MCNT-1 WRITE(4,'(15X,25H New data names in text =,I5)') NCNT-MCNT+1 WRITE(4,'(//,1X,A,05X,12HLine Numbers,/)') DICT WRITE(*,'(/25H Dictionary data names =,I5)') MCNT-1 WRITE(*,'(25H New data names in text =,I5)') NCNT-MCNT+1 C DO 50 I=1,NCNT IF(I.NE.MCNT) GOTO 20 WRITE(4,'(//1X,28HData names NOT in Dictionary,10X, * 12HLine Numbers,/)') 20 N=NPOS(I,1) WRITE(4,'(1X,A,2X,9I5,/,(35X,9I5))') DNAM(I),(NPOS(I,J+1),J=1,N) 50 CONTINUE C CLOSE(4) RETURN END C C*************************************************************************** C GETNAM extracts the data names following the '_name' signal. C GETSTR supplies strings as the variable 'stri' of length 'nchr'. C NTYP=1 for a data name; =4 for char data. C*************************************************************************** C SUBROUTINE GETNAM include 'cyclops.cmn' INTEGER I CHARACTER C*1 C 10 CALL GETSTR IF(IEOF.NE.0) GOTO 100 IF(NTYP.NE.1) GOTO 40 IF(NCHR.GT.32)CALL ERR(0,'Dictionary data name > 32 chars', * STRI(1:NCHR)) IF(STRI(1:NCHR).NE.'_name') GOTO 20 FLAG=1 GOTO 10 20 IF(STRI(1:NCHR).NE.'_compliance') GOTO 30 FLAG=2 GOTO 10 30 FLAG=0 GOTO 10 C 40 IF(FLAG.EQ.0) GOTO 10 IF(FLAG.EQ.1) GOTO 60 DICT=STRI(2:NCHR-1) FLAG=0 GOTO 10 60 IF(STRI(2:2).NE.'_')CALL ERR(1,'Data name must start with _', * STRI(2:NCHR-1)) IF(NCHR.GT.34)CALL ERR(0,'Dictionary data name > 32 chars', * STRI(2:NCHR-1)) NAME=STRI(2:NCHR-1) DO 80 I=1,NCHR-2 C=NAME(I:I) IF(C.GE.'A'.AND.C.LE.'Z') NAME(I:I)=CHAR(ICHAR(C)+CASE) 80 CONTINUE C 100 RETURN END C C*************************************************************************** C GETSTR extract a string of characters delimited by blanks, tabs, quotes. C NTYP=1 data name; =3 number data; =4 character data; =5 text data. C*************************************************************************** SUBROUTINE GETSTR include 'cyclops.cmn' C INTEGER I CHARACTER C*1,NUM*13 DATA NUM/'0123456789+-.'/ C C---------------------------------- loop over data items in each line 10 ICHR=ICHR+1 IF(ICHR.LE.MAXC) GOTO 30 C---------------------------------- get a new line from device ndev 20 READ(NDEV,'(A)',END=95) IBUF(1:MAXC) LINE=LINE+1 ICHR=1 NTYP=0 C---------------------------------- test for text data IF(IBUF(1:1).NE.';') GOTO 30 IF(NDEV.NE.2) GOTO 10 25 READ(NDEV,'(A)',END=95) IBUF(1:MAXC) LINE=LINE+1 IF(IBUF(1:1).NE.';') GOTO 25 GOTO 10 C---------------------------------- test for delimiter character 30 C=IBUF(ICHR:ICHR) IF(C.EQ.' ') GOTO 10 IF(C.EQ.TAB) GOTO 10 IF(C.EQ.'#') GOTO 20 IF(C.EQ.'''') GOTO 60 IF(C.EQ.'"') GOTO 60 C---------------------------------- test for data name IF(C.NE.'_') GOTO 40 NTYP=1 GOTO 45 C---------------------------------- test for number or character data 40 NTYP=3 IF(INDEX(NUM,C).EQ.0) NTYP=4 C---------------------------------- get blank-limited char string 45 DO 50 I=ICHR,MAXC IF(IBUF(I:I).EQ.' ') GOTO 90 IF(IBUF(I:I).EQ.TAB) GOTO 90 50 CONTINUE I=MAXC+1 GOTO 90 C---------------------------------- get quote-limited char string 60 NTYP=4 DO 70 I=ICHR+1,MAXC IF(IBUF(I:I).EQ.C) GOTO 80 70 CONTINUE IF(NDEV.EQ.5) GOTO 10 CALL ERR(0,'Quoted string in dictionary not closed', * IBUF(ICHR:MAXC)) I=MAXC IBUF(I:I)=C 80 I=I+1 C---------------------------------- count & store string 90 NCHR=I-ICHR ICHR=I-1 STRI(1:NCHR)=IBUF(I-NCHR:ICHR) GOTO 100 95 IEOF=1 100 RETURN END C C*************************************************************************** C Error message generator. Output to device 6 and stop. C*************************************************************************** SUBROUTINE ERR(I,MESS,STRG) include 'cyclops.cmn' INTEGER I C CHARACTER*(*) MESS,STRG C WRITE(*,'(11H Error >>> ,A,2X,A)') MESS,STRG IF(I.EQ.0) RETURN C IF(NDEV.NE.2) GOTO 20 WRITE(*,'(11X,31HFatal error -- Dictionary line ,I5/)') LINE CLOSE(2) GOTO 50 C 20 WRITE(*,'(11X,30HFatal error -- Text file line ,I5/)') LINE CLOSE(4) 50 STOP END C C -------------------------------------------------------------------------- C C Common file for CYCLOPS C CHARACTER*120IBUF CHARACTER*80 STRI CHARACTER*32 VERS CHARACTER*32 NAME CHARACTER*32 DICT CHARACTER*1 TAB CHARACTER*32 DNAM(1000) INTEGER LNAM(1000) INTEGER NPOS(1000,100) C C signals end of file on dict & text file INTEGER IEOF C current column pointer for GETSTR INTEGER ICHR C input device number (2 or 5) INTEGER NDEV C input string type from GETSTR INTEGER NTYP C number of characters in string INTEGER NCHR C number of lines input on archive file INTEGER LINE C signals when '_name' found in dictionary INTEGER FLAG C count of data names encountered INTEGER NCNT C count of data names in dictionary INTEGER MCNT C current max chars on GETSTR input file INTEGER MAXC C shift number from upper to lower casee INTEGER CASE C max chars expected on input text file INTEGER MAXTEX C COMMON/CYCLI/ NPOS,IEOF,ICHR,NDEV,NTYP,NCHR,LINE,FLAG,NCNT,MCNT, * MAXC,MAXTEX,LNAM,CASE C COMMON/CYCLC/ IBUF,STRI,VERS,DICT,DNAM,NAME,TAB C C-end-of-cyclops-end-of-cyclops-end-of-cyclops-end-of-cyclops-end-of-cyclops-end This simple script file 'cyclops' might be useful to execute CYCLOPS on Unix machines. #! /bin/sh DICT=/usr1/syd/cif EXT=cifdic.C91 if [ $# -eq 2 ]; then EXT=$2 fi DICT=$DICT/$EXT rm STARCHEK cp $DICT STARDICT cyclops.x < $1 rm STARDICT vi STARCHEK As a first test, after compiling and linking cyclops.f to create cyclops.x, use the above script to check 'cifdic.C91' itself. Enter: cyclops cifdic.C91 Note that the two "extra" data names detected in the dictionary arose from and appendix and an example. Use the listed line numbers to check this in the dictionary file. If you have a CIF that you wish to validate against the IUCr core dictionary, enter: cyclops If you have a CIF that you wish to validate against another dictionary (say, cifdic.P92), enter: cyclops cifdic.P92