	SUBROUTINE RDGET( funit, munit, fldnum, aindx, option, stats )
C
C	retrieve a record from RDM file (funit) using map file (munit)
C	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	fieldno = number of field to perform search on (see FIELDLIST in RDM)
C	(fldnum)  a binary search done if fieldno is master sort key or sort
C		  key used in map file else a sequential search is done.
C	aindx = index in array for compare if field is array type.
C		(no support for arrays of RECORD, or arrays w/in RECORD)
C	Option = 1 Lock this block
C	         2 unlock previously locked blocks
C		 4 Key is unique - return with first matching record
C		 8 Display Trace information (When compiled with Debug)
C                (Options may be added)
C
C	stats = status of RDGET operation: (Additive)
C
C		 1 = record not retreived
C		 2 = bad fieldno or illegal key type
C		 4 = bad unit number/file 
C		 8 = block locking failure
C		16 = Binary search performed 
C		32 = unsorted records at eof
C		64 = Unsorted section was searched 
C
C	value = in RDMBUF, must have contents of search key
C	keyval = working copy of value
C	keypoint = pointer to current position w/in the key (record)
C	rec = if record is found with value, rec will have contents of record.
C		else rec will be undefined. (whatever was there before)
C
C	If the record is not found the file record pointer doesn't change.
C	no boolean keys, please.
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..
	BYTE	fldtmp(256)	!temporary field for comparisons
	Byte	keyval(256)	!working copy of key value
	Integer*4 Trecno,Tmrno,	
	1		top,bottom	!pointers for binary search
C
C	types of comparisons that RDGET can make
C
	REAL*8		real8,treal8	!for real4, dollar data types
	REAL*4		real4,treal4	!for real, longdate, time data types
	INTEGER*2	int2w(2)	!for long, money data types 
	integer*2	tint2w(2)	!(must handle reversed words)
	INTEGER		int2,tint2	!for integer, date, scalar data types
	BYTE		byt,tbyt	!for byte, and possibly bit data types
	CHARACTER*255	strng,tstrng	!for char, string, numeric data types
	Logical*1	found		!a record matches (used in resolving
C					!non-unique keys)
	Logical*1	greatr,		!flag to signal > handling at end
	1		array,		!flag to signal array
	2		lock,		!signals block locking
	3		unlock		! "       "    unlocking
	Byte		answer
	Integer*4	mfrnos(128)	!map file record numbers
	Equivalence	(mfrnos,mblock)
C
C	equivalence comparison types to value (passed by application)
C
	EQUIVALENCE( keyval(1), real8 )
	EQUIVALENCE( keyval(1), real4 )
	EQUIVALENCE( keyval(1), int2w )
	EQUIVALENCE( keyval(1), int2 )
	EQUIVALENCE( keyval(1), byt )
	EQUIVALENCE( keyval(1), strng )
	EQUIVALENCE( keyval(1), inword )
C
C.. Equivalence comparison types for record key buffer
C
	EQUIVALENCE( fldtmp(1), treal8 )
	EQUIVALENCE( fldtmp(1), treal4 )
	EQUIVALENCE( fldtmp(1), tint2w )
	EQUIVALENCE( fldtmp(1), tint2 )
	EQUIVALENCE( fldtmp(1), tbyt )
	EQUIVALENCE( fldtmp(1), tstrng )
	EQUIVALENCE( fldtmp(1), tword )
C
	INTEGER stats, CONPNT, Munit
	LOGICAL*1    maping,	!.TRUE. if a valid munit and mapped
	1	     binary,	!.TRUE. if going to use binary search
	2	     unsrtd,	!.TRUE. RDM file has some unsorted records
	3	     recrd,	!.TRUE. if search is on type Record
	4	     unique,	!.TRUE. if key is unique
	5	     start,	!.True. if Starting with "Current" Record
	6	     tail	!.True. if searching only Unsorted section
D	Logical*1    trace	!.True. if tracing desired (debug mode)
C
C.. table for handling data type RECORD
C
	Parameter (mfrec=4)	! maximum fields w/in one record
	INTEGER nrf,		! number of record fields
	1	rfnum(mfrec),	! field number table
	2	rpoint		! pointer to current record field
C
C.. Clean the exhange buffer
C
	Do 5 I = 1, 512
	   rec(I) = 0
5	Continue
	Stats = 0			!assume everything will go O.K.
C
C.. See if unit number has changed since last RDM call
C
	If (Curfil.Le.0.Or.(funit.Ne.Units(Curfil))) Then
