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