dbfind.pro

来自「basic median filter simulation」· PRO 代码 · 共 383 行 · 第 1/2 页

dbno = db_item_info('DBNUMBER',it)                      ;data base number
                                                        ; particular db.
;
; get info on the need to byteswap item by item
;
external = db_info('external')                          ;External format?
bswap = external * (not IS_IEEE_BIG() )              ;Need to byteswap?
dbno1  = db_item_info('dbnumber', it)
bswap  = bswap[dbno1]

done=bytarr(nitems)                                     ;flag for completed
                                                        ; items
;----------------------------------------------------------------------
; ENTRY number is a search parameter?
;
for pos = 0,nitems-1 do begin
    if (it[pos] eq 0) then begin
        dbfind_entry,stype[pos],search_values[pos,*],nentries,list,count=count
        done[pos]=1                           ;flag as done
        if count LT 1 then goto, FINI            ;any found
     end
end     
;----------------------------------------------------------------------
;
; perform search on sorted items in the first db
;

for pos=0,nitems-1 do begin
     if(not done[pos]) and (dbno[pos] eq 0) and $
        (index[pos] ge 2) then begin
                dbfind_sort,it[pos],stype[pos],search_values[pos,*],list, $
                        fullstring=fullstring, Count = count
                if !err ne -2 then begin
                        if count lt 1 then goto,FINI 
                        done[pos]=1
                end
     end
end
; ------------------------------------------------------------------------
; Perform search on items in lookup file (indexed items) in first db
;
if total(done) eq nitems then goto,FINI
for pos=0,nitems-1 do begin
    if(not done[pos]) and (dbno[pos] eq 0) and (index[pos] ne 0) then begin
            dbext_ind,list,it[pos],0,values
            dbsearch, stype[pos], search_values[pos,*], values, good, $
                Fullstring = fullstring, Count = count
            if !err eq -2 then begin 
                print,'DBFIND - Illegal search value for item ', $
                       db_item_info('name',it[pos])
                       return,listin
            endif
            if count lt 1 then goto, FINI        ;any found
            if list[0] ne -1 then list=list[good] else list=good+1
            done[pos]=1                         ; DONE with that item
    end
end

;------------------------------------------------------------------------
;
; search index items in other opened data bases (if any)
;
found=where( (index gt 0) and (dbno ne 0 ), Nfound)
if Nfound gt 0 then begin
      db = dbno[ where(dbno NE 0) ]
      for i = 0, n_elements(db)-1 do begin
;
; find entry numbers of second database corresponding to entry numbers
; in the first data base.
;
        pointer=db_info('pointer',db[i])        ;item which points to it
;
        dbext,list,pointer,list2        ;extract entry numbers in 2nd db
        good=where(list2 ne 0,ngood)    ;is there a valid pointer
        if ngood lt 1 then goto, FINI 
        if list[0] eq -1 then list=good+1 else list=list[good]
        list2=list2[good]
        for pos=0,nitems-1 do begin
            if (not done[pos]) and (dbno[pos] eq db[i]) and (index[pos] ne 0) $
                              and (index[pos] ne 3) then begin
                    dbext_ind,list2,it[pos],dbno[pos],values
                    dbsearch, stype[pos], search_values[pos,*], values, good, $
                        fullstring = fullstring, count = count
                    if !err eq -2 then begin
                       message = 'Illegal search value for item ' + $
                               db_item_info('name',it[pos])
                       goto, handle_error
                    endif
                    if count lt 1 then goto, FINI        ;any found
                    if list[0] ne -1 then list=list[good] else list=good+1
                    list2=list2[good]
                    done[pos]=1                         ; DONE with that item
            endif
        endfor
     endfor
endif           
;---------------------------------------------------------------------------
; search remaining items
;

  if list[0] eq -1 then list= lindgen(nentries)+1       ;Fixed WBL Feb. 1989
  count = N_elements(list)
  !err = count
  if total(done) eq nitems then goto, FINI      ;all items searched

  nlist     = N_elements(list)        ;number of entries to search
  if nlist GT 2000 then begin
        print,'Non-indexed search on ',strtrim(nlist,2),' entries'
        print,'Expect Delay'
  end
;
; Create array to hold values of all remaining items...a big one.
;
  left = where( done EQ 0, N_left )           ;items left
  nbytes = nbytes[left]
  sbyte = sbyte[left]
  idltype = idltype[left]
  bswap = bswap[left]
  totbytes  = total(nbytes)           ;total number of bytes to extract
  big  = bytarr(totbytes,nlist)   ;array to store values of the items
;
; generate starting position in big for each item
;
  bpos  = intarr(N_left)        ;starting byte in bpos of each item
  if N_left GT 1 then for i=1,N_left-1 do bpos[i] = bpos[i-1]+nbytes[i-1]

  index = intarr(totbytes)      ;indices of bytes to extract
  ipos  = 0                     ;position in index array
  for i = 0,N_left-1 do begin   ;loop on items
    for j=0,nbytes[i]-1 do index[ipos+j]=sbyte[i]+j     ;position in entry
    ipos = ipos + nbytes[i]
  end;for

;
; loop on entries and extract info
;
  for ii = 0L, nlist-1L do begin
    dbrd,list[ii],entry, /noconvert                 ;read entry
    big[0,ii]= entry[index]
  endfor

;
; now extract values for each item and search for valid ones
;
  stillgood  = lindgen( N_elements(list) )

  for i = 0l,N_left-1 do begin
        val = big[ bpos[i]:bpos[i]+nbytes[i]-1, 0:nlist-1 ]
        case idltype[i] of
                1: v = byte(val,0,nlist)        ;byte
                2: v = fix(val,0,nlist)         ;i*2
                3: v = long(val,0,nlist)        ;i*4
                4: v = float(val,0,nlist)       ;r*4
                5: v = double(val,0,nlist)      ;r*8
                7: begin                        ;string
                   v = strarr(nlist)
                   if nlist EQ 1 then v[0] = string(val) else $
                   for ii=0l,nlist-1l do v[ii]=string(val[*,ii])
                   end
               12: v = uint(val,0,nlist)         ;u*2
               13: v = ulong(val,0,nlist)        ;u*4
               14: v = long64(val,0,nlist)       ;i*8
               15: v = ulong64(val,0,nlist)      ;u*8
         endcase
        v=v[stillgood]
        if bswap[i] then ieee_to_host, v, idltype=idltype[i]
        dbsearch, stype[left[i]], search_values[left[i],*], v, good, $
                Fullstring = fullstring, count = count
        if count LT 1 then goto, FINI 
        stillgood=stillgood[good]
  endfor
  list = list[stillgood]
  count = N_elements(list) & !ERR = count

FINI:
if not keyword_set(SILENT) then begin
  print,' ' & print,' '
  if count LE 0  then $
        print,'No entries found by dbfind in '+ db_info('name',0) $
  else $
        print,count,' entries found in '+ db_info('name',0)
endif
if count LE 0 then return,intarr(1) else return,list[sort(list)]
;
;  Error handling point.
;
HANDLE_ERROR:
        IF N_ELEMENTS(ERRMSG) NE 0 THEN ERRMSG = 'DBFIND: ' + MESSAGE $
                ELSE MESSAGE, MESSAGE
end