C==========================================================================
	SUBROUTINE BROWSE(gparm,*)
C==========================================================================
C Subroutine to browse through a bitmap table of entries 
C						B. H. Toby
C==========================================================================
	BYTE gparm

	include 'logic.common'
	include '[-.shared]flabel.common'
	INTEGER STATUS,CLI$DCL_PARSE,CLI$GET_VALUE,CLI$PRESENT
	LOGICAL GET_NUMBER,flag,GET_LOGICAL,DEF_LOGICAL,GET_FNUMBER
	INTEGER*4 NAMREC,FULREC,DIREC,ISEQ,JCARD,ngcard/5/
	BYTE CHFORM(200),CHNAME(205),TOPOP
	INTEGER*2 LCHFORM,LCHNAME
	CHARACTER*1 QM,commands*30,str1*8,str2*8
	DIMENSION dsp(200)
	INTEGER*2 INT(200),ln

	CHARACTER*95  cstr
	CHARACTER*80  BUFFER(135)
	CHARACTER*80  FILENAME
	REAL DATSCL,JCSCL
	LOGICAL nopeak/.true./,nodata/.true./,everyf/.false./
	SAVE nopeak,nodata,everyf,DATSCL,JCSCL
	INTEGER icol/2/
	REAL dhigh/10./,dlow/1.54178/
	REAL thigh,tlow
	SAVE dhigh,dlow,thigh,tlow,icol

C---------------------------------------------------------------------------
	cstr = ' '
	TOPOP = .true.
	IPAGE = 0

	IF (.not. PROMPT) goto 999
	IF (NPHASE .le. 0) then
	  write (lo,'(A)') ' There are no entries to browse through'
	  goto 999
	ENDIF

C initialize the full PDF-2 database, if not yet done
	IF (.not. initPDF2) then 
	  write (lo,'(a)') ' Initializing PDF-2 database'
	  CALL RET3_INIT(STATUS,PDFDISK,PDFCDROM,PDFLOCAL,LPDF2,LPDF2L)
	  IF (STATUS .NE. 0) then
	    write (lo,'(A)') ' WARNING -- Unable to open PDF-2 database'
	    CALL ps_PAUSE(PROMPT)
	  ENDIF
	  INITPDF2 = .true.
	ENDIF

211	ICARDNO = 0 
	IBIT = 31
	IWORD = 0
	CALL TERASE(ICRT,LO,LI)
213	WRITE(lo,25)
25	FORMAT(' Press RETURN to sequence though the phases',/,
	1	' 	+n   to skip ahead by "n" phases,',/,
	2	' 	-n   to skip backward by "n" phases,',/,
	3	' 	>n   to skip to entry number "n",',/,
	4	' 	[crd to skip to JCPDS entry "crd",',/,
	5	' 	C    to Cull (remove) current entry from table,',/,
	6' 	P    to Print current entry SUMMARY and advance to next,')
	commands = 'P,C,+n,-n,>n,[#'
	ln = 15
	IF (PDFDISK .or. PDFCDROM) THEN
	  WRITE(lo,29) 
29	  FORMAT( 
	1	' 	D    to Display all data on the current entry,',/,
	1	' 	A    to print All data on the current entry,')
	  commands = commands(1:ln)//',D,A'
          ln = ln + 4
	ENDIF
	if (ICRT .gt. 0) then
	  WRITE(lo,26) min(1+nphase-max(1,icardno),NGCARD)
26	  FORMAT( ' 	G    for graphic display of next ',i1,' entry(s),')
	  commands = commands(1:ln)//',G'
          ln = ln + 2
	ENDIF
	WRITE(lo,27)
27	FORMAT(' 	^Z or E to return to the main menu')
C----------------------------------------------------------------------
5	WRITE(str1,'(i8)') icardno
	call press(str1,l1)
	WRITE(str2,'(i8)') nphase
	call press(str2,l2)
	IF (icardno .eq. 0) then 
	  WRITE(lo,9031) 
