Blame view

src/idl/dustem_write_sed_grid.pro 11 KB
ffb6e66e   Jean-Philippe Bernard   First commit
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
PRO dustem_write_sed_grid,model $
						 						 ,parameters_description $
						 						 ,iv_min $
						 						 ,iv_max $
						 						 ,iv_Nvalues $
						 						 ,plog $
						 						 ,parameter_values $
												 ,seds $
												 ,em_spectra=em_spectra $
												 ,ext_spectra=ext_spectra $
						 						 ,fpd=fpd $
						 						 ,fiv=fiv $
						 						 ,filename=filename $
						 						 ,use_polarisation=use_polarisation $
						 						 ,double=double $
907a3ade   Jean-Philippe Bernard   improved
16
						 						 ,grain_keywords=grain_keywords $
ffb6e66e   Jean-Philippe Bernard   First commit
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
						 						 ,help=help

;+
; NAME:
;    dustem_write_sed_grid
; PURPOSE:
;    Writes a model GRID fits file
; CATEGORY:
;    Dustem
; CALLING SEQUENCE:
;    dustem_write_sed_grid,model,parameters_description,iv_min,iv_max,iv_Nvalues,plog $
;						 										,parameter_values,seds,em_spectra=em_spectra,ext_spectra=ext_spectra $
;																,fpd=fpd,fiv=fiv,filename=filename,use_polarisation=use_polarisation
; INPUTS:
;    model                  : dustemwrap model name to be used
;    parameters_description : dustemwrap parameter description array
;    iv_min                 : minimum values for each parameter
;    iv_max                 : maximum values for each parameter
;    iv_Nvalues             : number of parameter values for each parameter
;    plog                   : array indicating if a given parameter is to be sampled in linear (0) or log scale (1)
feb46599   Jean-Philippe Bernard   improved
37
;    parameter_values       : array of parameter values as computed with dustem_param_range2param_values.pro
ffb6e66e   Jean-Philippe Bernard   First commit
38
39
40
41
42
43
44
45
46
;    seds                   : array of seds
; OPTIONAL INPUT PARAMETERS:
;    em_spectra             : Emission spectra
;    ext_spectra            : Extinction spectra
;    fpd                    : Fixed parameter descritions
;    fiv                    : fixed parameter values
;    filename               : output fits file name for the table (default ='/tmp/dustem_seds.fits')
;    use_polarisation       : flag indicating if the model has polarisation predictions.
;    double                 : if set, writes the table in double accuracy
907a3ade   Jean-Philippe Bernard   improved
47
;    grain_keywords         : if set, these are added to the grid header for each grain type
ffb6e66e   Jean-Philippe Bernard   First commit
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
; OUTPUTS:
;    None
; OPTIONAL OUTPUT PARAMETERS:
;    None
; ACCEPTED KEY-WORDS:
;    help      = If set, print this help
; COMMON BLOCKS:
;    None
; SIDE EFFECTS:
;    A file is written
; RESTRICTIONS:
;    The DustEM fortran code must be installed
;    The DustEMWrap IDL code must be installed
; PROCEDURE:
;    Filters in the table are ordered by increasing wavelength
; EXAMPLES
;    
; MODIFICATION HISTORY:
;    Written by J.-Ph. Bernard (2023)
;    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_sed_grid'
  goto,the_end
ENDIF

polar=0
IF keyword_set(use_polarisation) THEN polar=1

IF keyword_set(em_spectra) AND keyword_set(ext_spectra) THEN BEGIN
  	include_spectra=1
ENDIF ELSE BEGIN
	include_spectra=0
	message,'either em_spectra or ext_spectra is unset',/continue
	message,'Spectra will not be saved in the Grid',/continue
	;stop
ENDELSE

;stop

Nc=n_elements(parameter_values)
Nparams=n_elements(*parameter_values[0])
use_filters=(*seds[0]).filter
Nfilters=n_elements(use_filters)

wavs=dustem_get_wavelengths()
Nwavs=n_elements(wavs)

format_template='0.E0'
feb46599   Jean-Philippe Bernard   improved
99
100
101
102
103
double4header=0
IF keyword_set(double) THEN BEGIN
	format_template='0.D0'
	double4header=1
ENDIF
ffb6e66e   Jean-Philippe Bernard   First commit
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122

;=== do the parameter value structure
str='one_param_st={'
FOR i=0L,Nparams-1 DO BEGIN
  str=str+'P'+strtrim(i+1,2)+':'+format_template
  IF i NE Nparams-1 THEN str=str+','
