C record filter C reads variable record length files a record at a time, C then emits the records to a stream_lf file. HUGE C records are supported because these long binary files C are created by FTP in ascii mode. Use to try to convert C munged .tar-z files into usable, decompressable .tar_lzw C files. Integer Recsiz,istati,istato Logical*1 Buf(32000) Integer maxrec,mrc,nbare Character*100 Infilnam,Outfilnam logical*1 barelf(512) C allow records up to 32000 bytes long!!! 1000 Format(Q,200A1,200A1,200A1,200A1,200A1,200A1,200A1,200A1, 1 200A1,200A1,200A1,200A1,200A1,200A1,200A1,200A1,200A1) 1001 Format(200A1,200A1,200A1,200A1,200A1,200A1,200A1,200A1, 1 200A1,200A1,200A1,200A1,200A1,200A1,200A1,200A1,200A1) C above format used to read a record and tell its size. do 10 ii=1,512 barelf(ii)=10 10 continue Write(6,100) 100 format(' Enter input file:') Read(5,101)infilnam 101 Format(a) Write(6,102) 102 Format(' Enter output filename:') Read(5,101)outfilnam nbyt=0 mrc=0 nbare=0 C now have filenames... C open the files first. Inquire(file=infilnam,recl=maxrec) if (maxrec.le.0) stop 'Zero max record len on input' open(unit=1,file=infilnam,access='sequential', 1 form='formatted',iostat=istati,readonly, 2 recl=32000,type='old',err=9998,blocksize=32000, 3 buffercount=1) open(unit=2,file=outfilnam,access='sequential', 1 form='formatted',iostat=istato, 2 recl=32000,type='new',err=9999,blocksize=32000, 3 buffercount=1,initialsize=10, 4 recordtype='stream_lf',carriagecontrol='none') 1 continue read(1,1000,end=9990,err=9991)recsiz,(buf(ii),ii=1,maxrec) mrc=mrc+1 if(mod(mrc,20).eq.0)write(6,200)recsiz,mrc 200 format(' Last recsiz=',i7,' Recs done=',i9) if(recsiz.eq.0)write (6,201)mrc,nbyt 201 format(' Zero length record found, rec no=',i7,' byte:',i10) nbyt=nbyt+recsiz+1 if(recsiz.gt.0.and.nbare.eq.0) 1 write(2,1001,err=9992)(buf(ii),ii=1,recsiz) c Since we don't know exact interaction of writes and suspect a c format (/) may emit TWO LFs, record number of consecutive c LFs here and emit that many when we get a non-null record. c The array overflows at 512 but hope we never get there. if(recsiz.eq.0)nbare=nbare+1 if(nbare.gt.512)stop 'Too many (over 512) null recs together' if(recsiz.gt.0.and.nbare.gt.0) 1 write(2,1001,err=9992)(barelf(iii),iii=1,nbare), 2 (buf(ii),ii=1,recsiz) if(recsiz.gt.0)nbare=0 c if(recsiz.eq.0)write(2,1002) c1002 format (/) if(recsiz.lt.0)stop 'Negative record size' Goto 1 9990 continue stop 'normal exit' 9991 continue stop 'I/O err on read' 9992 continue stop 'I/O error on write' 9998 continue stop 'In file open fail' 9999 continue stop 'Out file open fail' end