program xetlistb
c **20-Oct-92** exabyte event tape file event list **rev.17-Jul-00**
c ** Linux version ** 23-Jan-01 **
c %f77 xetlistb.f Ntimexb.f
	implicit integer (a-z)
	integer*2 hdr(8)
	character filename*16,ext*8
	real ssec,esec
	common data(4864),tsave(2),sdhm(2),sms,edhm(2),ems
	equivalence (data(1),hdr(1))
	tim(j)=and(lshift(data(j),24),'7f000000'x)
	1+and(lshift(data(j),8),'ff0000'x)
	1+and(rshift(data(j),8),'ff00'x)+and(rshift(data(j),24),'ff'x)

c
	open (2)
10	write (*,"('Open etdata.'$)")
	read (*,'(a)') ext
	if (ext.eq.' ') stop
	filename='etdata.'//ext
	write (2,*) 'File: ',filename
	open (1,file=filename,access='direct',form='unformatted'
	1,recl=4864)
	read (1,rec=1) data
	if (hdr(6).eq.'100'x) then
	 write (2,'(a)') 'New format'
	 nsb=6
	else
	 nsb=3
	 end if
	nbb=4860/nsb
	crec=1
	it=0
c
20	do n=1,nsb
	 p=(n-1)*nbb+5
	 ct=tim(p)
	 dt=(ct-it)
	 if (iabs(dt).gt.225000) 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
	  srec=crec
	  sblk=n
	  year=and(lshift(hdr(5),8),'ff00'x)+and(rshift(hdr(5),8),'ff'x)
	  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 (1,rec=crec,err=90) data
	go to 20
c
90	if (it.gt.0) then
	 eblk=nsb
	 erec=crec-1
	 call time03(tsave,edhm)
	 ssec=sms/1000.
	 esec=ems/1000.
	 write(2,2) srec,sblk,erec,eblk,year,sdhm,ssec,edhm,esec
	 end if
	close (1)
	write (2,*)
	go to 10
	end