Viewing contents of file '../idllib/astron/contrib/varosi/vlibm/allpro/rad_trans_1d.pro'
;+
; NAME:
;	Rad_Trans_1D
; PURPOSE:
;	Compute single temperature dust emission/absorption spectrum
;	with line of sight (LOS) absorption, in Janskys/arcsec^2.
;	If third argument is present, compute partial derivatives for fitting.
; CALLING:
;	IR_spec = Rad_Trans_1D( wvd, Params, Pder )
; INPUTS:
;	wvd = wavelength array, in microns.
;	Params = [ cLOS, T1, csrc1, T2, csrc2 ]
;	Pder = matrix of partial derivatives of parameters at wavelengths.
; KEYWORDS:
;	/FULL_SPECTRUM : use full resoltuion wavelength array in common block.
;	EXTINCT = array of LOS extinction factor vs. wavelength (returned).
;	/JANSKYS : return IR intensity in Jy/arcsec^2, otherwise
;		default is pure energy [nu.I(nu)]: W/m^2/arcsec^2.
; OUTPUTS:
;	Returns the IR intensity in W/m^2 or Janskys, per arcsec^2.
;
;	I(w)=  B(w,T1)*(1-exp[-TAU_src1])*exp[-TAU_LOS] 
;	     + B(w,T2)*(1-exp[-TAU_src2])*exp[-TAU_LOS]
; COMMON BLOCKS:
;	common IR_spectrum_comp, Fsil_LOS, Fsil_src1, Fsil_src2
;	common kappa_interp, wki, kigrf, kisil
;	common kappa_full, wkf, kgrf, ksil
;	common Rad_Trans_1D, cLOS
; EXTERNAL CALLS:
;	pro match
; PROCEDURE:
;
; HISTORY:
;	Written: Frank Varosi & Eli Dwek, NASA/GSFC, 1996.
;-

function Rad_Trans_1D, wvd, Params, Pder, FULL_SPECTRUM=fullspec, $
		EXTINCT=ext_LOS, JYS=janskys, T1_ONLY=T1_only, T2_ONLY=T2_only

   common IR_spectrum_comp, Fsil_LOS, Fsil_src1, Fsil_src2
   common kappa_interp, wki, kigrf, kisil
   common kappa_full, wkf, kgrf, ksil
   common RT_1D_fixed, cLOS, Tbb

 	Nwv = N_elements( wvd )
	Np = N_elements( Params ) 

	CASE Np OF
		1: begin
			csrc = Params(0)
			if N_elements( cLOS ) ne 1 then cLOS=0.
			if N_elements( Tbb ) ne 1 then Tbb = 200.
		     end
		2: begin
			Tbb = Params(0)
			csrc = Params(1)
			if N_elements( cLOS ) ne 1 then cLOS=0.
		     end
		3: begin
			cLOS = Params(0)
			Tbb = Params(1)
			csrc = Params(2)
		     end
		4: begin
			Tbb = Params(0)
			csrc = Params(1)
			Tbb2 = Params(2)
			csrc2 = Params(3)
			if N_elements( cLOS ) ne 1 then cLOS=0.
		     end
		5: begin
			cLOS = Params(0)
			Tbb = Params(1)
			csrc = Params(2)
			Tbb2 = Params(3)
			csrc2 = Params(4)
		     end
	  ENDCASE

	if keyword_set( fullspec ) then begin

		wvs = wkf
 		Nwv = N_elements(wvs)
		ksrc1 = Fsil_src1 * ksil + (1-Fsil_src1) * kgrf
		kLOS = Fsil_LOS * ksil + (1-Fsil_LOS) * kgrf

	 endif else begin

		match, wvd, wki, md, mki, COUNT=nmatch
		if( nmatch LT Nwv ) then begin
			message,"stored interpolate wavelengths do not match " $
				+"those for data, must restore Dust_Kappa.idl" $
				+ string(7b),/INFO
			stop
		   endif
		wvs = wvd
		ksrc1 = Fsil_src1 * kisil(mki) + (1-Fsil_src1) * kigrf(mki)
		kLOS = Fsil_LOS * kisil(mki) + (1-Fsil_LOS) * kigrf(mki)
	  endelse

