	SUBROUTINE RDCLOS( funit )
C
C	funit = unit number associated with RDM file to close
C
C.. this version will compress the field table to reclaim field space
C.. for speed, close files in the order opposite to opening
C
C	Walt Shpuntoff		Institute for Resource Management
C				P.O. Box 869, Arnold, MD 21012
C				(301) 757- 6503
C
	Integer*2 funit,Cfile,fpoint
	Byte Bell,Junk
	Data Bell/7/
	Include 'Rdmcom.for'
C
C.. Preserve the "Current" File settings
C
	Cfile = Curfil
C
C.. determine the internal file number
C
	If (Cfile.Eq.0.Or.(funit.Ne.Units(Cfile))) Then
	   Do 10 I = 1, Nfiles
	      Cfile = I
	      If (funit.Eq.Units(Cfile)) Goto 20
10	   Continue
	   Type 15,Bell
15	   Format(' **** Attempt to Close file that is not Open *****',/,
	1          '      nice trick.....',A1,/,
	2          ' Press RETURN to Continue....')
	   Accept 18,Junk
18	   Format(A1)
	   Goto 900
	Endif
20	Continue
C
C.. last one is simple case; reduce file & field counters
C
	If (Cfile.Eq.Nfiles) Then
	   Nfiles = Nfiles - 1
	   Nfields = fldofs(Cfile)
           If (Cfile.Eq.Curfil) Curfil = 0
	   Goto 800
	Endif
C
C.. compress field table
C
	nremov = fldofs(Cfile + 1) - fldofs(Cfile)
	fpoint = fldofs(cfile)
	Do 600 I = fldofs(cfile+1), Nfields
	   fpoint = fpoint + 1
	   do 500 J = 1, 4
	      recdef(fpoint,j) = recdef(i,j)
500	   Continue
C
C.. Recdef(..,5) & Dictab() are pointers - adjust by # fields removed
C
	   recdef(fpoint,5) = recdef(i,5) - nremov
	   Dictab(fpoint) = Dictab(i) - nremov
600	Continue
C
C.. Compress the file table and reduce file counter
C
	Do 700 i = (Cfile+1), Nfiles
	  Units(I-1) = Units(I)
	  xRnum(I-1) = xRnum(I)
	  xSnum(I-1) = xSnum(I)
	  recno(I-1) = recno(I)
	  Hnum(I-1) = Hnum(I)
	  Rsize(I-1) = Rsize(I)
	  fldofs(I-1) = fldofs(I)
	  ichan(I-1) = ichan(I)
	  Access(I-1) = Access(I)
	  sort(1,I-1) = sort(1,I)
	  sort(2,I-1) = sort(2,I)
700	Continue
	Nfiles = Nfiles - 1
C
C.. The End
C
800	Continue
	Call CLOSE( funit )
900	Continue
	RETURN
	END
��������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������������