IIINSTRUMENT Pipeline Reference Manual 4.4.3
visir_spectro.c
1/* $Id: visir_spectro.c,v 1.254 2013-09-24 10:46:00 jtaylor Exp $
2 *
3 * This file is part of the VISIR Pipeline
4 * Copyright (C) 2002,2003 European Southern Observatory
5 *
6 * This program is free software; you can redistribute it and/or modify
7 * it under the terms of the GNU General Public License as published by
8 * the Free Software Foundation; either version 2 of the License, or
9 * (at your option) any later version.
10 *
11 * This program is distributed in the hope that it will be useful,
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 * GNU General Public License for more details.
15 *
16 * You should have received a copy of the GNU General Public License
17 * along with this program; if not, write to the Free Software
18 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
19 */
20
21/*
22 * $Author: jtaylor $
23 * $Date: 2013-09-24 10:46:00 $
24 * $Revision: 1.254 $
25 * $Name: not supported by cvs2svn $
26 */
27
28#ifdef HAVE_CONFIG_H
29#include <config.h>
30#endif
31
32/*-----------------------------------------------------------------------------
33 Includes
34 -----------------------------------------------------------------------------*/
35
36#include "hdrl_spectrum_resample.h"
37#include "irplib_wavecal.h"
38#include "irplib_framelist.h"
39
40#define SBRM_UNDERSCORE_MACRO // enable the _() macro
41#include "sbrm.h"
42
43#include "visir_spectro.h"
44#include "visir_utils.h"
45#include "visir_pfits.h"
46#include "visir_inputs.h"
47#include "visir_parameter.h"
48#include "visir_spc_distortion.h"
49
50#include <cpl.h>
51
52#include <string.h>
53#include <math.h>
54#include <float.h>
55#include <assert.h>
56#include <stdbool.h>
57
58#include <gsl/gsl_fit.h>
59
60/*-----------------------------------------------------------------------------
61 Defines
62 -----------------------------------------------------------------------------*/
63
64// aliases for SBRM features
65#define INIT SBRM_INIT
66#define SET SBRM_SET
67#define CSET SBRM_CSET
68#define RESET SBRM_RESET
69#define FREE SBRM_FREE
70#define ABORT SBRM_ABORT
71#define CLEANUP SBRM_CLEANUP
72#define YANK SBRM_YANK
73#define WARN SBRM_WARN
74//#define _ // uncomment to disable in-line error checking via the _() macro
75
76// drop (discard) extraneous values down a hole (for use when NULL won't work)
77#define HOLE(type) &(type){0}
78
79#define skip_if_error_present() skip_if(0)
80
81#define MSG_WARN(...) cpl_msg_warning(cpl_func, __VA_ARGS__)
82#define MSG_INFO(...) cpl_msg_info(cpl_func, __VA_ARGS__)
83#define MSG_ERR(...) cpl_msg_error(cpl_func, __VA_ARGS__)
84#define MSG_DBG(...) cpl_msg_debug(cpl_func, __VA_ARGS__)
85
86/*----------------------------------------------------------------------------*/
92/*----------------------------------------------------------------------------*/
93
94/*-----------------------------------------------------------------------------
95 Private structs
96 -----------------------------------------------------------------------------*/
97
98typedef struct {
99 cpl_size cost; /* May be incremented for cost counting */
100 cpl_size xcost; /* Ditto (can exclude failed fills) */
101 cpl_size ulines; /* May be set to number of lines used */
102
103 double temp; /* Temperature of dominant black-body (M1) */
104 const cpl_vector * vsymm; /* Symmetric convolution vector from slit
105 width, FWHM of transfer function and
106 truncation width */
107
108 const cpl_bivector * lines; /* Sky spectrum, with
109 increasing X-vector elements */
110 const cpl_bivector * tqeff; /* Spectrum of detector quantum efficiency with
111 increasing X-vector elements */
112} visir_spectrum_model;
113
114typedef cpl_bivector * (extract_func)(cpl_image *, int, int, cpl_propertylist *,
115 cpl_image **, const visir_spc_config *,
116 const visir_apdefs *, const bool,
117 const cpl_size);
118/*-----------------------------------------------------------------------------
119 Private Function Prototypes
120 -----------------------------------------------------------------------------*/
121
122
123static cpl_error_code
124visir_polynomial_shift_1d_from_correlation(cpl_polynomial *,
125 const cpl_vector *,
126 irplib_base_spectrum_model *,
127 cpl_error_code (*)
128 (cpl_vector *,
129 const cpl_polynomial *,
130 irplib_base_spectrum_model *),
131 int, int, cpl_boolean,
132 double *, double *);
133
134static cpl_error_code visir_spectro_refine(cpl_polynomial *,
135 const cpl_vector *,
136 visir_spectrum_model *,
137 const cpl_polynomial *,
138 int, cpl_boolean, visir_spc_resol,
139 double *, cpl_boolean *, double *);
140
141static cpl_error_code visir_spectro_fill(cpl_vector *, const cpl_polynomial *,
142 irplib_base_spectrum_model *);
143
144static extract_func visir_spc_oldex;
145static extract_func visir_spc_newex;
146static extract_func visir_spc_extract;
147
148static cpl_error_code visir_spc_emission(cpl_bivector *, const cpl_vector *,
149 const cpl_bivector *,
150 const cpl_bivector *,
151 const cpl_vector *, double);
152
153static cpl_polynomial * visir_spc_phys_disp(int, double, visir_spc_resol, int,
154 int);
155static cpl_polynomial * visir_spc_phys_lrp(void);
156static double visir_spc_get_dispersion(const cpl_polynomial *, double);
157static cpl_error_code visir_vector_convolve_symm(cpl_vector *,
158 const cpl_vector *);
159static cpl_vector * cpl_spc_convolve_init(int, double, double, int);
160
161static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist *,
162 int, double,
163 cpl_boolean, double,
164 const cpl_polynomial *,
165 const cpl_polynomial *);
166
167static void * visir_spectro_qclist_obs(cpl_propertylist *, double, double);
168
169static const double N_upper = 13.4e-6; /* Upper limit of N-band */
170static const double whechelle = 35.8/2; /* Half the echelle width */
171
172#ifndef VISIR_XC_LEN
173#define VISIR_XC_LEN 50
174#endif
175#ifndef VISIR_XC_SUBSEARCH
176#define VISIR_XC_SUBSEARCH 100
177#endif
178
179#ifndef VISIR_SPECTRO_SIGMA
180#define VISIR_SPECTRO_SIGMA 3.0
181#endif
182
185/*-----------------------------------------------------------------------------
186 Function code
187 -----------------------------------------------------------------------------*/
188
189/*----------------------------------------------------------------------------*/
196/*----------------------------------------------------------------------------*/
197static const char * pn(const int oo)
198{
199 static char buf[80]; // FIXME: don't use static vars
200 const char * sign = oo ? (oo > 0 ? "+" : "-") : "";
201 snprintf(buf, sizeof(buf), "%s%d", sign, abs(oo));
202 return buf;
203}
204
205cpl_error_code visir_spc_extract_order(cpl_image ** order,
206 cpl_image ** comorder,
207 int * lcol, int * rcol,
208 const cpl_image * combined,
209 const cpl_image * imhcycle,
210 const double wlen,
211 const visir_spc_config * cfg,
212 const cpl_boolean do_ech,
213 const int is_aqu)
214{
215 int icol1, icol2;
216 int jcol1, jcol2;
217
218 jcol1 = visir_parameterlist_get_int(cfg->parlist, cfg->recipename,
219 VISIR_PARAM_REJLEFT);
220 jcol2 = visir_parameterlist_get_int(cfg->parlist, cfg->recipename,
221 VISIR_PARAM_REJRIGHT);
222
223
224 cpl_msg_debug(cpl_func, "extracting order, wlen=%f, do_ech=%d, jcol1=%d, "
225 "jcol2=%d", wlen, do_ech, jcol1, jcol2);
226
227 if (do_ech) {
228 skip_if (visir_spc_echelle_limit(&icol1, &icol2, wlen, cfg, 1,
229 cpl_image_get_size_y(combined),
230 is_aqu));
231 } else {
232 icol1 = 1;
233 icol2 = cpl_image_get_size_x(imhcycle);
234 }
235
236 if (do_ech) {
237 if (jcol1 != 0) {
238 cpl_msg_info(cpl_func, "Ignoring %d leftmost columns from %d to %d",
239 jcol1, icol1, icol1 + jcol1);
240 icol1 += jcol1;
241 }
242 if (jcol2 != 0) {
243 cpl_msg_info(cpl_func, "Ignoring %d rightmost columns from %d to %d",
244 jcol2, icol2 - jcol2, icol2);
245 icol2 -= jcol2;
246 }
247 } else {
248 if (jcol1 != 0) {
249 cpl_msg_info(cpl_func, "Ignoring %d leftmost columns", jcol1);
250 icol1 += jcol1;
251 }
252 if (jcol2 != 0) {
253 cpl_msg_info(cpl_func, "Ignoring %d rightmost columns", jcol2);
254 icol2 -= jcol2;
255 }
256 }
257
258 if (icol1 != 1 || icol2 != cpl_image_get_size_x(imhcycle)) {
259 *order = visir_spc_column_extract(imhcycle, icol1, icol2, cfg->plot);
260 skip_if_error_present();
261
262 *comorder = visir_spc_column_extract(combined, icol1, icol2, cfg->plot);
263 skip_if_error_present();
264
265 } else {
266 *order = cpl_image_duplicate(imhcycle);
267 *comorder = cpl_image_duplicate(combined);
268 }
269
270 *lcol = icol1;
271 *rcol = icol2;
272
273 end_skip;
274
275 return cpl_error_get_code();
276}
277
278/*----------------------------------------------------------------------------*/
294/*----------------------------------------------------------------------------*/
295visir_spc_resol visir_spc_get_res_wl(const irplib_framelist * rawframes,
296 double * pwlen, double * pslitw,
297 double * ptemp, double * pfwhm,
298 int is_aqu)
299{
300 cpl_errorstate cleanstate = cpl_errorstate_get();
301 /* Avoid (false) uninit warning */
302 visir_spc_resol resol = VISIR_SPC_R_ERR;
303 char ptmp[IRPLIB_FITS_STRLEN+1];
304 double wl, spx, pfov = 0.127; /* Avoid (false) uninit warning */
305 double sl = 0.0; /* Avoid (false) uninit warning */
306 cpl_boolean need_temp = ptemp != NULL;
307 int n;
308
309 /* Check entries */
310 cpl_ensure(rawframes != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
311 cpl_ensure(pwlen != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
312 cpl_ensure(pslitw != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
313 cpl_ensure(pfwhm != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
314
315 n = irplib_framelist_get_size(rawframes);
316
317 cpl_ensure(n > 0, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);
318
319 /* Allow 1 micron difference */
320 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_PIXSPACE,
321 CPL_TYPE_DOUBLE, CPL_TRUE, 1e-6));
322
323 /* The actual value depends on the age of the file :-( */
324 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_SLITWIDTH,
325 CPL_TYPE_DOUBLE, CPL_FALSE, 0.0));
326
327 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_RESOL,
328 CPL_TYPE_STRING, CPL_TRUE, 0.0));
329
330 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_SLITNAME,
331 CPL_TYPE_STRING, CPL_TRUE, 0.0));
332
333 for (int i = 0; i < n; i++) {
334 const cpl_propertylist * plist;
335 const char * filename =
336 cpl_frame_get_filename(irplib_framelist_get_const(rawframes, i));
337 const char * pfits;
338 double wl_tmp, sl_tmp, spx_tmp, pfov_tmp;
339
340
341 cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
342 VISIR_SPC_R_ERR);
343
344 cpl_ensure(filename != NULL, CPL_ERROR_DATA_NOT_FOUND,
345 VISIR_SPC_R_ERR);
346
347 plist = irplib_framelist_get_propertylist_const(rawframes, i);
348
349 cpl_ensure(plist != NULL, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);
350
351 wl_tmp = visir_pfits_get_wlen(plist);
352 if (wl_tmp <= 0.0 || !cpl_errorstate_is_equal(cleanstate)) {
353 irplib_error_recover(cleanstate, "Missing or invalid FITS card");
354 wl_tmp = VISIR_SPC_LRP_CWLEN;
355 }
356 pfits = visir_pfits_get_resol(plist);
357 if (pfits == NULL || !cpl_errorstate_is_equal(cleanstate)) {
358 irplib_error_recover(cleanstate, "Missing or invalid FITS card");
359 pfits = VISIR_SPC_LRP_NAME;
360 }
361 sl_tmp = visir_pfits_get_slitwidth(plist);
362 spx_tmp = visir_pfits_get_pixspace(plist);
363
364 /* FIXME: catch error 0.127, NULL, 0.127, ... */
365 {
366 pfov_tmp = visir_pfits_get_pixscale(plist);
367 if (pfov_tmp <= 0.) {
368 cpl_errorstate_set(cleanstate);
369 cpl_msg_warning(cpl_func, VISIR_PFITS_STRING_PIXSCALE
370 " not set, falling back to 0.127");
371 pfov_tmp = 0.127;
372 }
373 }
374
375 cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
376 VISIR_SPC_R_ERR);
377
378 if (i == 0) {
379
380 visir_optmod ins_settings;
381
382 sl = sl_tmp;
383 spx = spx_tmp;
384 wl = wl_tmp;
385 pfov = pfov_tmp;
386
387 /* Divide the slit width with the
388 Spectral PFOV = 0.127 Arcseconds/pixel */
389 *pslitw = sl / pfov; /* Convert Slit width from Arcseconds to pixel */
390
391 *pwlen = wl * 1e-6; /* Convert from micron to m */
392
393 strncpy(ptmp, pfits, IRPLIB_FITS_STRLEN);
394 ptmp[IRPLIB_FITS_STRLEN] = '\0';
395
396 cpl_msg_info(cpl_func, "RESOL [" VISIR_SPC_LRP_NAME "|LR|MR|HRS|HRG]"
397 " and WLEN [m] (%d frames): %s %g", n, ptmp, *pwlen);
398
399 if (spx <= 0) {
400 cpl_msg_error(cpl_func,"Pixel Spacing (%g) in %s is non-"
401 "positive", spx, filename);
402 cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
403 }
404
405 if (*pslitw <= 0) {
406 cpl_msg_error(cpl_func,"Slit Width (%g) in %s is non-positive",
407 sl, filename);
408 cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
409 }
410
411 cpl_msg_info(cpl_func, "Slit Width [pixel] and Pixel Spacing [m]: "
412 "%g %g", *pslitw, spx);
413
414 if (!strcmp(VISIR_SPC_LRP_NAME, ptmp)) {
415 resol = VISIR_SPC_R_LRP;
416 } else if (!strcmp("LR", ptmp)) {
417 resol = VISIR_SPC_R_LR;
418 } else if (!strcmp("MR", ptmp)) {
419 resol = VISIR_SPC_R_MR;
420 } else if (!strcmp("HRS", ptmp)) {
421 resol = VISIR_SPC_R_HR;
422 } else if (!strcmp("HRG", ptmp)) {
423 resol = VISIR_SPC_R_GHR;
424 } else {
425 cpl_msg_error(cpl_func,"Unsupported resolution (%s) in %s",
426 ptmp, filename);
427 cpl_ensure(0, CPL_ERROR_UNSUPPORTED_MODE, VISIR_SPC_R_ERR);
428 }
429
430 if (resol != VISIR_SPC_R_LRP) {
431 /* Allow 1 nm difference */
432 skip_if(irplib_framelist_contains(rawframes,
433 VISIR_PFITS_DOUBLE_WLEN,
434 CPL_TYPE_DOUBLE, CPL_TRUE,
435 1e-3));
436 }
437
438 if (visir_spc_optmod_init(resol, *pwlen, &ins_settings, is_aqu)) {
439 cpl_msg_error(cpl_func, "Resolution %s does not support "
440 "Central Wavelength [m]: %g", ptmp, *pwlen);
441 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
442 }
443
444 cpl_msg_info(cpl_func, "The %s-Spectral Resolution at %gm: %g",
445 ptmp, *pwlen,
446 visir_spc_optmod_resolution(&ins_settings));
447 cpl_msg_info(cpl_func, "The %s-Linear Dispersion at %gm [pixel/m]: "
448 "%g", ptmp, *pwlen,
449 visir_spc_optmod_dispersion(&ins_settings));
450
451 *pfwhm = *pwlen * visir_spc_optmod_dispersion(&ins_settings)
452 / visir_spc_optmod_resolution(&ins_settings);
453
454 cpl_msg_info(cpl_func, "The %s-FWHM at %gm [pixel]: %g",
455 ptmp, *pwlen, *pfwhm);
456 } else {
457 if (fabs(sl-sl_tmp) > 1e-3) { /* Allow 1 micron difference */
458 cpl_msg_error(cpl_func, "Inconsistent slit width (%g <=>"
459 " %g) in %s (%d of %d)",
460 sl, sl_tmp, filename, i+1, n);
461 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
462 }
463 if (fabs(pfov-pfov_tmp) > 1e-4) { /* Allow 1 micron difference */
464 cpl_msg_error(cpl_func, "Inconsistent pfov (%g <=>"
465 " %g) in %s (%d of %d)",
466 pfov, pfov_tmp, filename, i+1, n);
467 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
468 }
469 }
470 if (need_temp) {
471 /* Temperature [Celcius] not yet found */
472 const double temp = visir_pfits_get_temp(plist);
473 if (cpl_error_get_code()) {
474 visir_error_reset("Could not get FITS key");
475 } else if ((-20 < temp) && (temp < 60)) {
476 /* Only accept a non-extreme temperature */
477 need_temp = CPL_FALSE;
478 *ptemp = temp;
479 }
480 }
481
482 }
483
484 if (need_temp) {
485 cpl_msg_warning(cpl_func, "No FITS-files specify the M1 temperature, "
486 "using default");
487 *ptemp = 10; /* Default is 10 Celcius */
488 }
489
490
491 if (ptemp != NULL) {
492 *ptemp += 273.15; /* Convert to Kelvin */
493 cpl_msg_info(cpl_func, "The M1 temperature [Kelvin]: %g", *ptemp);
494 }
495
496 end_skip;
497
498 return resol;
499
500}
501
502/*----------------------------------------------------------------------------*/
523/*----------------------------------------------------------------------------*/
524cpl_error_code visir_vector_resample(cpl_vector * self,
525 const cpl_vector * xbounds,
526 const cpl_bivector * source)
527{
528
529 const cpl_vector * xsource = cpl_bivector_get_x_const(source);
530 const cpl_vector * ysource = cpl_bivector_get_y_const(source);
531
532 const double * pxsource = cpl_vector_get_data_const(xsource);
533 const double * pysource = cpl_vector_get_data_const(ysource);
534 const double * pxbounds = cpl_vector_get_data_const(xbounds);
535
536
537 cpl_vector * ybounds = cpl_vector_new(cpl_vector_get_size(xbounds));
538 IRPLIB_DIAG_PRAGMA_PUSH_IGN(-Wcast-qual)
539 cpl_bivector * boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,
540 ybounds);
541 IRPLIB_DIAG_PRAGMA_POP
542 double * pybounds = cpl_vector_get_data(ybounds);
543
544 double * pself = cpl_vector_get_data(self);
545 const int npix = cpl_vector_get_size(self);
546 int i;
547 int itt;
548
549
550 cpl_ensure_code(cpl_bivector_get_size(boundary) == npix + 1,
551 CPL_ERROR_ILLEGAL_INPUT);
552
553 skip_if_error_present();
554
555 itt = cpl_vector_find(xsource, pxbounds[0]);
556
557 skip_if_error_present();
558
559 skip_if (cpl_bivector_interpolate_linear(boundary, source));
560
561 /* At this point itt most likely points to element just below
562 pxbounds[0] */
563 while (pxsource[itt] < pxbounds[0]) itt++;
564
565 for (i=0; i < npix; i++) {
566
567 /* The i'th value is the weighted average of the two interpolated
568 values at the boundaries and the source values in between */
569
570 double xlow = pxbounds[i];
571 double x = pxsource[itt];
572
573 if (x > pxbounds[i+1]) x = pxbounds[i+1];
574 /* Contribution from interpolated value at lower boundary */
575 pself[i] = pybounds[i] * (x - xlow);
576
577 /* Contribution from table values in between boundaries */
578 while (pxsource[itt] < pxbounds[i+1]) {
579 const double xprev = x;
580 x = pxsource[itt+1];
581 if (x > pxbounds[i+1]) x = pxbounds[i+1];
582 pself[i] += pysource[itt] * (x - xlow);
583 xlow = xprev;
584 itt++;
585 }
586
587 /* Contribution from interpolated value at upper boundary */
588 pself[i] += pybounds[i+1] * (pxbounds[i+1] - xlow);
589
590 /* Compute average by dividing integral by length of sampling interval
591 (the factor 2 comes from the contributions) */
592 pself[i] /= 2 * (pxbounds[i+1] - pxbounds[i]);
593
594 }
595
596
597 end_skip;
598
599 cpl_vector_delete(ybounds);
600 cpl_bivector_unwrap_vectors(boundary);
601
602 return cpl_error_get_code();
603}
604
605
606
607/*----------------------------------------------------------------------------*/
633/*----------------------------------------------------------------------------*/
634void * visir_spc_extract_wcal(const cpl_image * combined,
635 const cpl_image * hcycle,
636 const int lcol, const int rcol,
637 const double wlen, const double slitw,
638 const double temp, const double fwhm,
639 const visir_spc_resol resol,
640 const visir_spc_config * cfg,
641 const char * spc_cal_lines,
642 const char * spc_cal_qeff,
643 const int is_aqu,
644 const visir_apdefs * aps,
645 const cpl_size ncomb, const bool rev,
646 cpl_table ** pspc_table,
647 cpl_image ** pweight2d,
648 cpl_propertylist * qclist)
649{
650 INIT(15);
651 const int npix = cpl_image_get_size_y(combined);
652
653 if (!pspc_table) return ABORT(CPL_ERROR_NULL_INPUT);
654 if (!pweight2d) return ABORT(CPL_ERROR_NULL_INPUT);
655 *pweight2d = NULL;
656
657 if (npix < 1) return ABORT(CPL_ERROR_ILLEGAL_INPUT);
658 if (npix != cpl_image_get_size_y(hcycle)) return ABORT(
659 CPL_ERROR_ILLEGAL_INPUT, "Sky frame does not have same size as the "
660 "object frame. %d vs %d pixels", (int)cpl_image_get_size_y(hcycle),
661 npix);
662
663
664 /* Determine the wavelength solution from the atmospheric lines */
665 visir_spc_wavecal _(hcycle, qclist, wlen, slitw, temp, fwhm, resol,
666 cfg, spc_cal_lines, spc_cal_qeff, pspc_table,
667 is_aqu);
668
669 /* Convert the combined image */
670 SET(flipped, cpl_image) = cpl_image_cast _(combined, CPL_TYPE_DOUBLE);
671
672 /* Extract spectrum with error from the combined image */
673 /* FIXME: Move inside */
674 SET(spc_n_err, cpl_bivector) = visir_spc_extract _(
675 flipped->o, lcol, rcol, qclist, pweight2d, cfg, aps, rev, ncomb);
676 FREE(flipped); // flipped->o is now NULL
677
678 /* apply the response calibration (if any) to eliminate fringing */
679 if (visir_str_par_is_empty(cfg->respcal)) {
680 cpl_table_new_column _(*pspc_table, "SPC_EXTRACTED", CPL_TYPE_DOUBLE);
681 cpl_table_new_column _(*pspc_table, "SPC_ERROR", CPL_TYPE_DOUBLE);
682
683 cpl_table_copy_data_double _(*pspc_table, "SPC_EXTRACTED",
684 cpl_bivector_get_x_data(spc_n_err->o));
685 cpl_table_copy_data_double _(*pspc_table, "SPC_ERROR",
686 cpl_bivector_get_y_data(spc_n_err->o));
687 }
688 else {
689 MSG_INFO("Applying response calibration...");
690
691 // create hdrl_spectrum1D from response calibration
692 SET(calib, cpl_table) = cpl_table_load _(cfg->respcal, 1, 0);
693 cpl_size nrows = cpl_table_get_nrow _(calib->o);
694 double * pwlen = cpl_table_get_data_double _(calib->o, "WLEN");
695 double * pflux = cpl_table_get_data_double _(calib->o, "FLUX");
696 double * perr = cpl_table_get_data_double(calib->o, "ERR"); // no_
697 if (cpl_error_get_code()) WARN("ERR column missing from %s, continuing "
698 "with zero error", cfg->respcal);
699 SET(wlen, cpl_array, p) = cpl_array_wrap_double _(pwlen, nrows);
700 cpl_array_multiply_scalar _(wlen->o, 1e-6); // convert to meters
701 SET(flux, cpl_image, p) = cpl_image_wrap_double _(nrows, 1, pflux);
702 SET(err, cpl_image, p) = !perr ? NULL : cpl_image_wrap_double _(
703 nrows, 1, perr);
704 SET(response, hdrl_spectrum1D, w) = hdrl_spectrum1D_create _(
705 flux->o, err->o, wlen->o, hdrl_spectrum1D_wave_scale_linear);
706
707 // create hdrl_spectrum1D from extracted spectrum
708 nrows = cpl_table_get_nrow _(*pspc_table);
709 pwlen = cpl_table_get_data_double _(*pspc_table, "WLEN");
710 pflux = cpl_bivector_get_x_data _(spc_n_err->o);
711 perr = cpl_bivector_get_y_data _(spc_n_err->o);
712 RESET(wlen) = cpl_array_wrap_double _(pwlen, nrows);
713 RESET(flux) = cpl_image_wrap_double _(nrows, 1, pflux);
714 RESET(err) = cpl_image_wrap_double _(nrows, 1, perr);
715 SET(spectrum, hdrl_spectrum1D, w) = hdrl_spectrum1D_create _(
716 flux->o, err->o, wlen->o, hdrl_spectrum1D_wave_scale_linear);
717
718 // resample response calib on spectrum wavelengths
719 const hdrl_spectrum1D_wavelength spec_wav =
720 hdrl_spectrum1D_get_wavelength _(spectrum->o);
721 SET(params, hdrl_parameter) =
722 hdrl_spectrum1D_resample_interpolate_parameter_create _(
723 hdrl_spectrum1D_interp_linear);
724 SET(result, hdrl_spectrum1D, w) = hdrl_spectrum1D_resample _(
725 response->o, &spec_wav, params->o);
726
727 // divide the spectrum by the resampled response & add results to table
728 hdrl_spectrum1D_div_spectrum _(spectrum->o, result->o);
729 hdrl_spectrum1D_append_to_table _(
730 spectrum->o, *pspc_table, "SPC_EXTRACTED", NULL, "SPC_ERROR", NULL);
731 }
732
733 cpl_table_set_column_unit _(*pspc_table, "SPC_EXTRACTED", "ADU/s");
734 cpl_table_set_column_unit _(*pspc_table, "SPC_ERROR", "ADU/s");
735
736 if (cfg->plot) {
737 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
738 "t 'Extracted Spectrum' w linespoints",
739 "", *pspc_table, "WLEN", "SPC_EXTRACTED");
740 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
741 "t 'Error on Extracted Spectrum' w linespoints",
742 "", *pspc_table, "WLEN", "SPC_ERROR");
743 }
744
745 return CLEANUP();
746}
747
748/*----------------------------------------------------------------------------*/
774/*----------------------------------------------------------------------------*/
775cpl_error_code visir_spc_wavecal(const cpl_image * hcycle,
776 cpl_propertylist * qclist,
777 double wlen, double slitw,
778 double temp, double fwhm,
779 visir_spc_resol resol,
780 const visir_spc_config * cfg,
781 const char * linefile,
782 const char * qefffile,
783 cpl_table ** pspc_table,
784 int is_aqu)
785{
786
787 /* Dispersion relation from physical model */
788 cpl_polynomial * phdisp = NULL;
789 /* Dispersion relation corrected by cross-correlation */
790 cpl_polynomial * xcdisp = NULL;
791
792 visir_spectrum_model mymodel;
793 cpl_vector * wlvals = NULL;
794 cpl_vector * spmodel = NULL;
795
796 cpl_bivector * emission = NULL;
797 cpl_vector * boundary = NULL;
798
799 cpl_bivector * temiss = NULL;
800 cpl_bivector * tqeff = NULL;
801
802 cpl_image * corrected = NULL;
803
804 cpl_image * xc_image = NULL;
805 cpl_vector * xc_vector = NULL;
806
807 cpl_vector * vsymm = NULL;
808 cpl_vector * vxc = NULL;
809
810 const int npix = cpl_image_get_size_y(hcycle);
811#if 0
812 double xc0;
813#endif
814 double qcxc = -1.0, qcsubdelta = 0.; /* avoid false unint warning */
815 double hc_min;
816 const cpl_size i0 = 0;
817 const cpl_size i1 = 1;
818 cpl_boolean didshift = CPL_FALSE;
819
820
821 cpl_ensure_code(!cpl_error_get_code(), cpl_error_get_code());
822 cpl_ensure_code(pspc_table, CPL_ERROR_NULL_INPUT);
823 cpl_ensure_code(npix > 0, CPL_ERROR_ILLEGAL_INPUT);
824
825
826 /* Make sure the corrected image is of type double */
827 corrected = cpl_image_cast(hcycle, CPL_TYPE_DOUBLE);
828 skip_if_error_present();
829
830 hc_min = cpl_image_get_min(corrected);
831 skip_if_error_present();
832 cpl_msg_info(cpl_func,"Half-cycle image [%d X %d] has minimum intensity: %g",
833 (int)cpl_image_get_size_x(hcycle), npix, hc_min);
834 if (hc_min < 0) {
835 cpl_msg_warning(cpl_func, "Thresholding negative intensities in half-"
836 "cycle image: %g", hc_min);
837 skip_if (cpl_image_threshold(corrected, 0.0, DBL_MAX, 0.0, DBL_MAX));
838 } else if (hc_min > 0) {
839 skip_if (cpl_image_subtract_scalar(corrected, hc_min));
840 }
841
842 xc_image = cpl_image_duplicate(corrected);
843
844 /* Average the spatial dimension - into a cpl_vector */
845 cpl_image_delete(corrected);
846 corrected = cpl_image_collapse_create(xc_image, 1);
847 cpl_image_delete(xc_image);
848 xc_image = corrected;
849 corrected = NULL;
850
851 skip_if(cpl_image_divide_scalar(xc_image, npix));
852
853 xc_vector = cpl_vector_wrap(npix, cpl_image_get_data(xc_image));
854
855 skip_if_error_present();
856
857#ifdef VISIR_SPC_LRP
858 phdisp = visir_spc_phys_lrp();
859 cpl_msg_info(cpl_func, "Central Dispersion (physical model) [pixel/m]: %g",
860 1.0/visir_spc_get_dispersion(phdisp, npix/2.0 + 0.5));
861 cpl_msg_info(cpl_func, "Central Wavelength (physical model) [m]: %g",
862 cpl_polynomial_eval_1d(phdisp, npix/2.0 + 0.5, NULL));
863 cpl_msg_info(cpl_func, "First Wavelength (physical model) [m]: %g",
864 cpl_polynomial_eval_1d(phdisp, 1.0, NULL));
865 cpl_msg_info(cpl_func, "Last Wavelength (physical model) [m]: %g",
866 cpl_polynomial_eval_1d(phdisp, 1024, NULL));
867 cpl_polynomial_dump(phdisp, stdout);
868 cpl_polynomial_delete(phdisp);
869#endif
870
871 phdisp = visir_spc_phys_disp(npix, wlen, resol, cfg->orderoffset, is_aqu);
872 skip_if_error_present();
873
874 if (cpl_polynomial_get_degree(phdisp) == 2) {
875 const cpl_size i2 = 2;
876 cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
877 " %gmum + ipix * %gmum/pixel + ipix^2 * (%g)mum/pixel^2 "
878 "[ipix = 1, 2, ..., %d]",
879 cpl_polynomial_get_coeff(phdisp, &i0) * 1e6,
880 cpl_polynomial_get_coeff(phdisp, &i1) * 1e6,
881 cpl_polynomial_get_coeff(phdisp, &i2) * 1e6,
882 npix);
883 }
884 else {
885 cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
886 " %gmum + ipix * %gmum/pixel [ipix = 1, 2, ..., %d]",
887 cpl_polynomial_get_coeff(phdisp, &i0) * 1e6,
888 cpl_polynomial_get_coeff(phdisp, &i1) * 1e6, npix);
889 }
890
891 temiss = visir_bivector_load_fits(linefile, "Wavelength", "Emission", 1);
892 any_if ("Could not load file with Emission Lines");
893
894 tqeff = visir_bivector_load_fits(qefffile, "Wavelength", "Efficiency",
895 npix > 256 ? 2 : 1);
896 any_if("Could not load file with Quantum-Efficiencies");
897
898 if (cfg->plot) {
899 visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';", "t '"
900 "Quantum Efficiency' w linespoints", "", tqeff);
901 }
902
903 vsymm = cpl_spc_convolve_init(npix, slitw, fwhm, cfg->plot);
904
905 skip_if (vsymm == NULL);
906
907 vxc = cpl_vector_new(1);
908 xcdisp = cpl_polynomial_new(1);
909
910 mymodel.lines = temiss;
911 mymodel.tqeff = tqeff;
912 mymodel.vsymm = vsymm;
913 mymodel.temp = temp;
914 mymodel.ulines = 0;
915 mymodel.cost = 0;
916 mymodel.xcost = 0;
917
918 skip_if(visir_spectro_refine(xcdisp, xc_vector, &mymodel, phdisp,
919 VISIR_XC_LEN, cfg->plot, resol,
920 &qcxc, &didshift, &qcsubdelta));
921
922 if (didshift) {
923 if (fabs(qcsubdelta) >= VISIR_XC_LEN) {
924 cpl_msg_warning(cpl_func, "Cross-correlation (%g pixel shift): %g",
925 qcsubdelta, qcxc);
926 } else {
927 cpl_msg_info(cpl_func,"Cross-correlation (%g pixel shift): %g",
928 qcsubdelta, qcxc);
929 }
930 }
931
932 cpl_msg_info(cpl_func, "Dispersion polynomial from cross-correlation: "
933 "%gm + ipix * %gm/pixel [ipix = 1, 2, ..., %d]",
934 cpl_polynomial_get_coeff(xcdisp, &i0),
935 cpl_polynomial_get_coeff(xcdisp, &i1), npix);
936
937 cpl_msg_info(cpl_func, "New Central Wavelength [m]: %g",
938 cpl_polynomial_eval_1d(xcdisp, 0.5*npix+0.5, NULL));
939
940 *pspc_table = cpl_table_new(npix);
941 skip_if_error_present();
942
943 /* Generate the new wavelengths based on the cross-correlation shift */
944 wlvals = cpl_vector_new(npix);
945 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(wlvals),
946 "WLEN"));
947
948 skip_if (cpl_vector_fill_polynomial(wlvals, xcdisp, 1.0, 1.0));
949
950 /* Dump the unshifted model spectrum to the table */
951 spmodel = cpl_vector_new(npix);
952 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
953 "SPC_MODEL_PH"));
954 skip_if (visir_spectro_fill(spmodel, phdisp,
955 (irplib_base_spectrum_model*)&mymodel));
956
957 /* - and the wavelength calibrated model spectrum */
958 (void)cpl_vector_unwrap(spmodel);
959 spmodel = cpl_vector_new(npix);
960 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
961 "SPC_MODEL_XC"));
962
963 skip_if (visir_spectro_fill(spmodel, xcdisp,
964 (irplib_base_spectrum_model*)&mymodel));
965
966 bug_if (cpl_table_wrap_double(*pspc_table,
967 cpl_image_get_data_double(xc_image),
968 "SPC_SKY"));
969 (void)cpl_image_unwrap(xc_image);
970 xc_image = NULL;
971
972 /* Get the emissivity (range 0 to 1) for the calibrated wavelengths */
973 (void)cpl_vector_unwrap(spmodel);
974 spmodel = cpl_vector_new(npix);
975 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
976 "SPC_EMISSIVITY"));
977
978 boundary = cpl_vector_new(npix + 1);
979 skip_if (cpl_vector_fill_polynomial(boundary, xcdisp, 0.5, 1.0));
980 skip_if (visir_vector_resample(spmodel, boundary, temiss));
981
982 bug_if (cpl_table_set_column_unit(*pspc_table, "WLEN", "m"));
983 bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_PH",
984 "J*radian/m^3/s"));
985 bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_XC",
986 "J*radian/m^3/s"));
987 bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_SKY", "ADU/s"));
988
989 /* If the spectrum goes into N-band the sky spectrum may have variable
990 atmospheric features, that are not in the model used for the model
991 spectrum. This can cause the wavelength calibration to yield completely
992 wrong results */
993 if (resol != VISIR_SPC_R_LRP && cpl_vector_get(wlvals, 0) < N_upper &&
994 N_upper < cpl_vector_get(wlvals, npix-1))
995 cpl_msg_warning(cpl_func, "Spectrum goes above N-band (%gm). Wavelength"
996 " Calibration may be entirely inaccurate", N_upper);
997
998 bug_if(visir_spectro_qclist_wcal(qclist, npix, qcxc, didshift, qcsubdelta,
999 phdisp, xcdisp));
1000
1001 if (cfg->plot) {
1002 cpl_bivector * plot = cpl_bivector_wrap_vectors(wlvals, xc_vector);
1003
1004 visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';", "t 'Spec"
1005 "trum from Half-cycle' w linespoints", "", plot);
1006 cpl_bivector_unwrap_vectors(plot);
1007
1008 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
1009 "t 'Calibrated Model Spectrum' w linespoints",
1010 "", *pspc_table, "WLEN", "SPC_MODEL_XC");
1011
1012 /* The unshifted model spectrum */
1013 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
1014 "t 'Physical Model Spectrum' w linespoints",
1015 "", *pspc_table, "WLEN", "SPC_MODEL_PH");
1016
1017 if (resol != VISIR_SPC_R_LRP) {
1018
1019 /* Create an model spectrum of twice the npix length */
1020 emission = cpl_bivector_new(2 * npix);
1021
1022 cpl_vector_delete(boundary);
1023 boundary = cpl_vector_new(2 * npix + 1);
1024
1025 cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
1026 phdisp, -0.5*npix, 1);
1027 cpl_vector_fill_polynomial(boundary, phdisp, -0.5*(npix+1), 1);
1028
1029 /* Get the emission at those wavelengths */
1030 visir_spc_emission(emission, boundary, temiss, tqeff, vsymm, temp);
1031 cpl_vector_delete(boundary);
1032 boundary = NULL;
1033
1034 visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';",
1035 "t 'Extended Model Spectrum' w linespoints",
1036 "", emission);
1037 }
1038 }
1039
1040 end_skip;
1041
1042 (void)cpl_vector_unwrap(wlvals);
1043 (void)cpl_vector_unwrap(spmodel);
1044 cpl_polynomial_delete(phdisp);
1045 cpl_polynomial_delete(xcdisp);
1046 cpl_image_delete(xc_image);
1047 cpl_vector_delete(vsymm);
1048 cpl_image_delete(corrected);
1049 cpl_bivector_delete(temiss);
1050 cpl_bivector_delete(tqeff);
1051 cpl_vector_delete(boundary);
1052 cpl_bivector_delete(emission);
1053 (void)cpl_vector_unwrap(xc_vector);
1054 cpl_vector_delete(vxc);
1055
1056 return cpl_error_get_code();
1057}
1058
1059
1060/*----------------------------------------------------------------------------*/
1077/*----------------------------------------------------------------------------*/
1078cpl_error_code visir_spc_echelle_limit(int * pcol1, int * pcol2, double wlen,
1079 const visir_spc_config * cfg,
1080 int icolmin, int icolmax,
1081 int is_aqu)
1082{
1083
1084 visir_optmod ins_settings;
1085 double echpos;
1086 double wleni; /* The central wavelength at order offset ioffset */
1087 int order;
1088 int error;
1089
1090
1091 cpl_ensure_code(wlen > 0, CPL_ERROR_ILLEGAL_INPUT);
1092 cpl_ensure_code(pcol1, CPL_ERROR_NULL_INPUT);
1093 cpl_ensure_code(pcol2, CPL_ERROR_NULL_INPUT);
1094 cpl_ensure_code(icolmin > 0, CPL_ERROR_ILLEGAL_INPUT);
1095 cpl_ensure_code(icolmax >= icolmin, CPL_ERROR_ILLEGAL_INPUT);
1096 /* There are up to 5 spectra in the imaage */
1097 cpl_ensure_code(cfg->orderoffset >= -4, CPL_ERROR_ILLEGAL_INPUT);
1098 cpl_ensure_code(cfg->orderoffset <= 4, CPL_ERROR_ILLEGAL_INPUT);
1099
1100 error = visir_spc_optmod_init(VISIR_SPC_R_GHR, wlen, &ins_settings, is_aqu);
1101 if (error) {
1102 MSG_ERR("HRG Optical model initialization (%p) failed: %d (%g)",
1103 (void*)&ins_settings, error, wlen);
1104 cpl_ensure_code(0, CPL_ERROR_ILLEGAL_INPUT);
1105 }
1106 order = cfg->orderoffset + visir_spc_optmod_get_echelle_order(&ins_settings);
1107
1108 /* There are 18 echelle orders */
1109 cpl_ensure_code(order > 0, CPL_ERROR_ILLEGAL_INPUT);
1110 cpl_ensure_code(order <= 18, CPL_ERROR_ILLEGAL_INPUT);
1111
1112 wleni = visir_spc_optmod_echelle(&ins_settings, wlen, cfg->orderoffset );
1113
1114 echpos = visir_spc_optmod_cross_dispersion(&ins_settings, wleni);
1115 if (echpos <= 0 || echpos >= icolmax) {
1116 MSG_ERR("Echelle order %2d: offset %s: location out of range [%d;%d]: "
1117 "%g", order, pn(cfg->orderoffset), icolmin, icolmax, echpos);
1118 cpl_ensure_code(0, CPL_ERROR_DATA_NOT_FOUND);
1119 }
1120
1121 *pcol1 = ceil(echpos - whechelle); /* Round up */
1122 *pcol2 = echpos + whechelle; /* Round down */
1123
1124 if (*pcol1 < icolmin) *pcol1 = icolmin;
1125 if (*pcol2 > icolmax) *pcol2 = icolmax;
1126
1127 MSG_INFO("Echelle order %2d: offset %s: at col %g [%d; %d]", order,
1128 pn(cfg->orderoffset), echpos, *pcol1, *pcol2);
1129
1130 if (cfg->phu) {
1131 char * label = cpl_sprintf("ESO DRS APGUI OFFS%d", order);
1132 cpl_propertylist_update_int(cfg->phu, label, cfg->orderoffset);
1133 cpl_free(label);
1134 label = cpl_sprintf("ESO DRS APGUI WLEN%d", order);
1135 cpl_propertylist_update_double(cfg->phu, label, wleni);
1136 cpl_free(label);
1137 label = cpl_sprintf("ESO DRS APGUI CPIX%d", order);
1138 cpl_propertylist_update_double(cfg->phu, label, echpos);
1139 cpl_free(label);
1140 label = cpl_sprintf("ESO DRS APGUI LPIX%d", order);
1141 cpl_propertylist_update_int(cfg->phu, label, *pcol1);
1142 cpl_free(label);
1143 label = cpl_sprintf("ESO DRS APGUI RPIX%d", order);
1144 cpl_propertylist_update_int(cfg->phu, label, *pcol2);
1145 cpl_free(label);
1146 }
1147
1148 return cpl_error_get_code();
1149
1150}
1151
1152/*----------------------------------------------------------------------------*/
1165/*----------------------------------------------------------------------------*/
1166cpl_image * visir_spc_column_extract(const cpl_image * self, int icol1,
1167 int icol2, int doplot)
1168{
1169
1170 cpl_image * band = NULL;
1171 cpl_image * spatial = NULL;
1172 const int nrow = cpl_image_get_size_y(self);
1173 const int ncol = cpl_image_get_size_x(self);
1174
1175 cpl_ensure(self != NULL, CPL_ERROR_NULL_INPUT, NULL);
1176 cpl_ensure(icol1 > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1177 cpl_ensure(icol2 >= icol1, CPL_ERROR_ILLEGAL_INPUT, NULL);
1178
1179 cpl_ensure(ncol >= icol2, CPL_ERROR_ILLEGAL_INPUT, NULL);
1180
1181 band = cpl_image_extract(self, icol1, 1, icol2, nrow);
1182 skip_if_error_present();
1183
1184 if (doplot > 0) {
1185 visir_image_plot("", "t 'The full-width image'", "", self);
1186
1187 if (doplot > 1) {
1188 /* Average the spectral dimension */
1189 spatial = cpl_image_collapse_create(self, 0);
1190 skip_if_error_present();
1191 skip_if (cpl_image_divide_scalar(spatial, nrow));
1192
1193 visir_image_row_plot("set grid;", "t 'Spectral direction "
1194 "collapsed' w linespoints", "",
1195 spatial, 1, 1, 1);
1196 }
1197 }
1198
1199 end_skip;
1200
1201 cpl_image_delete(spatial);
1202 if (cpl_error_get_code() && band != NULL) {
1203 cpl_image_delete(band);
1204 band = NULL;
1205 }
1206
1207 return band;
1208
1209}
1210
1211
1212/*----------------------------------------------------------------------------*/
1225/*----------------------------------------------------------------------------*/
1226cpl_error_code visir_spectro_qc(cpl_propertylist * qclist,
1227 cpl_propertylist * paflist,
1228 cpl_boolean drop_wcs,
1229 const irplib_framelist * rawframes,
1230 const char * regcopy,
1231 const char * regcopypaf)
1232{
1233
1234 const cpl_propertylist * reflist
1235 = irplib_framelist_get_propertylist_const(rawframes, 0);
1236
1237 bug_if (0);
1238
1239 bug_if (visir_qc_append_capa(qclist, rawframes));
1240
1241 if (regcopy != NULL)
1242 bug_if (cpl_propertylist_copy_property_regexp(qclist, reflist,
1243 regcopy, 0));
1244
1245 if (regcopypaf != NULL)
1246 bug_if (cpl_propertylist_copy_property_regexp(paflist, reflist,
1247 regcopypaf, 0));
1248
1249 bug_if (cpl_propertylist_append(paflist, qclist));
1250
1251 if (drop_wcs) {
1252 cpl_propertylist * pcopy = cpl_propertylist_new();
1253 const cpl_error_code error
1254 = cpl_propertylist_copy_property_regexp(pcopy, reflist, "^("
1255 IRPLIB_PFITS_WCS_REGEXP
1256 ")$", 0);
1257 if (!error && cpl_propertylist_get_size(pcopy) > 0) {
1258 cpl_msg_warning(cpl_func, "Combined image will have no WCS "
1259 "coordinates");
1260 }
1261 cpl_propertylist_delete(pcopy);
1262 bug_if(0);
1263 } else {
1264 bug_if(cpl_propertylist_copy_property_regexp(qclist, reflist, "^("
1265 IRPLIB_PFITS_WCS_REGEXP
1266 ")$", 0));
1267 }
1268
1269 end_skip;
1270
1271 return cpl_error_get_code();
1272
1273}
1274
1275
1279/*----------------------------------------------------------------------------*/
1292/*----------------------------------------------------------------------------*/
1293static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist * self,
1294 int npix, double xc,
1295 cpl_boolean didshift,
1296 double subdelta,
1297 const cpl_polynomial * phdisp,
1298 const cpl_polynomial * xcdisp)
1299{
1300
1301 const cpl_size phdegree = cpl_polynomial_get_degree(phdisp);
1302 const cpl_size xcdegree = cpl_polynomial_get_degree(xcdisp);
1303
1304 const double phdisp0 = cpl_polynomial_eval_1d(phdisp, 1.0, NULL);
1305 const double xcdisp0 = cpl_polynomial_eval_1d(xcdisp, 1.0, NULL);
1306
1307 const double xcwlen = cpl_polynomial_eval_1d(xcdisp, 0.5*(double)npix+0.5,
1308 NULL);
1309 const double phcdisp = visir_spc_get_dispersion(phdisp, npix/2.0 + 0.5);
1310 const double xccdisp = visir_spc_get_dispersion(xcdisp, npix/2.0 + 0.5);
1311 cpl_size i;
1312
1313
1314 bug_if (0);
1315 skip_if (phdegree < 1);
1316 skip_if (xcdegree < 1);
1317
1318 cpl_msg_info(cpl_func, "Central Dispersion (physical model) [m/pixel]: %g",
1319 phcdisp);
1320 cpl_msg_info(cpl_func, "Central Dispersion (calibrated) [m/pixel]: %g",
1321 xccdisp);
1322
1323 bug_if (cpl_propertylist_append_double(self, "ESO QC XC", xc));
1324
1325 if (didshift)
1326 bug_if (cpl_propertylist_append_double(self, "ESO QC XCSHIFT",
1327 subdelta));;
1328
1329 bug_if (cpl_propertylist_append_int(self, "ESO QC PHDEGREE", phdegree));
1330 bug_if (cpl_propertylist_append_double(self, "ESO QC PHDISPX0", phdisp0));
1331 for (i = 1; i <= phdegree; i++) {
1332 const double coeff = cpl_polynomial_get_coeff(phdisp, &i);
1333 char * label = cpl_sprintf("ESO QC PHDISPX%d", (int)i);
1334
1335 bug_if (cpl_propertylist_append_double(self, label, coeff));
1336 cpl_free(label);
1337 }
1338
1339 bug_if (cpl_propertylist_append_double(self, "ESO QC XCWLEN", xcwlen));
1340
1341 bug_if (cpl_propertylist_append_int(self, "ESO QC XCDEGREE", xcdegree));
1342 bug_if (cpl_propertylist_append_double(self, "ESO QC XCDISPX0", xcdisp0));
1343
1344 for (i = 1; i <= xcdegree; i++) {
1345 const double coeff = cpl_polynomial_get_coeff(xcdisp, &i);
1346 char * label = cpl_sprintf("ESO QC XCDISPX%d", (int)i);
1347
1348 bug_if (cpl_propertylist_append_double(self, label, coeff));
1349 cpl_free(label);
1350 }
1351
1352 end_skip;
1353
1354 return cpl_error_get_code();
1355
1356}
1357
1358
1359
1360/*----------------------------------------------------------------------------*/
1372/*----------------------------------------------------------------------------*/
1373static void * visir_spectro_qclist_obs(cpl_propertylist * self, double xfwhm,
1374 double xcentro)
1375{
1376 INIT(0);
1377
1378 cpl_propertylist_append_double _(self, "ESO QC XFWHM", xfwhm);
1379 cpl_propertylist_append_double _(self, "ESO QC XCENTROI", xcentro);
1380
1381 return CLEANUP();
1382
1383}
1384
1385
1386/*----------------------------------------------------------------------------*/
1398/*----------------------------------------------------------------------------*/
1399static cpl_error_code visir_vector_convolve_symm(cpl_vector * self,
1400 const cpl_vector * vsymm)
1401{
1402
1403 const int npix = cpl_vector_get_size(self);
1404 const int ihwidth = cpl_vector_get_size(vsymm) - 1;
1405 cpl_vector * raw = cpl_vector_duplicate(self);
1406 double * pself= cpl_vector_get_data(self);
1407 double * praw = cpl_vector_get_data(raw);
1408 const double * psymm = cpl_vector_get_data_const(vsymm);
1409
1410 int i, j;
1411
1412
1413 skip_if_error_present();
1414
1415 /* The convolution does not support this */
1416 skip_if (ihwidth >= npix);
1417
1418 /* Convolve with the symmetric function */
1419 for (i = 0; i < ihwidth; i++) {
1420 pself[i] = praw[i] * psymm[0];
1421 for (j = 1; j <= ihwidth; j++) {
1422 const int k = i-j < 0 ? 0 : i-j;
1423 pself[i] += (praw[k]+praw[i+j]) * psymm[j];
1424 }
1425
1426 }
1427
1428 for (i = ihwidth; i < npix-ihwidth; i++) {
1429 pself[i] = praw[i] * psymm[0];
1430 for (j = 1; j <= ihwidth; j++)
1431 pself[i] += (praw[i-j]+praw[i+j]) * psymm[j];
1432
1433 }
1434 for (i = npix-ihwidth; i < npix; i++) {
1435 pself[i] = praw[i] * psymm[0];
1436 for (j = 1; j <= ihwidth; j++) {
1437 const int k = i+j > npix-1 ? npix - 1 : i+j;
1438 pself[i] += (praw[k]+praw[i-j]) * psymm[j];
1439 }
1440
1441 }
1442
1443 end_skip;
1444
1445 cpl_vector_delete(raw);
1446
1447 return cpl_error_get_code();
1448}
1449
1450/*----------------------------------------------------------------------------*/
1471/*----------------------------------------------------------------------------*/
1472cpl_image * visir_spc_flip(const cpl_image * image, double wlen,
1473 visir_spc_resol resol, visir_data_type dtype,
1474 bool * is_flipped)
1475{
1476 cpl_image * flipped = cpl_image_cast(image, CPL_TYPE_DOUBLE);
1477 visir_optmod ins_settings;
1478 if (is_flipped) *is_flipped = false;
1479
1480 skip_if_error_present();
1481
1482 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1483 visir_spc_optmod_init(resol, wlen, &ins_settings,
1484 visir_data_is_aqu(dtype))) {
1485 visir_error_set(CPL_ERROR_ILLEGAL_INPUT);
1486 skip_if (1);
1487 }
1488
1489 /* The dispersion relation goes from the top of the image to the bottom
1490 - except aquarius , where the detector is rotated 90 degrees
1491 - except using the B-side (in high resolution) */
1492 if (visir_data_is_aqu(dtype)) {
1493 skip_if (cpl_image_turn(flipped, 1));
1494 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1495 visir_spc_optmod_side_is_A(&ins_settings) == 0) {
1496 cpl_msg_info(cpl_func, "Flipping image");
1497 skip_if (cpl_image_flip(flipped, 0));
1498 if (is_flipped) *is_flipped = true;
1499 }
1500 }
1501
1502 else if ((resol != VISIR_SPC_R_HR && resol != VISIR_SPC_R_GHR) ||
1503 visir_spc_optmod_side_is_A(&ins_settings) > 0) {
1504
1505 cpl_msg_info(cpl_func, "Flipping image");
1506
1507 skip_if (cpl_image_flip(flipped, 0));
1508 if (is_flipped) *is_flipped = true;
1509 }
1510
1511 end_skip;
1512
1513 if (cpl_error_get_code() && flipped) {
1514 cpl_image_delete(flipped);
1515 flipped = NULL;
1516 }
1517
1518 return flipped;
1519
1520}
1521
1522/*----------------------------------------------------------------------------*/
1538/*----------------------------------------------------------------------------*/
1539static cpl_polynomial * visir_spc_phys_disp(int npix, double wlen,
1540 visir_spc_resol resol, int ioffset,
1541 int is_aqu)
1542{
1543
1544 cpl_polynomial * phdisp = NULL;
1545 visir_optmod ins_settings;
1546
1547 double dwl;
1548 double wlen0;
1549 double wlen1;
1550 double disp;
1551 const cpl_size i1 = 1;
1552 const cpl_size i0 = 0;
1553
1554
1555 cpl_ensure(resol, CPL_ERROR_ILLEGAL_INPUT, NULL);
1556 cpl_ensure(wlen > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1557 cpl_ensure(npix > 1, CPL_ERROR_ILLEGAL_INPUT, NULL);
1558
1559 /* Initialize instrument-specific settings
1560 - the resolution is not needed hereafter
1561 visir_spc_optmod_init() does itself not use the CPL-error system
1562 because it is also used in a non-CPL scope */
1563
1564 cpl_ensure(!visir_spc_optmod_init(resol, wlen, &ins_settings, is_aqu),
1565 CPL_ERROR_ILLEGAL_INPUT, NULL);
1566
1567 /* Get wavelength range (and corresponding central-wavelength)
1568 visir_spc_optmod_wlen() does not use the CPL-error system
1569 because it is also used in a non-CPL scope */
1570 dwl = visir_spc_optmod_wlen(&ins_settings, &wlen0, &wlen1);
1571
1572 cpl_ensure(dwl >= 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1573
1574 /* Central-wavelength residual on Scan-Angle determination */
1575 dwl -= wlen;
1576 /* Warn if the residual exceeds twice the machine-precision */
1577 if (fabs(dwl) > 2*wlen*DBL_EPSILON) cpl_msg_warning(cpl_func, "Too large res"
1578 "idual in Scan-Angle determination [meps]: %g", dwl/DBL_EPSILON/wlen);
1579
1580 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1581 !visir_spc_optmod_side_is_A(&ins_settings)) {
1582 const double swap = wlen1;
1583 wlen1 = wlen0;
1584 wlen0 = swap;
1585 }
1586 cpl_ensure(wlen1 > wlen0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1587
1588 if (resol == VISIR_SPC_R_LRP) {
1589 phdisp = visir_spc_phys_lrp();
1590 } else {
1591 /* Construct the 1st degree dispersion relation
1592 based on the physical model */
1593 phdisp = cpl_polynomial_new(1);
1594
1595 /* The dispersion */
1596 disp = (wlen1-wlen0)/(npix-1);
1597
1598 skip_if_error_present();
1599
1600 skip_if (cpl_polynomial_set_coeff(phdisp, &i1, disp));
1601
1602 skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0-disp));
1603 }
1604
1605 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1606 !visir_spc_optmod_side_is_A(&ins_settings)) {
1607 cpl_msg_info(cpl_func,"HR B-side WLMin, WLMax, Disp: %g %g %g", wlen0,
1608 wlen1, cpl_polynomial_get_coeff(phdisp, &i1));
1609 } else {
1610 cpl_msg_info(cpl_func,"WLMin, WLMax, Disp: %g %g %g", wlen0, wlen1,
1611 cpl_polynomial_get_coeff(phdisp, &i1));
1612 }
1613
1614 if (resol == VISIR_SPC_R_GHR && ioffset != 0) {
1615 /* Another HRG Echelle order is requested
1616 - shift the 1st degree polynomial */
1617 const double dispi = visir_spc_optmod_echelle(&ins_settings,
1618 cpl_polynomial_get_coeff(phdisp, &i1), ioffset);
1619 const double wlen0i= visir_spc_optmod_echelle(&ins_settings,
1620 cpl_polynomial_get_coeff(phdisp, &i0), ioffset);
1621
1622 skip_if (cpl_polynomial_set_coeff(phdisp, &i1, dispi));
1623
1624 skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0i));
1625
1626 cpl_msg_info(cpl_func, "WLc relative error(%d): %g", ioffset,
1627 (wlen0i - cpl_polynomial_eval_1d(phdisp, 1, NULL))/wlen0i);
1628 }
1629
1630
1631 end_skip;
1632
1633 if (cpl_error_get_code() && phdisp != NULL) {
1634 cpl_polynomial_delete(phdisp);
1635 phdisp = NULL;
1636 }
1637
1638 return phdisp;
1639
1640}
1641
1642
1643/*----------------------------------------------------------------------------*/
1657/*----------------------------------------------------------------------------*/
1658
1659cpl_bivector * visir_bivector_load_fits(const char * file,
1660 const char * labelx,
1661 const char * labely,
1662 int extnum)
1663{
1664
1665 cpl_bivector * result = NULL;
1666 cpl_table * table = NULL;
1667 cpl_propertylist * extlist = NULL;
1668 cpl_vector * xwrapper;
1669 cpl_vector * ywrapper;
1670 char * sext = NULL;
1671 double * prowx;
1672 double * prowy;
1673 int next;
1674 int nlines;
1675
1676
1677 bug_if (extnum < 1);
1678
1679 next = cpl_fits_count_extensions(file);
1680 any_if("Could not load FITS table from (extension %d in) file: %s",
1681 extnum, file ? file : "<NULL>");
1682
1683 skip_if_lt(next, extnum, "extensions in file: %s", file);
1684
1685 table = cpl_table_load(file, extnum, 0);
1686 any_if ("Could not load FITS table from extension %d of %d in file: %s",
1687 extnum, next, file ? file : "<NULL>");
1688
1689 extlist = cpl_propertylist_load_regexp(file, extnum, "EXTNAME", 0);
1690 if (cpl_propertylist_has(extlist, "EXTNAME")) {
1691 const char * extname = cpl_propertylist_get_string(extlist, "EXTNAME");
1692 sext = cpl_sprintf(" (EXTNAME=%s)", extname);
1693 }
1694
1695 nlines = cpl_table_get_nrow(table);
1696 skip_if_lt(nlines, 2, "rows in table from extension %d%s of %d "
1697 "in %s", extnum, sext, next, file);
1698
1699 prowx = cpl_table_get_data_double(table, labelx);
1700 any_if("Table from extension %d%s of %d in %s has no column %s",
1701 extnum, sext, next, file, labelx);
1702
1703 prowy = cpl_table_get_data_double(table, labely);
1704 any_if("Table from extension %d%s of %d in %s has no column %s",
1705 extnum, sext, next, file, labely);
1706
1707 xwrapper = cpl_vector_wrap(nlines, prowx);
1708 ywrapper = cpl_vector_wrap(nlines, prowy);
1709
1710 result = cpl_bivector_wrap_vectors(xwrapper, ywrapper);
1711 cpl_table_unwrap(table, labelx);
1712 cpl_table_unwrap(table, labely);
1713
1714 cpl_msg_info(cpl_func, "Read %d rows from extension %d%s of %d "
1715 "in %s [%g;%g]", nlines, extnum, sext, next, file,
1716 cpl_vector_get(xwrapper, 0),
1717 cpl_vector_get(ywrapper, nlines-1));
1718
1719 end_skip;
1720
1721 cpl_free(sext);
1722 cpl_table_delete(table);
1723 cpl_propertylist_delete(extlist);
1724
1725 if (result && cpl_error_get_code()) {
1726 cpl_bivector_delete(result);
1727 result = NULL;
1728 }
1729
1730 return result;
1731
1732}
1733
1734
1735/*----------------------------------------------------------------------------*/
1762/*----------------------------------------------------------------------------*/
1763static cpl_error_code visir_spc_emission(cpl_bivector * emission,
1764 const cpl_vector * boundary,
1765 const cpl_bivector * temiss,
1766 const cpl_bivector * tqeff,
1767 const cpl_vector * vsymm,
1768 double temp)
1769{
1770 cpl_bivector * tqeffi = NULL;
1771 cpl_vector * planck = NULL;
1772 const int npix = cpl_bivector_get_size(emission);
1773
1774
1775 bug_if(emission == NULL);
1776 bug_if(boundary == NULL);
1777 bug_if(temiss == NULL);
1778 bug_if(tqeff == NULL);
1779
1780 /* npix is currently 256 */
1781 skip_if(npix <= 1);
1782
1783 skip_if(cpl_vector_get_size(boundary) != npix + 1);
1784
1785 planck = cpl_vector_new(npix);
1786 skip_if_error_present();
1787
1788 /* The atmospheric emission is assumed to be equivalent to that of
1789 a Black Body at 253 K */
1790 cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
1791 cpl_bivector_get_x(emission),
1792 CPL_UNIT_LENGTH, 253);
1793
1794 skip_if (visir_vector_resample(cpl_bivector_get_y(emission),
1795 boundary, temiss));
1796
1797 /* Convolve to reflect the instrument resolution */
1798 skip_if (visir_vector_convolve_symm(cpl_bivector_get_y(emission),
1799 vsymm));
1800
1801 skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission), planck));
1802
1803 /* The telescope emission is assumed to be equivalent to that of
1804 a Black Body */
1805 cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
1806 cpl_bivector_get_x(emission),
1807 CPL_UNIT_LENGTH, temp);
1808
1809 /* The telescope emissivity is assumed to be uniform at 0.12 */
1810 skip_if (cpl_vector_multiply_scalar(planck, 0.12));
1811
1812 /* Add the telescope emission to the atmospheric */
1813 skip_if (cpl_vector_add(cpl_bivector_get_y(emission), planck));
1814
1815 /* Multiply by the detector quantum efficiency */
1816 tqeffi = cpl_bivector_duplicate(emission);
1817 skip_if (cpl_bivector_interpolate_linear(tqeffi, tqeff));
1818
1819 skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission),
1820 cpl_bivector_get_y(tqeffi)));
1821
1822 end_skip;
1823
1824 cpl_bivector_delete(tqeffi);
1825 cpl_vector_delete(planck);
1826
1827 return cpl_error_get_code();
1828}
1829
1830
1831/*----------------------------------------------------------------------------*/
1854/*----------------------------------------------------------------------------*/
1855static cpl_vector * cpl_spc_convolve_init(int maxlen, double slitw,
1856 double fwhm, int doplot)
1857{
1858
1859 const double sigma = fwhm * CPL_MATH_SIG_FWHM;
1860 const int ihtophat = (int)slitw/2;
1861 const int gausshlen = 1 + 5 * sigma + ihtophat < maxlen/2
1862 ? 1 + 5 * sigma + ihtophat : maxlen/2 - 1;
1863 /* convolen must be at least twice the gausshlen */
1864 const int convolen = 1 + 10 * sigma + 8*ihtophat;
1865 cpl_vector * self = cpl_vector_new(gausshlen);
1866 cpl_vector * tophat = cpl_vector_new(convolen);
1867 int i;
1868
1869 /* Easiest way to fill with a Gaussian is via a CPL image */
1870 cpl_image * iself = cpl_image_wrap_double(gausshlen, 1,
1871 cpl_vector_get_data(self));
1872
1873
1874 skip_if_error_present();
1875
1876 skip_if( slitw <= 0.0);
1877 skip_if( fwhm <= 0.0);
1878 skip_if( convolen < 2 * gausshlen); /* This would indicate a bug */
1879
1880 /* Place the top point of the Gaussian on left-most pixel */
1881 skip_if (cpl_image_fill_gaussian(iself, 1.0, 1.0, CPL_MATH_SQRT2PI,
1882 sigma, 1.0));
1883
1884 if (doplot > 2) visir_vector_plot("set grid;", "t 'Right Half of Gaussian' "
1885 "w linespoints", "", self);
1886
1887 /* The number of non-zero elements is 1+2*ihtophat */
1888 skip_if( cpl_vector_fill(tophat, 0.0));
1889
1890 for (i = convolen/2-ihtophat; i < 1+convolen/2+ihtophat; i++)
1891 skip_if (cpl_vector_set(tophat, i, 1.0/(1.0+2.0*ihtophat)));
1892
1893 /* Convolve the Top-hat with the Gaussian */
1894 skip_if (visir_vector_convolve_symm(tophat, self));
1895
1896 if (doplot > 2) visir_vector_plot("set grid;","t 'Full Width Convolution' "
1897 "w linespoints", "", tophat);
1898
1899 /* Overwrite the Gaussian with the Right Half of the convolution of the
1900 Top-hat + Gausssian */
1901#if 1
1902 memcpy(cpl_vector_get_data(self),
1903 cpl_vector_get_data(tophat) + convolen/2,
1904 sizeof(double)*gausshlen);
1905#else
1906 /* Equivalent, but slower */
1907 for (i = 0 ; i < gausshlen; i++)
1908 skip_if (cpl_vector_set(self, i, cpl_vector_get(tophat,
1909 i + convolen/2)));
1910#endif
1911
1912 skip_if_error_present();
1913
1914 cpl_msg_info(cpl_func, "Convolving Model Spectrum, Gauss-sigma=%g, "
1915 "Tophat-width=%d, Truncation-Error=%g with width=%d", sigma,
1916 1+2*ihtophat,
1917 cpl_vector_get(self,gausshlen-1)/cpl_vector_get(self,0),
1918 2*gausshlen-1);
1919
1920 if (doplot > 1) visir_vector_plot("set grid;","t 'Right Half of Convolution"
1921 "' w linespoints", "", self);
1922
1923 end_skip;
1924
1925 cpl_vector_delete(tophat);
1926 cpl_image_unwrap(iself);
1927
1928 if (cpl_error_get_code()) {
1929 cpl_vector_delete(self);
1930 self = NULL;
1931 }
1932
1933 return self;
1934
1935}
1936
1937
1938static cpl_error_code
1939fit_gaussians(const cpl_image * flipped, const cpl_vector * error,
1940 cpl_size icollo, cpl_size icolhi,
1941 cpl_propertylist * qclist)
1942{
1943 cpl_size nrow = cpl_image_get_size_y(flipped);
1944 cpl_size ncol = cpl_image_get_size_x(flipped);
1945 icollo = CX_MAX(1, icollo);
1946 icolhi = CX_MIN(ncol, icolhi);
1947 cpl_errorstate cleanstate = cpl_errorstate_get();
1948 double sigs[nrow];
1949 double sigs_err = 0.;
1950 double peaks[nrow];
1951 double peaks_err = 0.;
1952 size_t nmeas = 0;
1953 for (cpl_size row = 0; row < nrow; row++) {
1954 const cpl_binary * dmask = cpl_image_get_bpm_const(flipped) ?
1955 cpl_mask_get_data_const(cpl_image_get_bpm_const(flipped)) : NULL;
1956 const double *dflipped = cpl_image_get_data_double_const(flipped);
1957 double * dx = cpl_malloc(ncol * sizeof(*dx));
1958 double * dy = cpl_malloc(ncol * sizeof(*dy));
1959 double * dye = cpl_malloc(ncol * sizeof(*dye));
1960 cpl_vector * x;
1961 cpl_vector * y;
1962 cpl_vector * ye;
1963 size_t n = 0;
1964 for (cpl_size i = icollo; i <= icolhi; i++) {
1965 if (dmask == NULL || !dmask[row * ncol + i]) {
1966 dx[n] = i;
1967 dy[n] = dflipped[row * ncol + (i - 1)];
1968 dye[n] = cpl_vector_get(error, (i - 1));
1969 n++;
1970 }
1971 }
1972 if (n > 0) {
1973 x = cpl_vector_wrap(n, dx);
1974 y = cpl_vector_wrap(n, dy);
1975 ye = cpl_vector_wrap(n, dye);
1976 double x0, sigma, sigma_err, peak, peak_err;
1977 fit_1d_gauss(x, y, ye, &x0, NULL, &peak, &peak_err, &sigma, &sigma_err);
1978 if (cpl_error_get_code() != CPL_ERROR_NONE) {
1979 cpl_msg_debug(cpl_func, "FIT row %lld failed", row);
1980 cpl_errorstate_set(cleanstate);
1981 }
1982 else {
1983 sigs[nmeas] = sigma;
1984 peaks[nmeas] = peak;
1985 sigs_err += sigma * sigma;
1986 peaks_err += peak * peak;
1987 nmeas++;
1988 cpl_msg_debug(cpl_func, "FIT row %lld x %g sig %g +- %g "
1989 "peak %g +- %g",
1990 row, x0, sigma, sigma_err, peak, peak_err);
1991 }
1992 cpl_vector_delete(x);
1993 cpl_vector_delete(y);
1994 cpl_vector_delete(ye);
1995 }
1996 else {
1997 cpl_free(dx);
1998 cpl_free(dy);
1999 cpl_free(dye);
2000 }
2001 }
2002 cpl_vector * sigv = cpl_vector_wrap(nmeas, sigs);
2003 cpl_vector * peakv = cpl_vector_wrap(nmeas, peaks);
2004 double medsigma = cpl_vector_get_median(sigv);
2005 double medsigma_err = sqrt(sigs_err) * sqrt(CPL_MATH_PI_2) / nmeas;
2006 double medpeak = cpl_vector_get_median(peakv);
2007 double medpeak_err = sqrt(peaks_err) * sqrt(CPL_MATH_PI_2) / nmeas;
2008 cpl_msg_info(cpl_func, "Median FWHM of spectrum: %g +- %g, Peak %g +- %g",
2009 medsigma, medsigma_err, medpeak, medpeak_err);
2010 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT FWHM",
2011 medsigma * 2.355);
2012 cpl_propertylist_set_comment(qclist, "ESO QC GAUSSFIT FWHM", "[pix]");
2013 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT FWHM_ERR",
2014 medsigma_err * 2.355);
2015 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT PEAK", medpeak);
2016 cpl_propertylist_set_comment(qclist, "ESO QC GAUSSFIT PEAK", "[adu/s]");
2017 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT PEAK_ERR",
2018 medpeak_err);
2019 cpl_vector_unwrap(sigv);
2020 cpl_vector_unwrap(peakv);
2021
2022 return cpl_error_get_code();
2023}
2024
2025/* ---------------------------------------------------------------------------*/
2032/* ---------------------------------------------------------------------------*/
2033static cpl_error_code
2034add_qc_background_sigma(const cpl_image * flipped, cpl_propertylist * qclist)
2035{
2036 cpl_size lly, ury;
2037 /* use approximate good wavelength range */
2038 if (cpl_image_get_size_y(flipped) > VISIR_AQU_APPROX_WLEN13) {
2039 lly = VISIR_AQU_APPROX_WLEN8;
2040 ury = VISIR_AQU_APPROX_WLEN13;
2041 }
2042 else {
2043 lly = 1;
2044 ury = cpl_image_get_size_y(flipped);
2045 }
2046
2047 cpl_image * cutimg =
2048 cpl_image_extract(flipped, 1, lly, cpl_image_get_size_x(flipped), ury);
2049
2050 /* clip to remove signal */
2051 double bkgmad, bkgmed;
2052 bkgmed = cpl_image_get_mad(cutimg, &bkgmad);
2053 for (size_t i = 0; i < 3; i++) {
2054 cpl_mask * rej =
2055 cpl_mask_threshold_image_create(cutimg,
2056 bkgmed - bkgmad * CPL_MATH_STD_MAD * 3,
2057 bkgmed + bkgmad * CPL_MATH_STD_MAD * 3);
2058 cpl_mask_not(rej);
2059 cpl_image_reject_from_mask(cutimg, rej);
2060 cpl_mask_delete(rej);
2061 bkgmed = cpl_image_get_mad(cutimg, &bkgmad);
2062 }
2063
2064 cpl_propertylist_append_double(qclist, "ESO QC BACKGD SIGMA",
2065 bkgmad * CPL_MATH_STD_MAD);
2066 cpl_propertylist_set_comment(qclist, "ESO QC BACKGD SIGMA",
2067 "[adu/s] background corrected");
2068 cpl_image_delete(cutimg);
2069
2070 return cpl_error_get_code();
2071}
2072
2073/*----------------------------------------------------------------------------*/
2079/*----------------------------------------------------------------------------*/
2080static double * visir_bkg_linfit(const cpl_image * row) {
2081 INIT(3, rv, double, v, cpl_free) = NULL;
2082
2083 const int n = cpl_image_get_size_x _(row);
2084 const int ngood = n - cpl_image_count_rejected _(row);
2085
2086 // generate the x & y buffers
2087 SET(x, double, v, cpl_free) = cpl_malloc(ngood * sizeof(double));
2088 SET(y, double, v, cpl_free) = cpl_malloc(ngood * sizeof(double));
2089 for (int bad, i = 0, j = 0; i < n; ++i) {
2090 const double cand = cpl_image_get _(row, i+1, 1, &bad);
2091 if (bad) continue;
2092 x->o[j] = i;
2093 y->o[j++] = cand;
2094 }
2095
2096 // linear least squares fit
2097 double c0, c1, cov00, cov01, cov11;
2098 gsl_fit_linear(x->o, 1, y->o, 1, ngood, &c0, &c1, &cov00, &cov01, &cov11,
2099 HOLE(double));
2100
2101 // interpolate row using model
2102 RESET(rv) = cpl_malloc(n * sizeof(double));
2103 for (int i = 0; i < n; ++i) gsl_fit_linear_est(
2104 i, c0, c1, cov00, cov01, cov11, rv->o + i, HOLE(double));
2105
2106 return CLEANUP();
2107}
2108
2109/*----------------------------------------------------------------------------*/
2128/*----------------------------------------------------------------------------*/
2129int visir_norm_coord(const bool rev, const float coord, const int lcol,
2130 const int rcol, const visir_apdefs * aps)
2131{
2132 const int x = coord < 0 ? -coord : coord;
2133 if (copysign(1.0, coord) > 0.0) return // positive == right
2134 rev ? rcol - aps->limits[x].l + 1 : aps->limits[x].r - lcol + 1;
2135 else return // negative == left
2136 rev ? rcol - aps->limits[x].r + 1 : aps->limits[x].l - lcol + 1;
2137}
2138
2139/*----------------------------------------------------------------------------*/
2147/*----------------------------------------------------------------------------*/
2148static cpl_image * visir_image_filter_median(const cpl_image * image,
2149 const int nx, const int ny)
2150{
2151 INIT(1, filtered, cpl_image) = cpl_image_duplicate _(image);
2152 if (nx < 2) return CLEANUP(); // no filtering requested
2153
2154 if (!(nx % 2))
2155 return ABORT(CPL_ERROR_ILLEGAL_INPUT, "kernel size must be odd");
2156
2157 const cpl_size xsz = cpl_image_get_size_x _(image);
2158 const cpl_size ysz = cpl_image_get_size_y _(image);
2159 const cpl_type type = cpl_image_get_type _(image);
2160 RESET(filtered) = cpl_image_new _(xsz, ysz, type);
2161
2162 SET(kernel, cpl_mask) = cpl_mask_new _(nx, ny);
2163 cpl_mask_not _(kernel->o);
2164 cpl_image_filter_mask _(filtered->o, image, kernel->o, CPL_FILTER_MEDIAN,
2165 CPL_BORDER_FILTER);
2166 return CLEANUP();
2167}
2168
2169/*----------------------------------------------------------------------------*/
2185/*----------------------------------------------------------------------------*/
2186static void * visir_extraction(const cpl_image * insci, const cpl_image * invar,
2187 const cpl_image * insky, cpl_vector * outext,
2188 cpl_vector * outsky, cpl_vector * outerr,
2189 cpl_image * outwgt, const visir_spc_config * cfg,
2190 const int method, const int ncomb, const int beg,
2191 const int end)
2192{
2193 INIT(5);
2194
2195 if (!insci || !invar || !insky || !cfg ||
2196 !outext || !outsky || !outerr || !outwgt)
2197 return ABORT(CPL_ERROR_NULL_INPUT);
2198
2199 const int specLen = cpl_image_get_size_x _(insci);
2200 const int numRows = cpl_image_get_size_y _(insci);
2201 if (beg < 0 || beg >= numRows || end < 0 || end >= numRows || beg > end)
2202 return ABORT(CPL_ERROR_INCOMPATIBLE_INPUT);
2203
2204 double * oext_d = cpl_vector_get_data _(outext);
2205 double * osky_d = cpl_vector_get_data _(outsky);
2206 double * oerr_d = cpl_vector_get_data _(outerr);
2207 double * owgt_d = cpl_image_get_data _(outwgt);
2208
2209 const double * const isci_d = cpl_image_get_data_const _(insci);
2210 const double * const isky_d = cpl_image_get_data_const _(insky);
2211 const double * const ivar_d = invar ? cpl_image_get_data_const(invar) : NULL;
2212
2213 /* Initial spectrum estimate */
2214 //if (isci_d[i + j * specLen] > 0.0)
2215
2216 if (method && abs(end-beg) > cfg->ox_kernel + 2 /* numRows > 5 */) {
2217 SET(smoothed, cpl_image) = visir_image_filter_median _(
2218 insci, cfg->ox_kernel, cfg->ox_kernel);
2219 double * smoo_d = cpl_image_get_data _(smoothed->o);
2220 for (int i = 0; i < specLen; i++) {
2221 oext_d[i] = 0.0;
2222 for (int j = beg; j <= end; j++)
2223 oext_d[i] += smoo_d[i + j * specLen];
2224 }
2225 }
2226 else {
2227 for (int i = 0; i < specLen; i++) {
2228 oext_d[i] = 0.0;
2229 for (int j = beg; j <= end; j++)
2230 oext_d[i] += isci_d[i + j * specLen];
2231 }
2232 }
2233
2234 if (method) {
2235
2236 SET(buf, double, v, cpl_free) = cpl_calloc(specLen, sizeof(double));
2237 for (int iter = 0; iter < cfg->ox_niters; iter++) {
2238
2239 /* Normalised spatial profile */
2240 for (int i = 0; i < specLen; i++) {
2241 for (int j = beg; j <= end; j++) {
2242 const int index = i + j * specLen;
2243 //owgt_d[index] = n_sci[index] > 0.0 && oext_d[i] > 0.00001
2244 owgt_d[index] = fabs(oext_d[i]) > 0.00001
2245 ? isci_d[index] / oext_d[i] : 0.0;
2246 }
2247 }
2248
2249 SET(wrap, cpl_vector, p) = NULL;
2250 for (int j = beg; j <= end; j++) {
2251
2252 /* Smooth each row in the dispersion direction, and enforce
2253 * positivity */
2254 for (int i = 0; i < specLen - cfg->ox_smooth; i++) {
2255 RESET(wrap) = cpl_vector_wrap _(cfg->ox_smooth, owgt_d +
2256 i + j * specLen);
2257 double value = cpl_vector_get_median_const _(wrap->o);
2258 if (value < 0) value = 0.0;
2259 buf->o[i + cfg->ox_smooth / 2] = value;
2260 }
2261
2262 /* left edge escaped filtering: replace with mean */
2263 RESET(wrap) = cpl_vector_wrap _(cfg->ox_smooth / 2, owgt_d +
2264 j * specLen);
2265 double value = cpl_vector_get_mean _(wrap->o);
2266 if (value < 0) value = 0.0;
2267 for (int i = 0; i < cfg->ox_smooth / 2; i++) buf->o[i] = value;
2268
2269 /* right edge escaped filtering: replace with mean */
2270 RESET(wrap) = cpl_vector_wrap _(cfg->ox_smooth / 2, owgt_d +
2271 specLen - cfg->ox_smooth / 2 + j * specLen);
2272 value = cpl_vector_get_mean _(wrap->o);
2273 if (value < 0) value = 0.0;
2274 for (int i = 0; i < cfg->ox_smooth / 2; i++)
2275 buf->o[i + specLen - cfg->ox_smooth / 2] = value;
2276 for (int i = 0; i < specLen; i++)
2277 owgt_d[i + j * specLen] = buf->o[i];
2278 }
2279
2280 /* Enforce normalization of spatial profile after smoothing */
2281 for (int i = 0; i < specLen; i++) {
2282 double value = 0.0;
2283 for (int j = beg; j <= end; j++)
2284 value += owgt_d[i + j * specLen];
2285 if (value > 0.00001)
2286 for (int j = beg; j <= end; j++)
2287 owgt_d[i + j * specLen] /= value;
2288 else
2289 for (int j = beg; j <= end; j++)
2290 owgt_d[i + j * specLen] = 0.0;
2291 }
2292
2293
2294 /* Optimal extraction */
2295 for (int i = 0; i < specLen; i++) {
2296 double sumSci, sumSky, sumWgt, sumProf, sumVar;
2297 sumSci = sumSky = sumWgt = sumProf = sumVar = 0.0;
2298 for (int j = beg; j <= end; j++) {
2299 const int index = i + j * specLen;
2300 //if (isci_d[index] > 0.0)
2301
2302 // This is the theoretical estimated variance. In principle,
2303 // since we have the propagated variance, we could use that
2304 // one, but I leave this as this is the original algorithm
2305 // (cgarcia)
2306 double var = cfg->ron * cfg->ron + fabs(oext_d[i] *
2307 owgt_d[index] + isky_d[index]) / cfg->gain;
2308 // next line necessary for when input dataset is sum of
2309 // ncomb images
2310 var /= ncomb;
2311
2312 double value = isci_d[index] - oext_d[i] * owgt_d[index];
2313 if (fabs(value) / sqrt(var) < cfg->ox_sigma) {
2314 const double weight = 1000000 * owgt_d[index] / var;
2315 sumSci += weight * isci_d[index];
2316 sumSky += weight * isky_d[index];
2317 sumWgt += weight * owgt_d[index];
2318 sumProf += owgt_d[index];
2319 // This is how we propagated the variance. We assume
2320 // that the weigth has no error, although in has been
2321 // computed from the profile and the theoretical var-
2322 // iance (which also includes the data)
2323 if (ivar_d) sumVar += weight * weight * ivar_d[index];
2324 }
2325 }
2326
2327 if (sumWgt > 0.00001) {
2328 oext_d[i] = sumSci / sumWgt;
2329 osky_d[i] = sumSky / sumWgt;
2330 if (ivar_d)
2331 // This is the error, not the variance.
2332 oerr_d[i] = sqrt(sumVar / sumWgt / sumWgt);
2333 else
2334 // This was the old formula, which is not a real error
2335 // propagation
2336 oerr_d[i] = 1000 * sqrt(sumProf / sumWgt);
2337 }
2338 else {
2339 //oext_d[i] = osky_d[i] = oerr_d[i] = 0.0;
2340 //oerr_d[i] = sqrt(cfg->ron * cfg->ron + fabs(oext_d[i] +
2341 // osky_d[i]) / cfg->gain);
2342 }
2343 }
2344 }
2345 }
2346 else {
2347
2348 /* Add sky estimation for the simple aperture extraction. */
2349 //if (isky_d[i + j * specLen] > 0.0)
2350
2351 for (int i = 0; i < specLen; i++) {
2352 osky_d[i] = 0.0;
2353 for (int j = beg; j <= end; j++)
2354 osky_d[i] += isky_d[i + j * specLen];
2355 }
2356
2357 /* Add error estimation for the simple aperture extraction. */
2358 for (int i = 0; i < specLen; i++) {
2359 if (ivar_d) {
2360 // propagate the variance of a simple addition
2361 oerr_d[i] = 0.0;
2362 for (int j = beg; j <= end; j++)
2363 oerr_d[i] += ivar_d[i + j * specLen];
2364 oerr_d[i] = sqrt(oerr_d[i]); // return error not variance
2365 }
2366 else
2367 oerr_d[i] = sqrt(cfg->ron * cfg->ron + fabs(oext_d[i] +
2368 osky_d[i]) / cfg->gain);
2369 }
2370 }
2371
2372 return CLEANUP();
2373}
2374
2375static cpl_bivector * visir_spc_extract(cpl_image * flipped,
2376 int lcol, int rcol,
2377 cpl_propertylist * qclist,
2378 cpl_image ** pweight2d,
2379 const visir_spc_config * cfg,
2380 const visir_apdefs * aps,
2381 const bool rev, const cpl_size ncomb)
2382{
2383 extract_func * meth = aps->ident < 0 ? visir_spc_oldex : visir_spc_newex;
2384 return meth(flipped, lcol, rcol, qclist, pweight2d, cfg, aps, rev, ncomb);
2385}
2386
2387/*----------------------------------------------------------------------------*/
2399/*----------------------------------------------------------------------------*/
2400static cpl_bivector * visir_spc_newex(cpl_image * flipped,
2401 int lcol, int rcol,
2402 cpl_propertylist * qclist,
2403 cpl_image ** pweight2d,
2404 const visir_spc_config * cfg,
2405 const visir_apdefs * aps,
2406 const bool rev, const cpl_size ncomb)
2407{
2408 INIT(20, rv, cpl_bivector) = NULL;
2409
2410 if (!flipped || !qclist || !cfg || !aps) return ABORT(CPL_ERROR_NULL_INPUT);
2411 const int ncol = cpl_image_get_size_x _(flipped);
2412 const int specLen = cpl_image_get_size_y _(flipped);
2413 const int oo = cfg->orderoffset;
2414 const size_t xn = cfg->extract;
2415
2416 if (aps->nlimits < 1) return ABORT(CPL_ERROR_INCOMPATIBLE_INPUT);
2417 if (!pweight2d || *pweight2d) return ABORT(CPL_ERROR_INCOMPATIBLE_INPUT);
2418 if (ncol != rcol-lcol+1) return ABORT(CPL_ERROR_INCOMPATIBLE_INPUT);
2419 MSG_DBG(":%s:%ld: > [%d;%d] ([%d;%d]) <", pn(oo), xn, 1, ncol, rcol, lcol);
2420
2421 // write aperture into PHU
2422 SET(line, char, v, cpl_free) = visir_apdefs_dump(aps);
2423 SET(key, char, v, cpl_free) = cpl_sprintf("ESO DRS APDEF%d", aps->ident);
2424 cpl_propertylist_append_string _(cfg->phu, key->o, line->o);
2425
2426 /* Compute ESO QC BACKGD SIGMA */
2427 add_qc_background_sigma _(flipped, qclist);
2428
2429 const bool apex = aps->extract_method == VISIR_EXTRACT_METHOD_APERTURE;
2430
2431 SET(bkg, cpl_image) = NULL;
2432 SET(diff, cpl_image) = cpl_image_duplicate _(flipped);
2433 if (!cfg->bkgcorrect) {
2434 const cpl_type type = cpl_image_get_type _(flipped);
2435 RESET(bkg) = cpl_image_new _(ncol, specLen, type); // init'd to zero
2436 MSG_WARN("Sky subtraction is not enabled: extraction results may be "
2437 "degraded");
2438 }
2439 else {
2440 /* make background image */
2441 RESET(bkg) = cpl_image_duplicate _(flipped);
2442 int lp = -9999;
2443
2444 // begin with 1 (or nlimits-1 in reversed case) to skip obj ap
2445 int beg = rev ? aps->nlimits - 1 : 1;
2446 int end = rev ? 0 : aps->nlimits;
2447 const int inc = rev ? -1 : 1;
2448
2449 // reject pixels outside the sky aperture windows
2450 for (int a = beg; a != end; a += inc) {
2451 int l = visir_norm_coord(rev, -a, lcol, rcol, aps);
2452 int r = visir_norm_coord(rev, +a, lcol, rcol, aps);
2453 MSG_DBG(":%s:%ld: [%d;%d] ([%d;%d])", pn(oo), xn, l, r,
2454 aps->limits[a].r, aps->limits[a].l);
2455
2456 --l; ++r;
2457 if ((1 <= lp && lp <= ncol) || (1 <= l && l <= ncol)) {
2458 const int trunc_lp = lp < 1 ? 1 : lp;
2459 const int trunc_l = l > ncol ? ncol : l;
2460 if (trunc_lp <= trunc_l) {
2461 cpl_image_fill_window _(bkg->o, trunc_lp, 1, trunc_l,
2462 specLen, -INFINITY);
2463 MSG_DBG(":%s:%ld: [%d;%d] rejected", pn(oo), xn, trunc_lp,
2464 trunc_l);
2465 }
2466 }
2467 lp = r;
2468 }
2469 if (1 <= lp && lp <= ncol) {
2470 cpl_image_fill_window _(bkg->o, lp, 1, ncol, specLen, -INFINITY);
2471 MSG_DBG(":%s:%ld: [%d;%d] rejected", pn(oo), xn, lp, ncol);
2472 }
2473 cpl_image_reject_value _(bkg->o, CPL_VALUE_MINUSINF);
2474
2475 // set method of sky background determination (called on extracted row)
2476 double (*method)(const cpl_image *) = cpl_image_get_median; // default
2477 if (apex && aps->sky_method == VISIR_SKY_METHOD_AVERAGE)
2478 method = cpl_image_get_mean;
2479 const bool linear = apex && aps->sky_method == VISIR_SKY_METHOD_LINFIT;
2480
2481 // determine bkg on raw row data and write it into row (overwriting raw)
2482 for (int r = 0; r < specLen; ++r) {
2483 SET(row, cpl_image) = cpl_image_extract _(bkg->o, 1, r+1, ncol, r+1);
2484 if (linear) {
2485 SET(levels, double, v, cpl_free) = visir_bkg_linfit _(row->o);
2486 for (cpl_size c = 0; c < ncol; ++c) {
2487 cpl_image_set _(bkg->o, c+1, r+1, levels->o[c]); }
2488 }
2489 else {
2490 double level = method _(row->o);
2491 cpl_image_fill_window _(bkg->o, 1, r+1, ncol, r+1, level);
2492 }
2493 }
2494
2495 // line below not needed: cpl_image_fill_window or cpl_image_set (above)
2496 // does this for us
2497 //cpl_image_accept_all _(bkg->o); // clear rejection flags set earlier
2498
2499 // subtract sky background
2500 cpl_image_subtract _(diff->o, bkg->o);
2501 }
2502
2503 /* initial variance estimate */
2504 SET(var, cpl_image) = cpl_image_duplicate _(flipped);
2505 cpl_image_abs _(var->o);
2506 cpl_image_divide_scalar _(var->o, cfg->gain);
2507 cpl_image_add_scalar _(var->o, cfg->ron * cfg->ron);
2508
2509 // prep for extraction (routine assumes a horizontal spectral axis)
2510 cpl_image_turn _(diff->o, 1);
2511 cpl_image_turn _(var->o, 1);
2512 cpl_image_turn _(bkg->o, 1);
2513
2514 // perform extraction
2515 SET(spc, cpl_vector) = cpl_vector_new _(specLen);
2516 SET(sky, cpl_vector) = cpl_vector_new _(specLen);
2517 SET(err, cpl_vector) = cpl_vector_new _(specLen);
2518 SET(wgt, cpl_image) = cpl_image_new _(specLen, ncol, CPL_TYPE_DOUBLE);
2519 const int beg = ncol - visir_norm_coord(rev, +0.0, lcol, rcol, aps);
2520 const int end = ncol - visir_norm_coord(rev, -0.0, lcol, rcol, aps);
2521 visir_extraction _(diff->o, var->o, bkg->o, spc->o, sky->o, err->o, wgt->o,
2522 cfg, apex ? 0 : 1, ncomb, beg, end);
2523
2524 cpl_image_turn _(wgt->o, -1); // rotate result back to vert spectral axis
2525 RESET(rv) = cpl_bivector_wrap_vectors _(spc->o, err->o);
2526 *pweight2d = YANK(wgt, cpl_image);
2527 YANK(spc); YANK(err);
2528 return CLEANUP();
2529}
2530
2531/*----------------------------------------------------------------------------*/
2552/*----------------------------------------------------------------------------*/
2553static cpl_bivector * visir_spc_oldex(cpl_image * flipped,
2554 int lcol, int rcol,
2555 cpl_propertylist * qclist,
2556 cpl_image ** pweight2d,
2557 const visir_spc_config * cfg,
2558 const visir_apdefs * aps,
2559 const bool rev, const cpl_size ncomb)
2560{
2561 INIT(20, rv, cpl_bivector) = NULL;
2562
2563 if (!flipped || !qclist || !cfg || !aps) return ABORT(CPL_ERROR_NULL_INPUT);
2564 const int ncol = cpl_image_get_size_x _(flipped);
2565 const int nrow = cpl_image_get_size_y _(flipped);
2566 const int oo = cfg->orderoffset;
2567 const size_t xn = cfg->extract;
2568
2569
2570 /* This is hard-coded to 3.0 */
2571 const double sigma = VISIR_SPECTRO_SIGMA; /* Assume signal at this level */
2572
2573 if (sigma <= 0.0) return ABORT(CPL_ERROR_UNSUPPORTED_MODE);
2574 if (aps->nlimits < 1) return ABORT(CPL_ERROR_INCOMPATIBLE_INPUT);
2575 if (!pweight2d || *pweight2d) return ABORT(CPL_ERROR_INCOMPATIBLE_INPUT);
2576 if (ncol != rcol-lcol+1) return ABORT(CPL_ERROR_INCOMPATIBLE_INPUT);
2577 MSG_DBG(":%s:%ld: > [%d;%d] ([%d;%d]) <", pn(oo), xn, 1, ncol, rcol, lcol);
2578
2579 // write aperture into PHU
2580 SET(line, char, v, cpl_free) = visir_apdefs_dump(aps);
2581 SET(key, char, v, cpl_free) = cpl_sprintf("ESO DRS APDEF%d", aps->ident);
2582 cpl_propertylist_append_string _(cfg->phu, key->o, line->o);
2583
2584 /* Compute ESO QC BACKGD SIGMA */
2585 add_qc_background_sigma _(flipped, qclist);
2586
2587 // will need the following later for optimal ex
2588 SET(orig, cpl_image) = cpl_image_duplicate _(flipped);
2589
2590
2591 /* Compute spatial weights:
2592 mean-subtract each row and average + normalize */
2593
2594 if (cfg->bkgcorrect) { /* Background correction */
2595
2596 // make a working copy of the input frame
2597 SET(work, cpl_image) = cpl_image_duplicate _(flipped);
2598
2599 for (int r = 0; r < nrow; ++r) {
2600 SET(row, cpl_image) = cpl_image_extract _(work->o, 1, r+1, ncol, r+1);
2601 double level = cpl_image_get_median _(row->o);
2602 cpl_image_fill_window _(work->o, 1, r+1, ncol, r+1, level);
2603 }
2604
2605 // perform the sky subtraction & cleanup
2606 cpl_image_subtract _(flipped, work->o);
2607 FREE(work);
2608 }
2609
2610 const int is_echelle = ncol <= 2 * (whechelle + 1);
2611 if (!is_echelle) {
2612 /* All but HR Grism has a negative signal equal to the positive i.e. the
2613 * mean is zero. FIXME: Not true for large offsets (or very extended
2614 * objects) */
2615 double mean = cpl_image_get_mean _(flipped);
2616 MSG_INFO("Combined image has mean: %g", mean);
2617
2618 SET(col, cpl_vector) = cpl_vector_new _(nrow);
2619
2620 /* Subtract the mean from each row/wavelength */
2621 double * pweight = cpl_image_get_data_double _(flipped);
2622 for (int r=0; r < nrow; r++, pweight += ncol) {
2623
2624 /* Get the next row of the input image */
2625 SET(imrow, cpl_image, p) = cpl_image_wrap_double _(ncol, 1, pweight);
2626
2627 /* Set the corresponding pixel of col to the row mean value */
2628 mean = cpl_image_get_mean _(imrow->o);
2629 cpl_vector_set _(col->o, r, mean);
2630
2631 /* Subtract this value from the row */
2632 cpl_image_subtract_scalar _(imrow->o, mean);
2633 }
2634
2635 /* col is a column vector, where each pixel contains the mean of the
2636 * corresponding row of the input image. */
2637 if (cfg->plot > 1) visir_vector_plot(
2638 "set grid;", "t 'Estimated Background' w linespoints", "", col->o);
2639 FREE(col); // free sooner rather than later
2640 }
2641
2642
2643 /* Average the spectral dimension */
2644 SET(spatial, cpl_image) = cpl_image_collapse_create _(flipped, 0);
2645 cpl_image_divide_scalar _(spatial->o, nrow);
2646
2647
2648 /* Create weights that have an absolute sum of 1 - as an image */
2649 SET(iweight, cpl_image) = cpl_image_duplicate _(spatial->o);
2650 cpl_image_normalise _(iweight->o, CPL_NORM_ABSFLUX);
2651 const double sqflux = cpl_image_get_sqflux _(iweight->o);
2652 const double weight_2norm = sqrt(sqflux);
2653 MSG_INFO("2-norm of weights: %g", weight_2norm);
2654
2655 if (cfg->plot > 1) visir_image_row_plot(
2656 "set grid;", "t 'Cleaned, normalized combined image with spectral "
2657 "direction averaged' w linespoints", "", iweight->o, 1, 1, 1);
2658
2659
2660 /* compute spatial median & noise stdev */
2661 const double sp_median = cpl_image_get_median _(spatial->o);
2662 double stdev2d = visir_img_phot_sigma_clip _(flipped);
2663 stdev2d /= sqrt(nrow); /* The st.dev. of the noise */
2664 MSG_INFO("spatial median %g and stdev %g", sp_median, stdev2d);
2665
2666
2667 /* Reject noise from spatial */
2668 SET(binary, cpl_mask) = cpl_mask_threshold_image_create _(spatial->o,
2669 sp_median - sigma * stdev2d, sp_median + sigma * stdev2d);
2670 int mspix = cpl_mask_count _(binary->o);
2671 if (mspix == ncol) return ABORT(CPL_ERROR_DATA_NOT_FOUND, "%d spatial "
2672 "weights too noisy. sigma=%g. stdev2d=%g. Spatial median=%g", ncol,
2673 sigma, stdev2d, sp_median);
2674 MSG_INFO("Pixels of noise (%g +/- %g*%g): %d", sp_median, stdev2d, sigma,
2675 mspix);
2676 cpl_image_reject_from_mask _(spatial->o, binary->o);
2677
2678
2679 /* get position & magnitude of largest value in the spatial image */
2680 cpl_size ifwhm; /* position of widest signal region */
2681 int rejected;
2682 cpl_image_get_maxpos _(spatial->o, &ifwhm, HOLE(cpl_size));
2683 const double max = cpl_image_get _(spatial->o, ifwhm, 1, &rejected);
2684 if (rejected) return ABORT(CPL_ERROR_ILLEGAL_OUTPUT);
2685 if (max <= 0.0) return ABORT(CPL_ERROR_DATA_NOT_FOUND, "Cannot compute "
2686 "FWHM on a collapsed spectrum with a non-positive maximum: %g (at "
2687 "i=%lld)", max, ifwhm);
2688
2689 if (cfg->plot > 1) {
2690 visir_image_col_plot("","t 'Most intense column' w linespoints",
2691 "", flipped, ifwhm, ifwhm, 1);
2692 visir_image_row_plot("set grid;", "t 'Combined image with spectral "
2693 "direction collapsed' w linespoints",
2694 "", spatial->o, 1, 1, 1);
2695 }
2696
2697
2698 /* Find edges of centroid in spatial */
2699 int ilnoise, ihnoise; // Low/High pixel of the widest signal-less region
2700 // Step the low position back until we reach the noise
2701 for (ilnoise = ifwhm; ilnoise > 0 &&
2702 !cpl_image_is_rejected(spatial->o, ilnoise, 1); ilnoise--);
2703 // Step the high position up until we reach the noise
2704 for (ihnoise = ifwhm; ihnoise <= ncol &&
2705 !cpl_image_is_rejected(spatial->o, ihnoise, 1); ihnoise++);
2706 // There may be no negative weights at all
2707 if (!ilnoise) ilnoise = 1;
2708 if (ihnoise > ncol) ihnoise = ncol;
2709
2710 /* get x-centroid of brightest object within the window of good pixels */
2711 const double xcentro = cpl_image_get_centroid_x_window _(spatial->o,
2712 ilnoise, 1, ihnoise, 1);
2713 double xfwhm; // FWHM around maximum pixel / brightest object
2714 cpl_image_get_fwhm _(spatial->o, ifwhm, 1, &xfwhm, HOLE(double));
2715 visir_spectro_qclist_obs _(qclist, xfwhm, xcentro);
2716 MSG_INFO("Spatial FWHM(%d:%lld:%d:%g): %g", ilnoise, ifwhm, ihnoise,
2717 xcentro, xfwhm);
2718 FREE(spatial); // free up some memory early
2719
2720
2721 /* Determine st.dev. on noise at signal-less pixels */
2722 if (is_echelle) {
2723 int ileft = 5;
2724 int iright = ncol - 5;
2725
2726 if (ileft > xcentro - xfwhm * 2) ileft = xcentro - xfwhm * 2;
2727 if (iright < xcentro + xfwhm * 2) iright = xcentro + xfwhm * 2;
2728 MSG_INFO("HRG pixels of noise: [1 %d] [%d %d]", ileft, iright, ncol);
2729
2730 // "binary" is the mask showing pixels rejected as noise in the spatial
2731 // image But this operation just zeroes it out
2732 cpl_mask_xor _(binary->o, binary->o);
2733
2734 // Reset the mask so that the pixels around the centroid are flagged
2735 // as good, and those that are more than 2 * xfwhm are bad
2736 cpl_binary * pbin = cpl_mask_get_data _(binary->o);
2737 for (int i = 0; i < ncol; i++) pbin[i] = CPL_BINARY_0;
2738 for (int i = 0; i < ileft; i++) pbin[i] = CPL_BINARY_1;
2739 for (int i = iright; i < ncol; i++) pbin[i] = CPL_BINARY_1;
2740
2741 mspix = cpl_mask_count _(binary->o);
2742 MSG_INFO("Pixels of noise (post-echelle refinement): %d", mspix);
2743 }
2744 if (mspix < 2) return ABORT(CPL_ERROR_DATA_NOT_FOUND, "Cannot estimate "
2745 "spectrum noise with just %d pixels of noise", mspix);
2746
2747
2748 /* Turn the mask into an image */
2749 SET(locnoise, cpl_image) = cpl_image_new_from_mask _(binary->o);
2750 FREE(binary); // not needed anymore: might as well free up some mem
2751
2752 /* Compute the noise for each wavelength */
2753 SET(error, cpl_vector) = cpl_vector_new _(nrow);
2754 for (int r = 0; r < nrow; r++) {
2755
2756 // Grab the next row of the image (remember that the spectra are
2757 // oriented so that a row is roughly equivalent to a wavelength)
2758 SET(imrow, cpl_image) = cpl_image_extract _(flipped, 1, r+1, ncol, r+1);
2759
2760 // Using the mask, which shows the location of noise pixels for every
2761 // row, calculate the details of the noise for this particular row
2762 SET(objs, cpl_apertures) = cpl_apertures_new_from_image _(imrow->o,
2763 locnoise->o);
2764
2765 // We actually just want the standard deviation of the noise pixels for
2766 // this row
2767 double stdev1d = cpl_apertures_get_stdev _(objs->o, 1);
2768
2769 // The noise per pixel is defined as the Standard Deviation on the noise
2770 // (computed from the part of the signal that has no object signal)
2771 // multiplied by the 2-norm of the noise-thresholded spatial weights
2772 double npp = weight_2norm * stdev1d;
2773
2774 // For this row, the noise per pixel is set in the error vector (remember
2775 // that nrow is the number of pixels in the wavelength direction)
2776 cpl_vector_set _(error->o, r, npp);
2777 }
2778
2779 /* Calculate some QC parameters from the image */
2780 fit_gaussians _(flipped, error->o, ifwhm - 20, ifwhm + 20, qclist);
2781
2782 /* Spectrum noise computation done:
2783 * "error" contains the error value per row (i.e. per wavelength) */
2784
2785
2786 /* Iterate through the spatial dimension - sum up the weighted columns
2787 * to create the output spectrum. */
2788 cpl_vector * spectrum = NULL;
2789 cpl_vector * divisor = NULL;
2790 for (int c = 1; c <= ncol; c++) {
2791 // Grab the column out of the image
2792 SET(ntor, cpl_vector) = cpl_vector_new_from_image_column _(flipped, c);
2793 SET(dtor, cpl_vector) = NULL; // denominator
2794
2795 // multiply col by its iweight (same size as spatial dim)
2796 const double weight = cpl_image_get _(iweight->o, c, 1, &rejected);
2797 if (rejected) return ABORT(CPL_ERROR_DATA_NOT_FOUND);
2798 // The sigma-clipping may cause many columns to be zero
2799 if (weight == 0) continue;
2800 cpl_vector_multiply_scalar _(ntor->o, weight);
2801
2802 // Keep a (potentially weighted) sum of columns
2803 if (spectrum) {
2804 cpl_vector_add _(spectrum, ntor->o);
2805 } else
2806 spectrum = YANK(ntor, cpl_vector);
2807
2808 if (divisor) {
2809 cpl_vector_add _(divisor, dtor->o);
2810 } else
2811 divisor = YANK(dtor, cpl_vector);
2812 }
2813 if (!spectrum) return ABORT(CPL_ERROR_ILLEGAL_OUTPUT);
2814
2815 if (divisor) { cpl_vector_divide _(spectrum, divisor); }
2816 double min = cpl_vector_get_min _(spectrum);
2817 if (min < 0) MSG_WARN("Extracted spectrum has negative intensity: %g", min);
2818
2819 /* Create 2D-weight map by replicating the 1D-weights over the wavelengths */
2820 *pweight2d = cpl_image_new _(ncol, nrow, CPL_TYPE_DOUBLE);
2821 for (int r=1; r <= nrow; r++) {
2822 cpl_image_copy _(*pweight2d, iweight->o, 1, r); }
2823 if (cfg->plot > 0)
2824 visir_image_plot("", "t 'The weight map'", "", *pweight2d);
2825
2826 RESET(rv) = cpl_bivector_wrap_vectors _(spectrum, error->o);
2827 error->o = NULL; //same effect as: YANK(error, cpl_vector);
2828 if (cfg->plot > 2)
2829 visir_bivector_plot("", "t 'error versus spectrum'", "", rv->o);
2830
2831 return CLEANUP();
2832}
2833
2834/*----------------------------------------------------------------------------*/
2856/*----------------------------------------------------------------------------*/
2857static cpl_error_code visir_spectro_fill(cpl_vector * self,
2858 const cpl_polynomial * disp,
2859 irplib_base_spectrum_model * model)
2860{
2861
2862 visir_spectrum_model * mymodel = (visir_spectrum_model*)model;
2863 const cpl_size npix = cpl_vector_get_size(self);
2864
2865 cpl_ensure_code(self, CPL_ERROR_NULL_INPUT);
2866 cpl_ensure_code(model, CPL_ERROR_NULL_INPUT);
2867 cpl_ensure_code(disp, CPL_ERROR_NULL_INPUT);
2868
2869 cpl_vector * wavelength = cpl_vector_new(npix);
2870 cpl_bivector * emission = cpl_bivector_wrap_vectors(wavelength, self);
2871 cpl_vector * boundary = cpl_vector_new(npix + 1);
2872
2873 /* Compute the wavelengths of the spectrum
2874 according to the physical model */
2875 skip_if (cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
2876 disp, 1, 1));
2877 skip_if (cpl_vector_fill_polynomial(boundary, disp, 0.5, 1));
2878
2879 /* Get the emission at those wavelengths */
2880 skip_if (visir_spc_emission(emission, boundary, mymodel->lines,
2881 mymodel->tqeff, mymodel->vsymm,
2882 mymodel->temp));
2883 end_skip;
2884
2885 cpl_bivector_unwrap_vectors(emission);
2886 cpl_vector_delete(wavelength);
2887 cpl_vector_delete(boundary);
2888
2889 return cpl_error_get_code();
2890}
2891
2892
2893
2894/*----------------------------------------------------------------------------*/
2909/*----------------------------------------------------------------------------*/
2910static cpl_error_code visir_spectro_refine(cpl_polynomial * self,
2911 const cpl_vector * xc_vector,
2912 visir_spectrum_model * pmymodel,
2913 const cpl_polynomial * phdisp,
2914 int hsize, cpl_boolean doplot,
2915 visir_spc_resol resol,
2916 double * pxc,
2917 cpl_boolean * pdidshift,
2918 double * pdelta)
2919{
2920 const int subres = VISIR_XC_SUBSEARCH;
2921 cpl_polynomial * shifted = NULL;
2922#ifdef VISIR_SPC_CAL_HIGH
2923 const int fitdeg = 2;
2924 double pixstep = 0.5;
2925 double pixtol = 1e-5;
2926 const int maxite = fitdeg * 200;
2927 int maxfail = 3;
2928 int maxcont = 3;
2929 const int clines = (int)(cpl_bivector_get_size(pmymodel->lines) *
2930 cpl_vector_get_size(xc_vector));
2931 cpl_errorstate prestate = cpl_errorstate_get();
2932#endif
2933
2934 cpl_ensure_code(self, CPL_ERROR_NULL_INPUT);
2935 cpl_ensure_code(xc_vector, CPL_ERROR_NULL_INPUT);
2936 cpl_ensure_code(pmymodel, CPL_ERROR_NULL_INPUT);
2937 cpl_ensure_code(phdisp, CPL_ERROR_NULL_INPUT);
2938 cpl_ensure_code(pxc, CPL_ERROR_NULL_INPUT);
2939 cpl_ensure_code(pdidshift, CPL_ERROR_NULL_INPUT);
2940 cpl_ensure_code(pdelta, CPL_ERROR_NULL_INPUT);
2941
2942 skip_if(cpl_polynomial_copy(self, phdisp));
2943
2944#ifdef VISIR_SPC_CAL_HIGH
2945 if (irplib_polynomial_find_1d_from_correlation_all
2946 (self, fitdeg, xc_vector, 1, clines,
2947 (irplib_base_spectrum_model*)pmymodel,
2948 visir_spectro_fill, pixtol, pixstep,
2949 hsize, maxite, maxfail, maxcont, doplot, pxc) || *pxc <= 0.0) {
2950
2951 irplib_error_recover(prestate, "Could not optimize %d "
2952 "coefficients, trying shifting", fitdeg);
2953 skip_if(cpl_polynomial_copy(self, phdisp));
2954
2955 skip_if(visir_polynomial_shift_1d_from_correlation
2956 (self, xc_vector, (irplib_base_spectrum_model*) pmymodel,
2957 visir_spectro_fill, hsize, subres, doplot, pxc, pdelta));
2958 *pdidshift = CPL_TRUE;
2959
2960 /* Retry optimization */
2961 shifted = cpl_polynomial_duplicate(self);
2962
2963 if (irplib_polynomial_find_1d_from_correlation_all
2964 (self, fitdeg, xc_vector, 1, clines,
2965 (irplib_base_spectrum_model*)pmymodel,
2966 visir_spectro_fill, pixtol, pixstep,
2967 hsize, maxite, maxfail, maxcont, doplot, pxc) || *pxc <= 0.0) {
2968
2969 irplib_error_recover(prestate, "Could not re-optimize %d "
2970 "coefficients, keeping shifted", fitdeg);
2971 skip_if(cpl_polynomial_copy(self, shifted));
2972 }
2973 }
2974
2975#else
2976 cpl_size clow = 0, chigh = 0;
2977 /* skip highly nonlinear areas */
2978 if (resol == VISIR_SPC_R_LRP) {
2979 clow = 155;
2980 chigh = 155;
2981 }
2982 cpl_vector * xc_vector_cut = cpl_vector_extract(xc_vector, clow,
2983 cpl_vector_get_size(xc_vector)
2984 - chigh - 1, 1);
2985 cpl_polynomial_shift_1d(self, 0, clow);
2986 skip_if(visir_polynomial_shift_1d_from_correlation
2987 (self, xc_vector_cut, (irplib_base_spectrum_model*) pmymodel,
2988 visir_spectro_fill, hsize, subres, doplot, pxc, pdelta));
2989 cpl_polynomial_shift_1d(self, 0, -clow);
2990 cpl_vector_delete(xc_vector_cut);
2991 *pdidshift = CPL_TRUE;
2992#endif
2993
2994 error_if (*pxc <= 0.0, CPL_ERROR_DATA_NOT_FOUND, "Atmospheric and Model "
2995 "Spectra have non-positive cross-correlation (%g pixel shift): "
2996 "%g", *pdelta, *pxc);
2997
2998 end_skip;
2999
3000 cpl_polynomial_delete(shifted);
3001
3002 return cpl_error_get_code();
3003
3004}
3005
3006/*----------------------------------------------------------------------------*/
3029/*----------------------------------------------------------------------------*/
3030static cpl_error_code
3031visir_polynomial_shift_1d_from_correlation(cpl_polynomial * self,
3032 const cpl_vector * obs,
3033 irplib_base_spectrum_model * model,
3034 cpl_error_code (*filler)
3035 (cpl_vector *,
3036 const cpl_polynomial *,
3037 irplib_base_spectrum_model *),
3038 int hsize,
3039 int subres,
3040 cpl_boolean doplot,
3041 double * pxc, double *pshift)
3042{
3043 const int nobs = cpl_vector_get_size(obs);
3044 cpl_polynomial * cand = NULL;
3045 cpl_bivector * xcplot = NULL;
3046 double * xcplotx = NULL;
3047 double * xcploty = NULL;
3048 cpl_vector * mspec1d = NULL;
3049 cpl_vector * vxc;
3050 double bestxc = -1.0;
3051 double bestdelta = -1.0; /* avoid false unint warning */
3052 int bestxxc = -1; /* avoid false unint warning */
3053 int i;
3054
3055 cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
3056 cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
3057 cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
3058 cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
3059 cpl_ensure_code(subres > 0, CPL_ERROR_ILLEGAL_INPUT);
3060 cpl_ensure_code(hsize > 0, CPL_ERROR_ILLEGAL_INPUT);
3061
3062 cand = cpl_polynomial_new(1);
3063 mspec1d = cpl_vector_new(2 * hsize + nobs);
3064 vxc = cpl_vector_new(2 * hsize + 1);
3065 if (doplot) {
3066 xcplot = cpl_bivector_new(subres * (2 * hsize + 1));
3067 xcplotx = cpl_bivector_get_x_data(xcplot);
3068 xcploty = cpl_bivector_get_y_data(xcplot);
3069 }
3070
3071 /* subdelta search is in the range [0; 1[ */
3072 for (i = 0; i < subres; i++) {
3073 const double delta = i / (double)subres;
3074 double xc;
3075 int ixc;
3076
3077 bug_if (cpl_polynomial_copy(cand, self));
3078 bug_if (cpl_polynomial_shift_1d(cand, 0, delta - hsize));
3079
3080 skip_if (filler(mspec1d, cand, model));
3081
3082 ixc = cpl_vector_correlate(vxc, mspec1d, obs);
3083 xc = cpl_vector_get(vxc, ixc);
3084
3085 if (xc > bestxc) {
3086 bestxc = xc;
3087 bestxxc = ixc - hsize;
3088 bestdelta = delta + bestxxc;
3089 cpl_msg_debug(cpl_func, "Shifting %g = %d + %g pixels (XC=%g)",
3090 bestdelta, bestxxc, delta, bestxc);
3091 }
3092 if (doplot) {
3093 int j;
3094 for (j = 0; j <= 2 * hsize; j++) {
3095 const double xcj = cpl_vector_get(vxc, j);
3096 xcplotx[i + j * subres] = (double)(j - hsize) + delta;
3097 xcploty[i + j * subres] = xcj;
3098 }
3099 }
3100 }
3101
3102#ifdef IRPLIB_SPC_DUMP
3103 /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
3104 irplib_polynomial_dump_corr_step(self, vxc, "Shift");
3105#endif
3106
3107 skip_if(cpl_polynomial_shift_1d(self, 0, bestdelta));
3108
3109 /* Verify correctness of shift, at hsize = 0 */
3110 cpl_vector_set_size(vxc, 1);
3111 cpl_vector_set_size(mspec1d, nobs);
3112 skip_if (filler(mspec1d, self, model));
3113 bug_if(cpl_vector_correlate(vxc, mspec1d, obs));
3114
3115 if (doplot) {
3116 char * title = cpl_sprintf("t 'Cross-correlation of %d-pixel spectrum "
3117 "(max=%.4g at %g pixel)' w points", nobs,
3118 cpl_vector_get(vxc, 0), bestdelta);
3119
3120 cpl_plot_bivector("set grid;set xlabel 'Offset [pixel]';set ylabel "
3121 "'Cross-correlation';", title, "", xcplot);
3122 cpl_free(title);
3123
3124 irplib_plot_spectrum_and_model(obs, self, model, filler);
3125 }
3126
3127 cpl_msg_info(cpl_func, "Shifting %g = %d + %g pixels (XC: %g <=> %g)",
3128 bestdelta, bestxxc, bestdelta - (double)bestxxc,
3129 cpl_vector_get(vxc, 0), bestxc);
3130
3131 if (pxc != NULL) *pxc = cpl_vector_get(vxc, 0);
3132 if (pshift != NULL) *pshift = bestdelta;
3133
3134 end_skip;
3135
3136 cpl_vector_delete(mspec1d);
3137 cpl_polynomial_delete(cand);
3138 cpl_vector_delete(vxc);
3139 cpl_bivector_delete(xcplot);
3140
3141 return cpl_error_get_code();
3142
3143}
3144
3145/*----------------------------------------------------------------------------*/
3150/*----------------------------------------------------------------------------*/
3151static cpl_polynomial * visir_spc_phys_lrp(void)
3152{
3153 const double xval[] = {161, 307, 336, 449, 491, 518, 623, 760, 795, 839};
3154 const double yval[] = {8.22e-6, 9.50e-06, 9.660e-06, 10.5e-06, 10.82e-6,
3155 11.e-06, 11.7e-06, 12.54e-06, 12.76e-06,
3156 13.02e-06 };
3157
3158 const cpl_size maxdeg1d = 2; /* The polynomial degree */
3159
3160 cpl_polynomial * self = cpl_polynomial_new(1);
3161 const cpl_boolean sampsym = CPL_FALSE;
3162 const size_t nvals = sizeof(xval)/sizeof(*xval);
3163
3164 IRPLIB_DIAG_PRAGMA_PUSH_IGN(-Wcast-qual)
3165 cpl_matrix * xmatrix = cpl_matrix_wrap(1, nvals, (double*)xval);
3166 cpl_vector * yvector = cpl_vector_wrap(nvals, (double*)yval);
3167 IRPLIB_DIAG_PRAGMA_POP;
3168 cpl_vector * fitres = cpl_vector_new(nvals);
3169
3170 const cpl_error_code error = cpl_polynomial_fit(self, xmatrix, &sampsym,
3171 yvector, NULL,
3172 CPL_FALSE, NULL, &maxdeg1d)
3173 || cpl_vector_fill_polynomial_fit_residual(fitres, yvector, NULL, self,
3174 xmatrix, NULL);
3175
3176 const double mse = cpl_vector_product(fitres, fitres) / (double)nvals;
3177
3178 (void)cpl_matrix_unwrap(xmatrix);
3179 (void)cpl_vector_unwrap(yvector);
3180 cpl_vector_delete(fitres);
3181
3182 if (error) {
3183 cpl_error_set_where(cpl_func);
3184 cpl_polynomial_delete(self);
3185 self = NULL;
3186 } else {
3187 cpl_msg_info(cpl_func, "Fitted %d degree 1D-polynomial to %u "
3188 "wavelengths with a root mean square error [m]: %g",
3189 (int)maxdeg1d, (unsigned)nvals, sqrt(mse));
3190 }
3191
3192 return self;
3193}
3194
3195/*----------------------------------------------------------------------------*/
3202/*----------------------------------------------------------------------------*/
3203static double visir_spc_get_dispersion(const cpl_polynomial * self, double xval)
3204{
3205
3206 cpl_errorstate prestate = cpl_errorstate_get();
3207 double disp;
3208
3209 (void)cpl_polynomial_eval_1d(self, xval, &disp);
3210
3211 if (!cpl_errorstate_is_equal(prestate)) {
3212 (void)cpl_error_set_where(cpl_func);
3213 }
3214
3215 return disp;
3216}
char * visir_apdefs_dump(const visir_apdefs *ap)
Convert an aperture definition into its string representation.
int visir_parameterlist_get_int(const cpl_parameterlist *self, const char *recipe, visir_parameter bitmask)
Retrieve the value of a VISIR integer parameter.
double visir_pfits_get_temp(const cpl_propertylist *self)
The telescope (M1) temperature [Celcius].
Definition: visir_pfits.c:835
double visir_pfits_get_slitwidth(const cpl_propertylist *self)
The slit width in Arcseconds.
Definition: visir_pfits.c:754
double visir_pfits_get_pixscale(const cpl_propertylist *self)
The pixel scale.
Definition: visir_pfits.c:711
double visir_pfits_get_pixspace(const cpl_propertylist *self)
The pixel spacing.
Definition: visir_pfits.c:727
double visir_pfits_get_wlen(const cpl_propertylist *self)
The central wavelength.
Definition: visir_pfits.c:895
const char * visir_pfits_get_resol(const cpl_propertylist *self)
The spectral resolution.
Definition: visir_pfits.c:820