ENDFOR
str=str+'}'

toto=execute(str)

;=== do the SED value structure
str='one_Iemsed_st={'
FOR i=0L,Nfilters-1 DO BEGIN
	istr=strtrim(use_filters[i],2)
	str=str+'I'+istr+':'+format_template
	str=str+','
ENDFOR
str=str+'total:0.d0}'
e983bf0b   Jean-Philippe Bernard   tried to optimize...
123
str1=str
ffb6e66e   Jean-Philippe Bernard   First commit
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
toto=execute(str)

;=== do the IR wavelengths structure
one_wave_st={wav:0.D0}

;=== do the Emission total spectrum structure
str='one_Iemspec_st={'
FOR i=0L,Nwavs-1 DO BEGIN
	istr=strtrim(i+1,2)
	str=str+'W'+istr+':'+format_template
	IF i NE Nwavs-1 THEN str=str+','
ENDFOR
str=str+'}'
toto=execute(str)

params_array=replicate(one_param_st,Nc)
Iem_seds_array=replicate(one_Iemsed_st,Nc)
wav_array=replicate(one_wave_st,Nwavs)
IF include_spectra THEN BEGIN
	;=== get the number of grains
	;Ngrain=n_tags(st.sed)-2
	Ngrains=(*!dustem_params).Ngrains
	Iem_spec_array=replicate(one_Iemspec_st,Nc)
	Iext_spec_array=replicate(one_Iemspec_st,Nc)
	Iem_spec_array_per_grain=replicate(one_Iemspec_st,[Nc,Ngrains])
	Iext_spec_array_per_grain=replicate(one_Iemspec_st,[Nc,Ngrains])
ENDIF

;=== Fill up parameters array
FOR i=0L,Nc-1 DO BEGIN
	FOR j=0L,Nparams-1 DO BEGIN
		params_array[i].(j)=(*parameter_values[i])[j]
	ENDFOR
ENDFOR

;=== Fill up Iem SED array
FOR i=0L,Nc-1 DO BEGIN
	FOR j=0L,Nfilters-1 DO BEGIN
		Iem_seds_array[i].(j)=((*seds[i]).stokesI)[j]
	ENDFOR
ENDFOR
;=== compute the sum of the Iem SED array
FOR i=0L,Nc-1 DO BEGIN
	 Iem_seds_array[i].total=total((*seds[i]).stokesI)
ENDFOR

;=== fill up the wavelengths array
;wav_array=wavs
;FOR j=0L,Nwavs-1 DO BEGIN
;		wav_array.wav=wavs[j]
;ENDFOR
wav_array.wav=wavs
fact_em=dustem_get_emission_conversion_factor()

;=== Fill up Iem spec array
3933a191   Jean-Philippe Bernard   improved
179
;stop
ffb6e66e   Jean-Philippe Bernard   First commit
180
181
182
IF include_spectra THEN BEGIN
	FOR i=0L,Nc-1 DO BEGIN
		FOR j=0L,Nwavs-1 DO BEGIN
e9f3d40d   Jean-Philippe Bernard   fixed a bug
183
			Iem_spec_array[i].(j)=((*em_spectra[i]).em_tot)[j]*fact_em[j]
ffb6e66e   Jean-Philippe Bernard   First commit
184
185
186
187
188
189
190
191
192
193
194
195
		ENDFOR
	ENDFOR
	;=== Fill up Iext spec array
	FOR i=0L,Nc-1 DO BEGIN
		FOR j=0L,Nwavs-1 DO BEGIN
			Iext_spec_array[i].(j)=((*ext_spectra[i]).ext_tot)[j]
		ENDFOR
	ENDFOR
	;=== Fill up Iem spec array per grain size
	FOR k=0L,Ngrains-1 DO BEGIN
		FOR i=0L,Nc-1 DO BEGIN
			FOR j=0L,Nwavs-1 DO BEGIN
e9f3d40d   Jean-Philippe Bernard   fixed a bug
196
				Iem_spec_array_per_grain[i,k].(j)=((*em_spectra[i]).(k+1))[j]*fact_em[j]
ffb6e66e   Jean-Philippe Bernard   First commit
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
			ENDFOR
		ENDFOR
	ENDFOR
	;stop
	;=== Fill up Iext spec array per grain size
	FOR k=0L,Ngrains-1 DO BEGIN
		FOR i=0L,Nc-1 DO BEGIN
			FOR j=0L,Nwavs-1 DO BEGIN
				Iext_spec_array_per_grain[i,k].(j)=((*ext_spectra[i]).abs_grain)[k]+((*ext_spectra[i]).sca_grain)[k]
			ENDFOR
		ENDFOR
	ENDFOR
