dbext_ind.pro

basic median filter simulation

pro dbext_ind,list,item,dbno,values
;+
; NAME:
;       DBEXT_IND
; PURPOSE:
;       routine to read a indexed item values from index file
;
; CALLING SEQUENCE:  
;       dbext_ind,list,item,dbno,values
;
; INPUTS:
;       list - list of entry numbers to extract values for
;               (if it is a scalar, values for all entries are extracted)
;       item - item to extract
;       dbno - number of the opened data base
;
; OUTPUT:
;       values - vector of values returned as function value
; HISTORY:
;       version 1  D. Lindler  Feb 88
;       Faster processing of string values    W. Landsman   April, 1992
;       William Thompson, GSFC/CDS (ARC), 30 May 1994
;               Added support for external (IEEE) data format
;       Converted to IDL V5.0   W. Landsman   September 1997
;       Allow multiple valued (nonstring) index items W. Landsman  November 2000      
;       Use 64bit integer index for large databases W. Landsman  February 2001
;       Fix sublisting of multiple valued index items W. Landsamn  March 2001
;-
On_error,2
;
if N_params() LT 4 then begin
     print,'Syntax - DBEXT_IND, list, item, dbno, values'
     return
endif

; Determine first and last block to extract
;
s=size(list) & ndim=s[0]
if (ndim GT 0) then if (list[0] EQ -1) then ndim=0
zeros = 0                               ;flag if zero's present in list
if ndim EQ 0 then begin
        minl = 1
        maxl = db_info('ENTRIES',dbno)
    end else begin
        minl = min(list)
        if minl EQ 0 then begin ;any zero values in list
                zeros = 1
                nonzero = where(list GT 0)
                bad = where(list LE 0)
                minl = min(list[nonzero])
        endif
        maxl=max(list)
 end
;
; get item info
;
db_item,item,it,ivalnum,dtype,sbyte,numvals,nbytes
nbytes = nbytes[0]
if N_elements(it) GT 1 then $
        message,'ERROR - Only one item can be extracted by dbext_ind'

itnum = db_item_info('itemnumber',it[0])  ;item number in this dbno
;
; determine if indexed
;
index_type = db_item_info('index',it[0])
if index_type EQ 0  then $
        message,'ERROR - Requested item is not indexed'

if index_type EQ 3 then $
        message,'ERROR - Unsorted values of item not recorded in index file'
;
; get unit number of index file and read header info
;
 unit=db_info('UNIT_DBX',dbno)
 external = db_info('EXTERNAL',dbno)     ;External (IEEE) data format?
 p=assoc(unit,lonarr(2))
 h=p[0]
 if external then ieee_to_host,h
 p = assoc(unit,lonarr(7,h[0]),8)
 header = p[0]
 if external then ieee_to_host,header
 items = header[0,*]
 pos = where(items EQ itnum, Nindex) & pos=pos[0]
 if Nindex LT 1 then $
        message,'Item not indexed, DBNO may be wrong'

;
; find starting location to read
;
if index_type NE 4 then sblock=header[4,pos] else sblock=header[6,pos]
;
numvals = numvals[0]
sbyte = 512LL*sblock
sbyte = sbyte+(minl-1L)*nbytes*numvals
nv = (maxl-minl+1L) ;number of bytes to extract
;            
; create mapped i/o variable
;
dtype = dtype[0]

if dtype NE 7 then begin
   if numvals GT 1 then $ 
   p = assoc(unit, make_array(size=[2,numvals,nv,dtype,0],/NOZERO), sbyte ) else $
   p = assoc(unit, make_array(size=[1,nv,dtype,0],/NOZERO), sbyte ) 
 endif else  p = assoc(unit, make_array(size=[2,nbytes,nv,1,0],/NOZERO), sbyte )

;
; read values from file
; Modified, April 92 to delay conversion to string until the last step WBL
;
values = p[0]
if external then ieee_to_host,values
;
; if subset list specified perform extraction
;

if ndim NE 0 then begin
        if zeros then begin                     ;zero out bad values
                if dtype NE 7 then begin        ;not a string?
                        if numvals EQ 1 then begin
                             values = values[(list-minl)>0 ]
                             values[bad]=0
                        endif else begin 
                             values = values[*,(list-minl)>0 ]
                             values[*,bad] = intarr(numvals)
                        endelse
                   end else begin                       ;string 
                        values = values[*, (list-minl)>0 ]
                        if N_elements(bad) EQ 1 then bad = bad[0]
                        values[0,bad] = replicate( 32b, nbytes )
                   endelse
           end else begin
                  if (dtype EQ 7) or (numvals GT 1) then  $
                            values = values[*, list-minl] $
                      else  values = values[ list-minl ]
        end
end
if dtype EQ 7 then values = string(values)
return
end