Subroutine Rdfutl ( funit, Option ) C C.. RDM Fortran Utility C C Walt Shpuntoff Institute for Resource Management C P.O. Box 869, Arnold, MD 21012 C (301) 757- 6503 C C Options C 9 = Zero Record Count 8.may.86 ws C Include 'Rdprem' Include 'Rdmcom' Integer funit,Option c c.. See if unit number has changed since last RDM call c If (funit.Ne.Units(Curfil)) Then c c.. search the table for the right file index (curfil) c Do 20 I = 1, Nfiles Curfil = I If (Units(I).Eq.funit) Goto 30 20 Continue c c.. not in table c Stats = 4 Return c c.. Got it c 30 Continue Ich = Ichan(Curfil) Endif C c.. check to make sure file is open & exclusive access c If (Option.Eq.9) Then Iacs = 0 ! Exclusive Access Ierr = Idclsf(Ich,Iacs) If (Ierr.Ne.0) Then C C. File Lock Error Messages C Type *,' *** Warning *** File Access Problem',bell Type *,' File =',fil,' Code=',Ierr If (Ierr.Eq.4) Type *,' Unable to get Exclusive Access to File' Type 1 1 Format(' Press RETURN to continue...',$) Accept 2,nb,Junk 2 Format(q,A) Stat = Ierr Goto 900 Endif c c.. read the preamble block c Read(funit'1,Err=900) block c c.. load the preamble record into its' buffer c DO 300 k=1,64 preamb(k) = block(k) 300 Continue c c.. change number of records to 0 c xRnum1 = 0 xRnum2 = 0 xRnum(Curfil) = 0 xSnum1 = 0 xSnum2 = 0 c c.. load preamble back into i/o block c DO 400 k=1,64 block(k) = preamb(k) 400 Continue C C.. write it back out C Write(funit'1,Err=900) block Endif Return 900 Continue Stop 'RDFUTL> Unable to Complete Operation' Return End