C*************************************************************************
      SUBROUTINE TBLREAD(STATUS)
	integer STATUS
C*************************************************************************
C	Reads in a table of hits and misses
C
C Command format:
C	READ 
C	READ file.name[/OR]
C	READ file.name[/AND]
C	READ file.name[/REPLACE]
C	READ/SUBPDF=subpdf_name
C	READ/LIST=file_name
C	READ/RANGE=(start,end)
C*************************************************************************
	include 'LOGIC.common'
        include '[-.shared]TBL.cmn'

	INTEGER   ilog,iopt,LN,LENCH
	INTEGER*2 IREC
	INTEGER CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,GET_LOGICAL,DEF_LOGICAL,GET_FNUMBER
	EXTERNAL CLI$_PRESENT,CLI$_DEFAULTED,CLI$_ABSENT,CLI$_NEGATED
	CHARACTER*60 filename,label
	CHARACTER*1 ians
	integer*4 NCARDS,NWORDS,cardno,card1,card2
	integer*4 ISEQ,ISEQ1,ISEQ2

	INTEGER tCLEN(100),tcnum,tcount
	CHARACTER*100 tCONTEXT(100)

	LOGICAL FLAG, userfl, fullf, nullf
	LOGICAL listF, rangeF

	tcount = 0
C---------------------------------------------------------------------
C Read from a subfile or a userfile?
C---------------------------------------------------------------------
	userfl = .false.
	nullf = .false.
	fullf = .false.
	listF = .false.
	rangeF = .false.
	irec = 0

	ilog = -1
C Choose the disposition for the current table
	IF (CLI$PRESENT('REPLACE')) THEN
	  ilog = 0
	ELSEIF (CLI$PRESENT('OR')) THEN
	  ilog = 1
	ELSEIF (CLI$PRESENT('AND')) THEN
	  ilog = 2
	ELSEIF (CLI$PRESENT('NOT')) THEN
	  ilog = 3
	ENDIF

	IF (CLI$PRESENT('SUBPDF')) THEN
	  ln = 0
	  STATUS = CLI$GET_VALUE('SUBPDF',filename,ln)
	  iopt = 0
	  DO I = 1,max_sub+3
	    IF (filename(1:ln) .eq. SUBPDF(i)(1:ln)) then
	      iopt = i
	      if (iopt .eq. max_sub+3) iopt = 0
	      GOTO 180
	    endif
	  ENDDO
	  write (lo,'(2a)') ' Illegal SUBPDF option: ',filename(:ln)
	  goto 3
C---------------------------------------------------------------------
	ELSEIF (CLI$PRESENT('LIST')) THEN
	  ln = 0
	  STATUS = CLI$GET_VALUE('LIST',filename,ln)
	  irec = -1
	  listF = .true.
	  GOTO 190
C---------------------------------------------------------------------
	ELSEIF (CLI$PRESENT('RANGE')) THEN
	  card1 = 0
	  card2 = 0
	  FLAG = GET_NUMBER('RANGE',CARD1)
	  FLAG = GET_NUMBER('RANGE',CARD2)
	  IF (card1 .le. 0 .or. card1 .ge. card2) THEN
	    write (lo,'(2(A,i9))') ' Illegal range:',card1,' - ',card2
	    STATUS = .FALSE.
	    RETURN
	  ENDIF
	  irec = -1
	  rangeF = .true.
	  GOTO 190
C---------------------------------------------------------------------
	ELSEIF (CLI$PRESENT('file_name')) THEN
	  irec = -1
	  userfl = .true.
	  STATUS = CLI$GET_VALUE('file_name',filename,ln)
C does the file exist?
	    INQUIRE(FILE=filename(1:ln),defaultfile='.usrPDF',
	1	exist=flag,name=filename)
	    ln = lench(filename)
	    IF (.not. FLAG) THEN
	      Write (lo,'(2A)') ' User PDF file not found:',
	1		filename(:ln)
	    GOTO 3
	  ENDIF
	  GOTO 190
C---------------------------------------------------------------------
	ELSEIF (.not. PROMPT) THEN 
	  write (lo,'(a)') ' ERROR -- no read parameters/file specified'
	  goto 3
	ENDIF
C---------------------------------------------------------------------
C---------------------------------------------------------------------
170	IF (PROMPT) THEN 
	  write(lo,'(/A)') ' Choose a subfile to read:'
	  j = max_sub+3
	  ln = lench(sublbl(j))
	  write(lo,162)  0,sublbl(j)(:ln),' [default]'
	  DO J=1,max_sub
	    ln = lench(sublbl(j))
	    IF (SUBREC(j) .gt. 0 .and. j .gt. 9) THEN
	      write(lo,163)  j,sublbl(j)(:ln),' subfile'
	    ELSEIF (SUBREC(j) .gt. 0) THEN
	      write(lo,162)  j,sublbl(j)(:ln),' subfile'
	    ENDIF
