	program readrt

c read rt-11 files from a tape or tpc image to current directory.
c created 24-OCT-94, Tim Shoppa (shoppa@altair.krl.caltech.edu)

	implicit none

	integer size
	integer blcount,blcountr

	integer mbufsize
	parameter (mbufsize=512)

	logical dironly
	character*1 answer

	character*(mbufsize) buffer
	byte bufbyte(mbufsize)

	character*255 tpc_file
	character*17 file_name

	write(6,1)
1	format(1x,'Tape device or TPC file to read:',$)
	read(5,2) tpc_file
2	format(a255)

	open(unit=11,file=tpc_file,status='old',form='formatted',
     1	carriagecontrol='none')

5	write(6,3)
3	format(1x,'(D)irectory or (E)xtract:',$)
	read(5,4) answer
4	format(a1)
	if (answer.eq.'D'.or.answer.eq.'d') then
	  dironly=.true.
	else if (answer.eq.'E'.or.answer.eq.'e') then
	  dironly=.false.
	else
	  go to 5
	end if

10	read(11,101) size,buffer(1:size)
101	format(q,a<size>)
c	type *,size
	write (6,201)buffer(1:3)
	write (6,202)buffer(4:4)
	write (6,203)buffer(5:10)
	write (6,204)buffer(38:50)

201	format(1x,'Label Identifier:',t30,a3)
202	format(1x,'Label Number    :',t30,a1)
203	format(1x,'Volume Identifier:',t30,a6)
204	format(1x,'Owner Identifier:',t30,a13)

	write(6,250)
	write(6,251)

250	format(1x,'Filename',t20,'Date',t40,'Actual/Reported Blocks')
251	format(1x,'--------',t20,'------',t40,'---------------------')


300	read(11,101,end=9990) size,buffer(1:size)
	if (size.lt.80 .or. buffer(1:4).ne.'HDR1') go to 300

	write(6,301) buffer(5:21),buffer(42:47)
	file_name=buffer(5:21)
301	format(1x,a17,t20,a6,t39,' ',$)

400	read(11,101,end=450) size,buffer(1:size)
	if (size.ne.0) stop ' No tape mark after HDR1 - not RT format?'
450	if (.not.dironly)
     1		open(unit=12,file=file_name,form='unformatted',
     2		recordtype='fixed',recl=128,status='new')
	blcount=0

500	read(11,101,end=600) size,buffer(1:size)
	if (size.eq.0) go to 600
	if (size.ne.512) stop ' Non-512 block length for RT-11 tape.'
	if (.not.dironly) write (12) buffer
	blcount=blcount+1
	go to 500

600	if (.not.dironly) close(12)
	read(11,101) size,buffer(1:size)
	if (buffer(1:3).ne.'EOF') stop 'Expected to see EOF!'
	read(buffer(55:60),*) blcountr
	write(6,605) blcount,blcountr
605	format('+',i5,'/',i5)

	read(11,101,end=300) size,buffer(1:size)
	if (size.eq.0) go to 300
	stop 'No tape mark after EOF!'

9990	stop 'Normal end of tape.'

	end
