Документ взят из кэша поисковой машины. Адрес оригинального документа : http://star.arm.ac.uk/~csj/idl/IDLINES/idlines.pro Дата изменения: Mon Nov 2 15:23:14 2015 Дата индексирования: Sun Apr 10 05:47:06 2016 Кодировка: Поисковые слова: п п п п п п п п п п п п п п п п

PRO idlines, specfile, linelist, xlo, xhi, xr, atoms, thresh, rv, $
FIT = kft, EW = kew, NF = knf, ALL = kall, STIS = kst, PRINT = kpr, $
XTEND = kxt, XPAND = kxp, MULT = kmlt, DUPLEX = kdup, QUAD = kfour


;--------------------------------------------------------------------------
;
; idlines
;
; IDL procedure to display
; a) a region of spectrum, together with a fit, if supplied,
; b) positions and relative strengths (gf or W_lambda) of lines in
; common atomic spectra may be marked in the lower panel.
; c) lines of sleceted atoms are identified in the top panel
;
; Command arguments:
;
; specfile - character string - name of file containing spectrum (and fit)
; assumed to be x,y file with 3-line header
; linelist - character string - name of file containing eq.widths
; assumed to be 'spectrum' output
; xlo - real variable - lower limit of plot
; xhi - real variable - upper limit of plot
; xr - real variable - range of indivusal plot
; atoms - integer vector - atomic numbers of spectra to be identified
; [ thresh - real variable - threshold eq width or line strength to identify lines ]
; [ rv - real variable - radial velocity of spectrum ]
;
;---------------------------------------------------------------------------

ann_idlines

IF N_PARAMS() LT 6 THEN BEGIN

print, 'idlines: insufficient parameters'
print, ' '
print, 'Usage:'
print, ' '
print, 'idlines, specfile, linelist, xlo, xhi, xr, ions, [thresh, [rv, ]], [keywords]'
print, ''
print, ' specfile - character string - name of file containing spectrum (and fit)'
print, ' assumed to be x,y file with 3-line header'
print, ' linelist - character string - name of file containing linelist'
print, ' assumed to be in ''lte_lines'' format'
print, ' xlo - real variable - lower limit of plot'
print, ' xhi - real variable - upper limit of plot'
print, ' xr - real variable - xrange for each segment '
print, ' atoms - integer vector - atomic numbers of spectra to be identified'
print, '[thresh - real variable - threshold linestrength to identify lines]'
print, '[rv - real variable - radial velocity of spectrum ]'
print, ''
print, ' Keywords '
print, '/FIT - overplot the fit '
print, '/EW - read and select the lines using equivalent widths '
print, '/NF - read and select the lines using n*gf (central opacities) '
print, '/ALL - plot individual atomic spectra schematically '
print, '/MULT - add multiplet labels to line ids '
print, '/STIS - to allow for air/vacuum shift at 2000A '
print, '/DUPLEX - plot 2 ranges of spectrum on one panel '
print, '/QUAD - plot 4 ranges of spectrum on one panel '
print, ' /XPAND - expand plot by factor 5 '
print, '/XTEND - extend line identification marks '
print, '/PRINT - plot hardcopy as a postscript file'
RETURN
END

IF N_PARAMS() LT 7 THEN thresh = 0.0
IF N_PARAMS() LT 8 THEN rv = 0.0

ylo = 0
yhi = 1.8

; Check for keywords
xft = 0 ; default
IF KEYWORD_SET(kft) THEN xft = 1

xew = 0 ; default
IF KEYWORD_SET(kew) THEN xew = 2
IF KEYWORD_SET(knf) THEN xew = 1

xall = 0 ; default
IF KEYWORD_SET(kall) THEN xall = 1

xmlt = 0 ; default
IF KEYWORD_SET(kmlt) THEN xmlt = 1
IF KEYWORD_SET(kmlt) THEN print,' Multiplet identification enabled: linelist must contain multiplet identifiers '

xstis = 0
IF KEYWORD_SET(kst) THEN xstis = 1

xxtd = 0
IF KEYWORD_SET(kxt) THEN xxtd = 1

xxpd = 0
IF KEYWORD_SET(kxp) THEN xxpd = 1

dev = 'X'
xcp = 0

IF KEYWORD_SET(kpr) THEN BEGIN
plotfile='idlines.ps'
xcp = 1
dev='PS'
set_plot,'ps'
IF ( NOT KEYWORD_SET(kfour) ) THEN device,filename=plotfile,/color,/landscape
IF ( KEYWORD_SET(kfour) ) THEN device,filename=plotfile,/color,/portrait,xsize=16,ysize=22,yoffset=2
ENDIF

