Viewing contents of file '../idllib/astron/contrib/varosi/vlibm/allpro/ep_rad_trans.pro'
;+
; NAME:
;	EP_Rad_Trans
; PURPOSE:
;	Approximate the radiative transfer of photons emitted in or impacting
;	a homogenous medium (dust & gas) of spherical/disk geometry,
;	using 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.
;	An approximation of absorption, ionization of gas, and resultant
;	heating of dust by Lyman-alpha from gas is also attempted,
;	but this needs more work.
; CALLING:
;	EP_Rad_Trans, SED_wave, SED_emit, 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_emit = emitted Spectral Energy Distribution (SED) vs. wavelength,
;		in solar luminosities per second per Angstrom.
;
; OUTPUTS:
;	SED_esc = escaping spectral energy distribution vs. wavelength.
;
;	Lumins = structure variable accounting of all Luminosities emitted,
;		escaped, and absorbed in dust/gas.
;
; KEYWORD INPUTS:
;
;	KAPPA_DUST = structure variable with dust absorption/scattering coeffs.
;	DUST_MASS_DEN = array of dust mass densities for each component.
;	GAS_DEN = density of atomic hydrogen, same units as RADIUS.
;	RADIUS = effective radius of sphere/disk containing clumpy medium.
;
;	SOURCE = string (upper or lowercase) indicating source of photons:
;		"C" : do case of central source,
;		"X" : do case of uniformly illuminating external source,
;			default is "U": uniformly distributed internal source.
;
;	/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.
;	FD = of the photons absorbed, the fractions going to each dust comp.
;	FG = fraction of photons absorbed by the gas at each wavelength.
; EXTERNAL CALLS:
;	function Finterpol
;	function ismeuv
;	function Tau_Eff_Scat
;	function Escape_Prob
;	function Pinteract
;	function Trapez
;	function ep_Lya
; PROCEDURE:
; HISTORY:
;	Written: Frank Varosi, HSTX @ NASA/GSFC, 1995
;-

pro EP_Rad_Trans, SED_wave, SED_emit, SED_esc, Lumins, PLOT=plotit, $
			KAPPA_DUST=Dust_Kappa, DUST_MASS_DEN=den_dustm, $
			RADIUS=Rs, GAS_DENSITY=den_gas, GAS_TEMPERATURE=Tgas, $
			EPWAVE=esc_prob, EPLYA=epLya, TAU_TOT=Tau_tot, $
			ALBEDO=albedo, FD=frac_dust, FG=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.

	if N_elements( den_dustm ) NE ndc then begin
		message,"keyword DUST_MASS_DEN 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 )
	junk = 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) )))
		Kscat(*,i) = exp( Finterpol( alog( Dust_Kappa.Ksca(*,i) )))
		gcos(*,i) = Finterpol( Dust_Kappa.gcos(*,i) ) < 1
	  endfor

	Kabstot = Kabs # den_dustm
	frac_dust = fltarr( Nwave, ndc )
	for i=0,ndc-1 do frac_dust(*,i) = Kabs(*,i)*den_dustm(i)/Kabstot

	Kscatot = Kscat # den_dustm
	Ktot = Kscatot + Kabstot
	gcos = gcos # ( den_dustm/total( den_dustm ) )
	albedo = Kscatot/Ktot

	wang = 1e4 * SED_wave		;convert microns to Angstroms.
	wlyc = where( wang LT 912, nlyc )

	Tau_tot = Rs * ( Ktot + ismeuv( wang, den_gas ) )
	frac_gas = 1 - Rs*Ktot/Tau_tot

	if N_elements( srctype ) ne 1 then srctype = "U"
	srctype = strupcase( srctype )

	CASE srctype OF

	  "C":	esc_prob = exp( -Tau_Eff_Scat( gcos, albedo, Tau_tot ) )

	  "X":	esc_prob = 1 - Pinteract( Tau_tot, albedo )

	  else:	esc_prob = Escape_Prob( Tau_tot, albedo )
	 ENDCASE

	if keyword_set( plotit ) then begin
		!P.multi=[0,1,2]
		!X.title="Wavelength (microns)"
		get_window,0,/SHOW
		plot, SED_wave, Tau_tot,/XTYP,/YTYP, XTIT="", YMARG=[0,2], $
					YTIT="Optical Depth"
		plot, SED_wave, albedo,/XTYP,YR=[0,1], YMARG=[4,2], $
					YTIT="Albedo"
		if srctype eq "C" then oplot, SED_wave, gcos, LINE=1
		get_window,1,/SHOW
		plot, SED_wave, frac_gas,/XTYP,YR=[0,1], XTIT="", YMARG=[2,2], $
			YTIT="Absorption Fractions (Gas, graphite, silicates)"
		for i=0,1 do oplot, SED_wave, frac_dust(*,i),LINE=2-i
		plot, SED_wave, esc_prob,/XTYP,YR=[0,1], $
				YTIT="Escape Probability"
		empty
		!X.title=""
		!P.multi=0
	   endif

	SED_esc = SED_emit * esc_prob
	SED_abs = SED_emit - SED_esc

	Lum_tot = Trapez( SED_emit, 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_emit(wlyc), wang(wlyc) )
		Nphot_Lyc = Trapez( SED_emit(wlyc) * hfinv, wang(wlyc) )
	 endif else begin
		Lum_Lyc = 0.0
		Nphot_Lyc = 0.0
	  endelse

	if nlyc GT 1 then begin
		abs = SED_abs * frac_gas
		Lum_gas = Trapez( abs, wang )
		Nphot_Lycabs = Trapez( abs * hfinv, wang(wlyc) )
	 endif else begin
		Lum_gas = 0.0
		Nphot_Lycabs = 0.0
	  endelse

	Lum_dust = fltarr( ndc )	;absorbed by: 0=graphite, 1=silicates.
	abs = SED_abs * (1-frac_gas)
	for i=0,ndc-1 do Lum_dust(i) = Trapez( frac_dust(*,i)*abs, wang )

;obtain optical depth and albedo of dust at Lyman-alpha wavelength,
; and get 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 ) )

	epLya = ep_Lya( TG=Tgas, G=den_gas, R=Rs, ALPHA=alpha, $
			TAU=Tau_tot(wLya), ALB=albedo(wLya) )

	Lum_Lya_abs = Lum_Lya * (1-epLya)
	Lum_Lya_dust = reform( frac_dust(wLya,*) ) * 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, $
			Radius_eff:	Rs, $
			DUST_MASS_DEN:	den_dustm, $
			GAS_DENSITY:	den_gas, $
			GAS_TEMPERATURE: Tgas,  $
			Tau_UBV:	Rs * Ktot(wUBV), $
			Alb_UBV:	albedo(wUBV), $
			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_emit", SED_emit, $
						"SED_esc", SED_esc, $
						"Tau_tot", Tau_tot, $
						"gcos", gcos, $
						"albedo", albedo )
	   endif

if !DEBUG then stop
end