9031	  FORMAT('$(Commands: +n,-n,>n,[c,^Z=exit,?=help) ',
	1		'press RETURN for phase #1: ')
	ELSE
	  WRITE(lo,9030) commands(1:lench(commands)),str1(1:l1),str2(1:l2)
9030	  FORMAT('$(Commands: ',a,',^Z=exit,?=help) Phase #',a,'/',a,'> ')
	ENDIF
	I1 = ' '
	READ(li,'(A1,I6)',END=127,err=212) I1,I2
C---------------------------------------------------------------------------
C--  Command begins with "-"  -- go back in list
12	IF (I1.EQ.'-') THEN 
	  IF (I2.EQ.0)I2=1
	  k = 0
21	  IBIT = IBIT - 1
	  IF (IBIT .lt. 0) then
	    IBIT = 31
22	    IWORD = IWORD - 1
	    IF (IWORD .le. 0) goto 211
	    IF (TABLE(IWORD) .EQ. 0) GOTO 22
	  ENDIF
	  IF (IBITS(TABLE(IWORD),IBIT,1).EQ.1) THEN
C found a entry
	    k = k + 1
	    ICARDNO = ICARDNO - 1
	  ENDIF
C       do we want to skip over this entry?
	  IF (K .lt. i2) goto 21
C---------------------------------------------------------------------------
C--  Command begins with "+"  -- go forward in list
	ELSEIF (I1.EQ.'+') THEN 
	  IF (I2.EQ.0) I2=1
	  k = 0
31	  IBIT = IBIT + 1
	  IF (IBIT .ge. 32) then
	    IBIT = 0
32	    IWORD = IWORD + 1
	    IF (IWORD .gt. N_Lwords) goto 127
	    IF (TABLE(IWORD) .EQ.0) GOTO 32
	  ENDIF
	  IF (IBITS(TABLE(IWORD),IBIT,1).EQ.1) THEN
C     found a entry
	    k = k + 1
	    ICARDNO = ICARDNO + 1
	  ENDIF
C       do we want to skip over this entry?
	  IF (K .lt. i2) goto 31
C---------------------------------------------------------------------------
C--  Command begins with ">"  -- translate to a "+" or "-" command
	ELSEIF (I1.EQ.'>') THEN 
	  IF (I2.EQ.0 .or. I2 .gt. NPHASE) GOTO 211
	  IF (I2 .GT. ICARDNO) THEN
	    I1 = '+'
	    I2 = I2 - ICARDNO
	  ELSEIF (I2 .LT. ICARDNO) THEN
	    I1 = '-'
	    I2 = ICARDNO - I2 
	  ELSE
	    goto 14
	  ENDIF
	  GOTO 12
C---------------------------------------------------------------------------
C--  Command begins with "["  -- find closest entry number 
	ELSEIF (I1.EQ.'[') THEN 
	  ipmax = 10000000
	  IBIT = 31
	  IWORD = 0
	  ICARDNO = 0 
41	  IBIT = IBIT + 1
	  IF (IBIT .ge. 32) then
	    IBIT = 0
42	    IWORD = IWORD + 1
C end of list with no closest entry, something is wrong!
	    IF (IWORD .gt. N_Lwords) goto 211
	    IF (TABLE(IWORD) .EQ.0) GOTO 42
	  ENDIF
	  IF (IBITS(TABLE(IWORD),IBIT,1).EQ.1) THEN
C     found a entry
	    ICARDNO = ICARDNO + 1
C   convert bit# and word# to seq#
	    ISEQ = 32*(IWORD-1) + IBIT  + 1
C 	get record numbers from seq#
	    READ (LUNM,rec=ISEQ,err=121) JCARD,NAMREC,FULREC,DIREC
	    IF (abs(jcard-i2) .gt. ipmax) then
