Документ взят из кэша поисковой машины. Адрес оригинального документа : http://hea-www.harvard.edu/PINTofALE/pro/id2emis2id.pro Дата изменения: Mon Jan 29 19:40:13 2001 Дата индексирования: Tue Oct 2 01:06:10 2012 Кодировка: Поисковые слова: spiral galaxy

function id2emis2id,idstr,ldbdir,dWVL=dWVL,verbose=verbose, _extra=e
;+
;function id2emis2id
; takes an ID structure, strips it into component parts,
; reads in new emissivities, and puts them back in.
;
;syntax
; newidstr=id2emis2id(idstr,ldbdir,dWVL=dWVL,verbose=verbose,$
; eps=eps,/incieq,mapping=mapping,pres=pres,logP=logP,n_e=n_e,$
; chifil=chifil,chidir=chidir,eqfile=eqfile)
;
;warning
; new emissivities will not necessarily reflect the fluxes
; as distributed among the components. also, if the database
; is changed, there is no reason to believe a priori that
; the correct lines are really read back in. we strongly
; recommend using a high (say 10) verbosity level.
;
;parameters
; idstr [INPUT; required] ID structure, see LINEID for description
; ldbdir [INPUT] directory in which to look for line database
; * default is "$CHIANTI"
; * if array size matches the number of features, is
; distributed among components appropriately; if size
; matches that of total number of lines, maps one-to-one
; onto line list; if size is incompatible with IDSTR,
; then uses only what is in the first element.
;
;keywords
; dWVL [INPUT] slack in wavelength search in which to find the
; matching line (this comes in handy when databases are
; being changed around)
; * default is 0.005
; verbose [INPUT] controls chatter
; _extra [INPUT ONLY] pass defined keywords to
; RD_LIST: EPS,INCIEQ,MAPPING,PRES,LOGP,N_E,CHIFIL,CHIDIR,EQFILE
;
;restrictions
; requires subroutines:
; RD_LIST, RD_LINE, FOLD_IONEQ, RD_IONEQ, READ_IONEQ,
; SYMB2ZION, ZION2SYMB, LAT2ARAB, CAT_LN, LINEFLX,
; INICON, WHEE, GETABUND, RDABUND, SYZE
; requires IDL 5.3+
;
;history
; vinay kashyap (AugMM)
; catch if correct emissivities not found; added keywords
; VERBOSE, DWVL; allowed LDBDIR to be array (VK; JanMMI)
;-

; usage
ok='ok'
np=n_params() & ni=n_elements(idstr) & nid=n_tags(idstr)
if np eq 0 then ok='Insufficient parameters' else $
if ni eq 0 then ok='IDSTR is undefined' else $
if nid eq 0 then ok='IDSTR is not a structure' else $
if nid eq 1 then ok='IDSTR too small to be an ID structure' else begin
idnam=tag_names(idstr)
if idnam[0] ne 'WVL' then ok='IDSTR in unknown format'
if idnam[1] eq 'WVL_COMMENT' then ok='IDSTR is empty'
endelse
if float(strmid(!version.RELEASE,0,3)) lt 5.3 then ok=$
'Requires IDL v5.3 or higher'
if ok ne 'ok' then begin
print,'Usage: newidstr=id2emis2id(idstr,ldbdir,dWVL=dWVL,verbose=verbose,$'
print,' eps=eps,/incieq,mapping=mapping,pres=pres,logP=logP,n_e=n_e,$'
print,' chifil=chifil,chidir=chidir,eqfile=eqfile)'
print," reread new emissivities corresponding to ID'd lines and store"
print," inside new ID structure"
message,ok,/info
return,-1L
endif

; explode IDSTR
obswvl=idstr.WVL ;wavelengths of the observed features
ncomp=n_elements(obswvl) ;number of features ID'd
nwvl=0L ;total number of IDs
for ic=0L,ncomp-1L do nwvl=nwvl+n_elements(idstr.(ic+1L).WVL)
idx=lonarr(nwvl) ;index pointing ID wavelength to ID component
wvl=fltarr(nwvl) ;wavelength of each ID
Z=intarr(nwvl) ;atomic numbers of IDs
ion=Z ;ionic states of IDs
labl=strarr(2,nwvl) ;level designation/e-configuration of ID
;??? NEED IMPROVEMENT IN HANDLING ???
elem=strarr(nwvl) ;atomic symbol for ID
notes=elem ;notes, if any *** NOT IMPLEMENTED ***
flux=fltarr(nwvl) ;fluxes (see UPDATID/SQUISHEM) of ID
fluxerr=flux ;errors on FLUX
logT=idstr.(1).LOGT ;temperature grid
nlogT=n_elements(logT) ;LOGT *must* be identical for all
emis=dblarr(nlogT,nwvl) ;emissivities, usually including ion balance