if !DEBUG GT 2 then help,cLOS,Tbb,csrc
if !DEBUG GT 4 then stop

	arcsec2 = ( !DTOR/60/60 )^2
	wavnum = 1/wvs
janskys=1
	if keyword_set( janskys ) then begin
		hcj = 2 * !cv.h * (1e-7 * 1e26) * !cv.c * 1e-2
		bhc = arcsec2 * hcj * 1e18 * wavnum^3
	 endif else begin
		hcw = 2 * !cv.h * (1e-7 * !cv.c * 1e4) * !cv.c * 1e-2 *1e10
		bhc = arcsec2 * hcw * 1e18 * wavnum^4
	  endelse

	hcok = !cv.h * 1e4 * !cv.c / !cv.k
	ext_LOS = EXP( -cLOS*kLOS )

	if keyword_set( T2_only ) then goto,T2

;First temperature B.B.:

	BT = fltarr(Nwv)
	xT = wavnum * ( hcok / Tbb )
	w = where( xT LT 88., nex )

	if nex gt 0 then begin
		eT = EXP( xT(w) )
		BT(w) = bhc(w)/(eT-1)
	   endif

	BT = BT * ext_LOS
	ext_SRC = EXP( -csrc*ksrc1 )
	Flux = BT * (1 - ext_SRC)

	if N_params() GE 3 then begin

		Pder = fltarr( Nwv, Np )

		if (Np eq 1) then begin
			Pder(*,0) =  BT * ext_SRC * ksrc1
			return, Flux
		   endif

		exprat = replicate( 1.0, Nwv )
		if nex gt 0 then exprat(w) = eT/(eT-1)

		if (Np eq 2) or (Np eq 4) then begin
			Pder(*,0) =  Flux * (xT/Tbb) * exprat
			Pder(*,1) =  BT * ext_SRC * ksrc1
		 endif else begin
			Pder(*,0) = -Flux * kLOS
			Pder(*,1) =  Flux * (xT/Tbb) * exprat
			Pder(*,2) =  BT * ext_SRC * ksrc1
		  endelse
	   endif

	if (Np LE 3) or keyword_set( T1_only ) then return, Flux

T2:	;optional second temperature B.B:

	if keyword_set( fullspec ) then $
		ksrc2 = Fsil_src2 * ksil + (1-Fsil_src2) * kgrf $
	  else	ksrc2 = Fsil_src2 * kisil(mki) + (1-Fsil_src2) * kigrf(mki)

	BT = fltarr(Nwv)
	xT = wavnum * ( hcok / Tbb2 )
	w = where( xT LT 88., nex )

	if nex gt 0 then begin
		eT = EXP( xT(w) )
		BT(w) = bhc(w)/(eT-1)
	   endif

	ext_SRC = EXP( -csrc2*ksrc2 )
	BT = BT * ext_LOS
	Flux2 = BT * (1 - ext_SRC)
	if N_elements( Flux ) LE 0 then Flux = 0
	Flux = Flux + Flux2 

	if N_params() GE 3 then begin
		exprat = replicate( 1.0, Nwv )
		if nex gt 0 then exprat(w) = eT/(eT-1)
		if (Np eq 4) then begin
			Pder(*,2) =  Flux2 * (xT/Tbb2) * exprat
			Pder(*,3) =  BT * ext_SRC * ksrc2
		 endif else begin
			Pder(*,0) = -Flux * kLOS
			Pder(*,3) =  Flux2 * (xT/Tbb2) * exprat
			Pder(*,4) =  BT * ext_SRC * ksrc2
		  endelse
	   endif

return, Flux
end