C we have gone past by one, go back
	      I1 = '-'
	      I2 = 1
	      GOTO 12
	    ELSEIF (jcard .ne. i2) then
C we have not hit the entry
	      ipmax = abs(jcard-i2)
	      goto 41
	    ENDIF
	  ELSE
	    GOTO 41
	  ENDIF
C---------------------------------------------------------------------------
C--  Command to remove the current entry
	ELSEIF (I1.EQ.'c' .or. I1.EQ.'C') THEN 
C---- is there a current entry?
	  IF (ICARDNO .eq. 0) Then
	    write(lo,24) 'cull (remove)'
	    GO TO 5
	  ENDIF
C remove entry
	  TABLE(IWORD) = IBCLR(TABLE(IWORD),IBIT)
C add comment line
C   convert bit# and word# to seq#
	  ISEQ = 32*(IWORD-1) + IBIT  + 1
C 	get record numbers from seq#
	  READ (LUNM,rec=ISEQ,err=121) JCARD,NAMREC,FULREC,DIREC
	  WRITE(str1,'(I6.6)') JCARD
	  IF (cstr .eq. ' ') THEN
	    cstr = str1
	  ELSE
	    cstr = cstr(:lench(cstr))//','//str1
	    IF (lench(cstr) .gt. 65) THEN
	      cnum = min(100,cnum + 1)
	      CONTEXT(cnum) = 'CULL/Card=('//cstr(:lench(cstr))//')'
	      CLEN(cnum) = LENCH(CONTEXT(cnum))
C update the number of entries
	      CALL TBLCOUNT(TABLE,N_Lwords,nphase)
	      CSTR = ' '
	    ENDIF
	  ENDIF
C---- advance to next entry
	  GOTO 112
C---------------------------------------------------------------------------
C--  Command to print the current entry
	ELSEIF (I1.EQ.'p' .or. I1.EQ.'P') THEN 
	  ipos = 1
C---- is there a current entry?
	  IF (ICARDNO .eq. 0) Then
	    write(lo,24) 'print'
24	    format(' ERROR -- no current entry to ',a)
	    GO TO 5
	  ENDIF
C---- open the print file, if this is the first access
	  IF (IPAGE .eq. 0) then
	    call opnpr(lo,li,lp,'LOGIC.lis',ncol,nlines)
	    IF (cnum .gt. 5) then
	      IPAGE = 1
	      WRITE(lp,721) IPAGE
	      IF (wave0 .LE. 0.0) THEN
	        WRITE(lp,811)
	      ELSE
	        WRITE(lp,812) irad0,wave0
	      ENDIF
	      WRITE(lp,810) (i,CONTEXT(i)(1:clen(i)),i=1,cnum)
810	      FORMAT('    Commands: ',i3,') ',a,/,99(14x,i3,') ',a,:/))
	    ENDIF
	  ENDIF
C---- is there room on the current page for the current entry?
C count the number of header lines
100	  if (ipos .eq. 1 .and. TOPOP) then 
	    NHEAD = 1 + 1 + (lchform-1)/90
	    NHEAD = NHEAD + 1 + (lchname-1)/90
	  ELSE
	    NHEAD = 1
	  ENDIF
C count the number of lines in the table
	  nline = min(ndsint - ipos,20)
C should we advance to a new page? is there room for this entry? 
	  IF (NHEAD+nline .gt. 25 .or. TOPOP) then
	    ipage = ipage+1
	    WRITE(lp,721) IPAGE
721	    FORMAT('1',120x,'Page',i4)
	    IF (wave0 .LE. 0.0) THEN
		WRITE(lp,811) 
811		FORMAT(' Peak Positions as d-spaces (Angstroms)')
	    ELSE
		WRITE(lp,812) irad0,wave0
