	PROGRAM    CREATE_TTL               ! Version 1.0, September 1990
C************************************************************************
C*      This program creates a .TTL file from the .REF file             *
C*      of an NBRF formatted database.                                  *
C*	The programs access command line input is as follows            *
C*                                                                      *
C*          CREATETTL 'database_name'/LENCODE                           *
C*                                                                      *
C*          default 'database_name' = PR$PIR1:                          *
C*          LENCODE may equal 6, 8, 10; default = 6                     *
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------------------------------------------------------------------------
	CHARACTER   DATA_BASE*80,LINE*500,LINE_2*500
	CHARACTER   KODE*10,CMD*132,LCODE*2

C    ---Get input parameters---
	DATA_BASE='PR$DATA_BASE:'
	LENCODE=6
	CALL LIB$GET_FOREIGN(CMD)
	IF (CMD.GT.' ') THEN
          LE=LENGTH(CMD)
	  LCODE=' '
	  M=INDEX(CMD,'/')
	  IF (M.GT.0) THEN
            LE=M-1
	    LCODE=CMD(M+1:M+2)
	    END IF
	  IF (LE.GT.0) DATA_BASE=CMD(1:LE)
	ELSE
	  WRITE (6,'(A)') '$Database: '
	  READ (5,'(A)') DATA_BASE
	  CALL STR$UPCASE(DATA_BASE,DATA_BASE)
          WRITE (6,'(A)') '$Code Length (6, 8, or 10) [6]: '
	  READ (5,'(A)') LCODE
	  END IF

C    ---Set code length---
	IF (LCODE(1:1).EQ.'6') THEN
	  LENCODE=6
	ELSE IF (LCODE(1:1).EQ.'8') THEN
          LENCODE=8
	ELSE IF (LCODE(1:2).EQ.'10') THEN
          LENCODE=10
	ELSE
	  LENCODE=6
	  WRITE (6,'(1X,A)') 'A code length of 6 will be assumed'
	  END IF


C    ---Open reference file (.REF) and create title file (.TTL)---
	OPEN (1,FILE=DATA_BASE//'.REF',STATUS='OLD',READONLY,SHARED,
	1     ERR=999)
	OPEN (2,FILE=DATA_BASE//'.TTL',STATUS='NEW',
	1     CARRIAGECONTROL='LIST',RECL=500,ERR=999)

	NENTRY=0
C    ---Read header line---
10	READ (1,'(Q,A)',END=90) LE,LINE
15	IF (LINE(1:1).NE.'>') GO TO 10
	NENTRY=NENTRY+1
	KODE=LINE(5:5+LENCODE-1)
C    ---Read Title line---
	READ (1,'(Q,A)',END=990) LE,LINE
	LINE_2=KODE(1:LENCODE)//LINE(1:LE)
	L2=LE+LENCODE
	KODE=' '
C    ---Search for N-lines---
20	READ (1,'(Q,A)',END=990) LE,LINE
	IF (LINE(1:2).EQ.'N;') THEN
C       --Write continuation line--
	  WRITE (2,'(2A)') LINE_2(1:L2),'-'
	  LINE_2=KODE(1:LENCODE)//LINE(3:LE)
	  L2=LE+LENCODE
	  GO TO 20
	  END IF
C    ---Write title of last N; line---
	L2=MIN(L2,500)
	WRITE (2,'(A)') LINE_2(1:L2)
	GO TO 15

90	WRITE (6,'(1X,A,I6)') 'Number of entries processed: ',NENTRY 
	STOP ' '

990	CLOSE (2,DISP='DELETE')
	STOP ' <Abort> abnormal end-of-file'
999	STOP ' <Abort> Database file open error'
	END

C**********************************************************************
	INTEGER FUNCTION LENGTH(LINE)
	CHARACTER  LINE*(*)
C
C  Purpose:
C     LENGTH locates the last non-blank character in the character
C     string represented in LINE.
C
C  Input:
C     LINE    a character string
C
C  Output:
C     LENGTH  the character position of the rightmost non-blank
C             character of the string in LINE. If LINE is blank,
C             then LENGTH is 0.
C
C  Notes:
C     The ASCII control characters are treated as blanks. Therefore,
C     the test in the loop is CHAR > ' ' instead of CHAR .ne. ' '.
C=======================================================================

	DO 10 LENGTH=LEN(LINE),1,-1
10	  IF (LINE(LENGTH:LENGTH).GT.' ') RETURN
	LENGTH=0
	END

