PRO dustem_write_fits_table,filename=filename,help=help

;+
; NAME:
;    dustem_write_fits_table

;

; PURPOSE:

;    Write a FITS table with content of current DustEMWrap system variables

;

; CATEGORY:

;    DustEMWrap, Distributed, High-Level, User Convenience

;

; CALLING SEQUENCE:
;    dustem_write_fits_table,file[,/help]

;

; INPUTS:

;    filename   = File name to be written (default='./dustemwrap_results.fits')

;

; OPTIONAL INPUT PARAMETERS:
;    None

;

; OUTPUTS:
;    None

;

; OPTIONAL OUTPUT PARAMETERS:
;    None

;

; ACCEPTED KEY-WORDS:
;    help      = If set, print this help

;

; COMMON BLOCKS:
;    None

;

; SIDE EFFECTS:

;    Output FITS file is written to disk.

;

; RESTRICTIONS:

;    The DustEMWrap IDL code must be installed

;

; PROCEDURE:
;    None

;

; EXAMPLES
;    
; MODIFICATION HISTORY:

;    Written by J.-Ph. Bernard July 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_write_fits_table'
  goto,the_end
ENDIF

used_model=!dustem_model

emission_sed_present=ptr_valid((*!dustem_data).sed)
extinction_sed_present=ptr_valid((*!dustem_data).ext)
;dustem_activate_plugins,p_dim/(*(*!dustem_fit).param_init_values),st=st  
;fact = 1.e4*(*!dustem_HCD)/(4.*!pi)/(3.e8/1.e-6/st.sed.wav)*1.e20/1.e7 ;this is correct despite the way it is presented (1.e4/1e.7*1e.20=1.e17 which is the factor to convert from ergs to Mega Janskys)
;SED_spec = st.sed.em_tot * fact

;===== run dustem to get predicted spectrum and sed