ENDIF
;stop

;======== save SED tables

fits_file='/tmp/dustem_seds.fits'
IF keyword_set(filename) THEN fits_file=filename
bits=str_sep(fits_file,'/')
filename_only=bits(n_elements(bits)-1)

unit_content=['Nothing']
mwrfits,params_array,fits_file,h,/create ;ext1
unit_content=[unit_content,'Model parameter values']
unit_count=1L
mwrfits,Iem_seds_array,fits_file
unit_content=[unit_content,'Emission SED values [MJy/sr for NH=1e20 H/cm2]']
unit_count=unit_count+1    				;ext1
IF include_spectra THEN BEGIN
	mwrfits,wav_array,fits_file
	unit_count=unit_count+1            				;ext2
	unit_content=[unit_content,'Spectra Wavelengths [mic]']
	mwrfits,Iem_spec_array,fits_file
	unit_count=unit_count+1       				;ext3
	unit_content=[unit_content,'Total Emission Spectrum [MJy/sr for NH=1e20 H/cm2]']
	mwrfits,Iext_spec_array,fits_file
	unit_count=unit_count+1      				;ext4
	unit_content=[unit_content,'Total Extinction Spectrum [opt depth for NH=1e20 H/cm2]']
	FOR k=0L,Ngrains-1 DO BEGIN
		mwrfits,Iem_spec_array_per_grain[*,k],fits_file
		unit_count=unit_count+1
		unit_content=[unit_content,'Grain'+strtrim(k+1,2)+' Emission Spectrum [MJy/sr for NH=1e20 H/cm2]']
	ENDFOR
	FOR k=0L,Ngrains-1 DO BEGIN
		mwrfits,Iext_spec_array_per_grain[*,k],fits_file
		unit_count=unit_count+1
		unit_content=[unit_content,'Grain'+strtrim(k+1,2)+' Extinction Spectrum [opt depth for NH=1e20 H/cm2]']
	ENDFOR
ENDIF

;==== read back the file to get main header and various extensions
all_sts=ptrarr(unit_count)
all_headers=ptrarr(unit_count)

st0=mrdfits(fits_file,0,h0)
FOR i=0L,unit_count-1 DO BEGIN
	st=mrdfits(fits_file,i+1,h)
	all_sts[i]=ptr_new(st)
	all_headers[i]=ptr_new(h)
ENDFOR

;stop
feb46599   Jean-Philippe Bernard   improved
260
NFparams=n_elements(fpd)
ffb6e66e   Jean-Philippe Bernard   First commit
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277

;=== Modify the main header
sxaddpar,h0,'COMMENT','***** This file is a DustemWrap Grid table ****',after='EXTEND'
sxaddpar,h0,'FILE',filename_only,'Original File Name',before='END'
sxaddpar,h0,'DATE',systime(0),'Creation Date',before='END'
sxaddpar,h0,'AUTHOR',strtrim(getenv('USER'),2),'Who made that file',before='END'
sxaddpar,h0,'SOFT',!dustem_version.version,'Dustem Sofware Version',before='END'
sxaddpar,h0,'INCSP',include_spectra,'Does the grid include Emission/Extinction spectra',before='END'
sxaddpar,h0,'COMMENT','***** File unit description ****',after='SOFT'
;stop
FOR k=1L,unit_count DO BEGIN
	tag='Unit'+strtrim(k,2)
	sxaddpar,h0,tag,unit_content[k],before='END'
	last_tag=tag
ENDFOR
sxaddpar,h0,'COMMENT','***** Model description ****',after=last_tag
sxaddpar,h0,'MODEL',model,'dustemwrap model used',before='END'
feb46599   Jean-Philippe Bernard   improved
278
sxaddpar,h0,'NGRAIN',Ngrains,'Number of grain types',before='END'
907a3ade   Jean-Philippe Bernard   improved
279
280
281
282
IF keyword_set(grain_keywords) THEN BEGIN
	FOR i=0L,Ngrains-1 DO BEGIN
		sxaddpar,h0,'KEYWG'+strtrim(i+1,2),grain_keywords[i],'dustemwrap grain keywords for grain '+strtrim(i+1,2),before='END'
	ENDFOR
