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