	program vtcopy
c **23-Jan-92** 9 to x copying of Viking tapes
	implicit integer (a-z)
	integer*2 ih(500),file,mb
	byte data(11250)
	character idr*12,odr*12,it*4,kt*4,tid*6,head*1000,ans*1
&	,buff1*10752,buff2*10764,buff3*11250
	equivalence (head,ih(1)),(tid,ih(2)),(file,ih(5)),(mb,ih(6))
&	,(buff1,buff2),(buff1,buff3),(buff1,data(1))
	data ih/5,499*0/
	parameter(idr='/dev/nrmt8',odr='/dev/nvrsmt0')
c
10	write(*,"('Starting input tape: '$)")
	read(*,'(a)') it
	open(2,file='vtlist',status='old')
15	read(2,1,end=80) kt,tid,nf,bn
1	format(a4,1xa6,i3,i2)
	if (kt.ne.it) go to 15
	open(3)
c
20	write(*,*) 'Mount tape ',it
21	write(*,"('[c]ontinue or [q]uit? '$)")
	read(*,'(a)') ans
	if (ans.eq.'q') go to 99
	if (ans.ne.'c') go to 21
30	st=topen(1,odr,.false.)
	if (st.ne.0) call perror(odr//' open error')
	if (bn.eq.1) then
	 mb=10752
	else if (bn.eq.2) then
	 mb=10764
	else
	 mb=11250
	 end if
	write(*,2) (ih(i),i=1,4),nf,ih(6)
	write(3,2) (ih(i),i=1,4),nf,ih(6)
2	format(i5,2x3a2,i4,i7)
	do file=1,nf
	 nb=twrite(1,head)
	 if (nb.ne.1000) go to 90
	 st=topen(0,idr,.false.)
	 if (st.ne.0) call perror(idr//' open error')
	 nr=0
	 go to (31,32,33), bn
31	 nb=tread(0,buff1)
	 go to 34
32	 nb=tread(0,buff2)
	 go to 34
33	 nb=tread(0,buff3)
34	 if (nb.le.0) go to 40
	 if (nb.lt.mb) then
	  i1=nb+1
	  do i=i1,mb
	   data(i)=-1
	   end do
	  end if
	 go to (36,37,38), bn
36	 nb=twrite(1,buff1)
	 go to 39
37	 nb=twrite(1,buff2)
	 go to 39
38	 nb=twrite(1,buff3)
39	 if (nb.ne.mb) go to 90
	 nr=nr+1
	 go to (31,32,33), bn
40	 if (nb.lt.0) write(*,*) 'Read error ', nb
	 st=tclose(0)
	 if (st.ne.0) call perror(idr//' close error')
	 write(*,*) tid,file,nr
	 write(3,*) tid,file,nr
	 end do
	st=tclose(1)
	if (st.ne.0) call perror(odr//' close error')
	read(2,1,end=99) kt,tid,nf,bn
	if (kt.eq.it) go to 30
	call system('mt -f '//idr//' offline')
	call system('mts -t '//odr)
	it=kt
	go to 20
c
80	close(2)
	write(*,*) it,' not found -last file ',kt
	go to 10
c
90	call perror('write error')
	st=tclose(0)
	if (st.ne.0) call perror(idr//' close error')
	st=tclose(1)
	if (st.ne.0) call perror(odr//' close error')
	call system('mt -f '//idr//' offline')
99	close(2)
	close(3)
	call system('mt -f '//odr//' eof')
	call system('mts -t '//odr)
	call system('mt -f '//odr//' offline')
	stop
	end