cd2aaf3e   Jean-Philippe Bernard   improved
283
284
285
286
287
ENDIF ELSE BEGIN
	FOR i=0L,Ngrains-1 DO BEGIN
		sxaddpar,h0,'KEYWG'+strtrim(k+1,2),((*!dustem_params).grains.TYPE_KEYWORDS)[k],'Grain DustemWrap keywords Used',before='END'
	ENDFOR
ENDELSE
ffb6e66e   Jean-Philippe Bernard   First commit
288
289
sxaddpar,h0,'NHREF',*!dustem_HCD,'dustemwrap reference NH [H/cm2]',after='MODEL'
sxaddpar,h0,'POLAR',polar,'dustemwrap polarization ?',after='NHREF'
feb46599   Jean-Philippe Bernard   improved
290
sxaddpar,h0,'DOUBLE',double4header,'double accuracy ?',after='POLAR'
ffb6e66e   Jean-Philippe Bernard   First commit
291
sxaddpar,h0,'COMMENT','**** Variable Dustemwrap PARAMETERS Used in the Grid ***',after='POLAR'
feb46599   Jean-Philippe Bernard   improved
292
sxaddpar,h0,'NPARAM',Nparams,'Number of free parameters',before='END'
ffb6e66e   Jean-Philippe Bernard   First commit
293
sxaddpar,h0,'NCOMB',Nc,'Number of parameter values combinations',before='END'
4ddd208e   Jean-Philippe Bernard   chnaged to store ...
294
sxaddpar,h0,'KEY',(*!dustem_params).keywords,'Global DustemWrap keywords Used',before='END'
ffb6e66e   Jean-Philippe Bernard   First commit
295
296
297
298
299
300
301
302
303
304
305
306
307
308
;stop
FOR j=0L,Nparams-1 DO BEGIN
	;value=sxpar(*all_headers[0],'TTYPE'+strtrim(j+1,2))
	;sxaddpar,h0,'TTYPE'+strtrim(j+1,2),value,'dustemwrap '+parameters_description[j],before='END'
	sxaddpar,h0,'PNAME'+strtrim(j+1,2),parameters_description[j],'dustemwrap param name',before='END'
	sxaddpar,h0,'PMIN'+strtrim(j+1,2),iv_min[j],'minimum param value',before='END'
	sxaddpar,h0,'PMAX'+strtrim(j+1,2),iv_max[j],'maximum param value',before='END'
	sxaddpar,h0,'PNVAL'+strtrim(j+1,2),iv_Nvalues[j],'Number of param values',before='END'
	sxaddpar,h0,'PLOG'+strtrim(j+1,2),plog[j],'1 if log scale sampling',before='END'
	last_tag='PLOG'+strtrim(j+1,2)
ENDFOR
;stop
IF keyword_set(fpd) THEN BEGIN
	sxaddpar,h0,'COMMENT','**** Fixed Dustemwrap PARAMETERS Used in the Grid ***',after='last_tag'
feb46599   Jean-Philippe Bernard   improved
309
310
	sxaddpar,h0,'NFPARAM',NFparams,'Number of fixed parameters',before='END'
	FOR j=0L,NFparams-1 DO BEGIN
ffb6e66e   Jean-Philippe Bernard   First commit
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
		sxaddpar,h0,'FPNAME'+strtrim(j+1,2),fpd[j],'fixed dustemwrap param name',before='END'
		sxaddpar,h0,'FPVALUE'+strtrim(j+1,2),fiv[j],'fixed dustemwrap param value',before='END'
		last_tag='FPVALUE'+strtrim(j+1,2)
	ENDFOR
ENDIF
sxaddpar,h0,'COMMENT','**** Dustemwrap FILTERS ***',after=last_tag
FOR j=0L,Nfilters-1 DO BEGIN
	;value=sxpar(*all_headers[2],'TTYPE'+strtrim(j+1,2))
	;sxaddpar,h0,'TTYPE'+strtrim(j+1,2),value,'Intensity in '+use_filters[j]
	sxaddpar,h0,'FNAME'+strtrim(j+1,2),use_filters[j],'dustemwrap filter name',before='END'
ENDFOR

;stop
mwrfits,bidon,fits_file,h0,/create
;FOR i=1L,unit_count-1 DO BEGIN
FOR i=0L,unit_count-1 DO BEGIN
	mwrfits,*all_sts[i],fits_file,*all_headers[i]
ENDFOR

message,'Wrote '+fits_file,/continue
;stop
;hprint,h0

the_end:

END