	SUBROUTINE TABLES(*)
C
C Subroutine to print tables of selected cards 
C
	include 'logic.common'
	INTEGER*2 ISET,ICARD
	INTEGER*4 NAMREC,FULREC,DIREC,ISEQ,JCARD
	BYTE CHFORM(200),CHNAME(205),TOPOP
	INTEGER*2 LCHFORM,LCHNAME
	CHARACTER*1 QM,ans
	DIMENSION dsp(200)
	INTEGER*2 INT(200)

C---------------------------------------------------------------------------
	type *,'printing tables...'
	call opnpr(lo,li,lp,'LOGIC.LIS',ncol,nlines)
	TOPOP = .true.
	IPAGE = 0
	ICARDNO = 0 
c write all commands on a separate page, if they will not fit on 5 lines
	IF (cnum .gt. 5) then
	  WRITE(lp,721) 1
	  IPAGE = 1
	  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

!	OPEN (UNIT=LPDF,NAME='PS_JCPDS:DI.library',STATUS='OLD',READONLY,
!	1	FORM='UNFORMATTED',ACCESS='DIRECT',SHARED)
!	OPEN (UNIT=LUNn,NAME='PS_JCPDS:NAME.DIRECT',STATUS='old',
!	1	READONLY,SHARED,FORM='UNFORMATTED',ACCESS='DIRECT')
	DO 10 N=N_Lwords,1,-1
	  NTABLE = TABLE(N)
	  IF (NTABLE.EQ.0) GOTO 10
	  DO J=31,0,-1
	    IF (IBITS(NTABLE,J,1).EQ.1) THEN
C	convert bit# and word# to seq#
	      ISEQ = 32*(N-1) + J + 1
C 	get record numbers from seq#
	      READ (LUNM,rec=ISEQ) JCARD,NAMREC,FULREC,DIREC
	      ISET = JCARD / 10000
	      ICARD = MOD(JCARD,10000)
	      ICARDNO = ICARDNO + 1
	      ipos = 1
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)
		
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 card? 
	      IF (NHEAD+nline .gt. 25 .or. TOPOP) then
		ipage = ipage+1
C prompt every 25 pages
	        if (mod(IPAGE,25) .eq. 0) then
		  write(lo,819) IPAGE-1
819		  format('$You have just printed',i4,
	1		' pages, continue? (Y/[N]): ')
		  read (li,'(a1)',end=999) ans
		  if (ans .ne. 'Y' .and. ans .ne. 'y') goto 999
		endif
		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 (in 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) 
	      ENDIF
	      NLINE = 23
	      if (ipos .eq. 1) then 
	        WRITE(lp,131) ISET,ICARD,FCOR,QM,ICARDNO,NPHASE
131	        FORMAT(' [',I2.2,I4.4,']',4x,'I/Ic=',F12.3,'  QM=',A1,
	1	40x,'Phase',i7,' of',i7,a)
	        NLINE = NLINE - 1
		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) ISET,ICARD,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 card 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 card?
	      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
	    ENDIF
	  ENDDO
10	CONTINUE

999	CALL CLPR(lo,li,lp)
!	CLOSE (UNIT=LPDF)
!	CLOSE (UNIT=LUNn)
1	RETURN
3	RETURN 1
	END
