Viewing contents of file '../idllib/uit/pro/dbfind_sort.pro'
pro dbfind_sort,it,type,svals,list
;+
; NAME:
;	DBFIND_SORT   
; PURPOSE:
;	This is a subroutine of dbfind and is not a standalone procedure
;	It is used to limit the search using sorted values
;
; CALLING SEQUENCE:
;	dbfind_sort, it, type, svals, list
;
; INPUT: 
;	it - item number, scalar
;	type - type of search (output from dbfparse)
;	svals - search values (output from dbfparse)
;
; INPUT/OUTPUT:
;	list - found entries
;	!err is set to number of good values
;	!ERR = -2 for an invalid search
;
; REVISION HISTORY:
;	D. Lindler  July,1987
;-
;----------------------------------------------------------------------------
;	READ EVERY 512TH VALUE IN SORTED VALUES
;
; get item info
;
itnum = db_item_info('itemnumber',it)	;item number in this dbno
index_type = db_item_info('index',it)
;
; get unit number of index file and read header info
;
unit = db_info('UNIT_DBX',0)
pi = assoc(unit,lonarr(2))
h = pi(0)
pi = assoc(unit,lonarr(7,h(0)),8)
header = pi(0)
items = header(0,*)
pos = where(items EQ itnum) & pos=pos(0)
;
; find starting location to read
;
sblock = header(3,pos)
sbyte = 512L*sblock
nv = (db_info('ENTRIES',0)+511)/512
;
; create mapped i/o variable
;
dtype = db_item_info('IDLTYPE',it)
p = assoc(unit,make_array( size=[1,nv,dtype(0),0],/NOZERO), sbyte)
numbyte = [0,1,2,4,4,8,0]
num_bytes = numbyte( dtype(0) )
;
; read values from file (for every 512th entry)
;
values=p(0)
;
;------------------------------------------------------------------
; CONVERT INPUT SVALS TO CORRECT DATA TYPE
;
; determine data type of values to be searched
;
s=size(values) & nv = N_elements(values)
;
; convert svals
;
nvals = type>2
sv=replicate(values(0),nvals)
for i=0L,nvals-1 do sv(i)=strtrim(svals(i),2)
sv0 = sv(0) & sv1 = sv(1)
;
;--------------------------------------------------------------------------
; FIND RANGE OF VALID SUBSCRIPTS IN LIST
;
;
case type of
 
	0: begin				;value=sv0
		good = where(values LT sv0)
		if !err LT 1 then first=0 else first=!err-1
		good=where(values GT sv0)
		if !err LT 1 then last=nv else last=good(0)
	   end

	-1: begin				;value>sv0
		good = where(values LT sv0)
		if !err LT 1 then first=0 else first=!err-1
		last = nv
	    end

	-2: begin				;value<sv1
		good = where(values GT sv1)
		if !err LT 1 then last=nv else last=good(0)
		first = 0
	    end

	-3: begin				;sv0<value<sv1

	    if sv1 LT sv0 then begin
	        temp = sv0
		sv0 = sv1
		sv1 = temp
	    end
		good = where(values LT sv0)
		if !err LT 1 then first=0 else first=!err-1
		good = where(values GT sv1)
		if !err LT 1 then last=nv else last=good(0)
	    end 
	-5: begin				;sv1 is tolerance

	    minv = sv0-abs(sv1)
	    maxv = sv0+abs(sv1)
		good = where(values LT minv)
		if !err LT 1 then first=0 else first=!err-1
		good = where(values GT maxv)
		if !err LT 1 then last=nv else last=good(0)
	    end

	-4: begin			;non-zero
		if values(0) EQ 0 then begin
			good=where(values EQ 0)
			first=!err-1
			last=nv
		 end else begin	;not allowed
			!err=-2
			return
		end
	   end
	else: begin				;set of values
              sv0 = min(sv(0:type-1)) & sv1 = max(sv(0:type-1))
		good=where(values LT sv0)
		if !err LT 1 then first=0 else first=!err-1
		good=where(values GT sv1)
		if !err LT 1 then last=nv else last=good(0)
	      end
endcase
;-----------------------------------------------------------------------------
; we now know valid values are between index numbers first*512 to last*512
;
if first EQ last then begin
	!err=0
	return
end
;
; extract data values for blocks first to last
;
sblock=header(4,pos)		;starting block for sorted data
sbyte=512L*sblock		;starting byte
first=first*512L+1
last=(last*512)<db_info('entries',0)
number=last-first+1
p = assoc(unit,make_array(size=[1,number,dtype,0],/nozero), $
                                             sbyte+(first-1)*num_bytes)
values=p(0)
;
; if index type is 2, data base is sorted on this item, first and last
; give range of valid entry numbers
;
if index_type EQ 2 then begin
	if list(0) EQ -1 then begin
		list=lindgen(number)+first
	   end else begin
		good=where((list ge first) and (list le last), number)
		if number GT  0 then begin
			 list=list(good)
			 values=values(list-first)
		endif
	end
;
; if index type wasn't 2 the item was sorted and index numbers must
;	be read
;

end else begin
;
; find starting location to read
;
	sblock=header(5,pos)
	sbyte=512L*sblock
;
; read values from file
;
p = assoc(unit,make_array(size=[1,number,3,0],/nozero),sbyte+(first-1)*4)
	if list(0) EQ -1 then begin
		list=p(0)
	   end else begin
		list2=p(0)
		match,list,list2,suba,subb
		number=!err
		if number GT 0 then begin
			list=list(suba)
			values=values(subb)
		end
	end
end
;
; now search indiviual entries
;
if number GT 0 then begin
	dbsearch,type,svals,values,good
	number=!err
	if number GT 0 then list=list(good)
end
!err=number
return
end