program xetlist c **20-Oct-92** exabyte event tape file event list **rev.17-Jul-00** c %f77 xetlist.f Ntimex.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(data(j),2147483647) 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' & ,recl=19456) read (1,rec=1) data if (hdr(6).eq.1) then c print 1 write (2,1) 1 format('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. c print 2, srec,sblk,erec,eblk,year,sdhm,ssec,edhm,esec 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=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 (1,rec=crec,end=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