; now step through the structure and extract the contents into arrays
k=0L
for ic=0L,ncomp-1L do begin
idtmp=idstr.(ic+1L) & mw=n_elements(idtmp.WVL) & slabl=size(idtmp.LABL)
idx[k:k+mw-1L]=ic+1L
wvl[k:k+mw-1L]=idtmp.WVL
z[k:k+mw-1L]=idtmp.Z
ion[k:k+mw-1L]=idtmp.ION
flux[k:k+mw-1L]=idtmp.FLUX
fluxerr[k:k+mw-1L]=idtmp.FLUXERR
emis[*,k:k+mw-1L]=(idtmp.EMIS)
if slabl[0] eq 1 then begin
if slabl[1] eq 1 then labl[*,k:k+mw-1L]=(idtmp.LABL)[0]
if slabl[1] eq mw then labl[0,k:k+mw-1L]=idtmp.LABL
if mw eq 1 and slabl[1] eq 2 then begin
labl[0,k:k+mw-1L]=(idtmp.LABL)[0]
labl[1,k:k+mw-1L]=(idtmp.LABL)[1]
endif
endif
if slabl[0] eq 2 then begin
if slabl[2] eq mw then begin
labl[0,k:k+mw-1L]=(idtmp.LABL)[0,*]
labl[1,k:k+mw-1L]=(idtmp.LABL)[1,*]
endif
endif
k=k+mw
endfor
zion2symb,z,ion,elem,ziform='Z ION'

; check input
dbdir=strarr(nwvl)+'$CHIANTI'
if np eq 1 then ldbdir=dbdir
if np eq 2 then begin
ndb=n_elements(ldbdir)
if ndb eq 0 then begin
message,'LDBDIR is undefined: using default -- '+dbdir[0],/info
endif
if ndb eq 1 then dbdir[*]=ldbdir[0]
if ndb gt 1 then begin
if ndb eq nwvl then begin
; the number of DBDIRs match the number of lines in ID structure
dbdir=ldbdir
for i=0L,nwvl-1L do if keyword_set(ldbdir[i]) then dbdir[i]=ldbdir[i]
endif else begin
if ndb eq ncomp then begin
; the number of DBDIRs match the number of features in IDSTR
for ic=0L,ncomp-1L do begin
oc=where(idx eq ic+1L,moc)
if keyword_set(ldbdir[ic]) then dbdir[oc]=ldbdir[ic]
endfor
endif else begin
message,'LDBDIR is incompatible with IDSTR.',/info
message,'Using only LDBDIR[0]='+strtrim(ldbdir[0],2),/info
dbdir=ldbdir[0]
endelse
endelse
endif
endif

dW=0.005 & if keyword_set(dWVL) then dW=abs(dWVL[0]) > 1e-10

; re read the emissivities
linelist=elem+'|'+strtrim(wvl,2)+'+-'+strtrim(dW,2)+'|'+dbdir+'|'+$
strtrim(labl[0,*],2)+' '+strtrim(labl[1,*],2)
lstr=rd_list(linelist,sep='|',/desig,/econf,verbose=verbose, _extra=e)

; well, did it work as expected?
ok='ok'
for i=0L,n_elements(wvl)-1L do begin
ow=where(abs(wvl[i]-lstr.WVL) lt dW,mow)
if mow eq 0 then begin
ok='line missing : '+linelist[i]
if keyword_set(verbose) then print,ok
endif
endfor
if n_elements(lstr.WVL) ne k then ok='returned emissivities do not match number of input lines'
if ok ne 'ok' then begin
print,''
message,ok,/info
message,'consider setting the keyword MAPPING',/info
message,'returning with no changes',/info
print,''
return,idstr
endif

; overwrite the old emissivities
emis=lstr.LINE_INT
wvl=lstr.WVL
labl=lstr.DESIG+' '+lstr.CONFIG

; push em back into IDstr
newidstr=idstr
for i=0L,ncomp-1L do begin
ok=where(idx eq i+1,mok) & if mok eq 0 then message,'BUG!'
newidstr.(i+1).WVL = wvl[ok]
newidstr.(i+1).EMIS = emis[*,ok]
newidstr.(i+1).LABL = labl[*,ok]
endfor

return,newidstr
end