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