SUBROUTINE RDPUT( funit, lock, stats ) C C.. write the last record retrieved back to RDM file (funit) C C funit = unit number associated with opened RDM file. C stats = status of RDPUT operation: C 0 = record written to file successfully C 1 = error in write C 2 = attempt to put to wrong file C 3 = File is Read Only C lock = block locking action to take C 0 = unlock block after write C 1 = keep block locked (i'm not sure why) C rec = rec has contents of record to save C C NOTE: The file record pointer (recno, blockno) does not change C C Walt Shpuntoff Institute for Resource Management C 2666 Riva Road - Suite 360 C Annapolis, MD 21401 C (301) 266 - 9216 C IMPLICIT INTEGER*2 (A-Z) INCLUDE 'RDMBUF' !for application program INCLUDE 'RDMCOM' !for RDOPEN,RDCLOS, etc.. C INTEGER*2 stats,Ierr C C.. See if unit number has changed since last RDM call C d Type *,'--> IN RDPUT <--' If (Curfil.Le.0.Or.(funit.Ne.Units(Curfil))) Then D TYPE *,' Rdput> unit number changed, record not rewritten' Stats = 2 Return Endif C C.. Make sure the file has been opened with write access c If (Access(Curfil).Eq.0) Then ! it is a read only file d Type *,' RDput> Attempt to Write to Read-Only File' Stats = 3 Return Endif stats = 0 !assume everything will go O.K. C C.. block should already be locked. C C... recompute blkno & recptr based on recno(curfil) C d Type *,' Rdput> Record #',Recno(Curfil) d Type *,' rdput> calculating the block number' nrecs = 512/Rsize(Curfil) !number of records per block blkno = (recno(Curfil) / nrecs) + Hnum(Curfil) + 1 d type *,' rdput> reading in block #', blkno READ(funit'blkno) block oldblk = blkno recptr = Mod(Recno(Curfil),nrecs)*Rsize(Curfil) C C.. put rec into appropiate bytes w/in block C d type *,'rdput> transfering record from buffer into block' DO 10 k=1,Rsize(Curfil) block( recptr+k ) = rec( k ) 10 Continue C C.. got record number and block number for RDM file C D Type *,'rdput> about to write back to file',Recnum WRITE(funit'blkno,ERR=1000) block d type *,'rdput> block returned to file' C C.. Unlock the block (if requested) C If ((Lock.Eq.0).And.(Access(Curfil).Eq.1)) Then D type *,' rdput> calling Iuspbk to unlock block' Ierr = Iuspbk( Ich, Tsxblk) D type *,' rdput> return code ',Ierr If (Ierr.Ne.-1) Then pause ' Rdput> block unlock failed' Stats = 1 Endif Endif C d Type *,' Rdput> about to return' RETURN 1000 CONTINUE stats = 1 D type *,' rdput> unable to write block back to disk' RETURN END