C
C.. search the table for the right file index (curfil)
C
	   Oldblk = 0
	   Do 10 I = 1, Nfiles
	     Curfil = I
	     If (Units(I).Eq.funit) Goto 20
10	   Continue
C
C.. not in table
C
	   Stats = Stats.Or.5	! 1-not retreived / 4-bad unit or file
	   Return
C
C.. Got it
C
20	   Continue
	   Ich = Ichan(Curfil)
	Endif
C
C.. let's get started -- calculate some parameters & set up
C
	nrecs = 512/Rsize(Curfil)	!number of records per block
	fieldno = fldnum + fldofs(Curfil) !adjusted field number
	ftyp = RecDef( fieldno,1 )	!get field data type
	fsiz = RecDef( fieldno,3 )	!get field size
D	Trace = (Option.And.8).Ne.0
D	If (Trace) Type *,' Rdget file>',Rdmnam(Curfil)
D	if (trace) type *,' rdget> *** start ***'
D	if (trace) type *,' Fieldno =',Fieldno,' fsiz =',fsiz,' ftyp =',ftyp
	Lock =   (Option.And.1).Ne.0
	Unlock = (Option.And.2).Ne.0
	Unique = (Option.And.4).Ne.0
	Start =  (Option.And.16).Ne.0
	Tail =   (Option.And.32).Ne.0
C
C.. check for impossible searches (boolean or bit keys, fsiz=0)
C
	IF ((ftyp.EQ.3).Or.(ftyp.eq.8).OR.(fsiz.EQ.0)) THEN 
D	   If (trace) Type *,' Rdget> Impossible Search'
	   Stats = Stats.Or.3	! 1-not retreived/2-bad fieldno or key type
	   RETURN
	ENDIF
C
C.. load the key value into its buffer
C
	Do 30 I = 1, fsiz
	   keyval(I) = value(I)
30	Continue
	Keypoint = 0
C
C.. if dealing with an array, adjust offset W/in record for array index
C
	array = RecDef(Fieldno,4).Ne.0
	IF ( array ) THEN 
D	   If (Trace) Type *,' Rdget> setting up for array'
	   fofs = (aindx-1)*fsiz + RecDef( fieldno,2 ) !offset in record
	ELSE
	   fofs = RecDef( fieldno,2 )
	   If (Aindx.Ne.0) Type *,' Rdget> *** Warning *** Array index ',
	1  'without Array '
	ENDIF
C
C.. find out if using a map file
C
	maping = mapped(Curfil).AND.(munit.GT.0)
C
C.. set binary search flag if fieldno is primary (or implied) sort key 
C
	If (.Not.maping) Then
	   binary = sort( 1, Curfil ).EQ.fieldno
	   If (.Not.binary) binary = sort ( 2, Curfil).EQ.fieldno
	Else
C
C.. Make sure we are positioned correctly in the map table
C
D	   If (Trace) Type *,' Rdget> using a map'
	   If (Curmap.Le.0.Or.Nmaps.Eq.0) Stop 'Rdget> No map files open'
	   If (munit.Ne.Mapunit(1,Curmap)) Then		! change map files
	      Do 40 Im = 1, Nmaps
	         If (Mapunit(1,Im).Eq.munit) Then
	           Curmap = Im
	           Goto 50
	         Endif
40	      Continue
	      Type *,'Rdget> Map Unit',munit,' not open'
	      Stop
50	      Continue
	   Endif
	   If (Mapunit(2,Curmap).Ne.funit) Then		! wrong file
	     Type *,' Rdget> Attempt to use map with unrelated file'
	     Stop
	   Endif
	   binary = Msort(Curmap).Eq.fieldno
	Endif
C
C. binary search only first field of array
C
	If (binary.And.array) binary = Aindx.Eq.1
D	If (Trace) then
D	   If (binary) then
D 	      Type *,' Rdget> will use Binary Search'
D	   else
D	      Type *,' Rdget> will use Sequential Search'
D 	   Endif
D	Endif
C
C.. test for unsorted records appended to end of file 
C
	Unsrtd = xRnum(Curfil).NE.xSnum(Curfil)
	If (Unsrtd) Stats = Stats.Or.32
D	If (Unsrtd.And.Trace) Type *,' Rdget> unsorted records at eof'
C
C.. If we are going to search on RECORD Datatype, some setup is required
C
	recrd = ftyp.eq.5
	If (recrd) Then