162	    format(4x,'(',i1,')  ',2A)
163	    format(3x,'(',i2,')  ',2A)
	  ENDDO
	  j = max_sub+1
	  ln = lench(sublbl(j))
	  write(lo,163)  j,sublbl(j)(:ln),' subfile'
	  j = max_sub+2
	  ln = lench(sublbl(j))
	  write(lo,163)  j,sublbl(j)(:ln),' subfile'
	  write(lo,163)  max_sub+3,'Read file with a list of entries'
	  write(lo,163)  max_sub+4,'Enter a range of entries'
	  write(lo,163)  -1,'Enter and display PDF entry(s) by number'
	  write(lo,'(A)') '$Choose a subfile by number [Default=0]: '
	  iopt = 0
	  read(lo,'(i)',err=170,end=3) iopt
	ENDIF
C---------------------------------------------------------------------
C---------------------------------------------------------------------
180	IF (iopt .eq. max_sub+2) THEN
C option to read a user defined subfile
	    write(lo,'(a)') ' ',
	1	' Enter the file name root (default type = .USRPDF)',
	2	'$or * for a list of *.USRPDF filenames: '
	    read (li,fmt='(q,a)',end=170) ln,filename
	    if (ln .le. 0) GOTO 170
	    if (filename(1:1) .eq. '*') then 
	      call lib$spawn('$ directory/nosiz/bri/notra *.usrPDF')
	      goto 180
	    endif
C does the file exist?
	    INQUIRE(FILE=filename(1:ln),defaultfile='.usrPDF',
	1	exist=flag,name=filename)
	    ln = lench(filename)
	    IF (.not. FLAG) THEN
	      Write (lo,'(2A)') ' User PDF file not found:',
	1		filename(:lench(filename))
	      goto 180
	    ENDIF
	    irec = -1
	    userfl = .true.
C----------------------------------------------------------------------
	ELSEIF (iopt .eq. max_sub+1) THEN
	  irec = -1
	  nullf = .true.
C----------------------------------------------------------------------
	ELSEIF (iopt .eq. 0) THEN
	  irec = -1
	  fullf = .true.
C----------------------------------------------------------------------
	ELSEIF (iopt .ge. 1 .and. iopt .le. max_sub .and. 
	1	SUBREC(iopt) .gt. 0) THEN
	  irec = SUBREC(iopt)
C----------------------------------------------------------------------
	ELSEIF (iopt .eq. max_sub+3) THEN
	  write(lo,'(a)') ' ',
	1	' Enter the file name root (default type = .PDFLIS)',
	2	'$or * for a list of *.PDFLIS filenames: '
	  read (li,fmt='(q,a)',end=170) ln,filename
	    if (ln .le. 0) GOTO 170
	    if (filename(1:1) .eq. '*') then 
	      call lib$spawn('$ directory/nosiz/bri/notra *.PDFLIS')
	      goto 180
	    endif
C does the file exist?
	    INQUIRE(FILE=filename(1:ln),defaultfile='.PDFLIS',
	1	exist=flag,name=filename)
	    ln = lench(filename)
	    IF (.not. FLAG) THEN
	      Write (lo,'(2A)') ' User PDF file not found:',
	1		filename(:ln)
	      goto 180
	    ENDIF
	    irec = -1
	    listF = .true.
C--------
	ELSEIF (iopt .eq. max_sub+4) THEN
311	  WRITE(lo,'(A,$)') ' Enter the first entry in the range: '
	  READ(li,'(2i10)') card1,i
	  if (i .gt. 0) card1 = card1*10000 + i
	  IF (card1 .le. 0) THEN
	    write (lo,'(2(A,i9))') ' Illegal range:',card1,' - ',card2
	    goto 311
	  ENDIF
	  WRITE(lo,'(A,$)') '  Enter the last entry in the range: '
	  READ(li,'(2i10)') card2,i
	  if (i .gt. 0) card2 = card2*10000 + i
	  IF (card1 .ge. card2) THEN
	    write (lo,'(2(A,i9))') ' Illegal range:',card1,' - ',card2
	    goto 311
	  ENDIF
	  irec = -1
	  rangeF = .true.
C--------
	ELSE
	  write (*,'(/a/)') ' Unknown option'
	  IF (PROMPT) goto 170
	  goto 3
	ENDIF
