	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,<ID>X,<NUM>(2X,A<LENCODE>))')
	1               (CODE(N),N=NB,NB+NUM-1)
	  WRITE(9,'(<ID>X,<NUM>(2X,A<LENCODE>))')
	1      (CODE(N),N=NB,NB+NUM-1)
	  NREC=NREC+1
	ELSE
	  IF (OUT) WRITE(6,'(1X,<NUM>(2X,A<LENCODE>))')
	1               (CODE(N),N=NB,NB+NUM-1)
	  WRITE(9,'(<NUM>(2X,A<LENCODE>))')
	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'<ABORT, Error reading .INX or .REF file>'
	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