IF emission_sed_present THEN BEGIN
	dustem_predicted_sed=dustem_compute_sed(*(*!dustem_fit).current_param_values,st=dustem_st)
	IF !run_pol THEN BEGIN
	;This is needed to compute Q,U of both SED and spectra
	   dustem_predicted_polsed=dustem_compute_stokes(*(*!dustem_fit).current_param_values, $
	                                                 Q_spec=dustem_predicted_Q_spec,U_spec=dustem_predicted_U_spec,PSI_spec=dustem_predicted_PSI_spec, $
	                                                 dustem_psi_em=dustem_psi_em)
	   dustem_predicted_Qsed=dustem_predicted_polsed[0]
	   dustem_predicted_Used=dustem_predicted_polsed[1]
	ENDIF

	;===== define structures containing results

	one_str_input_SED={FILTER:'',Wavelength:la_undef(4),STOKESI:la_undef(5),STOKESQ:la_undef(5),STOKESU:la_undef(5),varianceII:la_undef(5),varianceQQ:la_undef(5),varianceUU:la_undef(5)}
	one_str_predicted_SED={FILTER:'',Wavelength:la_undef(4),STOKESI:la_undef(5),STOKESQ:la_undef(5),STOKESU:la_undef(5)}

	;one_str_predicted_spectrum_tot={Wavelength:0.,I:0.,Q:0.,U:0.}
	;one_str_predicted_spectrum_grain1={Wavelength:0.,I:0.,Q:0.,U:0.}

	Nsed=n_elements((*(*!dustem_data).sed).filt_names)
	str_input_SED=replicate(one_str_input_SED,Nsed)
	str_input_SED.FILTER=(*(*!dustem_data).sed).filt_names
	str_input_SED.Wavelength=(*(*!dustem_data).sed).wav

	str_input_SED.STOKESI=(*(*!dustem_data).sed).values
	str_input_SED.varianceII=la_power((*(*!dustem_data).sed).sigma,2)   ;This is the variance

	N_predicted_sed=n_elements(dustem_predicted_sed)
	str_predicted_SED=replicate(one_str_predicted_SED,N_predicted_sed)
	;str_predicted_EXT=replicate(one_str_predicted_SED,N_predicted_sed)
	fully_undefined_sed=str_predicted_SED
	str_predicted_SED.FILTER=(*(*!dustem_data).sed).filt_names    ;taken from input SED
	str_predicted_SED.Wavelength=(*(*!dustem_data).sed).wav       ;taken from input SED

	str_predicted_SED.STOKESI=dustem_predicted_sed    

	;stop
	IF !run_pol THEN BEGIN

		qsed=aos2soa(*(*!dustem_data).qsed)
		ind=where(qsed.filt_names NE 'SPECTRUM',count,complement=inds,Ncomplement=counts)
		IF count NE 0 THEN BEGIN
			qsed=qsed[ind]
			FOR i=0L,n_elements(qsed.wav)-1 DO BEGIN
				ind=where(str_input_SED.FILTER EQ qsed[i].filt_names,count)
				IF count NE 0 THEN BEGIN
					str_input_SED[ind[0]].STOKESQ=qsed[i].values
					str_input_SED[ind[0]].varianceQQ=la_power(qsed[i].sigma,2.)
				ENDIF
				str_predicted_SED[ind[0]].STOKESQ=dustem_predicted_Qsed[i]
			ENDFOR
		ENDIF
		qsed=aos2soa(*(*!dustem_data).qsed)
		IF counts NE 0 THEN BEGIN
			qsed=qsed[inds]
			ind2=where(str_predicted_SED.filter EQ 'SPECTRUM',count2)
			str_predicted_SED[ind2].STOKESQ=interpol(qsed.values,qsed.wav,str_predicted_SED[ind2].Wavelength)
			str_predicted_SED[ind2].varianceQQ=interpol(la_power(qsed.sigma,2.),qsed.wav,str_predicted_SED[ind2].Wavelength)
		ENDIF
		used=aos2soa(*(*!dustem_data).used)
		ind=where(used.filt_names NE 'SPECTRUM',count,complement=inds,Ncomplement=counts)
		IF count NE 0 THEN BEGIN
			used=used[ind]
			FOR i=0L,n_elements(used.wav)-1 DO BEGIN
				ind=where(str_input_SED.FILTER EQ used[i].filt_names,count)
				IF count NE 0 THEN BEGIN
					str_input_SED[ind[0]].STOKESU=used[i].values
					str_input_SED[ind[0]].varianceUU=la_power(used[i].sigma,2.)
				ENDIF
				str_predicted_SED[ind[0]].STOKESU=dustem_predicted_Used[i]
			ENDFOR
		ENDIF
		used=aos2soa(*(*!dustem_data).used)
		IF counts NE 0 THEN BEGIN
			used=used[inds]
			ind2=where(str_predicted_SED.filter EQ 'SPECTRUM',count2)
			str_predicted_SED[ind2].STOKESU=interpol(used.values,used.wav,str_predicted_SED[ind2].Wavelength)
			str_predicted_SED[ind2].varianceUU=interpol(la_power(used.sigma,2.),used.wav,str_predicted_SED[ind2].Wavelength)
		ENDIF
        ;stop

		;str_predicted_SED.Q=dustem_predicted_Qsed
		;str_predicted_SED.U=dustem_predicted_Used

		;str_predicted_SED.Q=interpol(dustem_predicted_Qsed,(*(*!dustem_data).qsed).wav,(*(*!dustem_data).sed).wav)
		;str_predicted_SED.U=interpol(dustem_predicted_Used,(*(*!dustem_data).used).wav,(*(*!dustem_data).sed).wav)
		;ENDFOR

	ENDIF ELSE BEGIN

		str_predicted_SED.STOKESQ=fully_undefined_sed.STOKESQ
		str_predicted_SED.STOKESU=fully_undefined_sed.STOKESU

	ENDELSE

ENDIF

;stop

