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 <CYCLOPS> 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/' ,.:([{</|" '/
      DATA TAIL/' ,.?!;:)]}>/-=|" '/
      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
