PROGRAM CONVERT_INDEX !Version 2.0, March 1995 C************************************************************************ C* CONVERT_INDEX converts a binary NBRF-PIR index file into an * C* ASCII readable text file. The input file must be created by * C* one of the following programs: CREATEINS, GENINDX, EMBLINDX * C************************************************************************ C* * C* This is a limited-distribution, prototype version of * C* * C* the Experimental Query System (XQS) * C* * C* and associated software * C* * C* National Biomedical Research Foundation (NBRF) * C* Georgetown University Medical Center * C* 3900 Reservoir Road, N.W. * C* Washington, D.C. 20007 USA * C* Tel. (202) 687-2121 * C* * C* * C* We have made every effort to ensure proper functioning of the * C* programs and cannot be held responsible for the consequences * C* to users of any problems encountered during their operation. * C* * C* * C* Operating Environment: * C* Computer: Digital Equipment Corporation MicroVAX 3800 * C* System: VAX/VMS version 5.3 * C* Language: VAX-11 FORTRAN (a superset of ANSI FORTRAN-77) * C************************************************************************ C------------------------------------------------------------------------ PARAMETER (MAXCOD=20000,MAXLIN=80) IMPLICIT INTEGER (A-Z) CHARACTER INPUT*80,LINE*512,KEYWORD*500,ANS CHARACTER CODES(MAXCOD)*(12),DBASE*80,DFILE*80,EXT*10 LOGICAL FIRST/.TRUE./,OUT C ---Open input files--- 10 WRITE(6,'(A)') '$Index file to convert to ASCII: ' READ(5,'(A)') DBASE IF (DBASE.LE.' ') GOTO 10 WRITE(6,'(1X,A)') 'Output in file ASCII.ext where ext=index' WRITE(6,'(A)') '$Output to screen as well as file? [N]: ' READ(5,'(A)') ANS CALL STR$UPCASE(ANS,ANS) OUT=(ANS.EQ.'Y') IF (OPEN_BASE(DBASE,DFILE,EXT,LENCODE).NE.0) 1 STOP' Database files cannot be opened.' OPEN(1,FILE=DBASE,STATUS='OLD',READONLY,SHARED,IOSTAT=IOSTAT) IF (IOSTAT.NE.0) STOP ' Input index file cannot be opened.' C ---Open output file--- OPEN(9,FILE='ASCII.'//EXT,STATUS='NEW',CARRIAGECONTROL='LIST', 1 RECORDTYPE='FIXED',RECL=80,IOSTAT=IOSTAT) IF (IOSTAT.NE.0) STOP ' Output file cannot be opened.' C ---Read input index file--- KEYWORD=' ' NREC=0 NCODES=0 READ(1,'(Q,A)',END=120) LE,LINE 30 KEYWORD=LINE 40 READ(1,'(Q,A)',END=120) LE,LINE IF (LINE(1:1).NE.' ') THEN C ---Write out current--- CALL WRITE_OUTPUT(OUT,KEYWORD,CODES,NCODES,LENCODE,NREC,*990) NCODES=0 GO TO 30 END IF MB = 2 DO 50 WHILE (MB.LE.LE) NUM = 0 DO M = MB, LE IF (LINE(M:M).LT.'0' .OR. LINE(M:M).GT.'9') GO TO 45 NUM = (10*NUM)+(ICHAR(LINE(M:M))-ICHAR('0')) END DO 45 MB = M+1 NCODES=NCODES+1 CALL GET_CODE(NUM,CODES(NCODES)) 50 CONTINUE GO TO 40 120 CALL WRITE_OUTPUT(OUT,KEYWORD,CODES,NCODES,LENCODE,NREC,*990) WRITE(6,'(1X,A,I7)') 'Number records written',NREC WRITE(6,'(1X,A)') 'Program finished' STOP ' ' 990 STOP 'ERROR: Exceeded maximum number codes/keyword.' 991 STOP 'ERROR: Premature end of .TTL file.' END C*********************************************************************** SUBROUTINE WRITE_OUTPUT(OUT,KEYWORD,CODE,NKODES,LENCODE,NREC,*) PARAMETER (MAXLIN=80) CHARACTER KEYWORD*(*),CODE(*)*(*) LOGICAL OUT,CONT CONT=.FALSE. LC=LENCODE+2 NB=1 5 LK=LENGTH(KEYWORD) IF (LK.GT.MAXLIN-2) THEN CONT=.TRUE. IF (OUT) WRITE(6,'(1X,A)') KEYWORD(1:MAXLIN-2)//'##' WRITE(9,'(A)') KEYWORD(1:MAXLIN-2)//'##' NREC=NREC+1 KEYWORD='##'//KEYWORD(MAXLIN-1:) GOTO 5 END IF IF (OUT) WRITE(6,'(1X,A)') KEYWORD(1:LK) WRITE(9,'(A)') KEYWORD(1:LK) NREC=NREC+1 NUM=0 10 NB=NB+NUM NKODES=NKODES-NUM IF (NKODES.LE.0) RETURN NUM=MAXLIN/LC NUM=MIN(NUM,NKODES) ID=MOD(MAXLIN,LC) IF (ID.GT.0) THEN IF (OUT) WRITE(6,'(1X,X,(2X,A))') 1 (CODE(N),N=NB,NB+NUM-1) WRITE(9,'(X,(2X,A))') 1 (CODE(N),N=NB,NB+NUM-1) NREC=NREC+1 ELSE IF (OUT) WRITE(6,'(1X,(2X,A))') 1 (CODE(N),N=NB,NB+NUM-1) WRITE(9,'((2X,A))') 1 (CODE(N),N=NB,NB+NUM-1) NREC=NREC+1 END IF GOTO 10 END C************************************************************************* FUNCTION OPEN_BASE(DBASE,DFILE,EXT,LENCODE) IMPLICIT INTEGER (A-Z) CHARACTER DBASE*(*),CODE*(*),DFILE*(*),EXT*(*),LINE*512 EXTERNAL MRFA$OPEN INTEGER NUMLOC/-1/,LOCS(2,0:63),NUMSEQ OPEN_BASE=-1 IPER=LENGTH(DBASE) DO WHILE (DBASE(IPER:IPER).NE.'.'.AND.IPER.GT.0) IPER=IPER-1 END DO IF (IPER.LE.0) RETURN DFILE=DBASE(1:IPER-1) EXT=DBASE(IPER+1:) OPEN(70,FILE=DFILE//'.INX',STATUS='OLD',READONLY,SHARED, 1 IOSTAT=IOSTAT,ACCESS='DIRECT',ERR=10) OPEN(71,FILE=DFILE//'.REF',STATUS='OLD',READONLY,SHARED, 1 IOSTAT=IOSTAT,USEROPEN=MRFA$OPEN,ERR=10) READ(70,REC=1) NTYPE,NFORMAT,NENTRY,LENCODE,IPRIME,N1,N2,N3 10 OPEN_BASE=IOSTAT RETURN C----------------------------------------------------------------------- ENTRY GET_CODE(NUMSEQ,CODE) NREC=(NUMSEQ+63)/64 IF (NREC.NE.NUMLOC) THEN READ (70,REC=N2+NREC,ERR=30) LOCS NUMLOC=NREC END IF NS=MOD(NUMSEQ-1,64) LOCSEQ=LOCS(1,NS) LOCREF=LOCS(2,NS) CALL MRFA$FIND(71,LOCREF) READ (71,'(A)',ERR=30) LINE CODE=LINE(5:LENGTH(LINE)) RETURN 30 STOP'' END C*********************************************************************** FUNCTION MRFA$OPEN(FAB,RAB,LUNIT) IMPLICIT INTEGER (A-Z) C----------------------------------------------------------------------- C This module contains FORTRAN callable I/O utility routines that C manipulate the VAX-11 RMS Record Access Mode switches to perform C Random Access by Record's File Address from a FORTRAN program. C C Author: B.C. Orcutt (NBRF) Date: 14-Oct-1982 (FORTRAN version) C ----------------------------------------------------------- C The following parameters are obtained from the macros $FABDEF C and $RABDEF that define the symbols for these control blocks. C 1. FAB$L_FOP=4 bytes, FAB$V_SQO=6 bits. C Therefore the offset to the SQO bit in the FOP parameter C of the FAB is 8*FAB$L_FOP+FAB$V_SQO = 38 bits. C 2. RAB$W_RFA=16 bytes. C Therefore the offsets to the RFA block number longword and C the RFA byte offset word are 8*RAB$W_RFA = 128 bits and C 8*RAB$W_RFA+32 = 160 bits, respectively. C 3. RAB$B_RAC=30 bytes. C Therefore the offset to the record access mode parameter C is 8*RAB$B_RAC = 240 bits. C 4. RAB$C_RFA=2 and RAB$C_SEQ=0. C These are the record access mode parameters for RFA and C SEQuential access, respectively. C----------------------------------------------------------------------- C----------------------------------------------------------------------- C INTEGER FUNCTION MRFA$OPEN(FAB,RAB,LUNIT) C C FAB = File Access Block for the file (input). C RAB = Record Access Block for the file (input). C LUNIT = FORTRAN logical unit number (input). C MRFA$OPEN = RMS completion status code (output). C C MRFA$OPEN is for use with the USEROPEN keyword in the FORTRAN OPEN C statement. It clears the SQO bit in the FOP parameter of the FAB C for the file. This enables Random Access by Record's File Address. C Errors are handled by the FORTRAN OPEN routine. C C For example: C C EXTERNAL MRFA$OPEN C OPEN(LUNIT,FILE=file_spec,STATUS='OLD', C 1 READONLY,SHARED,USEROPEN=MRFA$OPEN) C----------------------------------------------------------------------- CALL LIB$INSV(0,38,1,FAB) !Clear SQO bit in FAB MRFA$OPEN=SYS$OPEN(FAB) !Open file, if successful IF (MRFA$OPEN) MRFA$OPEN=SYS$CONNECT(RAB) !connect to file RETURN C----------------------------------------------------------------------- C INTEGER FUNCTION MRFA$FIND(LUNIT,MRFA) C C LUNIT = FORTRAN logical unit number (input). C MRFA = Modified RFA (input). C MRFA$FIND = RMS completion status code (output). C C MRFA$FIND sets the next record in the file on unit LUNIT to the C record specified by the argument MRFA. Errors must be handled C by the calling routine. C----------------------------------------------------------------------- ENTRY MRFA$FIND(LUNIT,MRFA) RABADDR=FOR$RAB(LUNIT) !Get RAB address !Insert block number CALL LIB$INSV(LIB$EXTZV(9,23,MRFA),128,32,%VAL(RABADDR)) !Insert byte offset CALL LIB$INSV(LIB$EXTZV(0,9,MRFA),160,16,%VAL(RABADDR)) CALL LIB$INSV(2,240,8,%VAL(RABADDR)) !Set RFA mode MRFA$FIND=SYS$FIND(%VAL(RABADDR)) !Position file CALL LIB$INSV(0,240,8,%VAL(RABADDR)) !Reset SEQ mode RETURN C----------------------------------------------------------------------- C INTEGER FUNCTION MRFA$ADDR(LUNIT) C C LUNIT = FORTRAN logical unit number (input). C MRFA$ADDR = Modified RFA (output). C C MRFA$ADDR returns a modified RFA of the last record acted on by a C successful execution of a $GET, $PUT, or $FIND macro. The RFA C field in the RAB is a six byte field that indicates the location C of the first byte of the record. It has the following structure: C .LONG block number (range 1 to number of last block), C .WORD byte number (range 0 to 511). C MRFA$ADDR converts the RFA to a modified RFA, the MRFA, as folows: C MRFA = 512*block + byte. C Therefore, MRFA is the byte displacement from the beginning of the C file plus 512. The MRFA is returned as an integer (4 bytes). C----------------------------------------------------------------------- ENTRY MRFA$ADDR(LUNIT) RABADDR=FOR$RAB(LUNIT) MRFA$ADDR=ISHFT(LIB$EXTZV(128,32,%VAL(RABADDR)),9)+ 1 LIB$EXTZV(160,16,%VAL(RABADDR)) END C*********************************************************************** FUNCTION MOVZWL(WORD) INTEGER MOVZWL INTEGER*2 WORD MOVZWL=ZEXT(WORD) END C************************************************************************* INTEGER FUNCTION LENGTH(LINE) CHARACTER LINE*(*) DO 10 LENGTH=LEN(LINE),1,-1 IF (LINE(LENGTH:LENGTH).NE.' ') GOTO 15 10 CONTINUE LENGTH=0 15 END