IF extinction_sed_present THEN BEGIN
	;stop
	dustem_predicted_ext=dustem_compute_ext(*(*!dustem_fit).current_param_values,st=dustem_st)
	IF !run_pol THEN BEGIN
	;This is needed to compute Q,U of both SED and spectra
	   dustem_predicted_polext=dustem_compute_stokext((*!dustem_fit).current_param_values,st=dustem_st)

	   dustem_predicted_Qext=dustem_predicted_polext[0]
	   dustem_predicted_Uext=dustem_predicted_polext[1]
	ENDIF

	;===== define structures containing results

	one_str_input_EXT={FILTER:'',Wavelength:la_undef(4),I:la_undef(5),Q:la_undef(5),U:la_undef(5),varianceII:la_undef(5),varianceQQ:la_undef(5),varianceUU:la_undef(5)}
	one_str_predicted_EXT={FILTER:'',Wavelength:la_undef(4),I:la_undef(5),Q:la_undef(5),U:la_undef(5)}

	Next=n_elements((*(*!dustem_data).ext).filt_names)
	str_input_EXT=replicate(one_str_input_EXT,Next)
	str_input_EXT.FILTER=(*(*!dustem_data).ext).filt_names
	str_input_EXT.Wavelength=(*(*!dustem_data).ext).wav
	str_input_EXT.I=(*(*!dustem_data).ext).values

	str_input_EXT.varianceII=la_power((*(*!dustem_data).ext).sigma,2.)

	;N_predicted_ext=n_elements(dustem_predicted_polext[0])
	N_predicted_ext=n_elements(dustem_predicted_ext)
    str_predicted_EXT=replicate(one_str_predicted_EXT,N_predicted_EXT)
    fully_undefined_ext=str_predicted_ext
	IF N_predicted_ext NE Next THEN BEGIN  ;This is for cases when the extinction data to fit did not have the dimension of computed extinction curve
		message,'I have a problem with dimensions ...',/continue
        stop
	ENDIF ELSE BEGIN
		str_predicted_EXT.FILTER=(*(*!dustem_data).ext).filt_names    ;taken from input SED
		str_predicted_EXT.Wavelength=(*(*!dustem_data).ext).wav       ;taken from input SED
		str_predicted_EXT.I=dustem_predicted_ext
	ENDELSE
	;stop

	IF !run_pol THEN BEGIN

		str_predicted_EXT.Q=interpol(dustem_predicted_Qext,(*(*!dustem_data).qext).wav,(*(*!dustem_data).ext).wav)
		str_predicted_EXT.U=interpol(dustem_predicted_Uext,(*(*!dustem_data).uext).wav,(*(*!dustem_data).ext).wav)

	ENDIF ELSE BEGIN
		str_predicted_EXT.Q=fully_undefined_ext.Q
		str_predicted_EXT.U=fully_undefined_ext.U
	ENDELSE
ENDIF

Ngrains=n_tags(dustem_st.sed)-2

;===== Fill in header with parameter values
parameters_desc=*(*!dustem_fit).PARAM_DESCS
parameters_init_values=*(*!dustem_fit).PARAM_INIT_VALUES
best_parameters=*(*!dustem_fit).CURRENT_PARAM_VALUES
best_parameters_uncertainties=*(*!dustem_fit).CURRENT_PARAM_ERRORS
best_fit_chi2=(*!dustem_fit).CHI2
best_fit_rchi2=(*!dustem_fit).RCHI2

parameters_func_values=*(*!dustem_fit).PARAM_FUNC

Nparams=n_elements(parameters_desc)

file='./dustemwrap_tmp.fits'

;==== Write the observed SED in extension 1

unit=1L

;Yes, toto does not exist. This is just to write a dummy input to allow for a general header
mwrfits,toto,file,/create
IF emission_sed_present THEN BEGIN
	;==== add the input emission SED
	mwrfits,str_input_SED,file
	unit_input_sed=unit
	unit=unit+1
	;==== add the predicted emission SED
	mwrfits,str_predicted_SED,file
	unit_predicted_sed=unit
	unit=unit+1
ENDIF ELSE BEGIN
	unit_input_sed=-1
	unit_predicted_sed=-1
ENDELSE
IF extinction_sed_present THEN BEGIN
	;stop
	mwrfits,str_input_EXT,file
	unit_input_ext=unit
	unit=unit+1
	;==== add the predicted emission SED
	mwrfits,str_predicted_EXT,file
	unit_predicted_ext=unit
	unit=unit+1
ENDIF ELSE BEGIN
	unit_input_ext=-1
	unit_predicted_ext=-1
ENDELSE
;==== add the predicted per-grain emission spectrum
mwrfits,dustem_st.sed,file

unit_predicted_spectra=unit
unit=unit+1

;==== add the predicted per-grain extinction spectrum
mwrfits,dustem_st.ext,file

unit_predicted_extinctions=unit

unit=unit+1
IF !run_pol EQ 1 THEN BEGIN
	mwrfits,dustem_st.polsed,file
	unit_predicted_spectra_pol=unit
	unit=unit+1
	mwrfits,dustem_st.polext,file
	unit_predicted_extinctions_pol=unit
	unit=unit+1
ENDIF ELSE BEGIN
	unit_predicted_spectra_pol=-1
	unit_predicted_extinctions_pol=-1
ENDELSE

extension_numbers=[unit_input_sed,unit_predicted_sed, $
				   unit_input_ext,unit_predicted_ext, $
				   unit_predicted_spectra,unit_predicted_extinctions, $
				   unit_predicted_spectra_pol,unit_predicted_extinctions_pol]
extensions_strs=['INPUT_EMISSION_SED','DUSTEM_PREDICTED_SED', $
				 'INPUT_EXTINCTION_SED','DUSTEM_PREDICTED_EXTINCTION_SED', $
				 'DUSTEM_PREDICTED_EMISSION_SPECTRA','DUSTEM_PREDICTED_EXTINCTION_SPECTRA', $
				 'DUSTEM_PREDICTED_EMISSION_SPECTRA_POL','DUSTEM_PREDICTED_EXTINCTION_SPECTRA_POL']

