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 8 Display Trace information (compiled with debug) 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 2666 Riva Road - Suite 360 C Annapolis, MD 21401 C (301) 266 - 9216 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 D Logical*1 Trace c C C.. unpack the options C Lock = (Option.And.1).Ne.0 Unlock = (Option.And.2).Ne.0 d Trace = (Option.And.8).Ne.0 D If (Trace) Then d Type *,' Rdnxt> ---- Start ----' d Type *,' Options =',Options d Endif 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 D If (Trace) Type *,' Rdnxt> *** File Change ***' 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 If (Trace) Type *,' Rdnxt> file not in table' Stats = 4 D If (Trace) Type *,' Rdnxt> Returning with Status=',Stats 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 D If (Trace) Type *,' Rdnxt> using a map' If (Curmap.Eq.0.Or.Nmaps.Lt.1) Then Stat = 3 D If (Trace) Type *,' Rdnxt> Returning with Status=',Stats 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 D If (Trace) Type *,' Rdnxt> Returning with Status=',Stats 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 D If (Trace) Type *,' Rdnxt> trying for Record #',Recno(Curfil) IF (recno(Curfil).Ge.xRnum(Curfil)) Then D If (Trace) Type *,' Rdnxt> ***EOF***' stats = 2 ! end of file D If (Trace) Type *,' Rdnxt> Returning with Status=',Stats Return Endif ENDIF C C.. It's OK, retrieve RDM record C blkno = (recno(Curfil)/nrecs)+Hnum(Curfil)+1 IF (blkno.NE.oldblk) Then D If (Trace) Type *,' Reading in a new disk block' READ(funit'blkno) block Endif oldblk = blkno recptr = MOD(recno(Curfil),nrecs)*Rsize(Curfil) !offset into block D If (Trace) Type *,' Byte Offset in block (recptr)>',recptr C C.. put record into buffer to pass to application C DO 200 k=1,Rsize(Curfil) rec( k ) = block( recptr+k ) 200 Continue d If (Trace) Type *,' transferred to Rec()' 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 D If (Trace) Type *,'Rdnxt> calling to unlock all blocks' Call Iualbk(Ich,Ierr) d If (Trace) Type *,'Rdnxt> Return code from Iualbk=',Ierr Endif C C.. lock the block & Return C If (Lock) Then D If (Trace) Type *,' Rdnxt> in block locking section' 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 D If (Trace) Type *,' Rdnxt> Returning with Status=',Stats RETURN 1000 CONTINUE stats = 1 D If (trace) type *,'record not found' D If (Trace) Type *,' Rdnxt> Returning with Status=',Stats RETURN END