Viewing contents of file '../idllib/uit/pro/dbext_dbf.pro'
pro dbext_dbf,list,dbno,sbyte,nbytes,idltype,nval,v1,v2,v3,v4,v5,v6, $
v7,v8,v9,v10,v11,v12
;+
; NAME:
; DBEXT_DBF
; PURPOSE:
; Procedure to extract values of up to 12 items from a data base file.
; This is a subroutine of DBEXT, which is the routine a user should
; normally use.
;
; CALLING SEQUECE:
; dbext_dbf,list,dbno,sbyte,nbytes,idltype,nval,v1,v2,v3,v4,v5,v6,v7,
; v8,v9,v10,v11,v12
;
; INPUTS:
; list - list of entry numbers to extract desired items. It is the
; entry numbers in the primary data base unless dbno is greater
; than or equal to -1. In that case it is the entry number in
; the specified data base.
; dbno - number of the opened db file
; if set to -1 then all data bases are included
; sbyte - starting byte in the entry. If single data base then it must
; be the starting byte for that data base only and not the
; concatenation of db records
; nbytes - number of bytes in the entry
; idltype - idl data type of each item to be extracted
; nval - number of values per entry of each item to be extracted
;
; OUTPUTS:
; v1...v12 - the vectors of values for up to 12 items
;
; HISTORY
; version 1 D. Lindler Nov. 1987
; Extract multiple valued entries W. Landsman May 1989
;-
;*****************************************************************
;
COMMON db_com,qdb,qitems,qdbrec
nitems=n_elements(sbyte) ;number of items
scalar=0
if n_elements(list) eq 1 then begin
scalar=1
savelist=list
list=lonarr(1)+list
if list(0) eq -1 then list=lindgen(db_info('entries',0))+1
end
nlist=n_elements(list)
;
; create a big array to hold all extracted values in
; byte format
;
totbytes=total(nbytes)
big=bytarr(totbytes,nlist)
;
; generate vector of bytes in entries to extract
;
index=intarr(totbytes)
ipos=0
for i=0,nitems-1 do begin
for j=0,nbytes(i)-1 do index(ipos+j)=sbyte(i)+j
ipos=ipos+nbytes(i)
endfor
;
; generate vector of byte positions in big for each item
;
bpos=intarr(nitems)
if nitems gt 1 then for i=1,nitems-1 do bpos(i)=bpos(i-1)+nbytes(i-1)
;
; loop on records and extract info into big
;
if dbno ge 0 then begin
;
; bypass dbrd for increased performance
;
if dbno eq 0 then begin
for i=0L,nlist-1 do begin
if list(i) ge 0 then begin
entry=qdbrec(list(i))
big(0,i) = entry(index)
endif
endfor
end else begin ;mapped I/O
unit=db_info('unit_dbf',dbno)
rec_size=db_info('length',dbno)
for i=0L,nlist-1 do begin
if list(i) ge 0 then begin
p=assoc(unit,bytarr(rec_size,/nozero),rec_size*list(i))
entry=p(0)
big(0,i) = entry(index)
end
endfor
end
end else begin
for i = 0L, nlist-1 do begin
if list(i) GE 0 then begin
dbrd,list(i),entry
big(0,i) = entry(index)
endif
end
end
;
; now extract each value and convert to correct type
;
last = bpos + nbytes -1
for i = 0,nitems-1 do begin
st = 'v'+strtrim(i+1,2)
if nlist GT 1 then $
st = st + '= reform(' else $
st = st + '= ('
case idltype(i) of
1: convert = 'BYTE'
2: convert = 'FIX'
4: convert = 'FLOAT'
3: convert = 'LONG'
5: convert = 'DOUBLE'
7: st = st + 'STRING( big(bpos(i):last(i),0:nlist-1)))'
endcase
if idltype(i) NE 7 then $
st= st+ convert+'(big(bpos(i):last(i),0:nlist-1),0,nval(i),nlist))'
;
; copy v to correct output vector
;
status = execute(st)
;
; create line of form v<i> = v and execute it
;
end;for i loop on items
if scalar then list=savelist ;restore scalar value
return
end