812		FORMAT(' Peak Positions as angles for ',A2,
	1	' Radiation, wavelength =',f8.5,' (degrees 2Theta)')
	    ENDIF
	    WRITE(lp,810) (i,CONTEXT(i)(1:clen(i)),i=max(1,cnum-4),cnum)
	    WRITE(lp,810) 
	    TOPOP = .false.
	  ELSE
	    TOPOP = .true.
	  ENDIF
	  NLINE = 23
	  if (ipos .eq. 1) then 
	    WRITE(lp,131) JCARD,FCOR,QM,ICARDNO,NPHASE
	    NLINE = NLINE - 1
131	    FORMAT(' [',I6.6,']',4x,'I/Ic=',g12.3,'  QM=',A1,
	1	40x,'Phase',i5,' of',i5,a)
	    WRITE(lp,130) (CHFORM(i),i=1,LCHFORM)
	    NLINE = NLINE - 1 - (LCHFORM/90)
	    WRITE(lp,130) (CHNAME(i),i=1,LCHNAME)
	    NLINE = NLINE - 1 - (LCHNAME/90)
130	    FORMAT(12x,90a1)
	  else
	    WRITE(lp,131) JCARD,FCOR,QM,ICARDNO,NPHASE,
	1	'  (continued)'
	    NLINE = NLINE - 1
	    if (TOPOP) then
	      WRITE(lp,130) (CHFORM(i),i=1,LCHFORM)
	      NLINE = NLINE - 1 - (LCHFORM/90)
	      WRITE(lp,130) (CHNAME(i),i=1,LCHNAME)
	      NLINE = NLINE - 1 - (LCHNAME/90)
	    endif
	  endif
	  CALL DISPLAY(NDSINT,dsp,INT,lp,wave0,IPOS,NLINE)
C if this is a second entry on the page, advance to the next page
C otherwise pad with at least two lines, if there is room
	  IF (.not. TOPOP) THEN
	    topop = .true.
C are there more lines to print for this entry?
	  ELSEIF (NDSINT .GE. ipos) then 
	    write(lp,'(A)')
	    write(lp,'(A)')
	    TOPOP = .false.
	    goto 100
	  ELSEIF(NHEAD + NLINE .le. 25) then
	    topop = .false.
	    do i= 1,27 - (NHEAD+NLINE)
	      write(lp,'(A)')
	    ENDDO
	  ELSE
	    TOPOP = .true.
	  ENDIF
C---- advance to next entry
	  GOTO 112
C---------------------------------------------------------------------------
C--  Command to print/display the PDF-2 version of the current entry
	ELSEIF ((I1.EQ.'a' .or. I1.EQ.'A' .or. I1.EQ.'d' .or. I1.EQ.'D')
	1	 .and. (PDFDISK .or. PDFCDROM)) THEN
C if this is entry 0, advance to first entry
	  IF (ICARDNO .eq. 0) Then
	    DO IWORD=1,N_Lwords
	      IF (TABLE(IWORD) .NE.0) THEN 
		DO IBIT=0,31
		  IF (IBITS(TABLE(IWORD),IBIT,1).EQ.1) THEN
		    ICARDNO = 1
		    ISEQ = 32*(IWORD-1) + IBIT  + 1
C 	get record numbers from seq#
		    READ (LUNM,rec=ISEQ,err=121) JCARD,NAMREC,FULREC,DIREC
		    goto 331
		  ENDIF
		ENDDO
	      ENDIF
	    ENDDO
	    write (lo,'(A)') ' ERROR -- could not find any entries!'
	    goto 999
	  ENDIF
C---- read the pattern from the full database
331	  CALL GETPAT (fulrec, BUFFER, NBYTES, STATUS)
	  IF (STATUS .EQ. 1) THEN
	    WRITE(lo,'(A,i7.6)') ' ERROR: unable to retrieve PDF-2 entry'
     1	,JCARD
	    goto 5
	  ELSEIF (STATUS .EQ. 2) THEN
	    WRITE(lo,'(A,i7.6)') ' No PDF-2 entry exists for entry',JCARD
	    goto 5
	  ENDIF
	  CALL READBF (BUFFER, NBYTES, STATUS)
	  if (status .ne. 0) then
	    write(lo,28)
	    goto 5
	  endif
