fmq/TLUSTY
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

0

Browse Source
This commit is contained in:
fmq
2026-07-21 22:25:14 +08:00
parent 15971a5e01
commit c53fc99c1d
298 changed files with 459694 additions and 31 deletions
Download Patch File Download Diff File Expand all files Collapse all files
gui/IDL/convol.pro
+268
View File
@@ -0,0 +1,268 @@
PRO conv_spec,sx,sy,px,py,cx,cy
; note
; no zero padding applied, however sufficient precision also at end points
; note also, that response function centered, not wrapped arround,
; since referred to central frequency of signal.
n = n_elements(sx)
if n ne n_elements(px) then print,'error: different array dimensions'
shft = long(n/2)
tty = fltarr(n) + (sy(0)+sy(n-1))/2.
sy_t = sy - tty
cx = sx
cy = shift(fft(fft(sy_t,-1)*fft(py,-1),1),shft)
cy = ((cx(n-1)-cx(0))/(n-1)) * n * cy ; renormalise result of convolution
cy = cy + tty
END
PRO convol,sx,sy,cx,cy,vdop=vdop,fwhm=fwhm,resol=resol,vsini=vrot,beta=beta,vmacro=vmacro,message=message,original=original,help=help
if n_params() lt 4 then begin
print,'PRO convol,sx,sy,cx,cy[,vdop=[Km/s],fwhm=,resol=,vsini=[Km/s],beta=,vmacro=[Km/s],/message,/original]'
if keyword_set(help) then begin
; written by J. Puls, modified by J. Sundqvist
; spectrum is convolved as specified with keywords. units in
; Aangstrom or km/s.
print,'input'
print,'; sx : wavelength vector'
print,'; sy : flux vector'
print,'; cx : wavelength vector after convolution'
print,'; cy : flux vector after convolution'
;
print,'; keywords'
print,'; vdop : doppler width [km/s]'
print,'; fwhm : fwhm of gaussian profile [AA] '
print,'; resol : resolution=lambda0/fwhm'
print,'; vsini : projected rotational velocity [km/s]'
print,'; beta : constant used for rotation'
print,'; vmacro : radial-tangential macroturbulence'
print,'; (v_radial=v_tangential) [km/s]'
print,'; message : some information is printed'
print,'; original : if set, remap finally onto original'
print,'; wavelength grid. OBS:linear interpolation.'
;
print,'; note:'
print,'; keywords fwhm, resol, vdop mutually exclusive.'
print,'; if more than one set, the last is ignored'
print,'; if vsini set, rotational folding is done first'
endif
return
endif
;maximum resolution
max_resol=2d5
;max_resol=3d4
;default settings
if not keyword_set(beta) then beta = 1.5
if not keyword_set(message) then message = 0
if not keyword_set(original) then original = 0
if not keyword_set(vrot) then vrot = 0.d
;constants
clight = 299792.5d
rsmpl_fac = 0.7d
;wavelength vector must be strictly increasing!
i=sort(sx)-lindgen(n_elements(sx))
if max(i) ne 0 then begin
print,'Wavelength vector must be strictly increasing - sort!'
print,'returning'
return
endif
sxx = sx
syy = sy
n = n_elements(sxx)
nn = n
rdst= (sxx(n-1)-sxx(0))/double(n-1) ; resampling distance
intp= 0
;check if wavelength vector equidistant
dsx = abs(sxx(1:*)-sxx(0:n-2))
rdst_min = min(dsx,max=rdst_max)
meanw = 0.5d*(sxx(0)+sxx(n-1))
eps = meanw/max_resol
diff = abs(rdst_max-rdst_min)
not_eqdist = diff gt eps
if not_eqdist then begin
if message then print,'spectrum is not equidistant: rdmin= ',rdst_min,', rdmax= ',rdst_max
rdst = MAX([(rdst_min * rsmpl_fac),eps])
intp = 1
nn = (sxx(n-1)-sxx(0))/rdst
endif
xpow = alog(nn)/alog(2.)
pow = long(xpow)
if ((pow le 14 and pow gt 2) or intp) and ((xpow-pow) ne 0.) then begin
pow = pow + 1
nn_x = long(2.^pow)
if (float(nn)/float(nn_x) gt rsmpl_fac) and (not not_eqdist) then begin
nn = nn_x * 2l
endif else begin
nn = nn_x
endelse
rdst = (sxx(n-1)-sxx(0))/(nn-1)
sxx = lindgen(nn)*rdst + sx(0)
syy = interpol(sy,sx,sxx,/spline)
res=finite(syy)
bres=where(res eq 0, countb)
if countb ne 0 then begin
for i=0,nn-1 do begin
b=where(sx eq sxx(i),count)
if count gt 1 then begin
sym=mean(sy(b))
syy(i)=sym
endif
endfor
endif
if message then begin
print,'resampled grid with resampling distance: ',rdst
print, nn, format= "('resampled spectrum has ',i6,' points')"
endif
endif
px = (findgen(nn)-long(nn/2))*rdst
;rotation
if keyword_set(vrot) and vrot ge 0.1 then begin
lambda0 = (sxx(nn-1)+sxx(0))/2.
dlam_max = vrot*(lambda0/clight)
xx = px / dlam_max
one = where(abs(xx) gt 1)
xx(one) = 1.
xx_2 = xx*xx
unsoeld = (2.* sqrt(1-xx_2)/!pi + (1-xx_2)*beta/2.) / (1 + 2*beta/3.)
; gray = (2.*(1-beta)*sqrt(1-xx_2)/!pi + (1-xx_2)*beta/2.) / (1 - beta/3.)
py = unsoeld
py = py / dlam_max
conv_spec,sxx,syy,px,py,cx,cy
sxx = cx
syy = cy
endif
;macroturbulence
if keyword_set(vmacro) then begin
aar=1.
spi=sqrt(!dpi)
lambda0 = (sxx(nn-1) + sxx(0))/2.
mr=(vmacro*lambda0/clight)[0]
ccr=2.*aar/spi/mr
pxmr=abs(px)/mr
py=ccr*[exp(-pxmr^2)+spi*pxmr*(errorf(pxmr)-1.)]
py=py/int_tabulated(px,py,/double); to be sure the distribution is normalized
conv_spec,sxx,syy,px,py,cx,cy
sxx = cx
syy = cy
endif
;Gauss profile
if keyword_set(vdop) or keyword_set(fwhm) or keyword_set(resol) then begin
fac = 2.*sqrt(alog(2.))
lambda0 = (sxx(nn-1)+sxx(0))/2.
if keyword_set(fwhm) then begin
dlam_dop = fwhm/fac
vdop = dlam_dop*clight/lambda0
endif else if keyword_set(resol) then begin
vdop=clight/(resol*fac)
dlam_dop = vdop*(lambda0/clight)
endif else begin
dlam_dop = vdop*(lambda0/clight)
endelse
min_cnr = 5
max_cnr = long(nn*0.8)
if message then begin
print, vdop, dlam_dop, format="('vdop=',f7.3,'km/s <=>',f7.3,'a')"
print,fac*vdop,fac*dlam_dop, format="('fwhm=',f7.3,'km/s <=>',f7.3,'a')"
endif
cnr = long(4.*dlam_dop/rdst) + 1
if max_cnr le cnr then begin
percent = cnr/float(nn)*100.
print,'gauss profile is very large:' + string(percent,'(f6.2)') $
+ '% of spectrum points are forming the profile'
endif
if min_cnr ge cnr then begin
print,'gauss profile is very small: only ' + string(cnr,'(i4)') $
+ ' data points are forming the profile'
endif
xx = px / dlam_dop
six = where(abs(xx) lt 6.)
py = fltarr(nn)
py(six) = exp(-(xx(six)^2))/(sqrt(!pi)*dlam_dop)
conv_spec,sxx,syy,px,py,cx,cy
sxx = cx
syy = cy
endif
if original then begin
cy = interpol(syy,sxx,sx)
cx = sx
endif
;Return only real part
cy=real_part(cy)
cx=real_part(cx)
END
function fconvol,x,y,xout,rv=rv,vdop=vdop,fwhm=fwhm,resol=resol,vsini=vrot,beta=beta,vmacro=vmacro,message=message
xx=x[sort(x)]
yy=y[sort(x)]
yy=yy[uniq(xx)]
xx=xx[uniq(xx)]
n=n_elements(xx)
cc=2.99792458d5
if keyword_set(rv) then xx=xx*(1.0d - rv/cc)
if n_elements(xx) gt 50000 then begin
nps=25000l
segs=(n/nps)
yff=yy*0.0d
if n mod nps lt 1000 then begin
nps=24000l
segs=(n/nps)
endif
for ii=0, segs do begin
ind=[0l,nps-1l]+ii*nps
if (ii+1l)*nps gt n then ind[1]=n-1
cind=[max([0,ind[0]-1000l]), min([ind[1]+1000l,n-1])]
yff[ind[0] : ind[1]]=fconvol(xx[cind[0] : cind[1]],yy[cind[0] : cind[1]],xx[ind[0] : ind[1]],vdop=vdop,fwhm=fwhm,resol=resol,vsini=vrot,beta=beta,vmacro=vmacro,message=message)
endfor
yout=interpol(yff,xx,xout)
return,yout
endif
if odd(n_elements(xx)) then begin
xx=xx[1:*]
yy=yy[1:*]
endif
convol,xx,yy,nx,sol,vdop=vdop,fwhm=fwhm,resol=resol,vsini=vrot,beta=beta,vmacro=vmacro,message=message,/original
if n_elements(xout) gt 1 then yout=interpol(sol,xx,xout) else yout=sol
return,yout
end
gui/IDL/lineid_annot.pro
+252
View File
@@ -0,0 +1,252 @@
pro lineid_annot,wave,flux,wline,eqw,text1,text2,text3, $
charsize=charsize,extend=extend,charthick=charthick,_extra=pex
;+
; lineid_plot2b
;
; Plot spectrum with specified line identifications annotated at the
; top of the plot.
;
; CALLING SEQUENCE:
; lineid_annot,wave,flux,wline,eqw,text1,text2,text3, $
; charsize=charsize,extend = extend, charthick = charthick
;
; INPUTS:
; wave - wavelength vector for the plot
; flux - flux vector
; wline - vector of line identifications. (only the lines between
; the plot limits will be used)
; eqw - vector of equivalent widths
; text1 - string array of text to be used to annotate each line
; text2 - (OPTIONAL) second string array of text to be used for
; line annotation. Since the text is written with
; proportional spaced characters, TEXT2 can be used if
; you want two sets of annotation to be alinged:
;
; eg: Cr IV 1390.009
; Fe V 1390.049
; Ni IV 1390.184
; instead of
; Cr IV 1390.009
; Fe V 1390.049
; Ni IV 1390.184
; text3 - still additional text
;
; allows xyouts keywords
;
;
; OPTIONAL KEYWORD INPUTS:
;
; extend = specifies that the annotated lines should have a
; dotted line extended to the spectrum to indicate the
; line position. EXTEND can be a scalar (applies to
; all lines) or a vector with a different value for
; each line. The value of EXTEND gives the line
; IDL plot line thickness for the dotted lines.
; If EXTEND is a vector each dotted line can have a
; different thickness. A value of 0 indicates that
; no dotted line is to be drawn. (default = scalar 0)
; charsize = the character size of the annotation for each line.
; If can be a vector so that different lines are
; annotated with different size characters. Charsize
; can be used to make stronger lines have a larger
; annotation. (default = scalar 1.0).
; charthick = the character thickness of the annotation for
; each line. If can be a vector so that different lines
; are annotated with characters of varying thickness.
; CHARTHICK can be used to make stronger lines have
; a bolder annotation. (default = !p.charthick)
; OPERATIONAL NOTES:
;
; Once the program has completed, You can use OPLOT to draw additional
; plots on the display. The plots !X.TITLE and !Y.TITLE are used but
; the !P.TITLE (!MTITLE) is ignored.
;
; If your annotated characters are not being rotated properly,
; try setting !FANCY to a non zero value.
;
; !X.RANGE, !Y.RANGE or the routine SET_XY can be used to change
; plot limits before calling LINEID_PLOT.
;
; HISTORY:
; version 1 D. Lindler Jan, 1992
; Sept 27, 1993 DJL fixed bug in /extend option
; version 2 I. Hubeny Dec, 1993
; extension for selecting and plotting using equivalent width
;-
;----------------------------------------------------------------------------
if n_params(0) lt 1 then begin
print,'CALLING SEQUENCE: lineid_annot,wave,flux,wline,eqw,text1,[,text2,text3]'
print,'OPTIONAL KEYWORD PARAMETERS'
print,'EXTEND = switch for drawing indicating lines'
print,'CHARSIZE = character size'
print,'CHARTHICK = character thickness'
retall
end
;
; initialization
;
if n_elements(charsize) eq 0 then charsize=1
n = n_elements(wline)
if n_elements(text2) eq 0 then text2 = strarr(n)
if n_elements(text3) eq 0 then text3 = strarr(n)
if n_elements(charsize) eq 1 then csize = replicate(charsize,n) $
else csize = charsize
if n_elements(extend) eq 0 then extend = 0
if n_elements(extend) eq 1 then begin
if extend lt 0 then begin
ethick = alog10(eqw*abs(extend))
endif else ethick = replicate(extend,n)
endif else ethick = extend
if n_elements(charthick) eq 0 then cthick = !p.charthick $
else cthick = charthick
if n_elements(cthick) eq 1 then cthick = replicate(cthick,n)
;
; set plot area
;
; set_viewport,0.13,0.95,0.1,0.65
;
; plot data
;
; plot,wave,flux,title=' ',xstyle=1
;
; get data ranges
;
xmin = !x.crange(0)
xmax = !x.crange(1)
ymin = !y.crange(0)
ymax = !y.crange(1)
xrange = xmax-xmin
yrange = ymax-ymin
;
; find lines within x range and sort them
;
good = where((wline gt xmin) and (wline lt xmax),nlines)
if nlines lt 1 then return
wl = wline(good)
csize = csize(good) & cthick = cthick(good) & ethick = ethick(good)
txt1 = text1(good) & txt2 = text2(good)
sub = sort(wl)
wl = wl(sub) & csize = csize(sub) & ethick = ethick(sub)
chtick = cthick(sub)
txt1 = txt1(sub)
txt2 = txt2(sub)
es = string(format='(i5)',eqw)
txt2 = txt2+es(good)+' '+text3(sub)
maxids = 65/(total(csize)/nlines) ;maximum number of identifications
if nlines gt maxids then begin
print,'Too many lines to mark, print only first '+strtrim(fix(maxids),2)+' lines'
nlines=maxids
endif
;
; determine character height in wavelength units
;
char_height = abs(xrange) / 65 * csize
;
; adjust wavelengths of where to print the line ids
;
wlp = wl ;wavelength to print text
;
; test to see if we can just equally space the annotated lines
;
if (nlines gt maxids*0.85) and (n_elements(charsize) eq 1) then begin
wlp = findgen(nlines) * (xrange/(nlines-1)) + xmin
goto,print_text
end
;
; iterate to find room to annotate each line
;
changed = 1 ;flag saying we moved a wlp position
niter = 0
factor = 0.35 ;size of adjustments in text position
while changed do begin ;iterate
changed = 0
for i=0,nlines-1 do begin
;
; determine the difference of the annotation from the lines on the
; left and right of it and the required separation
;
if i gt 0 then begin
diff1 = wlp(i)-wlp(i-1)
separation1 = (char_height(i)+char_height(i-1))/2.0
end else begin
diff1 = wlp(i) - xmin + char_height(i)*1.01
separation1 = char_height(i)
end
if i lt (nlines-1) then begin
diff2 = wlp(i+1) - wlp(i)
separation2 = (char_height(i)+char_height(i+1))/2.0
end else begin
diff2 = xmax + char_height(i)*1.01 - wlp(i)
separation2 = char_height(i)
end
;
; determine if line annotation should be moved
;
if (diff1 lt separation1) or (diff2 lt separation2) then begin
if wlp(i) eq xmin then diff1 = 0
if wlp(i) eq xmax then diff2 = 0
if diff2 gt diff1 then $
wlp(i) = (wlp(i) + separation2*factor) < xmax $
else wlp(i) = (wlp(i) - separation1*factor) > xmin
changed = 1
endif
end
if niter eq 300 then $ ; fine adjustment for
factor = factor/3 ; crowded field
if niter eq 1000 then changed=0 ; stop at 1000 iterations
niter = niter + 1
endwhile
;
; print line id's
;
print_text:
maxcsize = max(csize)
start_arrow = ymax + yrange/60
bend1 = ymax + yrange/30
bend2 = ymax + (yrange/30)*3
stop_arrow = ymax + (yrange/30)*4
start_text1 = stop_arrow + yrange/50*maxcsize
start_text2 = start_text1 + $
max(strlen(strtrim(txt1,1)))*yrange/50*maxcsize
for i=0,nlines-1 do begin
plots,[wl(i),wl(i),wlp(i),wlp(i)], $
[start_arrow,bend1,bend2,stop_arrow]
xyouts,wlp(i) + char_height(i)/2, start_text1, txt1(i), $
orientation = 90, size=csize(i), charthick = cthick(i),_extra=pex
xyouts,wlp(i) + char_height(i)/2, start_text2, txt2(i), $
orientation = 90, size=csize(i), charthick = cthick(i),_extra=pex
endfor
;
; extend selected lines down to the spectrum
;
good = where((ethick gt 0) and (wl gt xmin) and (wl lt xmax),n)
if n lt 1 then return
ww = wl(good)
ethick = ethick(good)
; help,wave
; help,flux
; help,ww
; print,n_elements(wave)
; print,n_elements(flux)
; print,wline
linterp,wave,flux,ww,ff
ymax = !y.crange(1)
ymin = !y.crange(0)
offset = (ymax-ymin)/20.0
for i=0,n-1 do plots,[ww(i),ww(i)],[(ff(i)+offset)<ymax,ymax], $
line=2,thick = ethick(i),_extra=pex
return
end
gui/IDL/lineid_select.pro
+111
View File
@@ -0,0 +1,111 @@
pro lineid_select,file,Wline,lineid,wstring,strength,eqw, $
ewlim=ewlim,n=n,range=range
;+
; lineid_select
;
; procedure to extract the wave and ID's from the SYNSPEC output file
; input: file=name of file
; output:Wline = real*8 vector of wavelengths
; lineid = vector of identifications (string array)
; wstring = string vector of wavelengths
; strength = string line strength indicator
; eqw = approximate equivalent width
; optional keyword inputs:
; ewlim = lower limit for approximate equivalent width
; (default = 0)
; N = strength indicator ( 0 1 2 3 4
; (' ','.' or '*' or '**' or '***')
; (default n = 2)
; range = 2 element vector giving desired wavelength range
; (default = [0,99999])
;-
;----------------------------------------------------------------------------
;
; print calling sequence
;
if n_params(0) lt 1 then begin
print,'CALLING SEQUENCE: lineid_select,file,Wline,lineid,'+ $
'wstring,strength,eqw'
print,'OPTIONAL KEYWORD PARAMETERS:'
print,' EWLIM = limiting approx. equivalent width'
print,' RANGE = [wmin,wmax] default=[0,99999]'
print,' N = minimum strength (0-5) default=2'
return
end
;
; set keyword defaults
;
if n_elements(N) eq 0 then N=2
if n_elements(ewlim) eq 0 then ewlim=0
if n_elements(range) eq 0 then range = [0,999999]
wmin = range(0)
wmax = range(1)
;
; open input file
;
close,1 & openr,1,file
;
; initialization for loop
;
st = ''
wline = dblarr(2000)
wstring = strarr(2000)
lineid = strarr(2000)
strength = strarr(2000)
eqw = fltarr(2000)
nlines = 0
;
; loop on lines in the file
;
while not eof(1) do begin
readf,1,st ;read string
st = strtrim(st,2) ;trim blanks
; for i=0,1 do junk=gettok(st,' ') ;skip first 2 columns. The old version of synspec required that
wave = gettok(st,' ') ;get wavelength
w = double(wave) ;convert to r*8
if (w ge wmin) and (w le wmax) then begin ;within range?
el = gettok(st,' ') ;element
; strput,el,strlowcase(strmid(el,1,1)),1 ;make second character
; lower case '
ion = gettok(st,' ')
for i=5,7 do junk = gettok(st,' ') ;skip columns 5-7
ew = double(gettok(st,' '))
str = strtrim(strmid(st,0,4),2) ;strength
case str of ;decode strength
'' : Nx=0
'.' : Nx=1
'*' : Nx=2
'**' : Nx=3
'***': Nx=4
else : Nx=999 ;unknown
endcase
;
; add line to the list
;
if Nx ge N and ew ge ewlim and nlines lt 2000 then begin
wline(nlines) = w
wstring(nlines) = wave + ' '
lineid(nlines) = el + ' ' + ion + ' '
strength(nlines) = str
eqw(nlines) = ew
nlines = nlines + 1
endif
end
end
;
; extract good part of the arrays
;
if nlines gt 0 then begin
wline = wline(0:nlines-1)
wstring = wstring(0:nlines-1)
lineid = lineid(0:nlines-1)
strength = strength(0:nlines-1)
eqw = eqw(0:nlines-1)
end else begin
print,'LINEID_SELECT: No lines found for given range/N'
end
close,1
return
end
gui/IDL/loadopt.pro
+197
View File
@@ -0,0 +1,197 @@
pro loadopt, file, optable,bin=bin
if n_params() lt 2 then begin
print,' LOADOPT,file,optable,/bin'
print,'file =STRING : name of the ASCII opacity table(input)'
print,'optable=STRUCT : loaded data from the optable (output)'
print,'/bin : the table is in binary format'
return
endif
defsysv,'!gdl',exist=gdl ; 1 is GDL , 0 is IDL
if keyword_set(bin) then begin
openr, lun, file, /f77_un,/get_lun
type = STRARR(30)
abnd = FLTARR(30)
abnd2 = FLTARR(30)
hdr='opacity table with element abundances:'
hdr=[hdr,'element for EOS for opacities']
FOR ii = 0, 29 DO begin
a = 'aaaa'
b = 0.D
c = 0.D
READU,lun, a, b, c
; PRINT, a, b, c
type[ii]=a & abnd[ii]=b & abnd2[ii]=c
hdr=[hdr,string(a,b,c,format='(3x,a4,2e12.3E3)')]
ENDFOR
hdr=[hdr,'']
hdr=[hdr,'molecules - ifmol,tmolim:']
ifmol = LONG(0)
tmolim = 0.D0
READU,lun, ifmol, tmolim
; print, ifmol, tmolim
hdr=[hdr,string(ifmol,tmolim,format='(3x,i4,f12.1)')]
hdr=[hdr,'additional opacities']
hdr=[hdr,' H- H2+ He- CH OH']
iophmp = LONG(0)
ioph2p = LONG(0)
iophem = LONG(0)
iopch = LONG(0)
iopoh = LONG(0)
READU,lun, iophmp,ioph2p,iophem,iopch,iopoh
; print, iophmp,ioph2p,iophem,iopch,iopoh
hdr=[hdr,string(iophmp,ioph2p,iophem,iopch,iopoh,format='(5i4)')]
hdr=[hdr,'']
hdr=[hdr,'number of frequencies, temperatures, densities:']
nfgrid = LONG(0)
ntemp = LONG(0)
ndens = LONG(0)
READU,lun, nfgrid,ntemp,ndens
; PRINT, nfgrid,ntemp,ndens
temp = DBLARR(ntemp)
dens = DBLARR(ndens)
elec = DBLARR(ntemp, ndens)
READU,lun, temp
READU,lun, dens
READU,lun, elec
; absgrd = DBLARR(ntemp, ndens, nfgrid)
opt=DBLARR(nfgrid,ntemp,ndens)
wlgrid = DBLARR(nfgrid)
FOR k = 0L, nfgrid-1 DO BEGIN
w = 0.D0
READU,lun, w
wlgrid[k] = w
FOR j = 0, ndens-1 DO BEGIN
abs = FLTARR(ntemp)
READU,lun, abs
; absgrd[*, j, k] = abs
opt[k,*, j] = abs
; print, abs
ENDFOR
ENDFOR
close,lun & free_lun,lun
optable={hdr:hdr,wave:wlgrid,temp:exp(temp),rho:exp(dens),nel:exp(transpose(elec)),opt:opt}
return
endif
openr,lun,file,/get_lun
line=''
; read header ...
readf,lun,line ; 'opacity table with element abundances:'
hdr=line
readf,lun,line ; 'element for EOS for opacities'
while strpos(line,'frequenc') eq -1 and strpos(line,'temper') eq -1 do begin
hdr=[hdr,line]
readf,lun,line
endwhile
readf, lun, line ; numfreq numtemp numrho
kas=strsplit(line,' ',/extract)
numfreq=long(kas[0])
numtemp=long(kas[1])
numrho=long(kas[2])
opt=dblarr(numfreq,numtemp,numrho)
topt=dblarr(numtemp,numrho)
lambda=dblarr(numfreq)
readf,lun,line ; "log temperatures"
if strtrim(line,2) ne 'log temperatures' then stop,'Temperatures not where they should be. Check op table '
readf,lun,line ; array of temperatures
tempvec=strsplit(line,' ',/extract)
if n_elements(tempvec) ne numtemp then begin
repeat begin
readf,lun,line
tempvec=[tempvec,strsplit(line,' ',/extract)]
endrep until n_elements(tempvec) eq numtemp
endif
readf,lun,line ; "log densities"
if strtrim(line,2) ne 'log densities' then stop,' Densities not where they should be. Check op table '
readf,lun,line ; array of temperatures
rhovec=strsplit(line,' ',/extract)
if n_elements(rhovec) ne numrho then begin
repeat begin
readf,lun,line
rhovec=[rhovec,strsplit(line,' ',/extract)]
endrep until n_elements(rhovec) eq numrho
endif
readf,lun,line ; "log electron densities from EOS"
nel=dblarr(numtemp,numrho)
nel=transpose(nel)
ii=0
repeat begin
readf,lun,line
kas=strsplit(line,' ',/extract)
nel[ii : ii+n_elements(kas)-1]=double(kas)
ii+=n_elements(kas)
endrep until ii eq numtemp*numrho
nel=transpose(nel) ; to have it nel[ntemp,ndens]
line=findline(lun,'frequency') ; '*** frequency # :' ind lambda
kas=strsplit(line,' ',/extract)
lambda[0]=double(kas[-1])
readf,lun,line ; frequency
freqvec=double(line)
readf,lun,line
kas=double(strsplit(line,' ',/extract))
repeat begin
readf,lun,line
kas=[kas,double(strsplit(line,' ',/extract))]
endrep until n_elements(kas) eq numtemp*numrho
topt[*]=kas
opt[0,*,*]=topt
for ii=2L, numfreq do begin
; for ii=2, 1000 do begin
readf,lun,line ; empty line
readf,lun,line ; '*** frequency # :' ind lambda
kas=strsplit(line,' ',/extract)
lambda[ii-1]=double(kas[-1])
if ii mod 100 eq 0 then progress,'',round((ii*100)/(numfreq)),' % '
readf,lun,line ; frequency
freqvec=[freqvec,double(line)]
readf,lun,line
kas=double(strsplit(line,' ',/extract))
; kas[where(kas eq 0.)]=-99.00
repeat begin
readf,lun,line
kas=[kas,double(strsplit(line,' ',/extract))]
if n_elements(kas) gt numtemp*numrho then stop,'something is wrong in the opacity table !'
endrep until n_elements(kas) eq numtemp*numrho
topt[*]=kas
opt[ii-1,*,*]=topt
endfor
print,''
close,lun
free_lun,lun
optable={hdr:hdr,wave:lambda,temp:exp(tempvec),rho:exp(rhovec),nel:exp(nel),opt:opt}
end
pro printopt,opt,fileout
if n_params() eq 0 then begin
print,' prints the opacity table.'
print,' printopt,opt,fileout'
print,''
return
endif
openw,lun,fileout,/get_lun
for ii=0,n_elements(opt.hdr)-1 do printf,lun,opt.hdr[ii]
clight=2.99792548d18
printf,lun,'number of frequencies, temperatures, densities: '
nfr=n_elements(opt.wave)
nt=n_elements(opt.temp)
nr=n_elements(opt.rho)
printf,lun,nfr,nt,nr,format='(10x,3i10)'
printf,lun,'log temperatures'
printf,lun,alog(opt.temp),format='(6f11.6)'
printf,lun,'log densities'
printf,lun,alog(opt.rho),format='(6f11.6)'
printf,lun,'log electron densities from EOS'
printf,lun,alog(transpose(opt.nel)),format='(6f11.6)'
for ii=0L, nfr-1 do begin
printf,lun,''
printf,lun,ii+1,opt.wave[ii],format='(" *** frequency # :",i9,f15.5)'
printf,lun,clight/opt.wave[ii],format='(e20.8E3)'
for jj=0, nr-1 do printf,lun,opt.opt[ii,*,jj],format='(6E14.6E3)'
endfor
close,lun
free_lun,lun
end
gui/IDL/plotspec.pro
+111
View File
@@ -0,0 +1,111 @@
pro plotspec,ident,name,rv=rv,xrange=xr,lxrange=lxr,list_elem=elist,relative=relative,elem=ielem,_extra=pex,fwhm=fwhm,viewp=viewp,idsize=idsize
;
; made by Yeisson Osorio Feb 2020
;
if n_params() lt 2 then begin
print,"plotspec,ident,name,rv=rv,fwhm=fwhm,xrange=xr,elem=elem,idsize=idsize,_extra=pex"
print," ident = (real) if 0 just plot, if > 0 plot names of lines with weq >= iden (mAngs)"
print," name = (str) name of synspec output files (with no sufix)"
print," lxr = (real[2]) wavelength range to consider (default whole range)"
print," rv = (real) radial velocity shift"
print," elem = (str[]) name of the element(s) to plot (if empty plot all)"
print," list_elem = (output) list of visible elements"
return
endif
defsysv,'!gdl',exist=gdl ; 1 is GDL , 0 is IDL
if keyword_set(ielem) then elem=strtrim(ielem,2)+' '
if n_elements(xr) eq 0 then xr=[0,0]
if ident gt 0 and ~gdl then begin
if n_elements(viewp) eq 4 then vp=viewp else vp=[0.13,0.95,0.1,0.65]
set_viewport,vp[0],vp[1],vp[2],vp[3]
endif
if ident gt 0 and gdl then !p.position=[0.075,0.1,0.95,0.65]
if name eq 'fort' then begin
if keyword_set(relative) then rotin,'fort.7','fort.17','fort.10',/relative,wl,fl else readcol,'fort.7',wl,fl,format='(d,d)'
endif else begin
if keyword_set(relative) then readcol,name+'.10',wl,fl,format='(d,d)',/silent else readcol,name+'.7',wl,fl,format='(d,d)',/silent
endelse
wstart= xr[0] eq 0 ? min(wl) : xr[0]
wend = xr[1] eq 0 ? max(wl) : xr[1]
wl=reform(wl)
fl=reform(fl)
if n_elements(fwhm) eq 1 or n_elements(rv) eq 1 then fl=fconvol(wl,fl,wl,fwhm=fwhm,rv=rv)
plot,wl,fl,xr=xr,_extra=pex
if ident gt 0 then begin
if n_elements(extend) gt 0 then begin
if iplot ge 0 then begin
nln=n_elements(wl)
wla=fltarr(nln)
fla=wla
for i=0,nln-1 do begin wla(i)=wl(i) & fla(i)=fl(i) & endfor
endif
if n_elements(observ) eq 1 then begin
nobs=n_elements(wlobs)-1
if iplot ge 0 then beyond=wl(nln-1) lt wlobs(0) or wl(0) gt wlobs(nobs-1)
if iplot lt 0 then beyond=1
if extend lt 0 then begin
extend = -extend
beyond=1
endif
nln=n_elements(wlobs)
wla=fltarr(nln)
fla=wla
for i=0,nln-1 do begin wla(i)=wlobs(i) & fla(i)=flobs(i) & endfor
endif
endif
if keyword_set(lxr) then ra=lxr else ra=[wstart,wend]
ewl=ident
; the new version of synspec has fort.14 formatted the
; following way:
; 2 1 3721.935 H I -1.97 82259.250 1.06E-02 0.9 . 2 14
; and should be
; 3721.935 H I -1.97 82259.250 1.06E-02 0.9 . 2 14
;
if name eq 'fort' then begin
if file_test('fort.15') then begin
spawn,"sed 's/^\(.............\)\(....\) /\1 \2 ./g' fort.15 > f15"
spawn,'cat fort.12 f15 | sort -n -k 3,3 >| f12'
endif else spawn,"cp fort.12 f12"
endif else begin
if file_test(name+'.15') then begin
spawn,"sed 's/^\(.............\)\(....\) /\1 \2 ./g' "+name+".15 > f15"
spawn,'cat '+name+'.iden f15 | sort -n -k 3,3 >| f12'
endif else spawn,"cp "+name+".12 f12"
endelse
spawn,'rm tf12'
if n_elements(elem) ne 0 then begin
for ii=0, n_elements(elem)-1 do begin
kas=strsplit(elem[ii],' ',/extract)
if n_elements(kas) eq 1 then spawn,'grep "'+kas+'" f12 >> tf12' $
else spawn,'grep "'+kas[0]+'" f12 | grep "'+kas[1]+'" >> tf12'
endfor
spawn,'sort -n -k 3,3 tf12 > f12'
endif else begin
spc='" "'
spawn,"awk '{print $2"+spc+"$3}' f12 | sort -u > tf12"
readcol,'tf12',a,i,format='(a,a)',/silent
elist=a+' '+i
elist=strtrim(repstr(elist,'.',''),2)
endelse
line="awk '{if ($1 >= "+strtrim(min(ra),2)+" && $1 <= "+strtrim(max(ra),2)+") print $0 }' f12 > tf12"
spawn,line
if ident lt 1 then N=0 else N=2
lineid_select,'tf12',wli,lid,wst,st,ew,ewlim=ewl,range=ra,N=N
if n_elements(rv) eq 1 then $
wli=wli*(1.-rv/2.9977925e5)
if keyword_set(pex) then begin
dum=where(strpos(tag_names(pex),'CO') ne -1)
if dum ne -1 then dum=pex.(dum) else dum=!p.color
endif
lineid_annot,wla,fla,wli,ew,lid,wst,charsize=idsize,extend=extend,col=dum
if ~gdl then set_viewport
endif
end
gui/IDL/synplot.pro
+961
View File
@@ -0,0 +1,961 @@
pro synplot,ispec,iplot,ident,wl,fl,eqw,sp,wlobs=wlobs,flobs=flobs, $
atmos=atmos,linlist=linlist,input=input,abund=abund, $
imode=imode,idstd=idstd,iprin=iprin, $
kurucz=kurucz,oldinp=oldinp,disk=disk, $
cont=cont,nlte=nlte,lyman=lyman,vturb=vturb, $
optab=optab,optemp=optemp,opdens=opdens,nlamb=nlamb, $
bintab=bintab,relabn=relabn,inttab=inttab, $
wstart=wstart,wend=wend,wdist=wdist, $
cutoff=cutoff,strength=strength,icontl=icontl,ifhe2=ifhe2, $
hydprf=hydprf,he1prf=he1prf,he2prf=he2prf, $
nangles=nangles,anglmin=anglmin, $
vrot=vrot,vmac=vmac,steprot=steprot,fwhm=fwhm,stepins=stepins, $
relative=relative,scale=scale,rv=rv, $
extend=extend,charsize=charsize,lidshift=lidshift, $
observ=observ,noread=noread,spect=spect,inlist=inlist, $
save=save,f55=f55,molecules=molecules,ichang=ichang,_extra=e
;
;
; program for ploting spectra calculated by SYNSPEC,
; with a possibility to change interactively the chemical composition;
; and interactively convolved with rotation and instrumental broadening;
; and possibly also annotated by line identifications
;
; written by I. Hubeny, Nov-Dec 1994
; modified - Jul 1996
; further modified - Nov 1996
; May 1997
; modified - Yeisson Osorio Jul 2018
; - added optab and relabn for constructing opacity tables
; - added f55 option to use another fort.55 file (use with
; caution! )
;
; ispec = 0 - Synspec is run
; no change of chemical composition;
; < 0 - Synspec is not run (only Rotins is run)
; > 0 - ispec elements change abundance; entered interactively
; iplot = 0 - original plot
; = 1 - overplot, IPLOT has the meaning of the color index
; ident = 0 - identification is not plotted
;
; OPTIONAL KEYWORD INPUT:
;
; ATMOS - file name(s) for a model atmosphere
; LINLIST - filename of the line list
; INPUT - filenames of the additional input (usually not set)
; OBSERV - filename of the observed spectrum
; IMODE - basic mode of SYNSPEC
; KURUCZ - switch for indicating a Kurucz model input (if =1)
; NLTE - NLTE switch (see SYNSPEC)
; LYMAN - switch for treating Lyman lines (IOPHLI in Synspec)
; VTURB - turbulent velocity (in km/s)
;
; OPTAB - name of output file with the opacity table
; optemp - optemp = [NTEMP, TEMP1, TEMP2]
; opdens - opdens = [IDENS, NDENS, DENS1, DENS2] not defined
; nlamb - number of wavelength points
; inttab - transformation mode from internal to universal
; wavelength points
; /bintab - output table in binary mode (default ascii)
; RELABN - pairs (IATOM, RELABN) for op tables
;
; WSTART - starting wavelength (in Angstrom)
; WEND - final wavelength (in A)
; WDIST - step in wavelength
; STRENGTH - criterion for selecting lines (RELOP in Synspec)
; CUTOFF - distance in A to which lines are allow to contribute
; IFHE2 - He II opacity switch (see SYNSPEC)
;
; VROT - rotational velocity - v sin i (in km/s)
; VMAC - macro-turbulent velocity - (in km/s)
; STEPROT - step for the rotational convolution (if non-zero)
; FWHM - FWHM for the instrumental profile (in A)
; STEPINS - step for instrumental convolution (if non-zero)
; RELATIVE - switch for computing relative spectrum (if =1)
; SCALE - a scale factor to multiply the theoretical spectrum
; RV - radial velocity (in km/s) applied on theor. spectrum
;
; EXTEND - switch for drawing vertical lines in identification
; CHARSIZE - character size in identification
;
; ABUND - vector of abundance changes
; SAVE - core filename for saved files
;
; _EXTRA - a set of any extra keywords for PLOT
;
if n_params(0) eq 0 then begin
print,'pro synplot,ispec,iplot,ident,eqw,sp,flobs,wlobs, '
print,'OPTIONAL KEYWORD PARAMETERS '
print,' type 1 for a short list;'
print,' 2 for a long list with explanations;'
print,' else return'
read,ii
if ii eq 1 then begin
print,'atmos,linlist,input,observ, (filenames)'
print,'imode,idstd,kurucz,nlte,lyman,vturb (fort.55 for SYNSPEC)'
print,'wstart,wend,wdist,strength,cutoff,ifhe2,icontl, (still fort.55)'
print,'hydprf,he1prf,he2prf, (H, HeI, HeII line broadening tables-fort.55)'
print,'nangles,anglmin (still fort.55)'
print,'vrot,vmac,steprot,fwhm,stepins,relative, (for ROTINS)'
print,'scale,rv, (radial velocity and scaling of the final spectrum)'
print,'optab,optemp,opdens,inttab,nlamb,bintab,relabn, (for opacity tables )'
print,'extend,charsize, (for LINEID)'
print,'abund,noread,spect,save,_extra (miscellaneous)'
endif else begin
if ii eq 2 then begin
print,'POSITIONAL PARAMETERS:'
print,''
print,'ispec = 0 - normal run of Synspec; <0 - (no run of Synspec),'
print,' >0 - ispec abundances changed'
print,'iplot = 0 - first plot; >0 oplot (iplot is the color index)'
print,' <0 - plot only the observed spectrum'
print,'ident = 0 - no identification; >0 - identification'
print,' in that case, lines with eqw > ident mA are marked'
print,'eqw - output: total equivalent width (in mA)'
print,'sp - if present, an array of synthetic spectrum (generated'
print,' by a previous run of Synplot)'
print,'wlobs - if present, array of wavelengths of the observed spectrum'
print,'flobs - if present, array of fluxes of the observed spectrum'
print,''
print,'KEYWORD PARAMETERS:'
print,'atmos - names(s) for the input model atmosphere (disk)'
print,' if absent: either not needed, or assumed to be'
print,' fort.5 (std input) and fort.8 (model)'
print,' if a single string: generic name'
print,' files are atmos.5 and atmos.7'
print,' if a 2-comp string vector: '
print,' files are atmos(0) and atmos(1)'
print,'oldinp - if set, the "old" format of input (up to tlus194,syn41)'
print,'disk - if set, input accretion disk model is assumed'
print,'linlist - filename for the line list (default fort.19)'
print,'input - names(s) for the additional input to Synspec'
print,' (unit 55) and Rotins (std input)'
print,' default - SYNPLOT creates these files'
print,' if present, it must be a 2-comp string vector,'
print,' [filename for unit55, std input to Rotins]'
print,'abund - if present, it is another method to change abundances'
print,' must be vector [first at.number, last a.num., abund],'
print,' or more triads consecutively'
print,''
print,'imode - basic mode of Synspec (default 0)'
print,'cont - the same as imode=2 - flux in continuum'
print,'idstd - standard depth; if not set, the program assigns'
print,' the last depth point where T<Teff'
print,'kurucz - if =1, Kurucz model atmosphere, otherwise Tlusty'
print,' (default 0 - Tlusty)'
print,'nlte - NLTE switch in Synspec'
print,' (default 1 - NLTE lines, if NLTE populations given)'
print,'lyman - switch for the treatment of Lyman lines (default 1)'
print,'vturb - turbulent velocity (in km/s) - default 0'
print,''
print,'wstart - starting wavelength (in A)'
print,'wend - end of the wavelength interval (in A)'
print,'wdist - (maximum) wavelength step (in A) - default 0.01'
print,'strength - criterion for rejecting lines - default 1.e-4'
print,'icontl - switch for considering H lines as continua'
print,'ifhe2 - switch for treatment He II lines - default 0'
print,'hydprf - filename for the special H line broadening table'
print,'he1prf - filename for the special HeI line broadening table'
print,'he2prf - filename for the special HeII line broadening table'
print,'nangles- if set, the number of angles for evaluating intensity'
print,' equidistant mu''s between 1 and anglmin'
print,'anglmin- minimum mu = cos(angle) for evaluating intensity'
print,' default = 0.1'
print,''
print,'vrot - rotational velocity (in km/s) - default 0'
print,' < 0 - ROTIN is not called'
print,'vmac - macroturbulent velocity (in km/s) - default 0'
print,'steprot - wavelength step for rotated spectra (in A),'
print,' default = (wstart+wend)*vrot/c/5'
print,'fwhm - FWHM for (Gaussian) instrumental profile (default 0)'
print,' < 0 - ROTIN is not called'
print,'stepins- step for convolved spectra (default fwhm/10)'
print,'relative - if nonzero, plot relative spectrum (default 0)'
print,'scale - scale factor for synthetic spectra (default 1)'
print,'rv - radial velocity (in km/s) to be applied '
print,' to synthethic spectra (default 0)'
print,''
print,'optab - name of the file with the opacity table'
print,'optemp - [NTEMP, TEMP1, TEMP2]'
print,'opdens - [IDENS, NDENS, DENS1, DENS2]'
print,'nlamb - number of waelenght points for the opacity table'
print,'inttab - transformation mode from internal to universal'
print,' wavelength points (1 interpolation of wavelenghts '
print,' default = 0 by integral over wavelengths )'
print,'bintab - if 1 optable is in binary mode, default 0 (= ascii)'
print,'relabn - changes in chemical abundances in the opa table'
print,' is an arrya of pairs:'
print,' [[z1,rel1],[z2,rel2],...]'
print,' where zi is atomic number and reli multiplication'
print,' factor of the input abundance (typically 0)'
print,''
print,'extend - swich for drawing lines for identification'
print,'charsize - character size in identification (default 1)'
print,'lidshift - if set, identification is shifted with rv'
print,''
print,'observ - if present, and is a string, then it is the'
print,' the filename of the observed spectrum;'
print,' (simple table wavelength (in A) vers. flux(any units))'
print,' - if present, and is equal to number 1, '
print,' then it indicates that the observed spectrum is'
print,' on positional parameters WLOBS and FLOBS'
print,'noread - if present and non-zero, the synthetic spectrum is'
print,' not read from the file fort.10 (must be transfered'
print,' by positional parameter SP)'
print,'spect - has an effect only if NOREAD is not set,'
print,' and if the spectrum is not computed by the present run:'
print,' the filaneme where the synthetic spectrum is stored'
print,' (if it is different from fort.10)'
print,''
print,'save - if present, filename for saving created files'
print,' with filenames save+.7, save+.17, etc'
print,'_extra - any extra keywords for IDL routine PLOT'
endif else return
endelse
return
endif
; check op system
spawn,'uname',opsys
opsys=strlowcase(strtrim(opsys,2))
case opsys of
'linux' : begin
synspec='synspec.linux'
rotin='rotin.linux'
end
'darwin': begin
synspec='synspec.mac'
rotin='rotin.mac'
end
else: begin
message,'# WARNING: I am not sure the OS you are running me on... ',/cont
synspec='synspec.exe'
end
endcase
;
; initialization
;
if n_elements(atmos) eq 1 then begin
fort5=atmos+".5"
fort8=atmos+".7"
endif
if n_elements(atmos) eq 2 then begin
fort5=atmos(0)
if fort5 eq 'cool.5' then oldinp=1
fort8=atmos(1)
endif
;
if n_elements(inlist) eq 0 then inlist=10
if n_elements(ichang) eq 0 then ichang=0
if n_elements(linlist) eq 1 then begin
if linlist ne 'fort.19' then begin
a='ln -s -f '+linlist+' fort.19'
spawn,a
endif
endif
;
if n_elements(abund) ne 0 then ichemc=1 else ichemc=0
if n_elements(imode) eq 0 then imode=0
if keyword_set(cont) then imode=2
if keyword_set(optab) then iopt=1 else iopt=0
if n_elements(kurucz) eq 0 then inmod=1 else begin
if kurucz ge 0 then inmod=0 & endelse
if ispec ge 0 then begin
if strmid(fort8,0,5) eq 'ap00t' then inmod=0
endif
if keyword_set(disk) then inmod=2
if keyword_set(nlte) then nlte=1 else nlte=0
;if inmod eq 0 then nlte=0
if n_elements(icontl) eq 0 then icontl=0
if n_elements(ifhe2) eq 0 then ifhe2=0
if n_elements(lyman) eq 0 then lyman=0
;
; set up parameteres for special line broadening tables
;
if n_elements(hydprf) eq 0 then ihydpr=0 else ihydpr=hydprf
;else begin $
; ihydpr=20
; spawn,'rm -f fort.20'
; hydprf=strtrim(string(hydprf),2)
; if hydprf ne '1' then begin
; a='ln -s '+hydprf+' fort.20'
; spawn,a
; endif else begin
; spawn,'ln -s hydprf.dat fort.20'
; hydprf='hydprf.dat'
; endelse
;endelse
if n_elements(he1prf) eq 0 then ihe1pr=0 else begin $
ihe1pr=21
spawn,'rm -f fort.21'
he1prf=strtrim(string(he1prf),2)
if he1prf ne '1' then begin
a='ln -s '+he1prf+' fort.21'
spawn,a
endif else begin
spawn,'ln -s he1prf.dat fort.21'
he1prf='he1prf.dat'
endelse
endelse
if n_elements(he2prf) eq 0 then ihe2pr=0 else begin $
ihe2pr=22
spawn,'rm -f fort.22'
he2prf=strtrim(string(he2prf),2)
if he2prf ne '1' then begin
a='ln -s '+he2prf+' fort.22'
spawn,a
endif else begin
spawn,'ln -s he2prf.dat fort.22'
he2prf='he2prf.dat'
endelse
endelse
if n_elements(cutoff) eq 0 then if iopt then cutoff=50.0 else cutoff=100.00
if n_elements(strength) eq 0 then if iopt then strength=1.e-3 else strength =1.e-4
if n_elements(wdist) eq 0 then begin
if imode ne 2 then begin
if iopt then wdist=0.12 else wdist=0.01
endif else wdist=0.5
endif
;
close,1 ; in case unit 1 is open!
;
if ispec ge 0 then begin
if n_elements(wstart) eq 0 then begin
spawn,'head -1 fort.19 >| lin1.tmp'
openr,1,'lin1.tmp'
readf,1,al1
close,1
wstart=al1*10.
if imode eq 1 then wstart=wstart-cutoff*0.5
endif
;
if n_elements(wend) eq 0 then begin
spawn,'tail -1 fort.19 >| lin2.tmp'
openr,1,'lin2.tmp'
readf,1,al2
close,1
wend=al2*10.
if imode eq 1 then wend=wend+cutoff*0.5
endif
endif else begin
nmlist=fix(n_elements(molecules))
if n_elements(wstart) eq 0 then begin
spawn,'head -1 fort.7 >| lin1.tmp'
openr,1,'lin1.tmp'
readf,1,al1
close,1
wstart=al1
endif
;
if n_elements(wend) eq 0 then begin
spawn,'tail -1 fort.7 >| lin2.tmp'
openr,1,'lin2.tmp'
readf,1,al2
close,1
wend=al2
endif
endelse
;
if n_elements(vrot) eq 0 then vrot=0.
if n_elements(steprot) eq 0 then steprot=0
if n_elements(fwhm) eq 0 then fwhm=0.
if n_elements(stepins) eq 0 then stepins=0
if n_elements(relative) eq 0 then relative=0
if n_elements(scale) eq 0 then scale=1.
if n_elements(rv) eq 0 then rv=0.
if n_elements(iprin) eq 0 then iprin=0
;
;
if ispec ge 0 then begin
;
; construct the input file fort.55 for Synspec
;
if n_elements(input) eq 0 then begin
if iopt then begin
idstd=1
imode-=3
endif
if n_elements(idstd) gt 0 then idst=idstd else begin
idst=0
; if inmod eq 0 or inmod eq 2 then idst=0 else begin
; a='grep -v "*" '+fort5+' |head -1 >| tetmp'
; spawn,a
; close,1 & openr,1,'tetmp'
; readf,1,teff,grav
; close,1 & openr,1,fort8
; readf,1,nd,np
; np=abs(np) ; check consequenses !!
; dm=fltarr(nd)
; readf,1,dm
; parm=fltarr(np,nd)
; readf,1,parm
; temp=parm(0,*)
; for id=0,nd-1 do if temp(id) lt teff then ids=id
; idst=ids+1
; endelse
endelse
close,1
if keyword_set(molecules) then begin
nmlist=fix(n_elements(molecules)) & mols=fix(molecules)
endif else begin
nmlist=0 & mols=0
endelse
if ~keyword_set(f55) then begin
openw,1,'f55'
zero=0
one=1
printf,1,imode,idst,iprin
printf,1,inmod,zero,ichang,ichemc
printf,1,lyman,zero,zero,zero,zero
printf,1,one,nlte,icontl,inlist,ifhe2
printf,1,ihydpr,ihe1pr,ihe2pr
if iopt then printf,1,wstart,-abs(wend),cutoff,2000,strength,wdist $
else printf,1,wstart,wend,cutoff,zero,strength,wdist
printf,1,nmlist,mols
noturb=0
if n_elements(vturb) eq 1 then printf,1,vturb else noturb=1
if keyword_set(nangles) then begin
if n_elements(anglmin) eq 0 then anglmin=0.1
if noturb eq 1 then printf,1,-1
iflux=1
printf,1,nangles,anglmin,iflux
if nangles lt 0 then begin
print,'enter ',-nangles,' values of mu=cos(angle)'
ang=fltarr(-nangles)
read,ang
printf,1,ang
endif
endif
close,1
spawn,'/bin/cp f55 fort.55'
endif else spawn,'/bin/cp '+f55+' fort.55'
endif
;
; construct the input file fort.2 (rel abn for op tables) for Synspec
;
if iopt then begin
if n_elements(inttab) eq 0 then inttab=0
if n_elements(optemp) ne 3 then begin
print,'optemp = [NTEMP, TEMP1, TEMP2] not defined'
return
endif
if n_elements(opdens) ne 4 then begin
print,'opdens = [IDENS, NDENS, DENS1, DENS2] not defined'
return
endif
if n_elements(nlamb) ne 1 then begin
print,'nlamb = NLAMB not defined'
return
endif
openw,1,'fort.2'
printf,1,optemp,format='(i-5,2e-15.3e3)'
printf,1,opdens[0],format='(i-5)'
printf,1,opdens[1:*],format='(i-5,2e-15.3e3)'
printf,1,nlamb,inttab,wstart,wend,format='(i-12,i-3,2f15.0)'
printf,1,"'"+strtrim(optab,2)+"'",fix(keyword_set(bintab))
;
; construct the input file fort.3 (rel abn for op tables) for Synspec
;
if keyword_set(relabn) and iopt then begin
dum=size(relabn)
if dum[1] ne 2 then begin
print,'relative abundance for opacity table not used (wrong array`s format)'
endif else begin
for i=0, n_elements(relabn[0,*])-1 do begin
printf,1,relabn[*,i],format='(i4,f15.4)'
endfor
endelse
endif
close,1
if iopt then begin
print,'opacity table constructed with'
print,'FORT.2 : '
print,'--------------'
spawn,'cat fort.2'
print,'--------------'
print,''
endif
endif
;
; construct the input file fort.56 for Synspec
;
openw,1,'inp.tmp'
if ispec le 0 then begin
izer=0
if n_elements(abund) eq 0 then printf,1,izer
endif else begin
;
; interactive input of abundances
;
for i=1,ispec do begin
print,'enter starting and ending atomic number, abund'
read,ia0,ia1,abun
for ia=ia0,ia1 do printf,1,ia,abun,format='(i10,f10.3)'
endfor
endelse
;
; input of abundances as a parameter ABUND
;
if n_elements(abund) ge 3 then begin
ichemc=1
ispec=n_elements(abund)/3
for i=0,ispec-1 do begin
for ia=abund(3*i),abund(3*i+1) do printf,1,ia,abund(3*i+2),$
format='(i4,e15.4)'
endfor
endif else ichemc=0
close,1
if n_elements(abund) gt 0 or ispec gt 0 then begin
spawn,'wc -l inp.tmp > inum.tmp'
spawn,'sed s/inp.tmp// inum.tmp > inum1.tmp'
spawn,'cat inum1.tmp inp.tmp > fort.56'
endif else begin
spawn,'/bin/cp inp.tmp fort.56'
endelse
;
; construct the input file fort.1 for Synspec
;
i=0
if keyword_set(oldinp) then i=1
openw,1,'f1'
printf,1,i
close,1
spawn,'/bin/cp -f f1 fort.1'
;
if n_elements(optab) eq 0 then begin
a='/bin/cp '+fort8+' fort.8'
spawn,a
endif
;
a='./'+synspec+' < '+fort5+' > sylog.tmp'
;
spawn,a
if n_elements(optab) eq 0 then begin
spawn,'tail -1 fort.16 > eq.tmp'
openr,1,'eq.tmp'
readf,1,t1,t2,t3,t4,eqw1
print,'total equivalent width: ',eqw1,' milliangstrom'
close,1
eqw=eqw1
endif else begin
save=strsplit(optab,'.',/extract)
if n_elements(save) gt 1 then begin
save=save[0:n_elements(save)-2]
save=strjoin(save,'.')
endif
a='/bin/mv sylog.tmp '+save+".log"
spawn,a
return
endelse
endif
;
; -------------------------------------------------------------------------------
;
if ident gt 0 then set_viewport,0.13,0.95,0.1,0.65
if ~keyword_set(vmac) then vmac=0.0
if vrot ge 0 and fwhm ge 0 then begin
;
; construct the input file for rotins
;
openw,1,'r.tmp'
printf,1," 'fort.7' 'fort.17' 'fort.10' "
printf,1,vrot,wdist,steprot
printf,1,fwhm,stepins,vmac
printf,1,wstart,wend,relative
close,1
;
; run rotins
;
spawn,'./'+rotin+' <r.tmp > out.tmp'
endif else spawn,'/bin/cp -f fort.7 fort.10'
;
; -------------------------------------------------------------------------------
;
if n_elements(noread) eq 0 then begin
if n_elements(spect) ne 0 then begin
a='/bin/cp -f '+spect+' fort.10'
spawn,a
endif
spawn,'wc -l fort.10 >| eq.tmp'
openr,1,'eq.tmp'
readf,1,npt
close,1
openr,1,'fort.10'
sp=fltarr(2,npt)
readf,1,sp
close,1
endif
;
; -------------------------------------------------------------------------------
;
ymax=1
if relative gt 0 and iplot eq 0 then begin
ym=max(sp(1,*))
if ym le 1 and ym ge 0.8 then ymax=1.2
if ym gt 1.2 then ymax=ym
set_xy,0,0,0,ymax
endif
;
; apply scale factor (scale) and radial velocity (rv) to the convolved spectrum
; (if required)
;
if n_elements(scale) eq 0 then fl=reform(sp(1,*)) else fl=reform(sp(1,*))*scale
if n_elements(rv) eq 0 then wl=reform(sp(0,*)) else wl=reform(sp(0,*))*(1.+rv[0]/2.9977925e5)
if iplot le 0 then begin
;
; read and plot the observed spectrum (if required)
;
if n_elements(observ) eq 0 then plot,wl,fl,_extra=e else begin
observ=strtrim(string(observ),2)
if observ ne '1' then begin
close,1 & openr,1,observ
i=0L
wlobs=fltarr(35000) & flobs=wlobs
while not eof(1) do begin
readf,1,wl0,fl0
wlobs(i)=wl0
flobs(i)=fl0
i=i+1L
endwhile
nobs=i-1L
wlobs=wlobs(0:nobs)
flobs=flobs(0:nobs)
endif
plot,wlobs,flobs,xr=[wstart,wend],ps=sym(1),symsize=0.5,_extra=e
if iplot eq 0 then oplot,wl,fl
endelse
endif else begin
; if iplot le 256 then oplot,wl,fl,color=iplot_extra=e else oplot,wl,fl,_extra=e
oplot,wl,fl,_extra=e
endelse
set_xy
close,1
;
;
; if required (ident > 0), do graphical identification
;
if ident gt 0 then begin
if n_elements(extend) gt 0 then begin
if iplot ge 0 then begin
nln=n_elements(wl)
wla=fltarr(nln)
fla=wla
for i=0,nln-1 do begin wla(i)=wl(i) & fla(i)=fl(i) & endfor
endif
if n_elements(observ) eq 1 then begin
nobs=n_elements(wlobs)-1
if iplot ge 0 then beyond=wl(nln-1) lt wlobs(0) or wl(0) gt wlobs(nobs-1)
if iplot lt 0 then beyond=1
if extend lt 0 then begin
extend = -extend
beyond=1
endif
nln=n_elements(wlobs)
wla=fltarr(nln)
fla=wla
for i=0,nln-1 do begin wla(i)=wlobs(i) & fla(i)=flobs(i) & endfor
endif
endif
ra=[wstart,wend]
ewl=ident
; the new version of synspec has fort.14 with formated
; the following way:
; 2 1 3721.935 H I -1.97 82259.250 1.06E-02 0.9 . 2 14
; and should be
; 3721.935 H I -1.97 82259.250 1.06E-02 0.9 . 2 14
;
; so :
spawn,"sed 's/^.........../ /' fort.14 > f14"
if nmlist eq 0 then spawn,'cat fort.12 f14 | sort -n -k 3,3 >| f12' $
else begin
spawn,"sed 's/^\(..............\)\(...\) /\1 \2 ./' fort.15 > f15"
spawn,'cat fort.12 f15 | sort -n -k 3,3 >| f12'
endelse
lineid_select,'f12',wli,lid,wst,st,ew,ewlim=ewl,range=ra
if n_elements(rv) eq 1 and n_elements(lidshift) ne 0 then $
wli=wli*(1.+rv/2.9977925e5)
if keyword_set(e) then begin
dum=where(strpos(tag_names(e),'CO') ne -1)
if dum ne -1 then dum=e.(dum) else dum=!p.color
endif
lineid_annot,wla,fla,wli,ew,lid,wst,charsize=charsize,extend=extend,col=dum
set_viewport
endif
;
; save files (if parameter SAVE is set)
;
if n_elements(save) eq 1 then begin
a='/bin/mv fort.7 '+save+".7"
spawn,a
a='/bin/mv fort.17 '+save+".17"
spawn,a
a='/bin/mv fort.10 '+save+".10"
spawn,a
a='/bin/mv fort.12 '+save+".12"
spawn,a
a='/bin/mv fort.14 '+save+".14"
spawn,a
a='/bin/mv fort.16 '+save+".16"
spawn,a
a='/bin/mv sylog.tmp '+save+".log"
spawn,a
if n_elements(molecules) gt 0 then begin
a='/bin/mv fort.15 '+save+".15"
spawn,a
endif
if keyword_set(nlte) then begin
a='/bin/mv fort.11 '+save+".11"
spawn,a
endif
; if n_elements(nangles) gt 0 then begin
; a='/bin/mv fort.10 '+save+".int"
; spawn,a
; a='/bin/mv fort.18 '+save+".contint"
; spawn,a
; endif
endif
;
;delete fort.10 if is eq to fort.7
;
;spawn,'/bin/diff fort.7 fort.10',kas
;if strjoin(kas) eq '' then spawn,'/bin/rm -f fort.10'
;
;delete link to fort.19 (line list)
;
if n_elements(linlist) eq 1 then begin
if linlist ne 'fort.19' then begin
; spawn,'/bin/rm -f fort.19'
endif
endif
;
;delete link to fort.20; fort.21; fort.22 (line broadening)
;
;if n_elements(hydprf) eq 1 then begin
; if hydprf ne 'fort.20' then begin
;; spawn,'/bin/rm -f fort.20'
; endif
;endif
;if n_elements(he1prf) eq 1 then begin
; if he1prf ne 'fort.21' then begin
;; spawn,'/bin/rm -f fort.21'
; endif
;endif
;if n_elements(he2prf) eq 1 then begin
; if he2prf ne 'fort.22' then begin
;; spawn,'/bin/rm -f fort.22'
; endif
;endif
;
end
pro rotin,fin,fcont,fout,xout,yout,vrot=vrot,chard=chard,stepr=stepr,$
fwhm=fwhm,stepi=stepi,vmac=vmac,$
wstart=alam0,wend=alam1,relative=irel,help=help
if n_params() lt 3 then begin
print,'rotin,fin,fcont,fout[xout,yout,vrot=,chard=,stepr=,fwhm=,stepi=,vmac=,wstart=,wend=,/relative]'
if ~keyword_set(help) then return
print,' fin : file with synthetic spectrum (.7)'
print,' fcont : file with continuum flux (.17)'
print,' fout : name of the output file'
print,' xout,yout : read fout and store x and y'
print,' VROT - v sin i (in km/s, 0)'
print,' CHARD - characteristic delta lambda (0.01)'
print,' STEPR - wavelength step for evaluation rotational convolution'
print,' FWHM - full width at half maximum instrumental profile'
print,' STEPI - wavelength step for evaluating instrumental convolution '
print,' VMAC - macroturbulent velocity'
print,' ALAM0 - initial wavelength'
print,' ALAM1 - final wavelength'
print,' /RELATIVE - normalized spectrum '
return
endif
spawn,'uname',opsys
; check OS
opsys=strlowcase(strtrim(opsys,2))
case opsys of
'linux' : begin
rotin='./rotin.linux'
end
'darwin': begin
rotin='./rotin.mac'
end
else: begin
message,'# WARNING: I am not sure the OS you are running me on... ',/cont
return
end
endcase
if n_elements(vrot) eq 0 then vrot=0
if n_elements(chard) eq 0 then chard=0
if n_elements(stepr) eq 0 then stepr=0
if n_elements(fwhm) eq 0 then fwhm=0
if n_elements(stepi) eq 0 then stepi=0
if n_elements(vmac) eq 0 then vmac=0
if n_elements(alam0) eq 0 or n_elements(alam1) eq 0 then begin
readcol,fcont,x,/silent
alam0=min(x)
alam1=max(x)
endif
if keyword_set(irel) then irel=1 else irel=0
; ---------------------------------------------------------------
; INPUT - from unit 5 - four lines of input
; ---------------------------------------------------------------
;
; 1. filenames:
;
; fin - name of the file containing the detailed synthetic spectrum
; (i.e. fort.7 produced by Synspec )
;
; fcont - name of the file containing the continuum flux
; (i.e. fort.17 produced by Synspec )
;
; fout - name of the output file - convolved spectrum
;
;
; 2. parameters for rotational convolution
;
; VROT - v sin i (in km/s)
; if VROT=0 - rotational convolution is
; a) either not calculated,
; b) or, if simultaneously FWHM is rather large
; (vrot/c*lambda < FWHM/20.),
; vrot is set to FWHM/20*c/lambda;
; if VROT >0 but the previous condition b) applies, the
; value of VROT is changed as in the previous case
; if VROT<0 - the value of abs(VROT) is used regardless of
; how small compared to FWHM it is
; CHARD - characteristic scale of the variations of unconvolved
; stellar spectrum (basically, characteristic distance
; between two neighbouring wavelength points) - in A
; - if =0 - program sets up default (0.01 A)
; STEPR - wavelength step for evaluation rotational convolution;
; - if =0, the program sets up default (the wavelength
; interval corresponding to the rotational velocity
; devided by 3.)
; if <0, convolved spectrum calculated on the original
; (detailed) SYNSPEC wavelength mesh
;
;
; 3. parameters for instrumental convolution
;
; FWHM - full width at half maximum for Gaussian instrumental
; profile
; STEPI - wavelength step for evaluating instrumental convolution
; - if =0, the program sets up default (FWHM/10.)
; - if <0, convolved spectrum calculated with the previous
; wavelength mesh:
; either the original (SYNSPEC) one if vrot=0,
; or the one used in rotational convolution (vrot > 0)
;
; VMAC - macroturbulent velocity
;
; 4. wavelength interval and normalization of spectra
;
; ALAM0 - initial wavelength
; ALAM1 - final wavelength
; IREL - for =1 relative spectrum
; =0 absolute spectrum
;
openw,1,'rotin3.inp'
printf,1," '",fin,"' '",fcont,"' '",fout,"' "
printf,1,vrot,chard,stepr
printf,1,fwhm,stepi,vmac
printf,1,alam0,alam1,irel
close,1
spawn,rotin+' <rotin3.inp > '+fout+'.log'
if n_params() eq 5 then readcol,fout,xout,yout,/silent,format='(d,d)'
return
end
pro mkintfiles,fort,nmu,muind,fileout,mkcont=mkcont
; fort.10 has the syntetic intensities at different mu
; fort.18 has the continuum intensities at different mu
; nmu = number of mu values
; muind = index(ces) of the mu value to extract (start with 0 i.e.,
; disk centre mu=1.0)
; /mkcont = only make continuum
cc=2.99792458d18 ; speed of light in AA/sec
if ~keyword_set(mkcont) then begin
openr,lun,fort+'.10',/get_lun
lwave=''
lint=''
readf,lun,lwave
kas=strsplit(lwave,' ',/extract)
wave=double(kas[0])
readf,lun,lint
kas=strsplit(lint,' ',/extract)
nread=0
while n_elements(kas) lt nmu do begin
readf,lun,lint
nread++
kas=[kas,strsplit(lint,' ',/extract)]
endwhile
int=double(kas)
while(~eof(lun)) do begin
readf,lun,lwave
readf,lun,lint
kas=strsplit(lwave,' ',/extract)
wave=[wave,double(kas[0])]
kas=strsplit(lint,' ',/extract)
for jj=1, nread do begin
readf,lun,lint
kas=[kas,strsplit(lint,' ',/extract)]
endfor
int=[[int],[double(kas)]]
endwhile
close,lun
openw,lun,fileout+'.int'
for ii=0, n_elements(wave)-1 do printf,lun,wave[ii],int[muind,ii]*cc/wave[ii]/wave[ii],format='(f12.5,e15.5E3)'
close,lun
endif else get_lun,lun
;;; fort.18 continuum intensity
openr,lun,fort+'.18'
lwave=''
lint=''
readf,lun,lwave
kas=strsplit(lwave,' ',/extract)
wave=double(kas[0])
readf,lun,lint
kas=strsplit(lint,' ',/extract)
nread=0
while n_elements(kas) lt nmu do begin
readf,lun,lint
nread++
kas=[kas,strsplit(lint,' ',/extract)]
endwhile
int=double(kas)
while(~eof(lun)) do begin
readf,lun,lwave
kas=strsplit(lwave,' ',/extract)
wave=[wave,double(kas[0])]
readf,lun,lint
kas=strsplit(lint,' ',/extract)
for jj=1, nread do begin
readf,lun,lint
kas=[kas,strsplit(lint,' ',/extract)]
endfor
int=[[int],[double(kas)]]
endwhile
close,lun
openw,lun,fileout+'.contint'
for ii=0, n_elements(wave)-1 do if (ii mod 4 eq 2) or (ii mod 4 eq 3) then printf,lun,wave[ii],int[muind,ii]*cc/wave[ii]/wave[ii],format='(f12.5,e15.5E3)'
; for ii=0, n_elements(wave)-1 do printf,lun,wave[ii],int[muind,ii]*cc/wave[ii]/wave[ii],format='(f12.5,e15.5E3)'
close,lun
free_lun,lun
end