idsize = 1.0 ; [default size for line identifiers]
; IF ( KEYWORD_SET(kfour) ) THEN idsize = 0.7

; print,'keys:',xft,xew,xall,xmlt,xstis,xcp ; debugger

colors = GetColor(/Load)
!p.multi=0
IF KEYWORD_SET(kdup) AND xall EQ 0 THEN !p.multi=[0,1,2,0,0]


;; get the spectrum to plot
IF xft EQ 1 THEN BEGIN
readspecfit, specfile, specnw, specwav, specflx, specfit
ENDIF ELSE BEGIN
readspec, specfile, specnw, specwav, specflx
ENDELSE

IF xxpd THEN specflx = specflx * 5 - 4
IF xxpd AND xft THEN specfit = specfit * 5 - 4


IF xstis THEN ww = specwav

;; shift spectrum to rest wavelength if velocity supplied
IF ABS (rv) GT 1 THEN specwav = specwav * (1 - rv/2.997E5)

;; get the linelist with identifications

IF (xew EQ 2) THEN $
readeqwid, linelist, listn, listwav, listlab, listion, listmlt, listgf, listew
IF (xew EQ 1) THEN $
readlines, linelist, listn, listwav, listlab, listion, listmlt, listgf, listep, listfr
IF (xew EQ 0) THEN $
readlte, linelist, listn, listwav, listlab, listion, listmlt, listgf, listep, listfr

nx = fix((xhi - xlo) / xr)
dx = xr
cont = ' '

IF xstis THEN spec0 = specwav


;; =============================
;; Loop over wavelength intervals
FOR i = 0,nx-1 DO BEGIN

IF (cont NE 'N' AND cont NE 'n' and cont NE 'q' AND cont NE 'Q') THEN BEGIN

x1 = xlo + i * dx - dx/20.
x2 = xlo + i * dx + dx + dx/20.

y1 = 0.
y2 = 1.80
IF xall THEN BEGIN
y1 = -0.8
y2 = 1.8
ENDIF


;; plot the spectrum and fit
;; because linelist is in air for GE 2000 A
;; shift the observed spectrum to air so that
;; when identifying features from linelist do
;; not need to convert values in linelist
IF xstis THEN BEGIN
w2000 = where(ww GE 2000, nw2000)
IF nw2000 GT 1 THEN specwav(w2000) = specwav(w2000)/1.0003071
ENDIF


; establish the box
!x.title='!4k!3 (!3' + STRING(197B) + '!X)'
!y.title='A!D!4k!3!N'


IF NOT KEYWORD_SET(kfour) THEN plot, [x1,x2],[y1,y1], $
xrange=[x1,x2], yrange=[ylo,yhi],xstyle=1, ystyle=1,charsize=1.3,charthick=1.0, /nodata

plotpos = fltarr(4,4)
plotpos(*,3) = [0.1,0.05,0.99,0.25]
plotpos(*,2) = [0.1,0.3,0.99,0.50]
plotpos(*,1) = [0.1,0.55,0.99,0.75]
plotpos(*,0) = [0.1,0.8,0.99,1.00]


IF KEYWORD_SET(kfour) AND xall EQ 0 THEN BEGIN
imod = i mod 4
IF imod EQ 0 THEN erase
IF imod EQ 0 THEN plot, [x1,x2],[y1,y1], $
xrange=[x1,x2], yrange=[y1,y2],xstyle=1, ystyle=1,charsize=1.0,charthick=1.0, $
/nodata , pos = plotpos(*,imod),xtitle=' ',xticklen=0.05,yticklen=0.02
IF ( imod EQ 1 OR imod EQ 2) THEN plot, [x1,x2],[y1,y1], $
xrange=[x1,x2], yrange=[y1,y2],xstyle=1, ystyle=1,charsize=1.0,charthick=1.0, $
/nodata , pos = plotpos(*,imod), /noerase, xtitle=' ',xticklen=0.05,yticklen=0.02
IF imod EQ 3 THEN plot, [x1,x2],[y1,y1], $
xrange=[x1,x2], yrange=[y1,y2],xstyle=1, ystyle=1,charsize=1.0,charthick=1.0, $
/nodata , pos = plotpos(*,imod), /noerase,xticklen=0.05,yticklen=0.02
ENDIF


; plot the spectrum and the continuum
oplot, specwav, specflx, psym=10, thick=2 ; plot the spectrum
oplot, [xlo,xhi], [1,1], linestyle = 1 ; mark the continuum