C---------------------------------------------------------------------
C*************************************************************************
C Choose the disposition for the current table - if not selected on the
C command line
190	IF (ilog .eq. -1 .and. (NPHASE .eq. 0 .or.
	1	(IREC .eq. -1 .and. (nullf .or. fullf)))) then
C obvious cases: null current table, or loading null/full table
	  ilog = 0
	ELSEIF (PROMPT .and. ilog .eq. -1) THEN
	  write (lo,273) NPHASE
273	  FORMAT(/,' What should be done with the',i6,
	1	' selected entries in the current Table?',/,
	2	'  (0)  Replace the old Table with the new [default]',/,
	3	'  (1)  Add the two lists together (OR)',/,
	4	'  (2)  Allow only entries present in both lists (AND)',/,
	5	'  (3)  Remove entries in new table from old (AND NOT)',/,
	6	'$Enter the option [Default=0]: ')
	  read (li,'(i)',end=3) ilog
	ENDIF
	IF (ilog .lt. 0) THEN
	  write (lo,'(a)') 
	1	' ERROR -- no option specified for current table'
	  goto 3
	ENDIF
C*************************************************************************
C go get the new table
C*************************************************************************
	IF (irec .eq. -1 .and. userfl) then 
C   Read in the contents of filename into array TABLE1
	  OPEN(UNIT=IN,STATUS='OLD',FORM='UNFORMATTED',FILE=filename(1:ln),
	1	defaultfile='.usrPDF',READONLY,SHARED,ERR=999)
	  write (lo,'(a)') ' Reading file: '//filename(1:ln)
	  READ(IN,err=998) NCARDS,NWORDS,
	1	(TABLE1(i),i=1,MIN(N_Lwords,NWORDS))
	  tcount = 0
	  READ(IN,err=91) tcnum
	  do i=1,tcnum
	    READ(IN,err=91) tCLEN(i),tCONTEXT(i)(1:tCLEN(i))
	    tcount = tcount + 1
	  enddo
91	  CLOSE(IN)
	  IF (N_Lwords .lt. NWORDS) THEN
	    Write (lo,*) 'ERROR: too many words on file:'//filename(1:ln),
	1	NCARDS,N_cards
	    STATUS = .FALSE.
	    RETURN
	  ELSEIF (NWORDS .lt. N_Lwords) THEN
	    DO I=NWORDS+1,N_Lwords
	      TABLE1(i) = 0
	    ENDDO
	  ENDIF
	  IF (NCARDS .ne. N_cards) then
	    Write (lo,*) 
     1		'ERROR: # of entries on file does not match database:'
	    Write (lo,*) '     '//filename(1:ln),NCARDS,N_cards
	    Write (lo,*) 
	1 '      File written with different version of PDF data base',
	2	' Recreate this file using the following XTAL commands:',' '
	    do i=1,tcount
	      type *,'   '//tCONTEXT(i)(1:tCLEN(i))
	    ENDDO
	    Write (lo,*) ' ',' Press RETURN to continue'
	    read (li,'(A)',end=3) ians
	    STATUS = .FALSE.
	    RETURN
	  ENDIF
	  label = ' ' // filename(:ln) // ' !   user subfile'
	  goto 200
C---------------------------------------------------------------------
	ELSEIF (irec .eq. -1 .and. listf) then 
	  OPEN(UNIT=IN,STATUS='OLD',FORM='FORMATTED',
     1	  FILE=filename(1:ln),
     1	  defaultfile='.PDFLIS',READONLY,SHARED,ERR=999)
	  INQUIRE(UNIT=IN,name=filename)
	  filename = 'LIST='//filename
	  ln = lench(filename)
	  CALL TBLCLR(TABLE1,N_Lwords,nph1)
     	  DO 201 ii=1,10000
	    READ(IN,'(2i10)',end=250,err=998) cardno,i
	    if (i .gt. 0) cardno = cardno*10000 + i
	    IF (CARDNO .lt. 0) GOTO 250
	    IF (CARDNO .eq. 0) GOTO 201
	    IF (CARDNO .lt. 100 .or. CARDNO/10000 .gt. MAX_SETNO) then
202	      write (lo,'(A,i)') ' Invalid PDF entry number: ',
	1	cardno
	      goto 201
	    ENDIF
	    CALL CARDLOOK(CARDNO,NAMREC,FULREC,DIREC,ISEQ,N_cards,LUNM,
     1		STATUS)
	    IF (.not. STATUS) GOTO 202
C set bit number ISEQ in TABLE
	    CALL BITSET(TABLE1,ISEQ,N_cards,1)
201	  CONTINUE
250	  CLOSE(IN)
	  label = '/' // filename(:ln) // ' !   list file of entries'
	  goto 200
