Subroutine Rdadd(funit,Stats) C C.. RDADD Add a record to an RDM Data file C 11oct85 wms C C *** CAUTION **** This routine will not add records to INDEXED file C C *** Warning *** This Routine Requires EXCLUSIVE Access to File C C Return Codes: 0 - Everything went OK C 1 - End of File hit, record not saved C 2 - Indexed File, Add not allowed C 3 - Non-Exclusive Access to File C 4 - Unknown File (funit) C C Since we don't know the maximum number of entries allowed C in the file, it's all done with the error handling in the C Fortran I/O C C Walt Shpuntoff Institute for Resource Management C P.O. Box 869, Arnold, MD 21012 C (301) 757- 6503 C Implicit Integer*2 (A-Z) Integer*4 Jrec Include 'Rdmcom.For' Include 'Rdmbuf.For' Include 'Rdprem.For' Integer*4 Long Integer*2 Short(2) Equivalence (Short,Long) C C.. See if unit number has changed since last RDM call C If (funit.Ne.Units(Curfil)) Then D type *,' RDadd> **** file change ***' D type *,' will search file table Nfiles>',nfiles,' unit>',funit 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 d type *,' unable to find file' Stats = 4 Return C C.. Got it C 30 Continue Ich = Ichan(Curfil) Endif C C.. If the file is Indexed, or If we do not have Exclusive Access, forget it. C d type *,' file found' Stats = 0 If (Access(Curfil).Ne.2) Stats = 3 If (Indexed(Curfil)) Stats = 2 If (Stats.Ne.0) Return C C.. The record Offset will be Current # of records C Jrec = xRnum(Curfil) D type *,' RDADD> before add # records =',Jrec C C.. initialize some things C stats = 0 !assume everything will go O.K. nrecs = 512/Rsize(Curfil) !number of records per block C C.. calculate block # to hold new record. Note: Hnum = # blocks in header C blocks = JRec / nrecs ! block # w/in data area of file blkno = blocks + Hnum(Curfil) + 1 C C.. Read the block C D type *,' RDADD>reading block #',blkno READ(funit'blkno,Err=900) block C C.. Figure out which record w/in the block C Indx = Jrec - ((Jrec/nrecs)*nrecs) d type *,' record # w/in block=',indx If (Indx.Lt.0) Indx = 0 ! if adding first record Recptr = Indx * Rsize(Curfil) C C.. load it from the common area one byte at a time C Do 100 I = 1, Rsize(Curfil) Block(Recptr + I) = rec(I) 100 Continue C C.. write it back out C D type *,' RDADD>writing block #',blkno Write(funit'blkno,Err=900) block C C.. now read the block with the preamble C D type *,' RDADD>reading preamble block' 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.. update the number of records C xRnum(Curfil) = Jrec + 1 d type *,' there are now ',xRnum(Curfil),' records' C C.. reverse the words (Int*4 was kluged in RDM) C Long = xRnum(Curfil) xRnum1 = Short(2) xRnum2 = Short(1) 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 D type *,' RDADD>writing preamble back out' Write(funit'1,Err=900) block C C.. Normal finish C recno(Curfil) = xRnum(Curfil) recnum = recno(Curfil) Return C C.. errors C 900 Continue Stats = 1 Return End