Viewing contents of file '../idllib/iuedac/iuelib/pro/bbdraw.pro'
;******************************************************************************
;+
;*NAME:
;
; BBDRAW 6-JAN-83
;
;*CLASS:
;
;*CATEGORY:
;
;*PURPOSE:
;
; Draw blackbody curves over data through a given point.
;
;*CALLING SEQUENCE:
;
; BBDRAW,WAVE,FLUX,WPICK,TEMP,DILUTION,WBB,FBB,q=q,sigma=sigma
;
;*PARAMETERS:
;
; WAVE (REQ) (I) (1) (I L F D)
; Wavelength scale.
;
; FLUX (REQ) (I) (1) (I L F D)
; Flux to be fit.
;
; WPICK (REQ) (O) (0) (F)
; Wavelength of the point through which the blackbody curve is
; forced to pass.
;
; TEMP (REQ) (O) (0) (F)
; Blackbody temperature last chosen by user.
;
; DILUTION (REQ) (O) (0) (F)
; Dilution factor at point chosen by user for blackbody with
; temperature temp.
;
; WBB (REQ) (O) (1) (F)
; Array of final blackbody wavelengths.
;
; FBB (REQ) (O) (1) (F)
; Array of final blackbody fluxes.
;
; Q (KEY) (I) (1) (I L F D)
; Data quality flags (IUESIPS or NEWSIPS).
;
; SIGMA (KEY) (I) (1) (R)
; The NEWSIPS sigma vector (or other fitting error, e.g., GEX).
;
;*INTERACTIVE INPUT:
;
; User selects a point through which the blackbody curve must pass,
; then user inputs guesses for temperature until he or she gets tired.
;
;*FILES USED:
;
; User may create BBDRAW.PS if desired.
;
;*SYSTEM VARIABLES USED:
;
; !d.x_ch_size
; !d.y_ch_size
; !d.y_vsize
;
;*SUBROUTINES CALLED:
;
; PARCHECK Checks that the number of parameters entered is acceptable.
; PLANCK Calculates black body curve
; NSPLOT Plots data (with quality flags/sigmas if given)
; plotopen Creates PS file and redirects plot output to PS device
; plotclose Closes PS file and resets plot device
; plotprint Executes PLOTCLOSE and send PS file to printer, if desired
;
;*SIDE EFFECTS:
;
; If a PS file is created, a title is put on the plot, overriding the
; value of !p.title.
;
;*RESTRICTIONS:
;
;*NOTES:
;
; Uses PLANCK to calculate the bb curves.
;
;*PROCEDURE:
;
; The input parameters are plotted. The user must then mark the fit
; point. Then the user enters tempertures at the propmt. To exit,
; enter 0.
;
;*INF_1:
;
;*EXAMPLES:
;
;
; General data:
;
; bbdraw,w,f,wp,tp,dil,wbb,fbb
;
; IUESIPS data:
;
; bbdraw,w,f,wp,tp,dil,wbb,fbb,q=e
;
; NEWSIPS data:
;
; bbdraw,w,f,wp,tp,dil,wbb,fbb,q=n,sigma=s
; bbdraw,w,f,wp,tp,dil,wbb,fbb,sigma=s
; bbdraw,w,f,wp,tp,dil,wbb,fbb,q=n
;
;*MODIFICATION HISTORY:
;
; 26-JAN-83 BY RJP= correction of a program by I. Ahmad based on a
; program by S. Heap
; 6-21-85 RWT add WBB and FBB output parameters, use new IUEPLOT
; and remove unnecesssary compiles
; 10-22-85 RWT DIDL change: use # for @
; 5- 6-87 RWT VAX mods: add PARCHECK, plot titles, and use
; CURSOR for TEKDATA
; 9-24-87 CAG corrected dilution factor to reflect IUE calibration
; wavelength scale units of per Angstrom instead of per cm
; (as given in Allen, Astrophysical Quantities). URP #275.
; 10-12-87 RWT add procedure call listing
; 05-oct-89 jtb @gsfc modified for sun/unix idl
; 08 Apr 91 pjl@gsfc modified PLANCK to return result in units per
; ANGSTROM
; 19 Jun 91 PJL cleaned up; tested on SUN and VAX; updated prolog
; 5 Aug 93 PJL clean up; remove EPS parameter; add EPS, NU, and SIGMA
; keywords; add NSPLOT
; 28 Sep 93 LLT fix a few typos in prolog
; 27 Dec 94 LLT Remove IUEPLOT, change prompting for non-TEK devices,
; remove IF block for plotting since new NSPLOT can
; ignore undefined parameters, add option to print/make
; PS file of final results.
; 3 Jan 94 LLT use lower case for plot file name
;-
;******************************************************************************
pro bbdraw,wave,flux,wpick,temp,dilution,wbb,fbb,q=q,sigma=sigma
;
; initial setups
;
npar = n_params(0)
if (npar eq 0) then begin
print,'BBDRAW,WAVE,FLUX,WPICK,TEMP,DILUTION,WBB,FBB,q=q,sigma=sigma'
retall
endif ; npar
parcheck,npar,7,'BBDRAW'
;
; make plot and give instructions for interactive inputs
;
nsplot,0,wave,flux,q,sigma,/mark
; if (keyword_set(eps)) then iueplot,0,wave,flux,eps else begin
; if (keyword_set(sigma)) then begin
; if not(keyword_set(nu)) then nu = 0
; nsplot,0,wave,flux,nu,sigma
; endif else begin
; if (keyword_set(nu)) then nsplot,0,wave,flux,nu else nsplot,0,wave,flux
; endelse ; keyword_set(sigma)
; endelse ; keyword_set(eps)
tek=strlowcase(!d.name) eq 'tek'
if tek then begin
hpos = !d.x_ch_size
vspace = !d.y_ch_size * 1.1
vpos = !d.y_vsize -vspace
xyouts,hpos,vpos,/device, $
font=0,'Place cursor at point to fit and press any key.'
vpos = vpos - vspace
xyouts,hpos,vpos,/device, $
font=0,'Enter a temperature at the prompt (0 to quit).'
endif else print,'Place cursor at point to fit and press any key.'
;
cursor,wpick,fpick,/data ; accept input from cursor
;
; guess temperature
;
temp=0.
repeat begin
if tek then begin
vpos = vpos - vspace
xyreads,hpos,vpos,t,'bbtemp> ',/device
endif else read,'Enter a temperature (0 to stop): ',t
t = float(t)
;
; calculate and overplot the bb curve
;
if (t gt 0) then begin
temp = t
planck,temp,wpick,bbfpick ; bbfpick assumes per cm
dilution = fpick/bbfpick
planck,temp,wave,bbflux ; now calculate for the input wavelength grid
oplot,wave,dilution*bbflux
endif ; calculate and overplot
end until t le 0 ; guess temperature
;
if temp eq 0. then return
wbb = wave
fbb = dilution * bbflux
if tek then begin
for i=vpos-vspace,vspace,-vspace do xyouts,hpos,i,/device,'|'
xyouts,hpos,vspace,'V',/device
xyreads,hpos,0,a,/device,$
'Enter 1 to write results to PS file, 2 to send to Printer, 0 to Quit: '
endif else $
read,'Enter 1 to write results to PS file, 2 to send to Printer, 0 to Quit: ',a
if a gt 0 then begin
plotopen,d,'bbdraw'
nsplot,0,wave,flux,q,sigma,title='bbdraw: Temp='+strtrim(temp,2)
oplot,wbb,fbb
oplot,[wpick],[fpick],psym=2
if a eq 2 then plotprint,d,'bbdraw' else plotclose,d
endif ;a gt 0
;
return
end ; bbdraw