28	  format(' READBF ERROR -- unable to read Entry ',i6.6)
	  IF (I1.EQ.'a' .or. I1.EQ.'A') THEN
C Print the entry
	    IF (IPAGE .eq. 0) then
	      call opnpr(lo,li,lp,'LOGIC.lis',ncol,nlines)
	      IPAGE = 1
	      WRITE(lp,721) IPAGE
	      WRITE(lp,810) (i,CONTEXT(i)(1:clen(i)),i=1,cnum)
	    ENDIF
	    TOPOP = .true.
	    CALL ONCE
	    IPAGE = IPAGE + 1
	    WRITE(LP,721) IPAGE
	    CALL PDF2PRT(lp)
C----   advance to next entry
	    GOTO 112
	  ENDIF
C Display the entry
	  CALL ONCE
	  CALL PDF2DSP(ANSI)
	  goto 5
C---------------------------------------------------------------------------
C--  Command to Graphically display the current entry
	ELSEIF ((I1.EQ.'g' .or. I1.EQ.'G').and. ICRT .gt. 0) THEN 
C if this is entry 0, advance to first entry
	  IF (ICARDNO .eq. 0) Then
	    DO IWORD=1,N_Lwords
	      IF (TABLE(IWORD) .NE.0) THEN 
		DO IBIT=0,31
		  IF (IBITS(TABLE(IWORD),IBIT,1).EQ.1) THEN
		    ICARDNO = 1
		    ISEQ = 32*(IWORD-1) + IBIT  + 1
C 	get record numbers from seq#
		    READ (LUNM,rec=ISEQ,err=121) JCARD,NAMREC,FULREC,DIREC
		    goto 333
		  ENDIF
		ENDDO
	      ENDIF
	    ENDDO
	    write (lo,'(A)') ' ERROR -- could not find any entries!'
	    goto 999
	  ENDIF
333	  if (.not. gparm) then
	    gparm = .true.
	    if (wave0 .GT. 0) then 
	      tlow = 0.0
	      thigh = 180.
	      call DTOTT(dhigh,tlow,wave0)
	      call DTOTT(dlow,thigh,wave0)
	    endif
	    ians = 'Y'
	    jcscl = 1.0
	    datscl = 1.0
	  else
	    write(lo,'(a)') '$Change graphics parameters? (default=N) '
	    read(li,'(A1)',end=112)  ians
	  endif
	  if (ians .eq. 'Y' .or. ians .eq. 'y') then 
	    CALL GETFILE(NOPEAK,NODATA,filename)
232	    write(lo,'(a,i2,a)') 
	1	'$Maximum entries per page (default=',ngcard,'): '
	    read(li,'(q,i)',end=112,err=232) k,j
	    if (k .ne. 0) ngcard = j
	    if (ngcard .eq. 1) then 
	      everyF = .true.
	    elseif (nopeak .and. nodata) then 
	      everyF = .false.
	    elseif ((.not. nodata) .or. EVERYF) then 
	      everyF = .true.
	      write (lo,'(a)')
	1	'$Superimpose peaks/data over every entry? ([Y]/N): '
	      read(li,'(q,a1)',end=112) k,ans
	      if (ans .eq. 'N' .or. ans . eq. 'n') everyF = .false.
	    else
	      write (lo,'(a)')
	1	'$Superimpose peaks/data over every entry? (Y/[N]): '
	      read(li,'(q,a1)',end=112) k,ans
	      if (ans .eq. 'Y' .or. ans . eq. 'y') everyF = .true.
	    ENDIF
	    if ((.not. nodata) .or. (.not. nopeak)) then 
	      WRITE(lo,'(A,f6.2,A)') 
	1	'$Enter raw data magnification factor [default=', 
	2	datscl,']: '
	      READ (li,'(F10.0)') xtmp
	      IF (XTMP .GT. 0.0) datscl = xtmp
	    ENDIF
	    if (everyF) THEN
	      write(lo,'(a,i3,a)') 
	1	'$Enter color code for observed data/peaks (default=',
	1	icol,'): '
	      read(li,'(q,i)',end=112,err=232) k,j
	      if (k .ne. 0) icol = j
	    ENDIF