C---------------------------------------------------------------------
	ELSEIF (irec .eq. -1 .and. rangef) then 
	  j1 = card1
	  j2 = card2
	  CALL TBLCLR(TABLE1,N_Lwords,nph1)
C find last valid entry
	  CALL CARDLMIN(CARD2,NAMREC,FULREC,DIREC,ISEQ2,N_cards,LUNM,
     1		STATUS)
C find first valid entry
	  CALL CARDLMAX(CARD1,NAMREC,FULREC,DIREC,ISEQ1,N_cards,LUNM,
     1		STATUS)
	  IF (card2 .lt. card1 .or. ISEQ2 .lt. ISEQ2) THEN
	    type *,'WARNING -- no valid entries in range',j1,j2
	    STATUS = .FALSE.
	    RETURN
	  ENDIF
C set bit number ISEQ in TABLE
304	  DO ISEQ=ISEQ1,ISEQ2
	    CALL BITSET(TABLE1,ISEQ,N_cards,1)
	  ENDDO
C remove deleted entries
	  IF (.not. DELETED) THEN
C Open and read from Subfile
	    OPEN (UNIT=IN,NAME='PS_BITMAP:misc.bitmap',STATUS='OLD',
	1	FORM='UNFORMATTED',ACCESS='DIRECT',READONLY,SHARED,
	1	err=971)
	    WRITE(LO,'(A)') ' ...Removing deleted entries'
C load the deleted entries
	    READ (IN,rec=DL_sub) (TABLE2(I),i=1,N_Lwords)
C remove them from table 
	    CALL TBLnot(TABLE2,TABLE2,N_cards)
	    CALL TBLand(TABLE1,TABLE2,TABLE1,N_Lwords)
	    CLOSE (UNIT=IN)
	  ENDIF
	  write(filename,'(a,2(i6,a))') '/RANGE=(',card1,',',card2,')'
	  ln = lench(filename)
	  label = filename(:ln) // ' !   range of entries'
	  goto 200
C---------------------------------------------------------------------
	ELSEIF (irec .eq. -1 .and. nullf) then 
	  CALL TBLCLR(TABLE1,N_Lwords,nph1)
	  iopt = max_sub+1
C---------------------------------------------------------------------
	ELSEIF (irec .eq. -1 .and. fullf) then 
C Open and read from Subfile
	  IF (.not. DELETED) THEN
C Open and read from Subfile
	    OPEN (UNIT=IN,NAME='PS_BITMAP:misc.bitmap',STATUS='OLD',
	1	FORM='UNFORMATTED',ACCESS='DIRECT',READONLY,SHARED,
	1	err=971)
	  ENDIF
	  IF (.not. DELETED) THEN
	    WRITE(LO,'(A)') ' ...Removing deleted entries'
C load the deleted entries
	    READ (IN,rec=DL_sub) (TABLE1(I),i=1,N_Lwords)
C remove them from table 
	    CALL TBLnot(TABLE1,TABLE1,N_cards)
	    CLOSE (UNIT=IN)
	  ELSE
	    CALL TBLSET(TABLE1,N_cards,nph1)
	  ENDIF
	  iopt = max_sub+3
C---------------------------------------------------------------------
	ELSEIF (IREC .gt. 0) THEN
C Open and read from Subfile
	  OPEN (UNIT=IN,NAME='PS_BITMAP:misc.bitmap',STATUS='OLD',
	1	FORM='UNFORMATTED',ACCESS='DIRECT',READONLY,SHARED,
	1	err=971)
	  READ (IN,REC=irec,err=199)(TABLE1(I),I=1,N_Lwords)
	  IF (Iopt .EQ. DL_sub .and. .NOT. DELETED) THEN
	    WRITE(LO,'(A)') 
	1	' Setting DELETED/ENABLE ... to use deleted entries'
	    DELETED = .true.
	  ELSEIF (.not. DELETED) THEN
	    WRITE(LO,'(A)') ' ...Removing deleted entries'
C load the deleted entries
	    READ (IN,rec=DL_sub) (TABLE2(I),i=1,N_Lwords)
C remove them from table 
	    CALL TBLnot(TABLE2,TABLE2,N_cards)
	    CALL TBLand(TABLE1,TABLE2,TABLE1,N_Lwords)
	  ENDIF
	  CLOSE (UNIT=IN)
	ENDIF
C---------------------------------------------------------------------
	filename = SUBLBL(iopt)
	ln = lench(filename)
	filename = '"' // filename(:ln) // '"'
	ln = lench(filename)
	label = '/SUB=' // SUBPDF(iopt) // ' !   '// SUBLBL(iopt)