ind=where(extension_numbers NE -1,count)
extension_numbers=extension_numbers[ind]
extensions_strs=extensions_strs[ind]
order=sort(extension_numbers)
extension_numbers=extension_numbers[order]
extensions_strs=extensions_strs[order]
Nextensions=n_elements(extension_numbers)

;===== read back fits file to get proper extension headers

file='./dustemwrap_tmp.fits'

toto=mrdfits(file,0,hdr)      ;this would be to get the main header

IF unit_input_sed NE -1 THEN sst_input_sed=mrdfits(file,unit_input_sed,header_input_sed)
IF unit_predicted_sed NE -1 THEN sst_predicted_SED=mrdfits(file,unit_predicted_sed,header_predicted_SED)
IF unit_input_ext NE -1 THEN sst_input_ext=mrdfits(file,unit_input_ext,header_input_ext)
IF unit_predicted_ext NE -1 THEN sst_predicted_ext=mrdfits(file,unit_predicted_ext,header_predicted_ext)

dustem_st.sed=mrdfits(file,unit_predicted_spectra,header_predicted_spectra)
dustem_st.ext=mrdfits(file,unit_predicted_extinctions,header_predicted_extinctions)
IF !run_pol EQ 1 THEN BEGIN
	dustem_st.polsed=mrdfits(file,unit_predicted_spectra_pol,header_predicted_spectra)
	dustem_st.polext=mrdfits(file,unit_predicted_extinctions_pol,header_predicted_extinctions)
ENDIF
;===== write content of extensions in main header
FOR i=0L,Nextensions-1 DO BEGIN
	sxaddpar,hdr,'EXT'+strtrim(i+1,2),extensions_strs[i],'fits file extension'
ENDFOR

;====== write dustem wrap parameter best fit values
sxaddpar,hdr,'COMMENT','======= Dustemwrap dust model used ======',after='COMMENT'
sxaddpar,hdr,'MODEL',used_model,'Dust model used'
sxaddpar,hdr,'WRAP_V',!dustem_version.version,'Dustwrap version used'
sxaddpar,hdr,'COMMENT','===================================================',after='MODEL'
sxaddpar,hdr,'CHI2',best_fit_chi2,'Dustemwrap best fit chi2 [-]'
sxaddpar,hdr,'RCHI2',best_fit_rchi2,'Dustemwrap best fit reduced chi2 [-]'
sxaddpar,hdr,'NGRAINS',Ngrains,'Number of grain species'

;====== write dustem wrap parameter names

sxaddpar,hdr,'COMMENT','======= Dustemwrap parameter names ======',after='RCHI2'
sxaddpar,hdr,'NPARAMS',Nparams,' Number of DustemWrap free parameters'

FOR i=0L,Nparams-1 DO BEGIN

	sxaddpar,hdr,'PARN'+strtrim(i+1,2),parameters_desc[i],' DustemWrap parameter name'

ENDFOR

sxaddpar,hdr,'COMMENT','===================================================',after='PARN'+strtrim(i,2)
sxaddpar,hdr,'COMMENT','======= Dustemwrap dust model used in polarisation ? ======',after='COMMENT'
sxaddpar,hdr,'POL',!run_pol,'1 if pol was used, 0 otherwise'
sxaddpar,hdr,'COMMENT','===================================================',after='POL'

;====== write dustem wrap parameter best fit values

sxaddpar,hdr,'COMMENT','======= Dustemwrap parameter best fit values ======',after='COMMENT'

FOR i=0L,Nparams-1 DO BEGIN

	sxaddpar,hdr,'PARV'+strtrim(i+1,2),best_parameters[i],'Param. '+parameters_desc[i]

ENDFOR

sxaddpar,hdr,'COMMENT','===================================================',after='PARV'+strtrim(i,2)

;====== write dustem wrap parameter best fit values uncertainties

sxaddpar,hdr,'COMMENT','======= Dustemwrap best fit parameter uncertainties ======',after='COMMENT'

FOR i=0L,Nparams-1 DO BEGIN

	sxaddpar,hdr,'PARU'+strtrim(i+1,2),best_parameters_uncertainties[i],'Param. '+parameters_desc[i]

ENDFOR

sxaddpar,hdr,'COMMENT','===================================================',after='PARU'+strtrim(i,2)

;====== write dustem wrap parameter initial fit values

sxaddpar,hdr,'COMMENT','======= Dustemwrap parameter initial fit values ======',after='COMMENT'

