program xetlist2
c **20-Oct-92** exabyte event tape file event list
c **rev.16-Sep-99**
c %f77 xetlist.f Ntimex.f
	implicit integer (a-z)
	integer*2 hdr(8)
	character filename*16,ext*8
	real ssec,esec
	logical last
	common data(4864),tsave(2),sdhm(2),sms,edhm(2),ems
	equivalence (data(1),hdr(1))
	tim(j)=and(data(j),2147483647)
c
	write(*,"('Open xetfilelist.'$)")
	read(*,'(a)') ext
	open(1,file='xetfilelist.'//ext,status='old')
	open (2,file='xetcontents.'//ext)
10	read(1,'(a)', end=99) filename
	open (3,file=filename,access='direct',form='unformatted'
&	,recl=19456,status='old')
	write (2,*) 'File: ',filename
	write(*,'(a)') filename
	read (3,rec=1) data
	if (hdr(6).eq.1) then
	 write (2,"('New format')")
	 nsb=6
	else
	 nsb=3
	 end if
	nbb=4860/nsb
	crec=1
	it=0
	last=.false.
c
20	do n=1,nsb
	 if (.not.last) then
	  p=(n-1)*nbb+5
	  ct=tim(p)
	  dt=(ct-it)
	  end if
	 if (iabs(dt).gt.225000.or.last) then
	  if (it.gt.0) then
	   eblk=n-1
	   erec=crec
	   if (eblk.eq.0) then
	    eblk=nsb
	    erec=crec-1
	    call time03(tsave,edhm)
	   else
	    call time03(data(p-nbb),edhm)
	    end if
	   ssec=sms/1000.
	   esec=ems/1000.
	   write(2,2) srec,sblk,erec,eblk,year,sdhm,ssec,edhm,esec
2	   format(i4,'/',i1,'-',i4,'/',i1,':',3i5,f7.3,' -',2i5,f7.3)
	   end if
	  if (last) go to 30
	  srec=crec
	  sblk=n
	  year=hdr(5)
	  if (dt.lt.-225000.and.n.gt.1) year=year+1
	  call time03(data(p),sdhm)
	 end if
	 it=tim(p)
	 do i=1,2
	  tsave(i)=data(p+i-1)
	  end do
	 end do
	crec=crec+1
	read (3,rec=crec,end=29) data
	go to 20
29	last=.true.
	go to 20
c
30	close(3)
	write(2,*)
	go to 10
c
99	close(1)
	close(2)
	stop
	end