C---------------------------------------------------------------------
C  Count the number of bits in the table
200	CALL TBLCOUNT(TABLE1,N_Lwords,nph1)
	WRITE(LO,100) filename(1:ln),nph1,N_cards
100	FORMAT(/,' File ',a,' contains',i6,' entries, out of',I6)
C*************************************************************************
C now perform the merge/replace with the old table
	IF (ilog .EQ. 0) THEN
C   Replace the table with a subfile 
	  CALL TBLMOVE(TABLE1,TABLE2,N_Lwords)
	  nph2 = nph1
	  cnum = 1
	  IF (Deleted) then
	    context(cnum) = 'DELETED/INCLUDE'
	    clen(cnum) = lench(context(cnum))
	  ELSE
	    context(cnum) = 'DELETED/EXCLUDE'
	    clen(cnum) = lench(context(cnum))
	  ENDIF
	  cnum = cnum + 1
	  context(cnum) = 'READ/REPLACE'//label
	  CALL PS_PAUSE(prompt)
	ELSEIF (ilog .EQ. 1) THEN
C   OR the table with a subfile
	  CALL TBLOR(TABLE,TABLE1,TABLE2,N_Lwords)
	  CALL TBLCOUNT(TABLE2,N_Lwords,nph2)
	  WRITE(LO,101) NPHASE,N_cards
101	  FORMAT(' Current Table contains',i6,' entries, out of',I6)
	  WRITE(LO,102) 'OR',nph2
102	  FORMAT(' After the .',A,'. operation, the Table will contain',
	1	i6,' entries')
	  IF (PROMPT) THEN
	    WRITE(LO,103) 
103	    FORMAT(/,'$Proceed with change to table? [default=Y] ')
	    read (li,'(a)') ians
	    if (ians .eq. 'N' .or. ians .eq. 'n') goto 3
	  ENDIF
	  cnum = min(100-tcount,cnum+1)
	  context(cnum) = 'READ/OR'//label
	ELSEIF (ilog .EQ. 2) THEN
C   AND the table with a subfile 
	  CALL TBLAND(TABLE,TABLE1,TABLE2,N_Lwords)
	  CALL TBLCOUNT(TABLE2,N_Lwords,nph2)
	  WRITE(LO,101) NPHASE,N_cards
	  WRITE(LO,102) 'AND',nph2
	  IF (PROMPT) THEN
	    WRITE(LO,103) 
	    read (li,'(a)') ians
	    if (ians .eq. 'N' .or. ians .eq. 'n') goto 3
	  ENDIF
	  cnum = min(100-tcount,cnum+1)
	  context(cnum) = 'READ/AND'//label
	ELSE
C   AND the table with .NOT. the subfile 
	  CALL TBLnot(TABLE1,TABLE1,N_cards)
	  CALL TBLAND(TABLE,TABLE1,TABLE2,N_Lwords)
	  CALL TBLCOUNT(TABLE2,N_Lwords,nph2)
	  WRITE(LO,101) NPHASE,N_cards
	  WRITE(LO,102) 'AND. .NOT',nph2
	  IF (PROMPT) THEN
	    WRITE(LO,103) 
	    read (li,'(a)') ians
	    if (ians .eq. 'N' .or. ians .eq. 'n') goto 3
	  ENDIF
	  cnum = min(100-tcount,cnum+1)
	  context(cnum) = 'READ/NOT'//label
	ENDIF
	clen(cnum) = lench(context(cnum))
C update the log of commands
	do i=1,tcount
	  cnum = min(100-tcount+i,cnum+1)
	  context(cnum) = '!... '//tcontext(i)(1:tclen(i))
	  clen(cnum) = tCLEN(i) + 5
	enddo
	CALL TBLMOVE(TABLE2,TABLE,N_Lwords)
	NPHASE = nph2
	STATUS = .TRUE.
	RETURN
C*************************************************************************
199	WRITE(lo,'(A,i3)') ' Error reading SUBFILE file REC=',irec
	CLOSE(IN)
	goto 3
C error opening misc bitmap file 
999	WRITE(lo,'(A)') ' Error opening file '//filename(1:ln)
3	STATUS = .FALSE.
	return
998	WRITE(lo,'(A)') ' Error reading file '//filename(1:ln)
	CLOSE(IN)
	STATUS = .FALSE.
	RETURN
9170	WRITE(lo,'(A)') ' Error opening file '//filename(1:ln)
	goto 170
971	type *,'ERROR reading PS_BITMAP:misc.bitmap'
	STATUS = .FALSE.
	RETURN
	END