D	   If (Trace) Type *,' rdget> setup for search on type RECORD '
	   nrf = 0
C
C.. set up table of fields that will be used in the comparisons
C
51 	   Continue
	   nxtseq = Recdef(fieldno,5)		! next dictionary record
	   fieldno = Dictab(nxtseq)		! convert to field #
	   ftyp = Recdef(fieldno,1)
	   If (ftyp.eq.17) Goto 52		!end of record field
	   nrf = nrf + 1
	   if (nrf.Gt.mfrec) Stop 'rdget> too many fields w/in record'
	   rfnum (nrf) = fieldno
	   Goto 51
C
C.. load the first field w/in record into search buffer
C
52	   Continue
	   Assign 54 to CONPNT		!CONPNT = continuation point
	   Goto 14000
	Endif				!record setup finished
C
C.. set up for the search
C
54	Continue
	Found = .False.
	IF (binary) THEN		!set up binary search ptrs
	   IF (maping) THEN		!use map file
		top = mRnum(Curmap)	!end of records(elements)
		bottom = 0
		tmrno = top/2
	   ELSE				!use RDM file
		top = xSnum(Curfil) - 1	!end of sorted records
		bottom = 0
		trecno = top/2
	   ENDIF
	ELSE				!sequential search
	   tmrno = 0
	   trecno = 0
	ENDIF
