Viewing contents of file '../idllib/iuedac/iuelib/pro/feature_out.pro'
;***********************************************************************
;+
;*NAME:
;
; FEATURE_OUT AUG. 28, 1989
;
;*CLASS:
;
; formatted text output for feature.pro
;
;*CATEGORY:
;
;*PURPOSE:
;
; To output the results of the feature procedure measurements to
; text and graphics windows
;
;*CALLING SEQUENCE:
;
; FEATURE_OUT, R,comment
;
;*PARAMETERS:
;
; r (REQ) (I) (1) (F)
; Required input vector of argument values
; r(0)= the original value for W0 (rest wavelength).
; r(1)= short wavelength limit to integration
; r(2)= extremum of spectral line
; r(3)= long wavelength limit to integration
; r(4)= radial velocity for short wavelength limit
; to integration.
; r(5)= radial velocity for extremum of spectral line
; r(6)= radial velocity for the long wavelength limit
; to integration.
; r(7)= flux at the short wavelength limit to the
; integration.
; r(8)= flux at the spectral line extremum
; r(9)= flux at the long wavelength limit to the
; integration.
; r(10)=continuum flux
; r(11)=residual flux at extremum
; r(12)=equivalent width
; r(13)=total flux in the feature.
; r(14)=flux weighted wavelength for feature.
; r(15)=flux weighted sigma, which for a
; gaussian profile can be related to the full
; width at half maximum.
; r(16)=net flux in feature
; r(17)=flux weighted wavelength, with continuum
; not included
; r(18)=flux weighted sigma for net flux only.
;
; com (OPT) (I)
; Optional parameter for identifying comment. Limited to 20
; characters; it will be truncated if it is longer.
;
;*EXAMPLES:
;
; Load the result array (fltarr(19)) with the appropriate values
; and call feature_out.
;
; feature_out, result
;
;*SYSTEM VARIABLES USED:
;
; !d.name
; !d.x_ch_size
; !d.y_ch_size
; !d.y_size
;
;*INTERACTIVE INPUT:
;
;*SUBROUTINES CALLED:
;
; PARCHECK
;
;*FILES USED:
;
;*SIDE EFFECTS:
;
;*RESTRICTIONS:
;
;*NOTES:
;
; This procedure calls the graphics routine "xyouts" with
; the key words " font=0,/device ", and outputs text to the
; left side of the graphics window.
;
; tested with IDL Version 2.1.0 (sunos sparc) 20 Jun 91
; tested with IDL Version 2.1.0 (ultrix mispel) N/A
; tested with IDL Version 2.1.0 (vax vms) 21 Jun 91
;
;*PROCEDURE:
;
; This procedure uses "xyouts" for sending text to the
; graphics window and "print" for text output to the text
; window.
;
;
;*MODIFICATION HISTORY:
;
; aug. 28, 1989 jtb @gsfc version 1 for unix/sun idl
; Feb. 26, 1991 PJL @GSFC added an optional identifying comment to plot
; Jun. 17, 1991 PJL @GSFC changed test of TEK and PS to lowercase;
; tested on UNIX and VAX systems; updated prolog
; Jun. 21, 1991 PJL @GFSC cleaned up; tested on SUN ans VAx;
; updated prolog
;
;-
;********************************************************************
pro feature_out, r,com
;
npar = n_params(0)
if npar eq 0 then begin
print,' FEATURE_OUT,R,comment'
retall
endif ; npar
parcheck,npar,[1,2],'FEATURE_OUT'
;
if npar eq 2 then com = strmid(com,0,20) ; truncates to 20 characters
;
if ((strlowcase(!d.name) ne 'tek') and (strlowcase(!d.name) ne 'ps')) $
then begin
if npar eq 2 then print,format="(1x,a)",com
print,format="(/,1x,a,f10.3)",'wlab ',r(0)
print,format="(1x,a,f10.3)",'w1 ',r(1)
print,format="(1x,a,f10.3)",'w2 ',r(2)
print,format="(1x,a,f10.3)",'w3 ',r(3)
print,format="(/,1x,a,f10.3)",'rv1 ',r(4)
print,format="(1x,a,f10.3)",'rv2 ',r(5)
print,format="(1x,a,f10.3,/)",'rv3 ',r(6)
print,format="(1x,a,e10.3)",'f1 ',r(7)
print,format="(1x,a,e10.3)",'f2 ',r(8)
print,format="(1x,a,e10.3)",'f3 ',r(9)
print,format="(/,1x,a,e10.3)",'fcont',r(10)
print,format="(1x,a,f10.3)",'resi2',r(11)
if abs(r(12)) gt 1. then print,format="(/,1x,a,f10.3)",'ew-a ',r(12) $
else print,format="(/,1x,a,f10.3)",'ew-ma',1000.*r(12)
print,format="(/,1x,a,e10.3)",'ftot ',r(13)
print,format="(1x,a,f10.3)",'wtot ',r(14)
print,format="(1x,a,f8.3)",'widtot ',r(15)
print,format="(/,1x,a,e10.3)",'fnet ',r(16)
print,format="(1x,a,f10.3)",'wnet ',r(17)
print,format="(1x,a,f8.3,//)",'widnet ',r(18)
endif ; ne tek
;
;
vspace = 1.1 * !d.y_ch_size
vpos = !d.y_vsize - 3*vspace
hpos = !d.x_ch_size
;
vpos = vpos - vspace
if npar eq 2 then begin
s0 = string(format="(1x,a)",com)
xyouts,hpos,vpos,s0,font=0,/device
vpos = vpos - 2 * vspace
endif ; npar
;
s0 = string(format="(1x,a,f10.3)",'wlab ',r(0))
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'w1 ',r(1))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'w2 ',r(2))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'w3 ',r(3))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'rv1 ',r(4))
vpos = vpos - 2*vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'rv2 ',r(5))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'rv3 ',r(6))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,e10.3)",'f1 ',r(7))
vpos = vpos - 2*vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,e10.3)",'f2 ',r(8))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,e10.3)",'f3 ',r(9))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,e10.3)",'fcont',r(10))
vpos = vpos - 2*vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'resi2',r(11))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
if abs(r(12)) gt 1. then $
s0 = string(format="(1x,a,f10.3)",'ew-a ',r(12)) $
else s0 = string(format="(1x,a,f10.3)",'ew-ma',1000.*r(12))
vpos = vpos - 2*vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,e10.3)",'ftot ',r(13))
vpos = vpos - 2*vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'wtot ',r(14))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f8.3)",'widtot ',r(15))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,e10.3)",'fnet ',r(16))
vpos = vpos - 2*vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f10.3)",'wnet ',r(17))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
s0 = string(format="(1x,a,f8.3)",'widnet ',r(18))
vpos = vpos - vspace
xyouts,hpos,vpos,s0,font=0,/device
;
return
end ; feature_out