Документ взят из кэша поисковой машины. Адрес оригинального документа : http://hea-www.harvard.edu/PINTofALE/pro/idlabel.pro
Дата изменения: Wed May 10 09:28:51 2006
Дата индексирования: Tue Oct 2 00:26:29 2012
Кодировка:

Поисковые слова: arp 220
function idlabel,idstr,idx,Zbeda=Zbeda,Ibeda=Ibeda,Wbeda=Wbeda,Lbeku=Lbeku,$
wform=wform,wstyle=wstyle,sep=sep,intex=intex, _extra=e
;+
;function idlabel
; return a string array containg a nicely formatted set of labels,
; appropriate for each of the IDs in an ID structure.
;
;syntax
; label=idlabel(idstr,idx,/Zbeda,/Ibeda,/Wbeda,/Lbeku,$
; wform=wform,wstyle=wstyle,sep=sep,intex=intex, ziform=ziform)
;
;parameters
; idstr [INPUT; required] the ID structure containing the features
; with attached IDs. (see LINEID for description)
; idx [OUTPUT] an integer array pointing out which label belongs
; to which feature. this is of use in case of multiple IDs.
; * begins from 0, not 1
;
;keywords
; Zbeda [INPUT] if set, does not include the atomic symbol in label
; Ibeda [INPUT] if set, does not include the ionic state in label
; Wbeda [INPUT] if set, does not include the line wavelength in label
; Lbeku [INPUT] if set, includes a description of the transition,
; in the form of the level-designation and electronic
; configuration (if available) in label
; wform [INPUT] wavelength format, relevant if Wbeda=0
; * default: 'f7.2'
; if WSTYLE = 1, unadorned WFORM
; if WSTYLE = 2, automatically prepends $\lambda$:
; '"!4k!3 ",'+WFORM
; if WSTYLE = 4, automatically appends \AA:
; WFORM+',"'+string(byte(197))+'"'
; if WSTYLE = 8, automatically appends keV: WFORM+'," keV"'
; wstyle [INPUT] bit-style flag shortcut to various WFORMs
; * see above for effect on WFORM
; * if -ve, uses the wavelength of the ID'd feature, not
; the wavelength of the ID itself
; sep [INPUT] separator between "Z Ion", wvl, and description
; * default is "", unless INTEX is set, in which case
; the default is " & "
; intex [INPUT] if set, encloses the description (see LBEKU) within
; "$...$"
; _extra [INPUT] pass defined keywords to subroutines
; ZION2SYMB: ZIFORM
;
;restrictions
; requires input to be in format generated by LINEID, CAT_ID, etc.
; requires subroutines
; ZION2SYMB [INICON]
;
;examples
; l=idlabel(idstr,idx,wform='f5.1')
; l=idlabel(idstr,/Wbeda)
; l=idlabel(idstr,wstyle=4)
; l=idlabel(idstr,wstyle=6)
;history
; vinay kashyap (AugMM)
; added keywords SEP,INTEX; implemented LBEKU (VK; JanMMI)
; back-compatibility: STRMID must have 3 args (VK; FebMMI/A.Maggio)
; bug fix: IDNAM[2] is ID1, not ID2 (VK; MayMMVI/L.Lin)
;-

; Usage
ok='ok' & np=n_params() & ni=n_elements(idstr) & nid=n_tags(idstr)
if np eq 0 then ok='parameters missing' else $
if ni eq 0 then ok='IDSTR undefined' else $
if nid eq 0 then ok='IDSTR must be a structure'
if ok ne 'ok' then begin
print,'Usage: label=idlabel(idstr,idx,/Zbeda,/Ibeda,/Wbeda,/Lbeku,$'
print,' wform=wform,wstyle=wstyle,sep=sep,intex=intex, ziform=ziform)'
print,' return labels constructed from ID structure'
if np ne 0 then message,ok,/info
return,-1L
endif

