Документ взят из кэша поисковой машины. Адрес оригинального документа : http://hea-www.harvard.edu/ChaMPlane/quantile/4ciao4.3/rdrdb2.pro Дата изменения: Tue Mar 20 19:40:42 2012 Дата индексирования: Tue Oct 2 08:05:56 2012 Кодировка: Поисковые слова: р п р п р п р п р п р п р п р п р п р п р п р п р п р п р п

; read a rdb table
;
; JaeSub Hong, 2006-2007, version 2.0
; JaeSub Hong, 2002-2005, version 1.5
; Please report any problem or suggestion at jaesub@head.cfa.harvard.edu
;
;
; - consider any line starting with # comments
; - speed up by pre-setting array size (default 1000, change by n_step)
;

function rdrdb2, filename, $
noheader=noheader, comment=comment, $
data=data, sep=sep, struct=struct, recycle=recycle, $
names=names, units=units, n_step=n_step, n_data=n_data, $
def_num=def_num

if not keyword_set(sep) then sep=' ' ; tab
if not keyword_set(recycle) then recycle=0
if 0 eq n_elements(def_num) then def_num='0.0D'

line=''
openr, lun, filename, /get_lun
comment=''
if not keyword_set(noheader) then begin
while (not eof(lun)) do begin
readf, lun, line
if strpos(line,'#',0) eq 0 then comment=[comment,line] $
else goto, found_header
endwhile
; no header, no data, nothing
return, 0

found_header:
; names = str_sep(line,sep)
names = strsplit(line,sep,/extract,/preserve_null)
if not eof(lun) then begin
readf, lun, line
if strpos(line,'#',0) ne 0 then $
; units = str_sep(line,sep)
units = strsplit(line,sep,/extract,/preserve_null)
endif else return, 0
endif

n_field=n_elements(names)
for i=0, n_field-1 do begin
pos=strpos(names[i],"/",0)
if pos ge 0 then begin
names_ = strmid(names[i],0,pos) +'_' + $
strmid(names[i],pos+1,strlen(names[i])-pos)
names[i]=names_
endif
pos=strpos(names[i],"-",0)
if pos ge 0 then begin
names_ = strmid(names[i],0,pos) +'_' + $
strmid(names[i],pos+1,strlen(names[i])-pos)
names[i]=names_
endif
names[i] = strcompress(names[i],/remove_all)
; print,names[i]
endfor
;if (recycle eq 0) or (not keyword_set(struct)) then begin
if (not keyword_set(struct)) then begin
com_str = 'struct=create_struct('
for i=0, n_field-1 do begin
if i ne 0 then com_str=com_str+','
u_unit = strupcase(units[i])
pos=strpos(u_unit, 'N', 0)
mode='string'
if pos ge 0 then begin
pos_=strpos(u_unit, 'S', 0)
if pos_ lt 0 then mode='number' $
else if pos lt pos_ then mode ='number'
endif
if mode eq 'number' then begin
num_type = strmid(u_unit,pos,2)
case num_type of
'NI' : com_str=com_str+'"'+names[i]+'",'+'0'
'NL' : com_str=com_str+'"'+names[i]+'",'+'0L'
'NF' : com_str=com_str+'"'+names[i]+'",'+'0.0'
'ND' : com_str=com_str+'"'+names[i]+'",'+'0.0D'
else : com_str=com_str+'"'+names[i]+'",'+def_num
endcase
endif else com_str=com_str+'"'+names[i]+'",'+'""'

; if strupcase(strmid(units[i],0,1)) eq 'N' then $
; com_str=com_str+'"'+names[i]+'",'+'0.0D' $
; else com_str=com_str+'"'+names[i]+'",'+'""'
endfor
now=execute(com_str+')')
endif

if not keyword_set(n_step) then n_step=1000
data=replicate(struct,n_step)
n_data=0L
n_field=n_tags(struct)

while (not eof(lun)) do begin
readf, lun, line
if strpos(line,'#',0) eq 0 then begin
comment=[comment,line]
goto, next
endif
cur=struct
; fields = str_sep(line,sep)
fields = strsplit(line,sep,/extract,/preserve_null)
for i=0, n_field-1 do begin
; print, i, ' ',fields[i], ' ' ,names[i]
cur.(i) = fields[i]
endfor
data[n_data]=cur
n_data=n_data+1L
if n_data mod n_step eq 0 then data=[data,replicate(struct,n_step)]
next:
endwhile
free_lun,lun

if n_elements(comment) gt 1 then comment=comment[1:*]

if n_data gt 0 then data=data(0:n_data-1) $
else data=struct

return, data

end