233	    if (wave0 .GT. 0) then 
	      write(lo,'(a,f8.3,a)') '$Two-theta minimum (default=',
	1	tlow,'): '
	      read(li,'(q,f10.0)',end=112,err=233) k,ang
	      if (k .ne. 0) tlow = ang
	      call TTTOD(dhigh,tlow,wave0)
	      write(lo,'(a,f8.3,a)') '$Two-theta maximum (default=',
	1	thigh,'): '
	      read(li,'(q,f10.0)',end=112,err=233) k,ang
	      if (k .ne. 0) thigh = ang
	      call TTTOD(dlow,thigh,wave0)
	    else
	      write(lo,'(a,f8.3,a)') '$d-space minimum (default=',
	1	dlow,'): '
	      read(li,'(q,f10.0)',end=112,err=233) k,ang
	      if (k .ne. 0) dlow = ang
	      write(lo,'(a,f8.3,a)') '$d-space maximum (default=',
	1	dhigh,'): '
	      read(li,'(q,f10.0)',end=112,err=233) k,ang
	      if (k .ne. 0) dhigh = ang
	    endif
	    WRITE(lo,'(A,f6.2,A)') 
	1	'$Enter JCPDS peak magnification factor [default=', 
	2	jcscl,']: '
	    READ (li,'(F10.0)') xtmp
	    IF (XTMP .GT. 0.0) jcscl = xtmp
	  endif
	  ln = lench(filename)
	  if (wave0 .GT. 0) then 
	    call quickplt(ngcard,icardno,ibit,iword,
	1	filename(:ln),nopeak,nodata,everyf,
	1	tlow,thigh,icol,datscl,jcscl,*212)
	  else
	      call quickplt(ngcard,icardno,ibit,iword,
	1	filename(:ln),nopeak,nodata,everyf,
	1	dhigh,dlow,icol,datscl,jcscl,*212)
	  endif
	  goto 112
C---------------------------------------------------------------------------
	ELSEIF (I1.EQ.' ' .or. I1.EQ.0) THEN 
C---- advance to next entry
112	  I1 = '+'
	  I2 = 1
	  GOTO 12
C---------------------------------------------------------------------------
	ELSEIF (I1.EQ.'?') THEN 
	  CALL TERASE(ICRT,LO,LI)
	  goto 213
	ELSEIF (I1.EQ.'E' .or. I1 .eq. 'e') THEN 
	  goto 127
C---------------------------------------------------------------------------
C--  Hidden option: display the PDF-2 entry in AIDS format
	ELSEIF (I1.EQ.'.' .and. (PDFDISK .or. PDFCDROM)) THEN
	  IF (ICARDNO .eq. 0) goto 112
	  CALL GETPAT (fulrec, BUFFER, NBYTES, STATUS)
	  IF (STATUS .EQ. 1) THEN
	    WRITE(lo,'(A,i7.6)') ' ERROR: unable to retrieve PDF-2 entry'
     1	,JCARD
	    goto 5
	  ELSEIF (STATUS .EQ. 2) THEN
	    WRITE(lo,'(A,i7.6)') ' No PDF-2 entry exists for entry',JCARD
	    goto 5
	  ENDIF
          write (lo,'(1x,A80)') ' ',(BUFFER(I),I=1,nbytes/80)
	  call ps_pause(prompt)
	ELSE 
