Viewing contents of file '../idllib/astron/pro/ccm_unred.pro'
pro ccm_UNRED, wave, flux, ebv, funred, R_V = r_v
;+
; NAME:
; CCM_UNRED
; PURPOSE:
; Deredden a flux vector using the CCM 1989 parameterization
; EXPLANATION:
; The reddening curve is that of Cardelli, Clayton, and Mathis (1989 ApJ.
; 345, 245), including the update for the near-UV given by O'Donnell
; (1994, ApJ, 422, 158). Parameterization is valid from the IR to the
; far-UV (3.5 microns to 0.1 microns).
;
; Users might wish to consider using the alternate procedure FM_UNRED
; which uses the extinction curve of Fitzpatrick (1999).
; CALLING SEQUENCE:
; CCM_UNRED, wave, flux, ebv, funred, [ R_V = ]
; or
; CCM_UNRED, wave, flux, ebv, [ R_V = ]
; INPUT:
; WAVE - wavelength vector (Angstroms)
; FLUX - calibrated flux vector, same number of elements as WAVE
; If only 3 parameters are supplied, then this vector will
; updated on output to contain the dereddened flux.
; EBV - color excess E(B-V), scalar. If a negative EBV is supplied,
; then fluxes will be reddened rather than deredenned.
;
; OUTPUT:
; FUNRED - unreddened flux vector, same units and number of elements
; as FLUX
;
; OPTIONAL INPUT KEYWORD
; R_V - scalar specifying the ratio of total selective extinction
; R(V) = A(V) / E(B - V). If not specified, then R_V = 3.1
; Extreme values of R(V) range from 2.75 to 5.3
;
; EXAMPLE:
; Determine how a flat spectrum (in wavelength) between 1200 A and 3200 A
; is altered by a reddening of E(B-V) = 0.1. Assume an "average"
; reddening for the diffuse interstellar medium (R(V) = 3.1)
;
; IDL> w = 1200 + findgen(40)*50 ;Create a wavelength vector
; IDL> f = w*0 + 1 ;Create a "flat" flux vector
; IDL> ccm_unred, w, f, -0.1, fnew ;Redden (negative E(B-V)) flux vector
; IDL> plot,w,fnew
;
; NOTES:
; (1) The CCM curve shows good agreement with the Savage & Mathis (1979)
; ultraviolet curve shortward of 1400 A, but is probably
; preferable between 1200 and 1400 A.
; (2) Many sightlines with peculiar ultraviolet interstellar extinction
; can be represented with a CCM curve, if the proper value of
; R(V) is supplied.
; (3) Curve is extrapolated between 912 and 1000 A as suggested by
; Longo et al. (1989, ApJ, 339,474)
; (4) Use the 4 parameter calling sequence if you wish to save the
; original flux vector.
;
; REVISION HISTORY:
; Written W. Landsman Hughes/STX January, 1992
; Extrapolate curve for wavelengths between 900 and 1000 A Dec. 1993
; Use updated coefficients for near-UV from O'Donnell Feb 1994
; Allow 3 parameter calling sequence April 1998
; Converted to IDLV5.0 April 1998
;-
On_error, 2
if N_params() LT 3 then begin
print,'Syntax: CCM_UNRED, wave, flux, ebv, funred,[ R_V = ]'
return
endif
if not keyword_set(R_V) then R_V = 3.1
x = 10000./ wave ; Convert to inverse microns
npts = N_elements( x )
a = fltarr(npts)
b = fltarr(npts)
;******************************
good = where( (x GT 0.3) and (x LT 1.1), Ngood ) ;Infrared
if Ngood GT 0 then begin
a[good] = 0.574 * x[good]^(1.61)
b[good] = -0.527 * x[good]^(1.61)
endif
;******************************
good = where( (x GE 1.1) and (x LT 3.3) ,Ngood) ;Optical/NIR
if Ngood GT 0 then begin ;Use new constants from O'Donnell (1994)
y = x[good] - 1.82
; c1 = [ 1. , 0.17699, -0.50447, -0.02427, 0.72085, $ ;Original
; 0.01979, -0.77530, 0.32999 ] ;coefficients
; c2 = [ 0., 1.41338, 2.28305, 1.07233, -5.38434, $ ;from CCM89
; -0.62251, 5.30260, -2.09002 ]
c1 = [ 1. , 0.104, -0.609, 0.701, 1.137, $ ;New coefficients
-1.718, -0.827, 1.647, -0.505 ] ;from O'Donnell
c2 = [ 0., 1.952, 2.908, -3.989, -7.985, $ ;(1994)
11.102, 5.491, -10.805, 3.347 ]
a[good] = poly( y, c1)
b[good] = poly( y, c2)
endif
;******************************
good = where( (x GE 3.3) and (x LT 8) ,Ngood) ;Mid-UV
if Ngood GT 0 then begin
y = x[good]
F_a = fltarr(Ngood) & F_b = fltarr(Ngood)
good1 = where( (y GT 5.9), Ngood1 )
if Ngood1 GT 0 then begin
y1 = y[good1] - 5.9
F_a[ good1] = -0.04473 * y1^2 - 0.009779 * y1^3
F_b[ good1] = 0.2130 * y1^2 + 0.1207 * y1^3
endif
a[good] = 1.752 - 0.316*y - (0.104 / ( (y-4.67)^2 + 0.341 )) + F_a
b[good] = -3.090 + 1.825*y + (1.206 / ( (y-4.62)^2 + 0.263 )) + F_b
endif
; *******************************
good = where( (x GE 8) and (x LE 11), Ngood ) ;Far-UV
if Ngood GT 0 then begin
y = x[good] - 8.
c1 = [ -1.073, -0.628, 0.137, -0.070 ]
c2 = [ 13.670, 4.257, -0.420, 0.374 ]
a[good] = poly(y, c1)
b[good] = poly(y, c2)
endif
; *******************************
; Now apply extinction correction to input flux vector
A_V = R_V * EBV
A_lambda = A_V * (a + b/R_V)
if N_params() EQ 3 then flux = flux * 10.^(0.4*A_lambda) else $
funred = flux * 10.^(0.4*A_lambda) ;Derive unreddened flux
return
end