; check input
ok='ok' & idnam=tag_names(idstr)
if idnam[0] ne 'WVL' then ok='input ID structure missing wavelengths' else $
if idnam[1] eq 'WVL_COMMENT' then ok='input contains no data' else $
if nid gt 2 then begin
if idnam[2] ne 'ID1' then ok='input in unknown format'
endif
if ok ne 'ok' then begin
message,ok,/info & return,strarr(nid)+'-1'
endif

; keywords
ss=' ' & if keyword_set(intex) then ss=' & '
if n_elements(sep) gt 0 then ss=string(sep[0])

; initialize
obswvl=IDSTR.WVL & ncomp=n_elements(obswvl)
nwvl=0L & for i=0L,ncomp-1L do nwvl=nwvl+n_elements(IDSTR.(i+1L).WVL)
;
idx=lonarr(nwvl) & zid=intarr(nwvl) & iid=zid & wid=fltarr(nwvl)
lid=strarr(2,nwvl) & cid=strarr(nwvl)

; extract info from IDSTR
k=0L
for i=0L,ncomp-1L do begin
tmp=idstr.(i+1L) & mw=n_elements(tmp.WVL) & slabl=size(tmp.LABL)
idx[k:k+mw-1L]=i
zid[k:k+mw-1L]=tmp.Z
iid[k:k+mw-1L]=tmp.ION
wid[k:k+mw-1L]=tmp.WVL
if slabl[0] eq 1 then begin
if slabl[1] eq 1 then lid[*,k:k+mw-1L]=(tmp.LABL)[0]
if slabl[1] eq mw then lid[0,k:k+mw-1L]=tmp.LABL
if mw eq 1 and slabl[1] eq 2 then begin
lid[0,k:k+mw-1L]=(tmp.LABL)[0]
lid[1,k:k+mw-1L]=(tmp.LABL)[1]
endif
endif
if slabl[0] eq 2 then begin
if slabl[2] eq mw then begin
lid[0,k:k+mw-1L]=(tmp.LABL)[0,*]
lid[1,k:k+mw-1L]=(tmp.LABL)[1,*]
endif
endif
k=k+mw
endfor

; figure out output format

; Z and ION
if keyword_set(Zbeda) then zid[*]=0 ;no atomic symbols
if keyword_set(Ibeda) then iid[*]=0 ;no ionic states
zion2symb,zid,iid,symb, _extra=e
if keyword_set(Zbeda) then begin
; ZION2SYMB puts an 'X' for ZID=0. here delete that 'X'.
ix=strpos(symb,'X',0)
for i=0L,nwvl-1L do symb[i]=strmid(symb[i],ix[i]+1,strlen(symb[i]))
endif
if keyword_set(Ibeda) then begin
; ZION2SYMB puts a '0' for IID=0 in some cases. here delete that '0'.
i0=strpos(symb,'0',0)
for i=0L,nwvl-1L do $
if i0[i] ge 0 then symb[i]=strmid(symb[i],0,i0[i])
endif
cid=symb

; WVL
if not keyword_set(Wbeda) then begin
wfmt='f7.2' & if keyword_set(wform) then wfmt=wform
if keyword_set(wstyle) then begin
wst=fix(wstyle)
if wst lt 0 then wid=wvl[idx] ;replace line wvls with feature wvls
wst=abs(wst)
while wst ge 8 do begin
wfmt=wfmt+'," keV"' & wst=wst-8
endwhile
while wst ge 4 do begin
wfmt=wfmt+',"'+string(byte(197))+'"' & wst=wst-4
endwhile
while wst ge 2 do begin
wfmt='"!4k!3 ",'+wfmt & wst=wst-2
endwhile
endif
cid=cid+ss+string(wid,'('+wfmt+')')
endif

; level designations and e configuration
if keyword_set(Lbeku) then begin
cid=cid+ss
if keyword_set(intex) then cid=cid+'$'
cid=cid+reform(lid[0,*])+' '+reform(lid[1,*])
if keyword_set(intex) then cid=cid+'$'
for i=0L,nwvl-1L do begin ;{for each ID
endfor ;I=0,NWVL-1}
endif

return,cid
end