C---------------------------------------------------------------------------
C unrecognized command or invalid input
C   if the first letter was E treat as exit
212	  IF (I1.EQ.'E' .or. I1 .eq. 'e') goto 127
	  CALL TERASE(ICRT,LO,LI)
	  WRITE(lo,'(a,/)') ' ***** Invalid command, try again *****'
	  goto 213
	ENDIF
C---------------------------------------------------------------------------
C   lookup and display current entry
C---------------------------------------------------------------------------
C   convert bit# and word# to seq#
14	ISEQ = 32*(IWORD-1) + IBIT  + 1
C 	get record numbers from seq#
	READ (LUNM,rec=ISEQ,err=121) JCARD,NAMREC,FULREC,DIREC
	CALL TERASE(ICRT,LO,LI)
C   get name info
	CALL READNAM(NAMREC,LUNN,QM,FCOR,CHFORM,LCHFORM,CHNAME,LCHNAME)
C    get D/I info
	CALL READDI(DIREC,dsp,INT,NDSINT,LPDF,0.0,200)
!	CALL DSORT(dsp,INT,NDSINT)
	ipos = 1 

101	WRITE(str1,'(i8)') icardno
	call press(str1,l1)
	WRITE(str2,'(i8)') nphase
	call press(str2,l2)
	NLINE = 23
	if (wave0 .gt. 0.0) then
	  WRITE(lo,141) JCARD,FCOR,QM,wave0,str1(1:l1),str2(1:l2),
	1	(CHFORM(i),i=1,LCHFORM)
141	  FORMAT(' [',I6.6,']   I/Ic=',g9.2,'  QM=',A1,
	1	'   Wavelength=',F8.5,'A   Phase ',A,' of ',A
	2	,10(/,10x,60a1))
	  NLINE = NLINE - 2 - (LCHFORM/60)
	ELSE
	  WRITE(lo,129) JCARD,FCOR,QM,str1(1:l1),str2(1:l2),
	1	(CHFORM(i),i=1,LCHFORM)
129	  FORMAT(' [',I6.6,']     I/Ic=',g10.2,'  QM=',A1,
	1      20x,'Phase ',A,' of ',A:,10(/,10x,60a1))
	  NLINE = NLINE - 2 - (LCHFORM/60)
	ENDIF
	WRITE(lo,132) (CHNAME(i),i=1,LCHNAME)
132	FORMAT(10x,60a1)
	NLINE = NLINE - 1 - (LCHNAME/60)

	CALL DISPLAY(NDSINT,dsp,INT,lo,wave0,IPOS,NLINE)
C are there more lines to print?
	IF (NDSINT .GE. ipos) then 
	  write (lo,'(A)') '$Press RETURN for additional reflections'
	  read (li,'(A)',end=127) ians
	  goto 101
	ENDIF
	GOTO 5
C---------------------------------------------------------------------------
121	type *,'Error reading INDEX file, ISEQ=',ISEQ
	goto 5
C---------------------------------------------------------------------------
127	IF (IPAGE .ne. 0) CALL CLPR(lo,li,lp)
	IF (cstr .ne. ' ') THEN
	  cnum = min(100,cnum + 1)
	  CONTEXT(cnum) = 'CULL/Card=('//cstr(:lench(cstr))//')'
	  CLEN(cnum) = LENCH(CONTEXT(cnum))
C update the number of entries
	  CALL TBLCOUNT(TABLE,N_Lwords,nphase)
	ENDIF
	RETURN
C---------------------------------------------------------------------------
999	IF (IPAGE .ne. 0) CALL CLPR(lo,li,lp)
	IF (cstr .ne. ' ') THEN
	  cnum = min(100,cnum + 1)
	  CONTEXT(cnum) = 'CULL/Card=('//cstr(:lench(cstr))//')'
	  CLEN(cnum) = LENCH(CONTEXT(cnum))
C update the number of entries
	  CALL TBLCOUNT(TABLE,N_Lwords,nphase)
	ENDIF
	RETURN 1
	END