C
C.. Get record number from map file.
C
55	CONTINUE
	IF (maping) THEN
	  IF (tmrno.Le.112) THEN 	!1st 32 words is file header
	     mblkno = 1
	     mrcptr = tmrno + 16	!offset into block (skip header)
	  ELSE
	     mr = tmrno - 112
	     mblkno = mr / 128 + 2		!Calculate block #
	     mrcptr = MOD( mr , 128 )	!array element w/in block
	  ENDIF
	  IF (mblkno.NE.oldmbk) READ(munit'mblkno) mblock
	  oldmbk = mblkno
	  trecno = mfrnos(mrcptr)
	ENDIF
C
C.. got record number, retrieve RDM record
C
70	Continue
D	If (Trace) type *,' -> Top =',top,' Bottom=',bottom,' trecno=',trecno
D	If (Trace) type *,'    rpoint=',rpoint
	blkno = (trecno/nrecs)+Hnum(Curfil)+1	!no block spanning records
	IF (blkno.NE.oldblk) READ(funit'blkno) block
	oldblk = blkno
	recptr = MOD(trecno,nrecs)*Rsize(Curfil)	!offset into block
	greatr = .False.
C
C.. compare record with key value
C
C.. Load the field into the comparison buffer
C
	DO 80 k=1,fsiz
	   fldtmp(k) = block( recptr+fofs+k )
80	Continue
C
	Gindx = ftyp + 1
C
C ftyp =       0   1   2    3    4     5   6   7     8   9   10  11
C             ------------------------------------------------------
	Goto (100,200,300,10000,100,10000,100,300,10000,300,300,500,
	1     600,500,600,200,10000,10000,10000,200),Gindx
C              -------------------------------------
C  	       12  13  14  15   16    17    18   19 = ftyp
C
C Note: does not handle synonyms or nested records
C
C.. types Integer (0), Date (4), Scalar (6) (Integer*2)
C
100	Continue
D	   If (Trace) type *,' int2 comparison (key,rec)=',int2,tint2
D	   If (Trace) type 101,int2,tint2
101	   Format('   in octal key>',O6.6,' Record>',o6.6)
	   IF (int2.EQ.tint2) GOTO 9000
	   IF (int2.LT.tint2) GOTO 12000
	   GOTO 13000
C
C.. types Real (1), Longdate (15), Time (19) (Real*4)
C
200	Continue
D	   If (Trace) type *,' real4 comparison (key,rec)=',real4,treal4
	   IF (real4.EQ.treal4) GOTO 9000
	   IF (real4.LT.treal4) GOTO 12000
	   GOTO 13000
C
C.. Char (2), String(9), & Byte (7) 
C
300	Continue
D	   If (Trace) type *,' string comparison key=',strng(1:fsiz)
D	   If (Trace) Type *,' tstring >',tstrng(1:fsiz)
	   IF (strng(1:fsiz).EQ.tstrng(1:fsiz)) GOTO 9000
	   IF (strng(1:fsiz).LT.tstrng(1:fsiz)) GOTO 12000
	   GOTO 13000
C
C.. Real4 (13) & Dollar (11) (Real*8)
C
500	Continue
D	   If (Trace) type *,' real8 comparison=(key,rec)=',real8,treal8
	   IF (real8.EQ.treal8) GOTO 9000	!Found
	   IF (real8.LT.treal8) GOTO 12000	!goto less than computations
           GOTO 13000				!goto greater than comput.
C
C.. types Long (14), Money (12) 2-Word integers (non-standard)
C
600	Continue
D	   If (Trace) type *,' int4 comparison (key,rec)=',int2w,tint2w
	   Iw = 0
640	   Continue
	     Iw = Iw + 1
	     If (Iw.Ge.3) Goto 9000			! both words match
	     If (int2w(Iw).eq.tint2w(Iw)) Goto 640	! this word matches
	     If (int2w(Iw).Lt.tint2w(Iw)) Goto 12000
             Goto 13000
C
C.. End of Computed Goto
C
C-------------------------------------
C
C.. Found a record that matches
C
9000	Continue
D	If (Trace) Type *,' Rdget> ****Match****'
C
C.. Handle RECORD, if necessary
C
	If (recrd) then
D	  If (Trace) Type *,' Rdget> in record handling '
	  If (rpoint.lt.nrf) Then	! we ain't done yet
D	    If (Trace) type *,'       -- loading the next field in record --'
	    rpoint = rpoint + 1
C
C.. load the next field in the record
C
	    If (keypoint.Eq.0) Keypoint = fsiz
	    fieldno = rfnum(rpoint)
	    ftyp = RecDef( fieldno,1 )	!get field data type
	    fofs = RecDef( fieldno,2 )	!offset w/in data record
	    fsiz = RecDef( fieldno,3 )	!get new field size
C
C.. adjust the keyvalue so we use the right comparison value
C.	check for word alignment unless Char(2) or Byte(7)
C
	    If ((MOD(Keypoint,2).Ne.0)	!pointer not word aligned
	1         .And.(ftyp.Ne.2.And.ftyp.Ne.7)) Keypoint = Keypoint + 1
	    Do 9050 I = 1, fsiz
	       keypoint = keypoint + 1
	       keyval(i) = value(keypoint)
9050	    Continue
	    Goto 70			!do the next field
	  Endif
	Endif
C
C.. Check to make sure it's the first one 
C
	found = .True.	! set the flag that we have found one
	If (Binary.And..Not.Unique) then ! it might not be the first one
D	  If (Trace)   Type *,' Modifying binary pointers for uniqueness'
D	  If (Trace) type *,'  adjusting the top '
	  If (.Not.recrd) Goto 12000
C
C.. handle non-unique record key by reseting record to first field
C
	  Assign 12000 to CONPNT
	  Goto 14000
	Endif
C
C.. The End (Return point)
C
10000	CONTINUE
D	If (Trace) Then
D	Type *,' -- Welcome to the End -- '
D	Type *,' top =',top,' bottom=',bottom,' trecno=',trecno
D	Type *,' blkno=',blkno,' recptr=',recptr
D	endif
	If (binary) Stats = Stats.Or.16
C
C.. failure
C
	If (.Not.Found) Then
	   stats = stats.Or.1 	!(not found)
	   recnum = 0
	   Recno(Curfil) = 0
D	   If (Trace) type *,'record not found'
	   RETURN
	Endif
C
C.. success
C
	If (Greatr) Then	! it's the Next record
	   trecno = trecno + 1
	   blkno = (trecno/nrecs)+Hnum(Curfil)+1
	   IF (blkno.NE.oldblk) READ(funit'blkno) block
	   oldblk = blkno
	   recptr = MOD(trecno,nrecs)*Rsize(Curfil)
D	   If (trace) then
D	     type *,' ---adjusted values---'
D	     Type *,' top =',top,' bottom=',bottom,' trecno=',trecno
D	     Type *,' blkno=',blkno,' recptr=',recptr
D	   endif
	Endif
C
C.. Load it into the buffer
C
	DO 10120 k=1,Rsize(Curfil)
	   rec( k ) =  block( recptr+k )
10120	Continue
	Recno(Curfil) = trecno	! save record number for Rdnxt
	recnum = trecno + 1
D	If (Trace) type *,' Rdget> Recno(Curfil) =',Recno(Curfil)
D	If (Trace) type *,' Rdget> Curfil=',Curfil,' Recnum=',Recnum
C
C.. handle block locking here
C
	If (Access(Curfil).Ne.1) Return
D	If (Trace) Type *,' Rdget> will try to lock record'
	tsxblk = blkno - 1
C
C.. unlock all (previously) locked blocks on this channel
C
	If (Unlock) Call Iualbk(Ich,Ierr)
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(' ',A1,'Rdget> Record did not lock -- ',
	1	'Try Again ? [Y]',2A1)
	      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 = Stats.Or.8	!block lock failure
	   Endif
	Endif
	If (maping) Mrcno(Curmap) = tmrno
	RETURN
C-------------------------------------------------------
C
C	The Search 
C
C	target is LESS THAN current record, lower the top
C
12000	Continue
D	If (Trace) Type *,' ** target is LESS THAN CURRENT Record '
C
C.. binary
C
	IF (binary) THEN
	   IF (maping) THEN			! we're using a map
	      IF (bottom.Ge.top) GOTO 10000	! binary can't find it..finis
	      top = tmrno - 1			! reset binary pointers
	      tmrno = (top + bottom)/2
	   ELSE					!ptrs are to RDM file
	      IF (bottom.Ge.top) THEN		! binary can't find it
D               if (trace) Type *,'     bottom > top '
		If (.Not.unsrtd) Goto 10000	! nothing else to search
	        If (Found) Goto 10000
D	        If (Trace) Type *,'     start sequential search of unsrtd'
		binary = .FALSE.		! start seq. search
		trecno = xSnum(Curfil) 		!  with first unsorted rec.
		Stats = Stats.Or.32		! set return flag
	      ELSE
D               if (trace) type *,'       top lowered'
		top = trecno - 1		! reset binary pointers
		trecno = (top + bottom)/2
	      ENDIF				! bottom.vs.top
	   ENDIF				! maping
	ELSE
C
C.. sequential 
C
	   IF (maping) THEN	!ptrs are to map file
	     tmrno = tmrno + 1
	     IF (tmrno.GT.mRnum(Curmap)) GOTO 10000	! end of (map) file
	   ELSE					!ptrs are to RDM file
	     trecno = trecno + 1
	     IF (trecno.GT.xRnum(Curfil)) GOTO 10000 ! eof, bag it.
	   ENDIF
	ENDIF
	If (recrd.and.(Rpoint.Gt.1)) Then
	   Assign 70 to CONPNT
	   Goto 14000
	Endif
	GOTO 70		! go back to comparison section
C
C---------------------------------------------------------------
C
C	target is GREATER THAN current record, raise the bottom
C
13000	Continue
D	If (Trace) Type *,' ** target is GREATER THAN CURRENT Record '
	Greatr = .True.
	IF (binary) THEN	!modify binary search ptrs
	   IF (maping) THEN	!ptrs are to map file
	      IF (bottom.Ge.top) GOTO 10000
	      bottom = tmrno + 1
	      tmrno = (top + bottom)/2
	   ELSE			!ptrs are to RDM file
	      IF (bottom.Ge.top) THEN
D	         If (Trace) Type *,' Bottom > Top '
	         If (Found) Goto 10000		!no need to look
	         IF (.Not.unsrtd) Goto 10000	!nothing to search
D	         type *,' -- Switching to sequential search'
		 binary = .FALSE.		!seq. search
		 trecno = xSnum(Curfil)
	      ELSE
	         bottom = trecno + 1
		 trecno = (top + bottom)/2
	      ENDIF
           ENDIF
	ELSE			!modify sequential ptrs
	   IF (maping) THEN	!ptrs are to map file
	      tmrno = tmrno + 1
	      IF (tmrno.GT.mRnum(Curmap)) GOTO 10000
	   ELSE			!ptrs are to RDM file
	      trecno = trecno + 1
	      IF (trecno.GT.xRnum(Curfil)) GOTO 10000
	   ENDIF
	ENDIF
	If (.Not.recrd.Or.(rpoint.Eq.1)) Goto 70
	Assign 70 to CONPNT
C
C---------------------------------------------
C Reset the Key for first field in Record
C
14000	Continue
D	If (Trace) Type *,' Reseting the record table for first field '
	rpoint = 1
	fieldno = rfnum(rpoint)
	ftyp = RecDef( fieldno,1 )	!get field data type
	fofs = RecDef( fieldno,2 )	!offset w/in data record
	fsiz = RecDef( fieldno,3 )	!get new field size
	keypoint = fsiz
	Do 14100 I = 1, keypoint
	  keyval(I) = value(I)
14100	Continue
	Goto CONPNT
	END