FOR i=0L,Nparams-1 DO BEGIN

	sxaddpar,hdr,'PARI'+strtrim(i+1,2),parameters_init_values[i],'Param. '+parameters_desc[i]

ENDFOR

sxaddpar,hdr,'COMMENT','===================================================',after='PARI'+strtrim(i,2)

;====== write dustem wrap parameter func values (not sure exactly what this is)

sxaddpar,hdr,'COMMENT','======= Dustemwrap parameter func values ======',after='COMMENT'

FOR i=0L,Nparams-1 DO BEGIN

	sxaddpar,hdr,'PARF'+strtrim(i+1,2),parameters_func_values[i],'Param. '+parameters_desc[i]

ENDFOR

sxaddpar,hdr,'COMMENT','===================================================',after='PARF'+strtrim(i,2)

;===== complement extension header for input SED
sxaddpar,header_input_sed,'TITLE','OBSERVED INPUT SED TO DUSTEMWRAP',before='COMMENT'
sxaddpar,header_input_sed,'TTYPE1','FILTER','Dustemwrap Filter name'
sxaddpar,header_input_sed,'TTYPE2','WAVELENGTH','Dustemwrap Filter reference wavelength [microns]'
sxaddpar,header_input_sed,'TTYPE3','I','Observed Total Stokes I Intensity [??]'
sxaddpar,header_input_sed,'TTYPE4','Q','Observed Stokes Q Intensity [??]'
sxaddpar,header_input_sed,'TTYPE5','U','Observed Stokes U Intensity [??]'
sxaddpar,header_input_sed,'TTYPE6','VARIANCEII','Observed Total Stokes I Variance [??]'
sxaddpar,header_input_sed,'TTYPE7','VARIANCEQQ','Observed Stokes Q Variance [??]'
sxaddpar,header_input_sed,'TTYPE8','VARIANCEUU','Observed Stokes U Variance [??]'

;===== complement extension header for predicted SED
sxaddpar,header_predicted_SED,'TITLE','OUTPUT BEST FIT SED BY DUSTEMWRAP'
sxaddpar,header_predicted_SED,'TTYPE1','FILTER','Dustemwrap Filter name'
sxaddpar,header_predicted_SED,'TTYPE2','WAVELENGTH','Dustemwrap Filter reference wavelength [microns]'
sxaddpar,header_predicted_SED,'TTYPE3','I','Observed Total Stokes I Intensity [??]'
sxaddpar,header_predicted_SED,'TTYPE4','Q','Observed Stokes Q Intensity [??]'
sxaddpar,header_predicted_SED,'TTYPE5','U','Observed Stokes U Intensity [??]'

;===== complement extension header for predicted spectrum total

sxaddpar,header_predicted_spectra,'TITLE','OUTPUT BEST FIT PER-GRAIN AND TOTAL EMISSION SPECTRA BY DUSTEMWRAP'
sxaddpar,header_predicted_extinctions,'TITLE','OUTPUT BEST FIT PER-GRAIN AND TOTAL EXTINCTION BY DUSTEMWRAP'

;============== write final fits file

IF keyword_set(filename) THEN BEGIN
	file=filename
ENDIF ELSE BEGIN

	file='./dustemwrap_results.fits'

ENDELSE

;==== Write the observed SED (if any)
mwrfits,0,file,hdr,create=1
IF unit_input_sed NE -1 THEN BEGIN
	mwrfits,str_input_SED,file,header_input_sed
ENDIF
;==== add the predicted SED (if any)
IF unit_input_sed NE -1 THEN BEGIN
	mwrfits,str_predicted_SED,file,header_predicted_SED
ENDIF
IF unit_input_ext NE -1 THEN BEGIN
	mwrfits,str_input_EXT,file,header_input_sed
ENDIF
;==== add the predicted SED (if any)
IF unit_predicted_ext NE -1 THEN BEGIN
	mwrfits,str_predicted_EXT,file,header_predicted_SED
ENDIF
;==== add the predicted per-grain emission spectra
mwrfits,dustem_st.sed,file,header_predicted_spectra
;==== add the predicted per-grain extinction
mwrfits,dustem_st.ext,file,header_predicted_extinctions
IF !run_pol EQ 1 THEN BEGIN
	mwrfits,dustem_st.polsed,file
	mwrfits,dustem_st.polext,file
ENDIF

message,'================================================',/info

message,'Wrote '+file,/info

message,'File extenssions are: ',/info
FOR i=0L,Nextensions-1 DO BEGIN
	message,'extenssion '+strtrim(extension_numbers[i],2)+' : '+strtrim(extensions_strs[i],2),/info
ENDFOR
message,'================================================',/info

;stop

the_end:

END