SUBROUTINE RDNXT( funit, munit, option, stats ) C C retrieve next sequential record from RDM file (funit) C using map file (munit) if mapped. C C C funit = unit number associated with opened RDM file. C munit = unit number associated with an opened map file. C - not used if mapped flag is .FALSE. or munit=0. C Option = 1 Lock this block C 2 Unlock all other blocks C (Options may be added) C stats = status of RDNXT operation: C 0 = record found and retrieved C 1 = record not found C 2 = End of File C 3 = bad munit number- munit not been opened by MPOPEN C 4 = file not open on that unit C 5 = record did not lock C rec = if record is found with value, rec will have contents of record. C else rec will be undefined. C C If the record is not found the file record pointer doesn't change. C C Walt Shpuntoff Institute for Resource Management C P.O. Box 869, Arnold, MD 21012 C (301) 757- 6503 C IMPLICIT INTEGER(A-Z) INCLUDE 'RDMBUF.FOR' !for application program INCLUDE 'RDMCOM.FOR' !for RDOPEN,RDCLOS, etc.. Integer*4 Mfrnos(128) !Map record numbers (whole block) EQUIVALENCE( Mblock, mfrnos ) C INTEGER*2 stats,option LOGICAL*1 maping !.TRUE. if a valid munit and mapped Logical*1 Lock,Unlock c C C.. unpack the options C Lock = (Option.And.1).Ne.0 Unlock = (Option.And.2).Ne.0 C C.. clear the exhange buffer C Do 5 I = 1, 512 rec(I) = 0 5 Continue C C.. See if unit number has changed since last RDM call C If (Curfil.Le.0.Or.(funit.Ne.Units(Curfil))) Then oldblk = -1 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 stats = 0 !assume everything will go O.K. nrecs = 512/Rsize(Curfil) !number of records per block C C.. find out if using a map file C maping = mapped(Curfil).AND.(munit.GT.0) C C.. make sure we're positioned correctly in the map table C IF (maping) THEN If (Curmap.Eq.0.Or.Nmaps.Lt.1) Then Stat = 3 Return Endif If (Mapunit(1,Curmap).Ne.munit) Then oldmblk = - 1 Do 40 Im = 1, Nmaps If (Mapunit(1,Im).Eq.munit) Then Curmap = Im Goto 50 Endif 40 Continue Stat = 3 Return 50 Continue Endif C C.. increment record number w/in map file & check for eof C mrcno(Curmap) = mrcno(Curmap) + 1 IF (mrcno(Curmap).GT.mRnum(Curmap)) GOTO 1000 C C.. calculate map block # containing map record & position w/in block C IF (mrcno(Curmap).LE.112) THEN !1st block has header mblkno = 1 mrcptr = mrcno(Curmap) + 16 !offset into block ELSE mblkno = (mrcno(Curmap)-112)/128 + 2 mrcptr = MOD( mrcno(Curmap)-112, 128) ENDIF IF (mblkno.NE.oldmbk) READ(munit'mblkno) mblock oldmbk = mblkno C C.. pull physical record number from map C recno(Curfil) = mfrnos(mrcptr) ELSE ! not mapping C C.. increment the physical record number & test for end of file C recno(Curfil) = recno(Curfil) + 1 IF (recno(Curfil).Ge.xRnum(Curfil)) Then stats = 2 ! end of file Return Endif ENDIF C C.. It's OK, retrieve RDM record C blkno = (recno(Curfil)/nrecs)+Hnum(Curfil)+1 IF (blkno.NE.oldblk) Then READ(funit'blkno) block Endif oldblk = blkno recptr = MOD(recno(Curfil),nrecs)*Rsize(Curfil) !offset into block C C.. put record into buffer to pass to application C DO 200 k=1,Rsize(Curfil) rec( k ) = block( recptr+k ) 200 Continue recnum = recno(Curfil) + 1 C C.. do block locking here C C.. handle block locking here C tsxblk = blkno - 1 If (Access(Curfil).NE.1) Return !skip block lock If (Lock) Lock = Access(Curfil).Ne.0 ! read only file C C.. unlock all (previously) locked blocks on this channel C If (Unlock) Then Call Iualbk(Ich,Ierr) Endif C C.. lock the block & Return C If (Lock) Then 10140 Continue Call Lkblk(Ich,tsxblk,Ierr) If (Ierr.ne.0) Then Type 10146,7,8,8 10146 Format(' Rdnxt> Record did not lock -- Try Again ? [Y]',3A1) Accept 10147,Nb,Answer 10147 Format(Q,A) Answer = Answer.And.-33 ! Kick the Upper Case bit If (Nb.eq.0.Or.Answer.Eq.'Y') Goto 10140 Stats = 5 Endif Endif RETURN 1000 CONTINUE stats = 1 RETURN END