dustem_compute_stokext.pro 6.38 KB
FUNCTION dustem_compute_stokext,p_dim,$
                                st=st,$
                                QEXT_spec=QEXT_spec,$
                                UEXT_spec=UEXT_spec,$
                                PSIEXT_spec=PSIEXT_spec,$
                                dustem_psi_ext=dustem_psi_ext,$
                                help=help
                               

;+
; NAME:
;    dustem_compute_stokext
;
; PURPOSE:
;    Computes Stokes Parameters for extinction in units of optical depth for a given Dustem spectrum
;
; CATEGORY:
;    Dustem
;
; CALLING SEQUENCE:
;    out=dustem_compute_stokext(p_dim[,st=][,QEXT_spec=QEXT_spec][,UEXT_spec=UEXT_spec][,PSIEXT_spec=PSIEXT_spec][,dustem_psi_ext=dustem_psi_ext][,/help])
;
; INPUTS:
;    p_dim      = parameter values
;
; OPTIONAL INPUT PARAMETERS:
;    st        = Dustem structure
;
; OUTPUTS:
;    out        = List Containing the Stokes parameters extinction for spectrum points in !dustem_data 
;    out[0]     = Computed Stokes Q extinction for spectrum points in !dustem_data
;    out[1]     = Computed Stokes U extinction for spectrum points in !dustem_data 
;
; OPTIONAL OUTPUT PARAMETERS:
;    st        = Dustem output structure
;    QEXT_spec        = Dustem Stokes Q extinction 
;    UEXT_spec        = Dustem Stokes U extinction
;    PSIEXT_spec      = Dustem Polarization angle output in extinction
;    dustem_psi_ext   = Computed Polarization angle ouput for spectrum points in !dustem_data
;
; ACCEPTED KEY-WORDS:
;    help      = If set, print this help
;
; COMMON BLOCKS:
;    None
;
; SIDE EFFECTS:
;    None
;
; RESTRICTIONS:
;    The DustEM fortran code must be installed
;    The DustEMWrap IDL code must be installed
;
; PROCEDURE:
;    None
;
; EXAMPLES
;    
; MODIFICATION HISTORY:
;    Written by J.-Ph. Bernard 2022
;    Evolution details on the DustEMWrap gitlab.
;    See http://dustemwrap.irap.omp.eu/ for FAQ and help.  
;-


IF keyword_set(help) THEN BEGIN
    doc_library,'dustem_compute_stokext'
    out=0.
    goto,the_end
ENDIF

IF not keyword_set(st) THEN BEGIN
    dustem_activate_plugins,p_dim/(*(*!dustem_fit).param_init_values),st=st
    ;st=dustem_run(p_dim)
ENDIF

out=0. ; no specific output is required.

If keyword_set(result) THEN result=st

degtorad = !pi/180


EXT_spec = st.ext.ext_tot * (*!dustem_HCD)/1.e21     ;This is Total extinction (for a default value of 10^20 NH/cm^2)
POLEXT_spec = st.polext.ext_tot * (*!dustem_HCD)/1.e21   ;This is Polarized extinction

;Hard-coded test to set to zero potential negative values in the polarized extinction arrays:
;so far this has been seen in absorption arrays  
;This test needs to include all grain species that polarize

IF !run_pol THEN BEGIN
    
    ;THIS FALSE CORRECT  IT USING POLEXT_spec
    ;POLEXT_spec.abs_grain[2,*]
    ind_ngtv_plxt = where (POLEXT_spec LT 0, ct_ngtv_plxt)
    
    IF ct_ngtv_plxt NE 0 THEN (POLEXT_spec)[ind_ngtv_plxt] = 0.
        
        
ENDIF

Nwaves=(size(EXT_SPEC))[1]

frac=POLEXT_spec/EXT_spec
tes=where(finite(frac) eq 0)
frac(tes)=0.

scopes=tag_names((*!dustem_plugin))
IF scopes[0] NE 'NONE' THEN BEGIN

    FOR i=0L,n_tags(*!dustem_plugin)-1 DO BEGIN   
        
        IF total(strsplit((*(*!dustem_plugin).(i).scope),'+',/extract) EQ 'REPLACE_POLEXT') THEN BEGIN
            
            QEXT_spec = (*(*!dustem_plugin).(i).spec)[*,1]
            UEXT_spec = (*(*!dustem_plugin).(i).spec)[*,2]
            
        ENDIF 
    
    ENDFOR
