Viewing contents of file '../idllib/astron/contrib/varosi/vlibm/allpro/mgep_rad_trans.pro'
;+
; NAME:
; MGEP_Rad_Trans
; PURPOSE:
; Approximate the radiative transfer of photons emitted in or impacting
; a two-phase clumpy medium (dust & gas) of spherical/disk geometry,
; using the Mega-Grains approximation of Hobson & Padman,
; combined with the escape/interaction probability formulae:
; Osterbrock-Lucy E.P. for uniformly distributed internal source,
; Varosi's interaction prob. for uniformly illuminating external source,
; or Varosi's E.P. approximation for central source.
; See Varosi & Dwek 1999, ApJ 523, 265 for complete discussion.
; An approximation for the ionization of Hydrogen, and resultant
; heating of dust by Lyman-alpha photons is also attempted.
; See keyword SOURCE for the 5 types of photon sources modeled,
; (3 standard types and 2 special for sources only in clumps).
; CALLING:
; MGEP_Rad_Trans, SED_wave, SED_source, SED_esc, Lumins
;
; INPUTS:
; SED_wave = array of SED wavelengths, in microns.
; The dust abs. & scat. coeffs. (input from KAPPA_DUST keyword)
; are interpolated onto this SED wavelength grid.
;
; SED_source = Spectral Energy Distribution (SED) of source emission
; vs. wavelength, in solar luminosities per Angstrom (Lsun/A).
;
; OUTPUTS:
; SED_esc = escaping spectral energy distribution vs. wavelength (Lsun/A).
;
; Lumins = structure variable accounting of all Luminosities emitted,
; escaped, and absorbed in dust/gas.
;
; KEYWORD INPUTS: (ICM = interclump medium)
;
; KAPPA_DUST = structure variable with dust absorption/scattering coeffs.
; KAPPA_ICM_DUST = optional, structure with ICM dust abs. & scat. coeffs.
;
; DUST_MASS_DEN = equivalent homogeneous mass density of dust (gm/cm^3).
; DUST_FRAC = mass fraction of each component of the dust.
; DUST_ICM_FRAC = optional, dust component fractions in the ICM.
;
; GAS_DEN = homogeneous density (n(H)/cm^3) of atomic hydrogen.
; GAS_TEMP = temperature (K) of atomic hydrogen.
; RADIUS = effective radius of sphere/disk containing clumpy medium.
;
; FILL_FACT = volume filling factore of spherical clumps,
; CLUMP_RADIUS = radius of a spherical clump, same units as RADIUS.
; RATIO_DICM_DCL = ratio of ICM density to clump density.
;
; SOURCE = string (upper or lowercase) indicating source of photons:
; "C" : case of central point source,
; "X" : case of uniformly illuminating external source,
; "U" = uniformly distributed internal sources (default case).
; "MC" : central source only in clumps (no emission in ICM),
; "MU" : uniform source only in clumps (no emission in ICM).
;
; /PLOT : plot intermediate results.
; /VERBOSE : print informational messages about results.
; /FULL_STRUCT : include all results in output structure variable "Lumins"
;
; OPTIONAL KEYWORD OUTPUTS:
; EPWAVE = computed photon escape probability vs. wavelength.
; EPLYA = escape probability of Lyman alpha accounting for resonant
; scattering in a dusty medium.
; TAU_EFF = the effective optical depth of medium at each wavelength.
; ALBEDO_EFF = the effective albedo of clumpy medium at each wavelength.
; FDUST = fractions of photons absorbed by each dust component and phase.
; FGAS = fractions of photons absorbed by each gas phase at each wavelen.
; EXTERNAL CALLS:
; pro Mega_Grains
; function Mega_Grain_Abs
; function Finterpol
; function ismeuv
; function Tau_Eff_Scat
; function Escape_Prob
; function Pinteract
; function Trapez
; function ep_Lya
; HISTORY:
; Written: Frank Varosi, HSTX @ NASA/GSFC, 1995
; F.V. 1997, account for absorbtion by both ICM and clumps.
; F.V. 1999, added keyword options for different dust in ICM.
; F.V. 2000, added source types "MC" and "MU" (source just in clumps).
;-
pro MGEP_Rad_Trans, SED_wave, SED_source, SED_esc, Lumins, RADIUS=Rs, $
KAPPA_DUST=Dust_Kappa, KAPPA_ICM_DUST=Dust_ICM_Kappa, $
DUST_MASS_DEN=dust_dens, DUST_FRACTIONS=dust_fracs, $
DUST_ICM_FRACTIONS=dust_ICM_fracs, $
FILL_FACT=ffcl, CLUMP_RADIUS=Rcl, RATIO_DICM_DCL=drat, $
GAS_DENSITY=gas_dens, GAS_TEMP=gas_T, PLOTIT=plotit,$
EPWAVE=esc_prob, EPLYA=epLya, TAU_EFF=Tau_Eff, $
ALBEDO_EFF=albedo_eff, FDUST=frac_dust, FGAS=frac_gas, $
FULL_STRUCT=full_struct, VERBOSE=verbose, SOURCE=srctype
if N_struct( Dust_Kappa ) ne 1 then begin
message,"keyword KAPPA_DUST must be structure variable",/INFO
stop
endif
sz = size( Dust_Kappa.Kabs )
ndc = sz(2) ;usually 0=graphite, 1=silicates.
nphase = 2 ;0=ICM, 1=clumps.
if N_elements( dust_fracs ) NE ndc then begin
message,"keyword DUST_FRACTIONS must be a " + $
strtrim( ndc, 2 ) + " element array",/INFO
stop
endif
;interpolate dust abs & scat coeffs onto wavelength grid of SED:
Nwave = N_elements( SED_wave )
Kabs = fltarr( Nwave, ndc )
Kscat = fltarr( Nwave, ndc )
gcos = fltarr( Nwave, ndc )
r = Finterpol( dummy, alog( Dust_Kappa.WaveLen ), $
alog( SED_wave ), /INIT,/QUIET )
for i=0,ndc-1 do begin
Kabs(*,i) = exp( Finterpol( alog( Dust_Kappa.Kabs(*,i) ),/QU))
Kscat(*,i) = exp( Finterpol( alog( Dust_Kappa.Ksca(*,i) ),/QU))
gcos(*,i) = Finterpol( Dust_Kappa.gcos(*,i),/QUIET ) < 1
endfor
Kabstot = Kabs # dust_fracs
frac_dust = fltarr( Nwave, ndc, nphase )
for i=0,ndc-1 do frac_dust(*,i,1) = Kabs(*,i)*dust_fracs(i)/Kabstot
Kscatot = Kscat # dust_fracs
Ktot = Kscatot + Kabstot
Kalb = Kscatot/Ktot
gasp = gcos # dust_fracs
;if given, interpolate ICM dust coeffs onto SED wavelength grid:
if N_struct( Dust_ICM_Kappa ) eq 1 then begin
r = Finterpol( dummy, alog( Dust_ICM_Kappa.WaveLen ), $
alog( SED_wave ), /INIT,/QUIET )
for i=0,ndc-1 do begin
Kabs(*,i) = exp( Finterpol( alog( Dust_ICM_Kappa.Kabs(*,i) ),/QU))
Kscat(*,i) = exp( Finterpol( alog( Dust_ICM_Kappa.Ksca(*,i)),/QU))
gcos(*,i) = Finterpol( Dust_ICM_Kappa.gcos(*,i),/QUIET ) < 1
endfor
if N_elements( dust_ICM_fracs ) eq ndc then begin
Kabstot = Kabs # dust_ICM_fracs
for i=0,ndc-1 do $
frac_dust(*,i,0) = Kabs(*,i)*dust_ICM_fracs(i)/Kabstot
Kscatot = Kscat # dust_ICM_fracs
gasp_ICM = gcos # dust_ICM_fracs
endif else begin
Kabstot = Kabs # dust_fracs
for i=0,ndc-1 do $
frac_dust(*,i,0) = Kabs(*,i)*dust_fracs(i)/Kabstot
Kscatot = Kscat # dust_fracs
gasp_ICM = gcos # dust_fracs
endelse
Ktot_ICM = Kscatot + Kabstot
Kalb_ICM = Kscatot/Ktot
endif else frac_dust(*,*,0) = frac_dust(*,*,1)
if N_elements( srctype ) ne 1 then srctype = "U"
srctype = strupcase( srctype )
;DUST:
Mega_Grains, kd_mg, kd_icm, albedo_eff, gp_eff, TAU_CL=tau_cd, $
XSEC=Ktot, GP=gasp, ALB=Kalb, DEN=dust_dens, $
ICM_X=Ktot_ICM, ICM_G=gasp_ICM, ICM_A=Kalb_ICM,$
RADIUS_CL=Rcl, FILL=ffcl, RATIO=drat
fd_abs_ICM = Mega_Grain_Abs( XSEC=Ktot, GP=gasp, ALB=Kalb, $
ICM_X=Ktot_ICM, ICM_G=gasp_ICM, ICM_A=Kalb_ICM,$
RADIUS_CL=Rcl, FILL=ffcl, RATIO=drat, $
SOURCE=srctype, RADIUS_EFF=Rs, DEN=dust_dens )
for i=0,ndc-1 do frac_dust(*,i,0) = frac_dust(*,i,0) * fd_abs_ICM
for i=0,ndc-1 do frac_dust(*,i,1) = frac_dust(*,i,1) * (1 - fd_abs_ICM)
;GAS:
wang = 1e4 * SED_wave ;convert microns to Angstroms.
wlyc = where( wang LT 912, nlyc )
Mega_Grains, kg_mg, kg_icm, ALB=0, RADIUS_CL=Rcl, FILL=ffcl, RAT=drat,$
XSEC=ismeuv( wang, 1 ), DEN=gas_dens, TAU_CL=tau_cg
;Combine:
kd_eff = kd_mg + kd_icm
kg_eff = kg_mg + kg_icm
frac_gas = kg_eff/(kd_eff + kg_eff)
frac_gas = [[frac_gas],[frac_gas]] ;for two phases.
;GAS phase fractions:
if nlyc GT 1 then begin
fg_abs_ICM = Mega_Grain_Abs( ALB=0, GP=0, RADIUS_CL=Rcl, $
SOURC=srctype, RATIO=drat, $
RADIUS_EFF=Rs, FILL=ffcl, DEN=gas_dens,$
XSEC=ismeuv( wang(wlyc) < 911.5, 1 ) )
frac_gas(wlyc,0) = frac_gas(wlyc,0) * fg_abs_ICM
frac_gas(wlyc,1) = frac_gas(wlyc,1) * (1 - fg_abs_ICM)
endif
Tau_Eff = Rs * ( kd_eff + kg_eff )
Tau_Clu = tau_cd + tau_cg
CASE srctype OF
"C": esc_prob = exp( -Tau_Eff_Scat( gp_eff, albedo_eff, Tau_Eff ) )
"X": esc_prob = 1 - Pinteract( Tau_Eff, albedo_eff )
"U": esc_prob = Escape_Prob( Tau_Eff, albedo_eff )
"MU": esc_prob = Escape_Prob( Tau_Eff, albedo_eff ) $
* Escape_Prob( Tau_Clu, Kalb )
"MC": esc_prob = Escape_Prob( Tau_Eff, albedo_eff ) $
* exp( -Tau_Eff_Scat( gasp, Kalb, Tau_Clu ) )
else: esc_prob = Escape_Prob( Tau_Eff, albedo_eff )
ENDCASE
if keyword_set( plotit ) then begin
!P.multi=[0,1,2]
!X.title="Wavelength (microns)"
get_window,0,/SHOW
plot, SED_wave, Tau_Eff,/XTYP,/YTYP, XTIT="", YMARG=[0,2], $
YTIT="Effective Optical Depth", TIT=srctype
oplot, SED_wave, Rs * (kd_mg + kg_mg), LINE=2
oplot, SED_wave, Rs * (kd_icm + kg_icm), LINE=1
plot, SED_wave, albedo_eff,/XTYP,YR=[0,1], YMARG=[4,2], $
YTIT="Effective Albedo or g=<cos>"
oplot, SED_wave, gp_eff, LINE=1
get_window,1,/SHOW
plot, SED_wave, frac_gas,/XLOG,YR=[0,1], XTIT="", YMARG=[2,2], $
YTIT="Absorption Fractions", TIT=srctype,/NODATA
for j=0,nphase-1 do begin
oplot, SED_wave, frac_gas(*,j)
for i=0,ndc-1 do oplot,SED_wave,frac_dust(*,i,j),LIN=2-i
endfor
plot, SED_wave, esc_prob,/XTYP,YR=[0,1], $
YTIT="Escape Probability & Frac_Abs_ICM"
oplot, SED_wave, fd_abs_ICM, LINE=2
empty
!X.title=""
!P.multi=0
endif
SED_esc = SED_source * esc_prob
SED_abs = SED_source - SED_esc
Lum_tot = Trapez( SED_source, wang )
Lum_esc = Trapez( SED_esc, wang )
hc = !cv.h * !cv.c * 1e4 ;units = erg-microns
hfinv = SED_wave/hc ; = 1/(h*freq) = ergs^(-1)
if nlyc GT 1 then begin
Lum_Lyc = Trapez( SED_source(wlyc), wang(wlyc) )
Nphot_Lyc = Trapez( SED_source(wlyc) * hfinv, wang(wlyc) )
endif else begin
Lum_Lyc = 0.0
Nphot_Lyc = 0.0
endelse
Nphot_Lycabs = fltarr( nphase ) ;absorbed by: 0=ICM, 1=clumps.
Lum_gas = fltarr( nphase )
Lum_dust = fltarr( ndc, nphase ) ;absorbed by: 0=graphite, 1=silicates.
for j=0,nphase-1 do begin
if nlyc GT 1 then begin
abs = SED_abs(wlyc) * frac_gas(*,j)
Lum_gas(j) = Trapez( abs, wang(wlyc) )
Nphot_Lycabs(j) = Trapez( abs * hfinv, wang(wlyc) )
endif
for i=0,ndc-1 do begin
frac_dust(*,i,j) = frac_dust(*,i,j) * (1-frac_gas(*,j))
Lum_dust(i,j) = Trapez( frac_dust(*,i,j)*SED_abs, wang )
endfor
endfor
; Lyman-alpha escape probability:
if N_elements( Lyafr ) NE 1 then Lyafr = 0.68
Lum_Lya = Lyafr * Nphot_Lycabs * hc/0.1215
wLya = scalar( where( SED_wave GE 0.1215 ) )
gdc = gas_dens/( ffcl + (1-ffcl)*drat )
if strpos( srctype, "M" ) eq 0 then begin
epLya = ep_Lya( TG=gas_T, G=gdc, R=Rs, ALPHA=alpha, $
TAU=Tau_Clu(wLya), ALB=Kalb(wLya) )
endif else begin
epLya = ep_Lya( TG=gas_T, G=gdc * drat, R=Rs, ALPHA=alpha, $
TAU=Tau_Eff(wLya), ALB=albedo_eff(wLya) )
endelse
Lum_Lya_abs = Lum_Lya * (1-epLya)
Lum_Lya_dust = reform( frac_dust(wLya,*,*) ) $
* transpose( [ [Lum_Lya_abs], [Lum_Lya_abs] ] )
Lum_dust = Lum_dust + Lum_Lya_dust
LogLsun = alog10( !cv.Lsun )
wV = scalar( where( SED_wave GE 0.55 ) )
wB = scalar( where( SED_wave GE 0.44 ) )
wU = scalar( where( SED_wave GE 0.36 ) )
wUBV = [wU,wB,wV]
Lumins = { Lum_tot: Lum_tot, $
Lum_esc: Lum_esc, $
Lum_Lyc: Lum_Lyc, $
Lum_gas: Lum_gas, $
Log_Nphot_Lyc: alog10( Nphot_Lyc ) + LogLsun, $
Log_Nphot_Lycabs: alog10( Nphot_Lycabs ) + LogLsun, $
Lum_Lya: Lum_Lya, $
Lum_Lya_abs: Lum_Lya_abs, $
Lum_Lya_dust: Lum_Lya_dust, $
Lum_dust: Lum_dust, $
Lum_dust_tot: total( Lum_dust ), $
SrcType: srctype, $
dust_comp: Dust_Kappa.dust_comp, $
dust_phase: ["ICM","clumps"], $
Radius_eff: Rs, $
Rclump: Rcl, $
FFCL: ffcl, $
RATIO_DICM_DCL: drat, $
DUST_MASS_DEN: dust_dens, $
GAS_DENSITY: gas_dens, $
GAS_TEMPERATURE: gas_T, $
Tau_UBV: Rs * dust_dens * Ktot(wUBV), $
Alb_UBV: Kalb(wUBV), $
Tau_Eff_UBV: Tau_Eff(wUBV), $
Alb_Eff_UBV: Albedo_Eff(wUBV), $
Tau_Eff_Lya: Tau_Eff(wLya), $
Alb_Eff_Lya: albedo_eff(wLya), $
ep_Lya: epLya, $
alpha: alpha }
if keyword_set( verbose ) then begin
print," "
print_struct, Lumins, TR=[0,5], FORM=['g','11','3']
print," "
print_struct, Lumins, TR=[6,8], FORM=['g','11','3']
print," "
print_struct, Lumins, TR=[9,10], FORM=['g','11','3']
endif
if keyword_set( full_struct ) then begin
Lumins = create_struct( Lumins, "SED_wave", SED_wave, $
"SED_source", SED_source, $
"SED_esc", SED_esc, $
"kd_mg", kd_mg, $
"kd_icm", kd_icm, $
"tau_cd", tau_cd, $
"gp_eff", gp_eff, $
"albedo_eff", albedo_eff )
if full_struct gt 1 then $
Lumins = create_struct( Lumins, "kg_mg", kg_mg, $
"kg_icm", kg_icm, $
"tau_cg", tau_cg )
endif
if !DEBUG then stop
end