IF xstis THEN specwav = spec0

IF xft THEN $
oplot, specwav, specfit, color=colors.red,thick=2 ; overplot the fit

;; mark individual lines
;determine lines that are greater than the threshold
;this is done element at a time
wavt=fltarr(1)
labt=strarr(1)
mult=strarr(1)
wavt2=fltarr(1)
labt2=strarr(1)
mult2=strarr(1)
ik1=0
ik2=0


FOR zel = 0,n_elements(atoms)-1 DO BEGIN

;DETERMINE IONS GREATER THAN THRESH
IF xew EQ 2 THEN $
markion, atoms(zel), x1, x2, listn, listwav, listion, listlab, listmlt, listew, -thresh, wl, lab, mlt
IF xew EQ 1 THEN $
markion, atoms(zel), x1, x2, listn, listwav, listion, listlab, listmlt, listfr, thresh, wl, lab, mlt
IF xew EQ 0 THEN $
markion, atoms(zel), x1, x2, listn, listwav, listion, listlab, listmlt, listfr, 0.0, wl, lab, mlt

;MAKE ARRAY OF ELEMENTS TO MARK
if atoms(zel) lt 21 then begin
wavt = [wavt,wl]
labt = [labt,lab]
mult = [mult,mlt]
endif
if atoms(zel) gt 20 then begin
wavt2 = [wavt2,wl]
labt2 = [labt2,lab]
mult2 = [mult2,mlt]
endif

ENDFOR

nwt=n_elements(wavt)
nw2=n_elements(wavt2)
; print,'nlines:',nwt,nw2 ; debugger

;sort lines that met the thresh criteria into wavelength order
IF (nwt GT 1) then BEGIN
xx=sort(wavt)
wavt=wavt(xx)
labt=labt(xx)
mult=mult(xx)
ENDIF

IF (nw2 GT 1) then BEGIN
xx=sort(wavt2)
wavt2=wavt2(xx)
labt2=labt2(xx)
mult2=mult2(xx)
ENDIF


;TIDY UP ARRAYS (REMOVE ALL 0 VALUED ELEMENTS)
iwt = where(wavt2 GT 0, nwt)
IF (nwt GT 1) then BEGIN
pwav2=wavt2(iwt)
plab2=labt2(iwt)
pmlt2=mult2(iwt)

;OPLOT LINE IDENTIFICATIONS Z > 20 (BLUE)
IF xmlt THEN plab2 = plab2+pmlt2
idls_oplot,specwav,specflx,specfit, x1,x2,y1,y2,pwav2,plab2,extend=xxtd,lcharsize=idsize

ENDIF

;TIDY UP ARRAYS (REMOVE ALL 0 VALUED ELEMENTS)
iwt = where(wavt GT 0, nwt)
IF (nwt GT 1) then BEGIN
pwav=wavt(iwt)
plab=labt(iwt)
pmlt=mult(iwt)

;PLOT LINE IDENTIFICATIONS Z < 21 (RED)
IF xmlt THEN plab = plab+pmlt
idls_plot,specwav,specflx,specfit, x1,x2,y1,y2,pwav,plab,extend=xxtd,lcharsize=idsize

ENDIF

;; mark separate spectra

IF xall THEN BEGIN
FOR zel = 2,28 DO BEGIN
IF xew EQ 2 THEN $
markeqwid, zel, x1, x2, listn, listwav, listion, listlab, listmlt, $
listgf, listew
IF xew EQ 1 THEN $
markeqwid, zel, x1, x2, listn, listwav, listion, listlab, listmlt, $
listgf, listfr
ENDFOR
ENDIF

;; expand the plot
; oplot, [x1, x2], [0.4,0.4]
; oplot, [x1, x2], [1.6,1.6], linestyle=1
; oplot, specwav, 5 * specflx - 5 + 1.6, clip = [x1,1.1,x2,1.7]
; IF fit EQ 1 THEN $
; oplot, specwav, 5 * specfit - 5 + 1.6, clip = [x1,1.1,x2,1.7], color=colors.red, thick=2

;; check for continuation
IF i LT nx-1 AND NOT xcp THEN $
read,prompt='Continue (-/n/q) ? >',format='(a)', cont



ENDIF

ENDFOR


IF xcp EQ 1 THEN BEGIN
print,' '
print,' Output: idlines plot written to file: ',plotfile
print,' '
device,/close
set_plot,'X'
dev='X'
ENDIF


END