ENDIF    
    
IF ~isa(QEXT_spec) && ~isa(UEXT_spec) THEN BEGIN
    polar_ippsi2iqu,EXT_spec,QEXT_spec,UEXT_spec,frac,replicate(!dustem_psi_ext,Nwaves);PSI_spec 
ENDIF    
        

IF scopes[0] NE 'NONE' THEN BEGIN        
    FOR i=0L,n_tags(*!dustem_plugin)-1 DO BEGIN
        
        IF total(strsplit((*(*!dustem_plugin).(i).scope),'+',/extract) EQ 'ADD_POLEXT') THEN BEGIN
            
            QEXT_spec+=(*(*!dustem_plugin).(i).spec)[*,1]
            UEXT_spec+=(*(*!dustem_plugin).(i).spec)[*,2]
        
        ENDIF
    
    ENDFOR
ENDIF
;-----------------------------------------


;Hard-coded block to avoid cases where Q=-0.0 and U=0.
testnzero = where(QEXT_spec EQ -0., ct_nzero)
if ct_nzero ne 0 then QEXT_spec[testnzero] = 0


PSIEXT_spec = 0.5*atan(UEXT_spec,QEXT_spec)/degtorad


;INITIALIZING THE STOKES SEDS
dustem_qext = (*(*!dustem_data).qext).values * 0.
dustem_uext = (*(*!dustem_data).uext).values * 0.
;Using a list because dustem_qext and dustem_uext can have different dimensions
out=list(fltarr(n_elements(dustem_qext)),fltarr(n_elements(dustem_uext)))
if not isarray(EXT_spec) THEN stop 


;COLOR CORRECTION NOT PERFORMED YET. ONLY SPECTRUM DATA POINTS ARE CONSIDERED FOR NOW
; 
; ;Performing color corrections on the dustem spectra and generating the SEDs at the given filters 
; 
; IF !dustem_do_cc NE 0 AND !dustem_never_do_cc EQ 0 THEN BEGIN
;     message,'DOING color correction calculations',/info
; ENDIF ELSE BEGIN
;           message,'SKIPPING color correction calculations',/info
;       ENDELSE
; 
; ind_qsed=where((*(*!dustem_data).qsed).filt_names NE 'SPECTRUM',count_qsed)
; ind_used=where((*(*!dustem_data).used).filt_names NE 'SPECTRUM',count_used)
;   
;   
; IF count_qsed NE 0 THEN BEGIN 
;   filter_names=((*(*!dustem_data).qsed).filt_names)(ind_qsed)    
;   if isa(dustem_qsed) then begin 
;     sqsed=dustem_cc(st.polsed.wav,Q_spec,filter_names,cc=cc)
;     dustem_qsed(ind_qsed)=sqsed
;   endif
; ENDIF
; 
; IF count_used NE 0 THEN BEGIN
; filter_names=((*(*!dustem_data).used).filt_names)(ind_used)
; if isa(dustem_used) then begin
;   sused=dustem_cc(st.polsed.wav,U_spec,filter_names,cc=cc)
;   dustem_used(ind_used)=sused
; endif
; ENDIF


;For spectrum data points, interpolate in log-log
;Linear interpolation leads to wrong values, in particular where few
;wavelengths points exist in the model (long wavelengths).

ind_qspec=where((*(*!dustem_data).qext).filt_names EQ 'SPECTRUM',count_qspec)
ind_uspec=where((*(*!dustem_data).uext).filt_names EQ 'SPECTRUM',count_uspec)

IF count_qspec NE 0 THEN BEGIN
  if isa(dustem_qext) then dustem_qext(ind_qspec)=interpol(QEXT_spec,st.polext.wav,(((*(*!dustem_data).qext).wav)(ind_qspec)))  
ENDIF

IF count_uspec NE 0 THEN BEGIN
  if isa(dustem_uext) then dustem_uext(ind_uspec)=interpol(UEXT_spec,st.polext.wav,(((*(*!dustem_data).uext).wav)(ind_uspec)))
ENDIF

out_st=st

;generating interpolates for Psi_ext
dustem_psi_ext = 0.5*atan(dustem_uext,dustem_qext)/degtorad


out[0] = dustem_qext
out[1] = dustem_uext

;clean pointers
heap_gc

the_end:

RETURN,out

END