IIINSTRUMENT Pipeline Reference Manual 4.6.2
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#include "visir_spectro.h"
41#include "visir_utils.h"
42#include "visir_pfits.h"
43#include "visir_inputs.h"
44#include "visir_parameter.h"
45#include "visir_spc_distortion.h"
46
47#include <cpl.h>
48
49#include <string.h>
50#include <math.h>
51#include <float.h>
52#include <assert.h>
53#include <stdbool.h>
54
55#include <gsl/gsl_fit.h>
56
57/*-----------------------------------------------------------------------------
58 Defines
59 -----------------------------------------------------------------------------*/
60
61#define skip_if_error_present() skip_if(0)
62
63#define MSG_WARN(...) cpl_msg_warning(cpl_func, __VA_ARGS__)
64#define MSG_INFO(...) cpl_msg_info(cpl_func, __VA_ARGS__)
65#define MSG_ERR(...) cpl_msg_error(cpl_func, __VA_ARGS__)
66#define MSG_DBG(...) cpl_msg_debug(cpl_func, __VA_ARGS__)
67
68/*----------------------------------------------------------------------------*/
74/*----------------------------------------------------------------------------*/
75
76/*-----------------------------------------------------------------------------
77 Private structs
78 -----------------------------------------------------------------------------*/
79
80typedef struct {
81 cpl_size cost; /* May be incremented for cost counting */
82 cpl_size xcost; /* Ditto (can exclude failed fills) */
83 cpl_size ulines; /* May be set to number of lines used */
84
85 double temp; /* Temperature of dominant black-body (M1) */
86 const cpl_vector * vsymm; /* Symmetric convolution vector from slit
87 width, FWHM of transfer function and
88 truncation width */
89
90 const cpl_bivector * lines; /* Sky spectrum, with
91 increasing X-vector elements */
92 const cpl_bivector * tqeff; /* Spectrum of detector quantum efficiency with
93 increasing X-vector elements */
94} visir_spectrum_model;
95
96typedef cpl_bivector * (extract_func)(cpl_image *, int, int, cpl_propertylist *,
97 cpl_image **, const visir_spc_config *,
98 const visir_apdefs *, const bool,
99 const cpl_size);
100/*-----------------------------------------------------------------------------
101 Private Function Prototypes
102 -----------------------------------------------------------------------------*/
103
104
105static cpl_error_code
106visir_polynomial_shift_1d_from_correlation(cpl_polynomial *,
107 const cpl_vector *,
108 irplib_base_spectrum_model *,
109 cpl_error_code (*)
110 (cpl_vector *,
111 const cpl_polynomial *,
112 irplib_base_spectrum_model *),
113 int, int, cpl_boolean,
114 double *, double *);
115
116static cpl_error_code visir_spectro_refine(cpl_polynomial *,
117 const cpl_vector *,
118 visir_spectrum_model *,
119 const cpl_polynomial *,
120 int, cpl_boolean, visir_spc_resol,
121 double *, cpl_boolean *, double *);
122
123static cpl_error_code visir_spectro_fill(cpl_vector *, const cpl_polynomial *,
124 irplib_base_spectrum_model *);
125
126static extract_func visir_spc_oldex;
127static extract_func visir_spc_newex;
128static extract_func visir_spc_extract;
129
130static cpl_error_code visir_spc_emission(cpl_bivector *, const cpl_vector *,
131 const cpl_bivector *,
132 const cpl_bivector *,
133 const cpl_vector *, double);
134
135static cpl_polynomial * visir_spc_phys_disp(int, double, visir_spc_resol, int,
136 int);
137static cpl_polynomial * visir_spc_phys_lrp(void);
138static double visir_spc_get_dispersion(const cpl_polynomial *, double);
139static cpl_error_code visir_vector_convolve_symm(cpl_vector *,
140 const cpl_vector *);
141static cpl_vector * cpl_spc_convolve_init(int, double, double, int);
142
143static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist *,
144 int, double,
145 cpl_boolean, double,
146 const cpl_polynomial *,
147 const cpl_polynomial *);
148
149static void * visir_spectro_qclist_obs(cpl_propertylist *, double, double);
150
151static const double N_upper = 13.4e-6; /* Upper limit of N-band */
152static const double whechelle = 35.8/2; /* Half the echelle width */
153
154#ifndef VISIR_XC_LEN
155#define VISIR_XC_LEN 50
156#endif
157#ifndef VISIR_XC_SUBSEARCH
158#define VISIR_XC_SUBSEARCH 100
159#endif
160
161#ifndef VISIR_SPECTRO_SIGMA
162#define VISIR_SPECTRO_SIGMA 3.0
163#endif
164
167/*-----------------------------------------------------------------------------
168 Function code
169 -----------------------------------------------------------------------------*/
170
171/*----------------------------------------------------------------------------*/
178/*----------------------------------------------------------------------------*/
179static const char * pn(const int oo)
180{
181 static char buf[80]; // FIXME: don't use static vars
182 const char * sign = oo ? (oo > 0 ? "+" : "-") : "";
183 snprintf(buf, sizeof(buf), "%s%d", sign, abs(oo));
184 return buf;
185}
186
187cpl_error_code visir_spc_extract_order(cpl_image ** order,
188 cpl_image ** comorder,
189 int * lcol, int * rcol,
190 const cpl_image * combined,
191 const cpl_image * imhcycle,
192 const double wlen,
193 const visir_spc_config * cfg,
194 const cpl_boolean do_ech,
195 const int is_aqu)
196{
197 int icol1, icol2;
198 int jcol1, jcol2;
199
200 jcol1 = visir_parameterlist_get_int(cfg->parlist, cfg->recipename,
201 VISIR_PARAM_REJLEFT);
202 jcol2 = visir_parameterlist_get_int(cfg->parlist, cfg->recipename,
203 VISIR_PARAM_REJRIGHT);
204
205
206 cpl_msg_debug(cpl_func, "extracting order, wlen=%f, do_ech=%d, jcol1=%d, "
207 "jcol2=%d", wlen, do_ech, jcol1, jcol2);
208
209 if (do_ech) {
210 skip_if (visir_spc_echelle_limit(&icol1, &icol2, wlen, cfg, 1,
211 cpl_image_get_size_y(combined),
212 is_aqu));
213 } else {
214 icol1 = 1;
215 icol2 = cpl_image_get_size_x(imhcycle);
216 }
217
218 if (do_ech) {
219 if (jcol1 != 0) {
220 cpl_msg_info(cpl_func, "Ignoring %d leftmost columns from %d to %d",
221 jcol1, icol1, icol1 + jcol1);
222 icol1 += jcol1;
223 }
224 if (jcol2 != 0) {
225 cpl_msg_info(cpl_func, "Ignoring %d rightmost columns from %d to %d",
226 jcol2, icol2 - jcol2, icol2);
227 icol2 -= jcol2;
228 }
229 } else {
230 if (jcol1 != 0) {
231 cpl_msg_info(cpl_func, "Ignoring %d leftmost columns", jcol1);
232 icol1 += jcol1;
233 }
234 if (jcol2 != 0) {
235 cpl_msg_info(cpl_func, "Ignoring %d rightmost columns", jcol2);
236 icol2 -= jcol2;
237 }
238 }
239
240 if (icol1 != 1 || icol2 != cpl_image_get_size_x(imhcycle)) {
241 *order = visir_spc_column_extract(imhcycle, icol1, icol2, cfg->plot);
242 skip_if_error_present();
243
244 *comorder = visir_spc_column_extract(combined, icol1, icol2, cfg->plot);
245 skip_if_error_present();
246
247 } else {
248 *order = cpl_image_duplicate(imhcycle);
249 *comorder = cpl_image_duplicate(combined);
250 }
251
252 *lcol = icol1;
253 *rcol = icol2;
254
255 end_skip;
256
257 return cpl_error_get_code();
258}
259
260/*----------------------------------------------------------------------------*/
276/*----------------------------------------------------------------------------*/
277visir_spc_resol visir_spc_get_res_wl(const irplib_framelist * rawframes,
278 double * pwlen, double * pslitw,
279 double * ptemp, double * pfwhm,
280 int is_aqu)
281{
282 cpl_errorstate cleanstate = cpl_errorstate_get();
283 /* Avoid (false) uninit warning */
284 visir_spc_resol resol = VISIR_SPC_R_ERR;
285 char ptmp[IRPLIB_FITS_STRLEN+1];
286 double wl, spx, pfov = 0.127; /* Avoid (false) uninit warning */
287 double sl = 0.0; /* Avoid (false) uninit warning */
288 cpl_boolean need_temp = ptemp != NULL;
289 int n;
290
291 /* Check entries */
292 cpl_ensure(rawframes != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
293 cpl_ensure(pwlen != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
294 cpl_ensure(pslitw != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
295 cpl_ensure(pfwhm != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
296
297 n = irplib_framelist_get_size(rawframes);
298
299 cpl_ensure(n > 0, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);
300
301 /* Allow 1 micron difference */
302 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_PIXSPACE,
303 CPL_TYPE_DOUBLE, CPL_TRUE, 1e-6));
304
305 /* The actual value depends on the age of the file :-( */
306 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_SLITWIDTH,
307 CPL_TYPE_DOUBLE, CPL_FALSE, 0.0));
308
309 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_RESOL,
310 CPL_TYPE_STRING, CPL_TRUE, 0.0));
311
312 skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_SLITNAME,
313 CPL_TYPE_STRING, CPL_TRUE, 0.0));
314
315 for (int i = 0; i < n; i++) {
316 const cpl_propertylist * plist;
317 const char * filename =
318 cpl_frame_get_filename(irplib_framelist_get_const(rawframes, i));
319 const char * pfits;
320 double wl_tmp, sl_tmp, spx_tmp, pfov_tmp;
321
322
323 cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
324 VISIR_SPC_R_ERR);
325
326 cpl_ensure(filename != NULL, CPL_ERROR_DATA_NOT_FOUND,
327 VISIR_SPC_R_ERR);
328
329 plist = irplib_framelist_get_propertylist_const(rawframes, i);
330
331 cpl_ensure(plist != NULL, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);
332
333 wl_tmp = visir_pfits_get_wlen(plist);
334 if (wl_tmp <= 0.0 || !cpl_errorstate_is_equal(cleanstate)) {
335 irplib_error_recover(cleanstate, "Missing or invalid FITS card");
336 wl_tmp = VISIR_SPC_LRP_CWLEN;
337 }
338 pfits = visir_pfits_get_resol(plist);
339 if (pfits == NULL || !cpl_errorstate_is_equal(cleanstate)) {
340 irplib_error_recover(cleanstate, "Missing or invalid FITS card");
341 pfits = VISIR_SPC_LRP_NAME;
342 }
343 sl_tmp = visir_pfits_get_slitwidth(plist);
344 spx_tmp = visir_pfits_get_pixspace(plist);
345
346 /* FIXME: catch error 0.127, NULL, 0.127, ... */
347 {
348 pfov_tmp = visir_pfits_get_pixscale(plist);
349 if (pfov_tmp <= 0.) {
350 cpl_errorstate_set(cleanstate);
351 cpl_msg_warning(cpl_func, VISIR_PFITS_STRING_PIXSCALE
352 " not set, falling back to 0.127");
353 pfov_tmp = 0.127;
354 }
355 }
356
357 cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
358 VISIR_SPC_R_ERR);
359
360 if (i == 0) {
361
362 visir_optmod ins_settings;
363
364 sl = sl_tmp;
365 spx = spx_tmp;
366 wl = wl_tmp;
367 pfov = pfov_tmp;
368
369 /* Divide the slit width with the
370 Spectral PFOV = 0.127 Arcseconds/pixel */
371 *pslitw = sl / pfov; /* Convert Slit width from Arcseconds to pixel */
372
373 *pwlen = wl * 1e-6; /* Convert from micron to m */
374
375 strncpy(ptmp, pfits, IRPLIB_FITS_STRLEN);
376 ptmp[IRPLIB_FITS_STRLEN] = '\0';
377
378 cpl_msg_info(cpl_func, "RESOL [" VISIR_SPC_LRP_NAME "|LR|MR|HRS|HRG]"
379 " and WLEN [m] (%d frames): %s %g", n, ptmp, *pwlen);
380
381 if (spx <= 0) {
382 cpl_msg_error(cpl_func,"Pixel Spacing (%g) in %s is non-"
383 "positive", spx, filename);
384 cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
385 }
386
387 if (*pslitw <= 0) {
388 cpl_msg_error(cpl_func,"Slit Width (%g) in %s is non-positive",
389 sl, filename);
390 cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
391 }
392
393 cpl_msg_info(cpl_func, "Slit Width [pixel] and Pixel Spacing [m]: "
394 "%g %g", *pslitw, spx);
395
396 if (!strcmp(VISIR_SPC_LRP_NAME, ptmp)) {
397 resol = VISIR_SPC_R_LRP;
398 } else if (!strcmp("LR", ptmp)) {
399 resol = VISIR_SPC_R_LR;
400 } else if (!strcmp("MR", ptmp)) {
401 resol = VISIR_SPC_R_MR;
402 } else if (!strcmp("HRS", ptmp)) {
403 resol = VISIR_SPC_R_HR;
404 } else if (!strcmp("HRG", ptmp)) {
405 resol = VISIR_SPC_R_GHR;
406 } else {
407 cpl_msg_error(cpl_func,"Unsupported resolution (%s) in %s",
408 ptmp, filename);
409 cpl_ensure(0, CPL_ERROR_UNSUPPORTED_MODE, VISIR_SPC_R_ERR);
410 }
411
412 if (resol != VISIR_SPC_R_LRP) {
413 /* Allow 1 nm difference */
414 skip_if(irplib_framelist_contains(rawframes,
415 VISIR_PFITS_DOUBLE_WLEN,
416 CPL_TYPE_DOUBLE, CPL_TRUE,
417 1e-3));
418 }
419
420 if (visir_spc_optmod_init(resol, *pwlen, &ins_settings, is_aqu)) {
421 cpl_msg_error(cpl_func, "Resolution %s does not support "
422 "Central Wavelength [m]: %g", ptmp, *pwlen);
423 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
424 }
425
426 cpl_msg_info(cpl_func, "The %s-Spectral Resolution at %gm: %g",
427 ptmp, *pwlen,
428 visir_spc_optmod_resolution(&ins_settings));
429 cpl_msg_info(cpl_func, "The %s-Linear Dispersion at %gm [pixel/m]: "
430 "%g", ptmp, *pwlen,
431 visir_spc_optmod_dispersion(&ins_settings));
432
433 *pfwhm = *pwlen * visir_spc_optmod_dispersion(&ins_settings)
434 / visir_spc_optmod_resolution(&ins_settings);
435
436 cpl_msg_info(cpl_func, "The %s-FWHM at %gm [pixel]: %g",
437 ptmp, *pwlen, *pfwhm);
438 } else {
439 if (fabs(sl-sl_tmp) > 1e-3) { /* Allow 1 micron difference */
440 cpl_msg_error(cpl_func, "Inconsistent slit width (%g <=>"
441 " %g) in %s (%d of %d)",
442 sl, sl_tmp, filename, i+1, n);
443 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
444 }
445 if (fabs(pfov-pfov_tmp) > 1e-4) { /* Allow 1 micron difference */
446 cpl_msg_error(cpl_func, "Inconsistent pfov (%g <=>"
447 " %g) in %s (%d of %d)",
448 pfov, pfov_tmp, filename, i+1, n);
449 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
450 }
451 }
452 if (need_temp) {
453 /* Temperature [Celcius] not yet found */
454 const double temp = visir_pfits_get_temp(plist);
455 if (cpl_error_get_code()) {
456 visir_error_reset("Could not get FITS key");
457 } else if ((-20 < temp) && (temp < 60)) {
458 /* Only accept a non-extreme temperature */
459 need_temp = CPL_FALSE;
460 *ptemp = temp;
461 }
462 }
463
464 }
465
466 if (need_temp) {
467 cpl_msg_warning(cpl_func, "No FITS-files specify the M1 temperature, "
468 "using default");
469 *ptemp = 10; /* Default is 10 Celcius */
470 }
471
472
473 if (ptemp != NULL) {
474 *ptemp += 273.15; /* Convert to Kelvin */
475 cpl_msg_info(cpl_func, "The M1 temperature [Kelvin]: %g", *ptemp);
476 }
477
478 end_skip;
479
480 return resol;
481
482}
483
484/*----------------------------------------------------------------------------*/
505/*----------------------------------------------------------------------------*/
506cpl_error_code visir_vector_resample(cpl_vector * self,
507 const cpl_vector * xbounds,
508 const cpl_bivector * source)
509{
510
511 const cpl_vector * xsource = cpl_bivector_get_x_const(source);
512 const cpl_vector * ysource = cpl_bivector_get_y_const(source);
513
514 const double * pxsource = cpl_vector_get_data_const(xsource);
515 const double * pysource = cpl_vector_get_data_const(ysource);
516 const double * pxbounds = cpl_vector_get_data_const(xbounds);
517
518
519 cpl_vector * ybounds = cpl_vector_new(cpl_vector_get_size(xbounds));
520 IRPLIB_DIAG_PRAGMA_PUSH_IGN(-Wcast-qual)
521 cpl_bivector * boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,
522 ybounds);
523 IRPLIB_DIAG_PRAGMA_POP
524 double * pybounds = cpl_vector_get_data(ybounds);
525
526 double * pself = cpl_vector_get_data(self);
527 const int npix = cpl_vector_get_size(self);
528 int i;
529 int itt;
530
531
532 cpl_ensure_code(cpl_bivector_get_size(boundary) == npix + 1,
533 CPL_ERROR_ILLEGAL_INPUT);
534
535 skip_if_error_present();
536
537 itt = cpl_vector_find(xsource, pxbounds[0]);
538
539 skip_if_error_present();
540
541 skip_if (cpl_bivector_interpolate_linear(boundary, source));
542
543 /* At this point itt most likely points to element just below
544 pxbounds[0] */
545 while (pxsource[itt] < pxbounds[0]) itt++;
546
547 for (i=0; i < npix; i++) {
548
549 /* The i'th value is the weighted average of the two interpolated
550 values at the boundaries and the source values in between */
551
552 double xlow = pxbounds[i];
553 double x = pxsource[itt];
554
555 if (x > pxbounds[i+1]) x = pxbounds[i+1];
556 /* Contribution from interpolated value at lower boundary */
557 pself[i] = pybounds[i] * (x - xlow);
558
559 /* Contribution from table values in between boundaries */
560 while (pxsource[itt] < pxbounds[i+1]) {
561 const double xprev = x;
562 x = pxsource[itt+1];
563 if (x > pxbounds[i+1]) x = pxbounds[i+1];
564 pself[i] += pysource[itt] * (x - xlow);
565 xlow = xprev;
566 itt++;
567 }
568
569 /* Contribution from interpolated value at upper boundary */
570 pself[i] += pybounds[i+1] * (pxbounds[i+1] - xlow);
571
572 /* Compute average by dividing integral by length of sampling interval
573 (the factor 2 comes from the contributions) */
574 pself[i] /= 2 * (pxbounds[i+1] - pxbounds[i]);
575
576 }
577
578
579 end_skip;
580
581 cpl_vector_delete(ybounds);
582 cpl_bivector_unwrap_vectors(boundary);
583
584 return cpl_error_get_code();
585}
586
587
588
589/*----------------------------------------------------------------------------*/
615/*----------------------------------------------------------------------------*/
616void * visir_spc_extract_wcal(const cpl_image * combined,
617 const cpl_image * hcycle,
618 const int lcol, const int rcol,
619 const double wlen, const double slitw,
620 const double temp, const double fwhm,
621 const visir_spc_resol resol,
622 const visir_spc_config * cfg,
623 const char * spc_cal_lines,
624 const char * spc_cal_qeff,
625 const int is_aqu,
626 const visir_apdefs * aps,
627 const cpl_size ncomb, const bool rev,
628 cpl_table ** pspc_table,
629 cpl_image ** pweight2d,
630 cpl_propertylist * qclist)
631{
632 cpl_image* flipped = NULL;
633 cpl_bivector* spc_n_err = NULL;
634 cpl_table* calib = NULL;
635 double * pwlen = NULL;
636 double * pflux = NULL;
637 double * perr = NULL;
638 cpl_array* warr = NULL;
639 cpl_image* flux = NULL;
640 cpl_image* err = NULL;
641 hdrl_spectrum1D* response = NULL;
642 hdrl_spectrum1D* spectrum = NULL;
643
644 const int npix = cpl_image_get_size_y(combined);
645
646 if (!pspc_table) {
647 cpl_error_set(cpl_func, CPL_ERROR_NULL_INPUT);
648 }
649 if (!pweight2d) {
650 cpl_error_set(cpl_func, CPL_ERROR_NULL_INPUT);
651 }
652
653 skip_if (0);
654
655 *pweight2d = NULL;
656
657 if (npix < 1) {
658 cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);
659 } else if (npix != cpl_image_get_size_y(hcycle)) {
660 cpl_msg_error(cpl_func,
661 "Sky frame does not have same size as the "
662 "object frame. %d vs %d pixels",
663 (int)cpl_image_get_size_y(hcycle), npix);
664 cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);
665 }
666
667 skip_if (0);
668
669 /* Determine the wavelength solution from the atmospheric lines */
670 visir_spc_wavecal(hcycle, qclist, wlen, slitw, temp, fwhm, resol,
671 cfg, spc_cal_lines, spc_cal_qeff, pspc_table,
672 is_aqu);
673
674 skip_if (0);
675
676 /* Convert the combined image */
677 flipped = cpl_image_cast(combined, CPL_TYPE_DOUBLE);
678
679 skip_if (0);
680
681 /* Extract spectrum with error from the combined image */
682 /* FIXME: Move inside */
683 spc_n_err = visir_spc_extract(
684 flipped, lcol, rcol, qclist, pweight2d, cfg, aps, rev, ncomb);
685 cpl_image_delete(flipped); flipped = NULL;
686
687 skip_if (0);
688
689 /* apply the response calibration (if any) to eliminate fringing */
690 if (visir_str_par_is_empty(cfg->respcal)) {
691 cpl_table_new_column(*pspc_table, "SPC_EXTRACTED", CPL_TYPE_DOUBLE);
692 cpl_table_new_column(*pspc_table, "SPC_ERROR", CPL_TYPE_DOUBLE);
693
694 cpl_table_copy_data_double(*pspc_table, "SPC_EXTRACTED",
695 cpl_bivector_get_x_data(spc_n_err));
696 cpl_table_copy_data_double(*pspc_table, "SPC_ERROR",
697 cpl_bivector_get_y_data(spc_n_err));
698 } else {
699 MSG_INFO("Applying response calibration...");
700
701 // create hdrl_spectrum1D from response calibration
702 calib = cpl_table_load(cfg->respcal, 1, 0);
703 cpl_size nrows = cpl_table_get_nrow(calib);
704 pwlen = cpl_table_get_data_double(calib, "WLEN");
705 pflux = cpl_table_get_data_double(calib, "FLUX");
706
707 skip_if (0);
708
709 perr = cpl_table_get_data_double(calib, "ERR");
710 if (cpl_error_get_code()) {
711 cpl_msg_warning(cpl_func, "ERR column missing from %s, "
712 "continuing with zero error", cfg->respcal);
713 cpl_error_reset();
714 perr = NULL;
715 }
716
717 warr = cpl_array_wrap_double(pwlen, nrows);
718 cpl_array_multiply_scalar(warr, 1e-6); // convert to meters
719 cpl_image* flux = cpl_image_wrap_double(nrows, 1, pflux);
720 cpl_image* err = (!perr ? NULL : cpl_image_wrap_double(
721 nrows, 1, perr));
722
723 skip_if (0);
724
725 hdrl_spectrum1D* response = hdrl_spectrum1D_create(
726 flux, err, warr, hdrl_spectrum1D_wave_scale_linear);
727
728 cpl_array_unwrap(warr); warr = NULL;
729
730 skip_if (0);
731
732 // create hdrl_spectrum1D from extracted spectrum
733 nrows = cpl_table_get_nrow(*pspc_table);
734 pwlen = cpl_table_get_data_double(*pspc_table, "WLEN");
735 pflux = cpl_bivector_get_x_data(spc_n_err);
736 perr = cpl_bivector_get_y_data(spc_n_err);
737 warr = cpl_array_wrap_double(pwlen, nrows);
738 flux = cpl_image_wrap_double(nrows, 1, pflux);
739 err = cpl_image_wrap_double(nrows, 1, perr);
740
741 skip_if (0);
742
743 hdrl_spectrum1D* spectrum = hdrl_spectrum1D_create(
744 flux, err, warr, hdrl_spectrum1D_wave_scale_linear);
745
746 skip_if (0);
747
748 // resample response calib on spectrum wavelengths
749 const hdrl_spectrum1D_wavelength spec_wav =
750 hdrl_spectrum1D_get_wavelength(spectrum);
751 hdrl_parameter* params =
752 hdrl_spectrum1D_resample_interpolate_parameter_create(
753 hdrl_spectrum1D_interp_linear);
754 hdrl_spectrum1D* result = hdrl_spectrum1D_resample(
755 response, &spec_wav, params);
756
757 skip_if (0);
758
759 // divide the spectrum by the resampled response & add results to table
760 hdrl_spectrum1D_div_spectrum(spectrum, result);
761 hdrl_spectrum1D_append_to_table(
762 spectrum, *pspc_table, "SPC_EXTRACTED", NULL, "SPC_ERROR", NULL);
763 }
764
765 skip_if (0);
766
767 cpl_table_set_column_unit(*pspc_table, "SPC_EXTRACTED", "ADU/s");
768 cpl_table_set_column_unit(*pspc_table, "SPC_ERROR", "ADU/s");
769
770 skip_if (0);
771
772 if (cfg->plot) {
773 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
774 "t 'Extracted Spectrum' w linespoints",
775 "", *pspc_table, "WLEN", "SPC_EXTRACTED");
776 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
777 "t 'Error on Extracted Spectrum' w linespoints",
778 "", *pspc_table, "WLEN", "SPC_ERROR");
779 }
780
781 end_skip;
782
783 if (cpl_error_get_code()) {
784 cpl_msg_error(cpl_error_get_where(), "%s", cpl_error_get_message());
785 }
786
787 cpl_image_delete(flipped);
788 cpl_bivector_delete(spc_n_err);
789 cpl_table_delete(calib);
790 cpl_array_unwrap(warr);
791 cpl_image_unwrap(flux);
792 cpl_image_unwrap(err);
793 hdrl_spectrum1D_delete(&response);
794 hdrl_spectrum1D_delete(&spectrum);
795
796 return NULL;
797}
798
799/*----------------------------------------------------------------------------*/
825/*----------------------------------------------------------------------------*/
826cpl_error_code visir_spc_wavecal(const cpl_image * hcycle,
827 cpl_propertylist * qclist,
828 double wlen, double slitw,
829 double temp, double fwhm,
830 visir_spc_resol resol,
831 const visir_spc_config * cfg,
832 const char * linefile,
833 const char * qefffile,
834 cpl_table ** pspc_table,
835 int is_aqu)
836{
837
838 /* Dispersion relation from physical model */
839 cpl_polynomial * phdisp = NULL;
840 /* Dispersion relation corrected by cross-correlation */
841 cpl_polynomial * xcdisp = NULL;
842
843 visir_spectrum_model mymodel;
844 cpl_vector * wlvals = NULL;
845 cpl_vector * spmodel = NULL;
846
847 cpl_bivector * emission = NULL;
848 cpl_vector * boundary = NULL;
849
850 cpl_bivector * temiss = NULL;
851 cpl_bivector * tqeff = NULL;
852
853 cpl_image * corrected = NULL;
854
855 cpl_image * xc_image = NULL;
856 cpl_vector * xc_vector = NULL;
857
858 cpl_vector * vsymm = NULL;
859 cpl_vector * vxc = NULL;
860
861 const int npix = cpl_image_get_size_y(hcycle);
862#if 0
863 double xc0;
864#endif
865 double qcxc = -1.0, qcsubdelta = 0.; /* avoid false unint warning */
866 double hc_min;
867 const cpl_size i0 = 0;
868 const cpl_size i1 = 1;
869 cpl_boolean didshift = CPL_FALSE;
870
871
872 cpl_ensure_code(!cpl_error_get_code(), cpl_error_get_code());
873 cpl_ensure_code(pspc_table, CPL_ERROR_NULL_INPUT);
874 cpl_ensure_code(npix > 0, CPL_ERROR_ILLEGAL_INPUT);
875
876
877 /* Make sure the corrected image is of type double */
878 corrected = cpl_image_cast(hcycle, CPL_TYPE_DOUBLE);
879 skip_if_error_present();
880
881 hc_min = cpl_image_get_min(corrected);
882 skip_if_error_present();
883 cpl_msg_info(cpl_func,"Half-cycle image [%d X %d] has minimum intensity: %g",
884 (int)cpl_image_get_size_x(hcycle), npix, hc_min);
885 if (hc_min < 0) {
886 cpl_msg_warning(cpl_func, "Thresholding negative intensities in half-"
887 "cycle image: %g", hc_min);
888 skip_if (cpl_image_threshold(corrected, 0.0, DBL_MAX, 0.0, DBL_MAX));
889 } else if (hc_min > 0) {
890 skip_if (cpl_image_subtract_scalar(corrected, hc_min));
891 }
892
893 xc_image = cpl_image_duplicate(corrected);
894
895 /* Average the spatial dimension - into a cpl_vector */
896 cpl_image_delete(corrected);
897 corrected = cpl_image_collapse_create(xc_image, 1);
898 cpl_image_delete(xc_image);
899 xc_image = corrected;
900 corrected = NULL;
901
902 skip_if(cpl_image_divide_scalar(xc_image, npix));
903
904 xc_vector = cpl_vector_wrap(npix, cpl_image_get_data(xc_image));
905
906 skip_if_error_present();
907
908#ifdef VISIR_SPC_LRP
909 phdisp = visir_spc_phys_lrp();
910 cpl_msg_info(cpl_func, "Central Dispersion (physical model) [pixel/m]: %g",
911 1.0/visir_spc_get_dispersion(phdisp, npix/2.0 + 0.5));
912 cpl_msg_info(cpl_func, "Central Wavelength (physical model) [m]: %g",
913 cpl_polynomial_eval_1d(phdisp, npix/2.0 + 0.5, NULL));
914 cpl_msg_info(cpl_func, "First Wavelength (physical model) [m]: %g",
915 cpl_polynomial_eval_1d(phdisp, 1.0, NULL));
916 cpl_msg_info(cpl_func, "Last Wavelength (physical model) [m]: %g",
917 cpl_polynomial_eval_1d(phdisp, 1024, NULL));
918 cpl_polynomial_dump(phdisp, stdout);
919 cpl_polynomial_delete(phdisp);
920#endif
921
922 phdisp = visir_spc_phys_disp(npix, wlen, resol, cfg->orderoffset, is_aqu);
923 skip_if_error_present();
924
925 if (cpl_polynomial_get_degree(phdisp) == 2) {
926 const cpl_size i2 = 2;
927 cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
928 " %gmum + ipix * %gmum/pixel + ipix^2 * (%g)mum/pixel^2 "
929 "[ipix = 1, 2, ..., %d]",
930 cpl_polynomial_get_coeff(phdisp, &i0) * 1e6,
931 cpl_polynomial_get_coeff(phdisp, &i1) * 1e6,
932 cpl_polynomial_get_coeff(phdisp, &i2) * 1e6,
933 npix);
934 }
935 else {
936 cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
937 " %gmum + ipix * %gmum/pixel [ipix = 1, 2, ..., %d]",
938 cpl_polynomial_get_coeff(phdisp, &i0) * 1e6,
939 cpl_polynomial_get_coeff(phdisp, &i1) * 1e6, npix);
940 }
941
942 temiss = visir_bivector_load_fits(linefile, "Wavelength", "Emission", 1);
943 any_if ("Could not load file with Emission Lines");
944
945 tqeff = visir_bivector_load_fits(qefffile, "Wavelength", "Efficiency",
946 npix > 256 ? 2 : 1);
947 any_if("Could not load file with Quantum-Efficiencies");
948
949 if (cfg->plot) {
950 visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';", "t '"
951 "Quantum Efficiency' w linespoints", "", tqeff);
952 }
953
954 vsymm = cpl_spc_convolve_init(npix, slitw, fwhm, cfg->plot);
955
956 skip_if (vsymm == NULL);
957
958 vxc = cpl_vector_new(1);
959 xcdisp = cpl_polynomial_new(1);
960
961 mymodel.lines = temiss;
962 mymodel.tqeff = tqeff;
963 mymodel.vsymm = vsymm;
964 mymodel.temp = temp;
965 mymodel.ulines = 0;
966 mymodel.cost = 0;
967 mymodel.xcost = 0;
968
969 skip_if(visir_spectro_refine(xcdisp, xc_vector, &mymodel, phdisp,
970 VISIR_XC_LEN, cfg->plot, resol,
971 &qcxc, &didshift, &qcsubdelta));
972
973 if (didshift) {
974 if (fabs(qcsubdelta) >= VISIR_XC_LEN) {
975 cpl_msg_warning(cpl_func, "Cross-correlation (%g pixel shift): %g",
976 qcsubdelta, qcxc);
977 } else {
978 cpl_msg_info(cpl_func,"Cross-correlation (%g pixel shift): %g",
979 qcsubdelta, qcxc);
980 }
981 }
982
983 cpl_msg_info(cpl_func, "Dispersion polynomial from cross-correlation: "
984 "%gm + ipix * %gm/pixel [ipix = 1, 2, ..., %d]",
985 cpl_polynomial_get_coeff(xcdisp, &i0),
986 cpl_polynomial_get_coeff(xcdisp, &i1), npix);
987
988 cpl_msg_info(cpl_func, "New Central Wavelength [m]: %g",
989 cpl_polynomial_eval_1d(xcdisp, 0.5*npix+0.5, NULL));
990
991 *pspc_table = cpl_table_new(npix);
992 skip_if_error_present();
993
994 /* Generate the new wavelengths based on the cross-correlation shift */
995 wlvals = cpl_vector_new(npix);
996 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(wlvals),
997 "WLEN"));
998
999 skip_if (cpl_vector_fill_polynomial(wlvals, xcdisp, 1.0, 1.0));
1000
1001 /* Dump the unshifted model spectrum to the table */
1002 spmodel = cpl_vector_new(npix);
1003 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
1004 "SPC_MODEL_PH"));
1005 skip_if (visir_spectro_fill(spmodel, phdisp,
1006 (irplib_base_spectrum_model*)&mymodel));
1007
1008 /* - and the wavelength calibrated model spectrum */
1009 (void)cpl_vector_unwrap(spmodel);
1010 spmodel = cpl_vector_new(npix);
1011 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
1012 "SPC_MODEL_XC"));
1013
1014 skip_if (visir_spectro_fill(spmodel, xcdisp,
1015 (irplib_base_spectrum_model*)&mymodel));
1016
1017 bug_if (cpl_table_wrap_double(*pspc_table,
1018 cpl_image_get_data_double(xc_image),
1019 "SPC_SKY"));
1020 (void)cpl_image_unwrap(xc_image);
1021 xc_image = NULL;
1022
1023 /* Get the emissivity (range 0 to 1) for the calibrated wavelengths */
1024 (void)cpl_vector_unwrap(spmodel);
1025 spmodel = cpl_vector_new(npix);
1026 bug_if (cpl_table_wrap_double(*pspc_table, cpl_vector_get_data(spmodel),
1027 "SPC_EMISSIVITY"));
1028
1029 boundary = cpl_vector_new(npix + 1);
1030 skip_if (cpl_vector_fill_polynomial(boundary, xcdisp, 0.5, 1.0));
1031 skip_if (visir_vector_resample(spmodel, boundary, temiss));
1032
1033 bug_if (cpl_table_set_column_unit(*pspc_table, "WLEN", "m"));
1034 bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_PH",
1035 "J*radian/m^3/s"));
1036 bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_XC",
1037 "J*radian/m^3/s"));
1038 bug_if (cpl_table_set_column_unit(*pspc_table, "SPC_SKY", "ADU/s"));
1039
1040 /* If the spectrum goes into N-band the sky spectrum may have variable
1041 atmospheric features, that are not in the model used for the model
1042 spectrum. This can cause the wavelength calibration to yield completely
1043 wrong results */
1044 if (resol != VISIR_SPC_R_LRP && cpl_vector_get(wlvals, 0) < N_upper &&
1045 N_upper < cpl_vector_get(wlvals, npix-1))
1046 cpl_msg_warning(cpl_func, "Spectrum goes above N-band (%gm). Wavelength"
1047 " Calibration may be entirely inaccurate", N_upper);
1048
1049 bug_if(visir_spectro_qclist_wcal(qclist, npix, qcxc, didshift, qcsubdelta,
1050 phdisp, xcdisp));
1051
1052 if (cfg->plot) {
1053 cpl_bivector * plot = cpl_bivector_wrap_vectors(wlvals, xc_vector);
1054
1055 visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';", "t 'Spec"
1056 "trum from Half-cycle' w linespoints", "", plot);
1057 cpl_bivector_unwrap_vectors(plot);
1058
1059 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
1060 "t 'Calibrated Model Spectrum' w linespoints",
1061 "", *pspc_table, "WLEN", "SPC_MODEL_XC");
1062
1063 /* The unshifted model spectrum */
1064 visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
1065 "t 'Physical Model Spectrum' w linespoints",
1066 "", *pspc_table, "WLEN", "SPC_MODEL_PH");
1067
1068 if (resol != VISIR_SPC_R_LRP) {
1069
1070 /* Create an model spectrum of twice the npix length */
1071 emission = cpl_bivector_new(2 * npix);
1072
1073 cpl_vector_delete(boundary);
1074 boundary = cpl_vector_new(2 * npix + 1);
1075
1076 cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
1077 phdisp, -0.5*npix, 1);
1078 cpl_vector_fill_polynomial(boundary, phdisp, -0.5*(npix+1), 1);
1079
1080 /* Get the emission at those wavelengths */
1081 visir_spc_emission(emission, boundary, temiss, tqeff, vsymm, temp);
1082 cpl_vector_delete(boundary);
1083 boundary = NULL;
1084
1085 visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';",
1086 "t 'Extended Model Spectrum' w linespoints",
1087 "", emission);
1088 }
1089 }
1090
1091 end_skip;
1092
1093 (void)cpl_vector_unwrap(wlvals);
1094 (void)cpl_vector_unwrap(spmodel);
1095 cpl_polynomial_delete(phdisp);
1096 cpl_polynomial_delete(xcdisp);
1097 cpl_image_delete(xc_image);
1098 cpl_vector_delete(vsymm);
1099 cpl_image_delete(corrected);
1100 cpl_bivector_delete(temiss);
1101 cpl_bivector_delete(tqeff);
1102 cpl_vector_delete(boundary);
1103 cpl_bivector_delete(emission);
1104 (void)cpl_vector_unwrap(xc_vector);
1105 cpl_vector_delete(vxc);
1106
1107 return cpl_error_get_code();
1108}
1109
1110
1111/*----------------------------------------------------------------------------*/
1128/*----------------------------------------------------------------------------*/
1129cpl_error_code visir_spc_echelle_limit(int * pcol1, int * pcol2, double wlen,
1130 const visir_spc_config * cfg,
1131 int icolmin, int icolmax,
1132 int is_aqu)
1133{
1134
1135 visir_optmod ins_settings;
1136 double echpos;
1137 double wleni; /* The central wavelength at order offset ioffset */
1138 int order;
1139 int error;
1140
1141
1142 cpl_ensure_code(wlen > 0, CPL_ERROR_ILLEGAL_INPUT);
1143 cpl_ensure_code(pcol1, CPL_ERROR_NULL_INPUT);
1144 cpl_ensure_code(pcol2, CPL_ERROR_NULL_INPUT);
1145 cpl_ensure_code(icolmin > 0, CPL_ERROR_ILLEGAL_INPUT);
1146 cpl_ensure_code(icolmax >= icolmin, CPL_ERROR_ILLEGAL_INPUT);
1147 /* There are up to 5 spectra in the imaage */
1148 cpl_ensure_code(cfg->orderoffset >= -4, CPL_ERROR_ILLEGAL_INPUT);
1149 cpl_ensure_code(cfg->orderoffset <= 4, CPL_ERROR_ILLEGAL_INPUT);
1150
1151 error = visir_spc_optmod_init(VISIR_SPC_R_GHR, wlen, &ins_settings, is_aqu);
1152 if (error) {
1153 MSG_ERR("HRG Optical model initialization (%p) failed: %d (%g)",
1154 (void*)&ins_settings, error, wlen);
1155 cpl_ensure_code(0, CPL_ERROR_ILLEGAL_INPUT);
1156 }
1157 order = cfg->orderoffset + visir_spc_optmod_get_echelle_order(&ins_settings);
1158
1159 /* There are 18 echelle orders */
1160 cpl_ensure_code(order > 0, CPL_ERROR_ILLEGAL_INPUT);
1161 cpl_ensure_code(order <= 18, CPL_ERROR_ILLEGAL_INPUT);
1162
1163 wleni = visir_spc_optmod_echelle(&ins_settings, wlen, cfg->orderoffset );
1164
1165 echpos = visir_spc_optmod_cross_dispersion(&ins_settings, wleni);
1166 if (echpos <= 0 || echpos >= icolmax) {
1167 MSG_ERR("Echelle order %2d: offset %s: location out of range [%d;%d]: "
1168 "%g", order, pn(cfg->orderoffset), icolmin, icolmax, echpos);
1169 cpl_ensure_code(0, CPL_ERROR_DATA_NOT_FOUND);
1170 }
1171
1172 *pcol1 = ceil(echpos - whechelle); /* Round up */
1173 *pcol2 = echpos + whechelle; /* Round down */
1174
1175 if (*pcol1 < icolmin) *pcol1 = icolmin;
1176 if (*pcol2 > icolmax) *pcol2 = icolmax;
1177
1178 MSG_INFO("Echelle order %2d: offset %s: at col %g [%d; %d]", order,
1179 pn(cfg->orderoffset), echpos, *pcol1, *pcol2);
1180
1181 if (cfg->phu) {
1182 char * label = cpl_sprintf("ESO DRS APGUI OFFS%d", order);
1183 cpl_propertylist_update_int(cfg->phu, label, cfg->orderoffset);
1184 cpl_free(label);
1185 label = cpl_sprintf("ESO DRS APGUI WLEN%d", order);
1186 cpl_propertylist_update_double(cfg->phu, label, wleni);
1187 cpl_free(label);
1188 label = cpl_sprintf("ESO DRS APGUI CPIX%d", order);
1189 cpl_propertylist_update_double(cfg->phu, label, echpos);
1190 cpl_free(label);
1191 label = cpl_sprintf("ESO DRS APGUI LPIX%d", order);
1192 cpl_propertylist_update_int(cfg->phu, label, *pcol1);
1193 cpl_free(label);
1194 label = cpl_sprintf("ESO DRS APGUI RPIX%d", order);
1195 cpl_propertylist_update_int(cfg->phu, label, *pcol2);
1196 cpl_free(label);
1197 }
1198
1199 return cpl_error_get_code();
1200
1201}
1202
1203/*----------------------------------------------------------------------------*/
1216/*----------------------------------------------------------------------------*/
1217cpl_image * visir_spc_column_extract(const cpl_image * self, int icol1,
1218 int icol2, int doplot)
1219{
1220
1221 cpl_image * band = NULL;
1222 cpl_image * spatial = NULL;
1223 const int nrow = cpl_image_get_size_y(self);
1224 const int ncol = cpl_image_get_size_x(self);
1225
1226 cpl_ensure(self != NULL, CPL_ERROR_NULL_INPUT, NULL);
1227 cpl_ensure(icol1 > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1228 cpl_ensure(icol2 >= icol1, CPL_ERROR_ILLEGAL_INPUT, NULL);
1229
1230 cpl_ensure(ncol >= icol2, CPL_ERROR_ILLEGAL_INPUT, NULL);
1231
1232 band = cpl_image_extract(self, icol1, 1, icol2, nrow);
1233 skip_if_error_present();
1234
1235 if (doplot > 0) {
1236 visir_image_plot("", "t 'The full-width image'", "", self);
1237
1238 if (doplot > 1) {
1239 /* Average the spectral dimension */
1240 spatial = cpl_image_collapse_create(self, 0);
1241 skip_if_error_present();
1242 skip_if (cpl_image_divide_scalar(spatial, nrow));
1243
1244 visir_image_row_plot("set grid;", "t 'Spectral direction "
1245 "collapsed' w linespoints", "",
1246 spatial, 1, 1, 1);
1247 }
1248 }
1249
1250 end_skip;
1251
1252 cpl_image_delete(spatial);
1253 if (cpl_error_get_code() && band != NULL) {
1254 cpl_image_delete(band);
1255 band = NULL;
1256 }
1257
1258 return band;
1259
1260}
1261
1262
1263/*----------------------------------------------------------------------------*/
1276/*----------------------------------------------------------------------------*/
1277cpl_error_code visir_spectro_qc(cpl_propertylist * qclist,
1278 cpl_propertylist * paflist,
1279 cpl_boolean drop_wcs,
1280 const irplib_framelist * rawframes,
1281 const char * regcopy,
1282 const char * regcopypaf)
1283{
1284
1285 const cpl_propertylist * reflist
1286 = irplib_framelist_get_propertylist_const(rawframes, 0);
1287
1288 bug_if (0);
1289
1290 bug_if (visir_qc_append_capa(qclist, rawframes));
1291
1292 if (regcopy != NULL)
1293 bug_if (cpl_propertylist_copy_property_regexp(qclist, reflist,
1294 regcopy, 0));
1295
1296 if (regcopypaf != NULL)
1297 bug_if (cpl_propertylist_copy_property_regexp(paflist, reflist,
1298 regcopypaf, 0));
1299
1300 bug_if (cpl_propertylist_append(paflist, qclist));
1301
1302 if (drop_wcs) {
1303 cpl_propertylist * pcopy = cpl_propertylist_new();
1304 const cpl_error_code error
1305 = cpl_propertylist_copy_property_regexp(pcopy, reflist, "^("
1306 IRPLIB_PFITS_WCS_REGEXP
1307 ")$", 0);
1308 if (!error && cpl_propertylist_get_size(pcopy) > 0) {
1309 cpl_msg_warning(cpl_func, "Combined image will have no WCS "
1310 "coordinates");
1311 }
1312 cpl_propertylist_delete(pcopy);
1313 bug_if(0);
1314 } else {
1315 bug_if(cpl_propertylist_copy_property_regexp(qclist, reflist, "^("
1316 IRPLIB_PFITS_WCS_REGEXP
1317 ")$", 0));
1318 }
1319
1320 end_skip;
1321
1322 return cpl_error_get_code();
1323
1324}
1325
1326
1330/*----------------------------------------------------------------------------*/
1343/*----------------------------------------------------------------------------*/
1344static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist * self,
1345 int npix, double xc,
1346 cpl_boolean didshift,
1347 double subdelta,
1348 const cpl_polynomial * phdisp,
1349 const cpl_polynomial * xcdisp)
1350{
1351
1352 const cpl_size phdegree = cpl_polynomial_get_degree(phdisp);
1353 const cpl_size xcdegree = cpl_polynomial_get_degree(xcdisp);
1354
1355 const double phdisp0 = cpl_polynomial_eval_1d(phdisp, 1.0, NULL);
1356 const double xcdisp0 = cpl_polynomial_eval_1d(xcdisp, 1.0, NULL);
1357
1358 const double xcwlen = cpl_polynomial_eval_1d(xcdisp, 0.5*(double)npix+0.5,
1359 NULL);
1360 const double phcdisp = visir_spc_get_dispersion(phdisp, npix/2.0 + 0.5);
1361 const double xccdisp = visir_spc_get_dispersion(xcdisp, npix/2.0 + 0.5);
1362 cpl_size i;
1363
1364
1365 bug_if (0);
1366 skip_if (phdegree < 1);
1367 skip_if (xcdegree < 1);
1368
1369 cpl_msg_info(cpl_func, "Central Dispersion (physical model) [m/pixel]: %g",
1370 phcdisp);
1371 cpl_msg_info(cpl_func, "Central Dispersion (calibrated) [m/pixel]: %g",
1372 xccdisp);
1373
1374 bug_if (cpl_propertylist_append_double(self, "ESO QC XC", xc));
1375
1376 if (didshift)
1377 bug_if (cpl_propertylist_append_double(self, "ESO QC XCSHIFT",
1378 subdelta));;
1379
1380 bug_if (cpl_propertylist_append_int(self, "ESO QC PHDEGREE", phdegree));
1381 bug_if (cpl_propertylist_append_double(self, "ESO QC PHDISPX0", phdisp0));
1382 for (i = 1; i <= phdegree; i++) {
1383 const double coeff = cpl_polynomial_get_coeff(phdisp, &i);
1384 char * label = cpl_sprintf("ESO QC PHDISPX%d", (int)i);
1385
1386 bug_if (cpl_propertylist_append_double(self, label, coeff));
1387 cpl_free(label);
1388 }
1389
1390 bug_if (cpl_propertylist_append_double(self, "ESO QC XCWLEN", xcwlen));
1391
1392 bug_if (cpl_propertylist_append_int(self, "ESO QC XCDEGREE", xcdegree));
1393 bug_if (cpl_propertylist_append_double(self, "ESO QC XCDISPX0", xcdisp0));
1394
1395 for (i = 1; i <= xcdegree; i++) {
1396 const double coeff = cpl_polynomial_get_coeff(xcdisp, &i);
1397 char * label = cpl_sprintf("ESO QC XCDISPX%d", (int)i);
1398
1399 bug_if (cpl_propertylist_append_double(self, label, coeff));
1400 cpl_free(label);
1401 }
1402
1403 end_skip;
1404
1405 return cpl_error_get_code();
1406
1407}
1408
1409
1410
1411/*----------------------------------------------------------------------------*/
1423/*----------------------------------------------------------------------------*/
1424static void * visir_spectro_qclist_obs(cpl_propertylist * self, double xfwhm,
1425 double xcentro)
1426{
1427 cpl_propertylist_append_double(self, "ESO QC XFWHM", xfwhm);
1428 cpl_propertylist_append_double(self, "ESO QC XCENTROI", xcentro);
1429
1430 if (cpl_error_get_code()) {
1431 cpl_msg_error(cpl_func, "Could not append QC params");
1432 }
1433
1434 return NULL;
1435}
1436
1437
1438/*----------------------------------------------------------------------------*/
1450/*----------------------------------------------------------------------------*/
1451static cpl_error_code visir_vector_convolve_symm(cpl_vector * self,
1452 const cpl_vector * vsymm)
1453{
1454
1455 const int npix = cpl_vector_get_size(self);
1456 const int ihwidth = cpl_vector_get_size(vsymm) - 1;
1457 cpl_vector * raw = cpl_vector_duplicate(self);
1458 double * pself= cpl_vector_get_data(self);
1459 double * praw = cpl_vector_get_data(raw);
1460 const double * psymm = cpl_vector_get_data_const(vsymm);
1461
1462 int i, j;
1463
1464
1465 skip_if_error_present();
1466
1467 /* The convolution does not support this */
1468 skip_if (ihwidth >= npix);
1469
1470 /* Convolve with the symmetric function */
1471 for (i = 0; i < ihwidth; i++) {
1472 pself[i] = praw[i] * psymm[0];
1473 for (j = 1; j <= ihwidth; j++) {
1474 const int k = i-j < 0 ? 0 : i-j;
1475 pself[i] += (praw[k]+praw[i+j]) * psymm[j];
1476 }
1477
1478 }
1479
1480 for (i = ihwidth; i < npix-ihwidth; i++) {
1481 pself[i] = praw[i] * psymm[0];
1482 for (j = 1; j <= ihwidth; j++)
1483 pself[i] += (praw[i-j]+praw[i+j]) * psymm[j];
1484
1485 }
1486 for (i = npix-ihwidth; i < npix; i++) {
1487 pself[i] = praw[i] * psymm[0];
1488 for (j = 1; j <= ihwidth; j++) {
1489 const int k = i+j > npix-1 ? npix - 1 : i+j;
1490 pself[i] += (praw[k]+praw[i-j]) * psymm[j];
1491 }
1492
1493 }
1494
1495 end_skip;
1496
1497 cpl_vector_delete(raw);
1498
1499 return cpl_error_get_code();
1500}
1501
1502/*----------------------------------------------------------------------------*/
1523/*----------------------------------------------------------------------------*/
1524cpl_image * visir_spc_flip(const cpl_image * image, double wlen,
1525 visir_spc_resol resol, visir_data_type dtype,
1526 bool * is_flipped)
1527{
1528 cpl_image * flipped = cpl_image_cast(image, CPL_TYPE_DOUBLE);
1529 visir_optmod ins_settings;
1530 if (is_flipped) *is_flipped = false;
1531
1532 skip_if_error_present();
1533
1534 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1535 visir_spc_optmod_init(resol, wlen, &ins_settings,
1536 visir_data_is_aqu(dtype))) {
1537 visir_error_set(CPL_ERROR_ILLEGAL_INPUT);
1538 skip_if (1);
1539 }
1540
1541 /* The dispersion relation goes from the top of the image to the bottom
1542 - except aquarius , where the detector is rotated 90 degrees
1543 - except using the B-side (in high resolution) */
1544 if (visir_data_is_aqu(dtype)) {
1545 skip_if (cpl_image_turn(flipped, 1));
1546 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1547 visir_spc_optmod_side_is_A(&ins_settings) == 0) {
1548 cpl_msg_info(cpl_func, "Flipping image");
1549 skip_if (cpl_image_flip(flipped, 0));
1550 if (is_flipped) *is_flipped = true;
1551 }
1552 }
1553
1554 else if ((resol != VISIR_SPC_R_HR && resol != VISIR_SPC_R_GHR) ||
1555 visir_spc_optmod_side_is_A(&ins_settings) > 0) {
1556
1557 cpl_msg_info(cpl_func, "Flipping image");
1558
1559 skip_if (cpl_image_flip(flipped, 0));
1560 if (is_flipped) *is_flipped = true;
1561 }
1562
1563 end_skip;
1564
1565 if (cpl_error_get_code() && flipped) {
1566 cpl_image_delete(flipped);
1567 flipped = NULL;
1568 }
1569
1570 return flipped;
1571
1572}
1573
1574/*----------------------------------------------------------------------------*/
1590/*----------------------------------------------------------------------------*/
1591static cpl_polynomial * visir_spc_phys_disp(int npix, double wlen,
1592 visir_spc_resol resol, int ioffset,
1593 int is_aqu)
1594{
1595
1596 cpl_polynomial * phdisp = NULL;
1597 visir_optmod ins_settings;
1598
1599 double dwl;
1600 double wlen0;
1601 double wlen1;
1602 double disp;
1603 const cpl_size i1 = 1;
1604 const cpl_size i0 = 0;
1605
1606
1607 cpl_ensure(resol, CPL_ERROR_ILLEGAL_INPUT, NULL);
1608 cpl_ensure(wlen > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1609 cpl_ensure(npix > 1, CPL_ERROR_ILLEGAL_INPUT, NULL);
1610
1611 /* Initialize instrument-specific settings
1612 - the resolution is not needed hereafter
1613 visir_spc_optmod_init() does itself not use the CPL-error system
1614 because it is also used in a non-CPL scope */
1615
1616 cpl_ensure(!visir_spc_optmod_init(resol, wlen, &ins_settings, is_aqu),
1617 CPL_ERROR_ILLEGAL_INPUT, NULL);
1618
1619 /* Get wavelength range (and corresponding central-wavelength)
1620 visir_spc_optmod_wlen() does not use the CPL-error system
1621 because it is also used in a non-CPL scope */
1622 dwl = visir_spc_optmod_wlen(&ins_settings, &wlen0, &wlen1);
1623
1624 cpl_ensure(dwl >= 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1625
1626 /* Central-wavelength residual on Scan-Angle determination */
1627 dwl -= wlen;
1628 /* Warn if the residual exceeds twice the machine-precision */
1629 if (fabs(dwl) > 2*wlen*DBL_EPSILON) cpl_msg_warning(cpl_func, "Too large res"
1630 "idual in Scan-Angle determination [meps]: %g", dwl/DBL_EPSILON/wlen);
1631
1632 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1633 !visir_spc_optmod_side_is_A(&ins_settings)) {
1634 const double swap = wlen1;
1635 wlen1 = wlen0;
1636 wlen0 = swap;
1637 }
1638 cpl_ensure(wlen1 > wlen0, CPL_ERROR_ILLEGAL_INPUT, NULL);
1639
1640 if (resol == VISIR_SPC_R_LRP) {
1641 phdisp = visir_spc_phys_lrp();
1642 } else {
1643 /* Construct the 1st degree dispersion relation
1644 based on the physical model */
1645 phdisp = cpl_polynomial_new(1);
1646
1647 /* The dispersion */
1648 disp = (wlen1-wlen0)/(npix-1);
1649
1650 skip_if_error_present();
1651
1652 skip_if (cpl_polynomial_set_coeff(phdisp, &i1, disp));
1653
1654 skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0-disp));
1655 }
1656
1657 if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
1658 !visir_spc_optmod_side_is_A(&ins_settings)) {
1659 cpl_msg_info(cpl_func,"HR B-side WLMin, WLMax, Disp: %g %g %g", wlen0,
1660 wlen1, cpl_polynomial_get_coeff(phdisp, &i1));
1661 } else {
1662 cpl_msg_info(cpl_func,"WLMin, WLMax, Disp: %g %g %g", wlen0, wlen1,
1663 cpl_polynomial_get_coeff(phdisp, &i1));
1664 }
1665
1666 if (resol == VISIR_SPC_R_GHR && ioffset != 0) {
1667 /* Another HRG Echelle order is requested
1668 - shift the 1st degree polynomial */
1669 const double dispi = visir_spc_optmod_echelle(&ins_settings,
1670 cpl_polynomial_get_coeff(phdisp, &i1), ioffset);
1671 const double wlen0i= visir_spc_optmod_echelle(&ins_settings,
1672 cpl_polynomial_get_coeff(phdisp, &i0), ioffset);
1673
1674 skip_if (cpl_polynomial_set_coeff(phdisp, &i1, dispi));
1675
1676 skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0i));
1677
1678 cpl_msg_info(cpl_func, "WLc relative error(%d): %g", ioffset,
1679 (wlen0i - cpl_polynomial_eval_1d(phdisp, 1, NULL))/wlen0i);
1680 }
1681
1682
1683 end_skip;
1684
1685 if (cpl_error_get_code() && phdisp != NULL) {
1686 cpl_polynomial_delete(phdisp);
1687 phdisp = NULL;
1688 }
1689
1690 return phdisp;
1691
1692}
1693
1694
1695/*----------------------------------------------------------------------------*/
1709/*----------------------------------------------------------------------------*/
1710
1711cpl_bivector * visir_bivector_load_fits(const char * file,
1712 const char * labelx,
1713 const char * labely,
1714 int extnum)
1715{
1716
1717 cpl_bivector * result = NULL;
1718 cpl_table * table = NULL;
1719 cpl_propertylist * extlist = NULL;
1720 cpl_vector * xwrapper;
1721 cpl_vector * ywrapper;
1722 char * sext = NULL;
1723 double * prowx;
1724 double * prowy;
1725 int next;
1726 int nlines;
1727
1728
1729 bug_if (extnum < 1);
1730
1731 next = cpl_fits_count_extensions(file);
1732 any_if("Could not load FITS table from (extension %d in) file: %s",
1733 extnum, file ? file : "<NULL>");
1734
1735 skip_if_lt(next, extnum, "extensions in file: %s", file);
1736
1737 table = cpl_table_load(file, extnum, 0);
1738 any_if ("Could not load FITS table from extension %d of %d in file: %s",
1739 extnum, next, file ? file : "<NULL>");
1740
1741 extlist = cpl_propertylist_load_regexp(file, extnum, "EXTNAME", 0);
1742 if (cpl_propertylist_has(extlist, "EXTNAME")) {
1743 const char * extname = cpl_propertylist_get_string(extlist, "EXTNAME");
1744 sext = cpl_sprintf(" (EXTNAME=%s)", extname);
1745 }
1746
1747 nlines = cpl_table_get_nrow(table);
1748 skip_if_lt(nlines, 2, "rows in table from extension %d%s of %d "
1749 "in %s", extnum, sext, next, file);
1750
1751 prowx = cpl_table_get_data_double(table, labelx);
1752 any_if("Table from extension %d%s of %d in %s has no column %s",
1753 extnum, sext, next, file, labelx);
1754
1755 prowy = cpl_table_get_data_double(table, labely);
1756 any_if("Table from extension %d%s of %d in %s has no column %s",
1757 extnum, sext, next, file, labely);
1758
1759 xwrapper = cpl_vector_wrap(nlines, prowx);
1760 ywrapper = cpl_vector_wrap(nlines, prowy);
1761
1762 result = cpl_bivector_wrap_vectors(xwrapper, ywrapper);
1763 cpl_table_unwrap(table, labelx);
1764 cpl_table_unwrap(table, labely);
1765
1766 cpl_msg_info(cpl_func, "Read %d rows from extension %d%s of %d "
1767 "in %s [%g;%g]", nlines, extnum, sext, next, file,
1768 cpl_vector_get(xwrapper, 0),
1769 cpl_vector_get(ywrapper, nlines-1));
1770
1771 end_skip;
1772
1773 cpl_free(sext);
1774 cpl_table_delete(table);
1775 cpl_propertylist_delete(extlist);
1776
1777 if (result && cpl_error_get_code()) {
1778 cpl_bivector_delete(result);
1779 result = NULL;
1780 }
1781
1782 return result;
1783
1784}
1785
1786
1787/*----------------------------------------------------------------------------*/
1814/*----------------------------------------------------------------------------*/
1815static cpl_error_code visir_spc_emission(cpl_bivector * emission,
1816 const cpl_vector * boundary,
1817 const cpl_bivector * temiss,
1818 const cpl_bivector * tqeff,
1819 const cpl_vector * vsymm,
1820 double temp)
1821{
1822 cpl_bivector * tqeffi = NULL;
1823 cpl_vector * planck = NULL;
1824 const int npix = cpl_bivector_get_size(emission);
1825
1826
1827 bug_if(emission == NULL);
1828 bug_if(boundary == NULL);
1829 bug_if(temiss == NULL);
1830 bug_if(tqeff == NULL);
1831
1832 /* npix is currently 256 */
1833 skip_if(npix <= 1);
1834
1835 skip_if(cpl_vector_get_size(boundary) != npix + 1);
1836
1837 planck = cpl_vector_new(npix);
1838 skip_if_error_present();
1839
1840 /* The atmospheric emission is assumed to be equivalent to that of
1841 a Black Body at 253 K */
1842 cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
1843 cpl_bivector_get_x(emission),
1844 CPL_UNIT_LENGTH, 253);
1845
1846 skip_if (visir_vector_resample(cpl_bivector_get_y(emission),
1847 boundary, temiss));
1848
1849 /* Convolve to reflect the instrument resolution */
1850 skip_if (visir_vector_convolve_symm(cpl_bivector_get_y(emission),
1851 vsymm));
1852
1853 skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission), planck));
1854
1855 /* The telescope emission is assumed to be equivalent to that of
1856 a Black Body */
1857 cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
1858 cpl_bivector_get_x(emission),
1859 CPL_UNIT_LENGTH, temp);
1860
1861 /* The telescope emissivity is assumed to be uniform at 0.12 */
1862 skip_if (cpl_vector_multiply_scalar(planck, 0.12));
1863
1864 /* Add the telescope emission to the atmospheric */
1865 skip_if (cpl_vector_add(cpl_bivector_get_y(emission), planck));
1866
1867 /* Multiply by the detector quantum efficiency */
1868 tqeffi = cpl_bivector_duplicate(emission);
1869 skip_if (cpl_bivector_interpolate_linear(tqeffi, tqeff));
1870
1871 skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission),
1872 cpl_bivector_get_y(tqeffi)));
1873
1874 end_skip;
1875
1876 cpl_bivector_delete(tqeffi);
1877 cpl_vector_delete(planck);
1878
1879 return cpl_error_get_code();
1880}
1881
1882
1883/*----------------------------------------------------------------------------*/
1906/*----------------------------------------------------------------------------*/
1907static cpl_vector * cpl_spc_convolve_init(int maxlen, double slitw,
1908 double fwhm, int doplot)
1909{
1910
1911 const double sigma = fwhm * CPL_MATH_SIG_FWHM;
1912 const int ihtophat = (int)slitw/2;
1913 const int gausshlen = 1 + 5 * sigma + ihtophat < maxlen/2
1914 ? 1 + 5 * sigma + ihtophat : maxlen/2 - 1;
1915 /* convolen must be at least twice the gausshlen */
1916 const int convolen = 1 + 10 * sigma + 8*ihtophat;
1917 cpl_vector * self = cpl_vector_new(gausshlen);
1918 cpl_vector * tophat = cpl_vector_new(convolen);
1919 int i;
1920
1921 /* Easiest way to fill with a Gaussian is via a CPL image */
1922 cpl_image * iself = cpl_image_wrap_double(gausshlen, 1,
1923 cpl_vector_get_data(self));
1924
1925
1926 skip_if_error_present();
1927
1928 skip_if( slitw <= 0.0);
1929 skip_if( fwhm <= 0.0);
1930 skip_if( convolen < 2 * gausshlen); /* This would indicate a bug */
1931
1932 /* Place the top point of the Gaussian on left-most pixel */
1933 skip_if (cpl_image_fill_gaussian(iself, 1.0, 1.0, CPL_MATH_SQRT2PI,
1934 sigma, 1.0));
1935
1936 if (doplot > 2) visir_vector_plot("set grid;", "t 'Right Half of Gaussian' "
1937 "w linespoints", "", self);
1938
1939 /* The number of non-zero elements is 1+2*ihtophat */
1940 skip_if( cpl_vector_fill(tophat, 0.0));
1941
1942 for (i = convolen/2-ihtophat; i < 1+convolen/2+ihtophat; i++)
1943 skip_if (cpl_vector_set(tophat, i, 1.0/(1.0+2.0*ihtophat)));
1944
1945 /* Convolve the Top-hat with the Gaussian */
1946 skip_if (visir_vector_convolve_symm(tophat, self));
1947
1948 if (doplot > 2) visir_vector_plot("set grid;","t 'Full Width Convolution' "
1949 "w linespoints", "", tophat);
1950
1951 /* Overwrite the Gaussian with the Right Half of the convolution of the
1952 Top-hat + Gausssian */
1953#if 1
1954 memcpy(cpl_vector_get_data(self),
1955 cpl_vector_get_data(tophat) + convolen/2,
1956 sizeof(double)*gausshlen);
1957#else
1958 /* Equivalent, but slower */
1959 for (i = 0 ; i < gausshlen; i++)
1960 skip_if (cpl_vector_set(self, i, cpl_vector_get(tophat,
1961 i + convolen/2)));
1962#endif
1963
1964 skip_if_error_present();
1965
1966 cpl_msg_info(cpl_func, "Convolving Model Spectrum, Gauss-sigma=%g, "
1967 "Tophat-width=%d, Truncation-Error=%g with width=%d", sigma,
1968 1+2*ihtophat,
1969 cpl_vector_get(self,gausshlen-1)/cpl_vector_get(self,0),
1970 2*gausshlen-1);
1971
1972 if (doplot > 1) visir_vector_plot("set grid;","t 'Right Half of Convolution"
1973 "' w linespoints", "", self);
1974
1975 end_skip;
1976
1977 cpl_vector_delete(tophat);
1978 cpl_image_unwrap(iself);
1979
1980 if (cpl_error_get_code()) {
1981 cpl_vector_delete(self);
1982 self = NULL;
1983 }
1984
1985 return self;
1986
1987}
1988
1989
1990static cpl_error_code
1991fit_gaussians(const cpl_image * flipped, const cpl_vector * error,
1992 cpl_size icollo, cpl_size icolhi,
1993 cpl_propertylist * qclist)
1994{
1995 cpl_size nrow = cpl_image_get_size_y(flipped);
1996 cpl_size ncol = cpl_image_get_size_x(flipped);
1997 icollo = CX_MAX(1, icollo);
1998 icolhi = CX_MIN(ncol, icolhi);
1999 cpl_errorstate cleanstate = cpl_errorstate_get();
2000 double sigs[nrow];
2001 double sigs_err = 0.;
2002 double peaks[nrow];
2003 double peaks_err = 0.;
2004 size_t nmeas = 0;
2005 for (cpl_size row = 0; row < nrow; row++) {
2006 const cpl_binary * dmask = cpl_image_get_bpm_const(flipped) ?
2007 cpl_mask_get_data_const(cpl_image_get_bpm_const(flipped)) : NULL;
2008 const double *dflipped = cpl_image_get_data_double_const(flipped);
2009 double * dx = cpl_malloc(ncol * sizeof(*dx));
2010 double * dy = cpl_malloc(ncol * sizeof(*dy));
2011 double * dye = cpl_malloc(ncol * sizeof(*dye));
2012 cpl_vector * x;
2013 cpl_vector * y;
2014 cpl_vector * ye;
2015 size_t n = 0;
2016 for (cpl_size i = icollo; i <= icolhi; i++) {
2017 if (dmask == NULL || !dmask[row * ncol + i]) {
2018 dx[n] = i;
2019 dy[n] = dflipped[row * ncol + (i - 1)];
2020 dye[n] = cpl_vector_get(error, (i - 1));
2021 n++;
2022 }
2023 }
2024 if (n > 0) {
2025 x = cpl_vector_wrap(n, dx);
2026 y = cpl_vector_wrap(n, dy);
2027 ye = cpl_vector_wrap(n, dye);
2028 double x0, sigma, sigma_err, peak, peak_err;
2029 fit_1d_gauss(x, y, ye, &x0, NULL, &peak, &peak_err, &sigma, &sigma_err);
2030 if (cpl_error_get_code() != CPL_ERROR_NONE) {
2031 cpl_msg_debug(cpl_func, "FIT row %lld failed", row);
2032 cpl_errorstate_set(cleanstate);
2033 }
2034 else {
2035 sigs[nmeas] = sigma;
2036 peaks[nmeas] = peak;
2037 sigs_err += sigma * sigma;
2038 peaks_err += peak * peak;
2039 nmeas++;
2040 cpl_msg_debug(cpl_func, "FIT row %lld x %g sig %g +- %g "
2041 "peak %g +- %g",
2042 row, x0, sigma, sigma_err, peak, peak_err);
2043 }
2044 cpl_vector_delete(x);
2045 cpl_vector_delete(y);
2046 cpl_vector_delete(ye);
2047 }
2048 else {
2049 cpl_free(dx);
2050 cpl_free(dy);
2051 cpl_free(dye);
2052 }
2053 }
2054 cpl_vector * sigv = cpl_vector_wrap(nmeas, sigs);
2055 cpl_vector * peakv = cpl_vector_wrap(nmeas, peaks);
2056 double medsigma = cpl_vector_get_median(sigv);
2057 double medsigma_err = sqrt(sigs_err) * sqrt(CPL_MATH_PI_2) / nmeas;
2058 double medpeak = cpl_vector_get_median(peakv);
2059 double medpeak_err = sqrt(peaks_err) * sqrt(CPL_MATH_PI_2) / nmeas;
2060 cpl_msg_info(cpl_func, "Median FWHM of spectrum: %g +- %g, Peak %g +- %g",
2061 medsigma, medsigma_err, medpeak, medpeak_err);
2062 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT FWHM",
2063 medsigma * 2.355);
2064 cpl_propertylist_set_comment(qclist, "ESO QC GAUSSFIT FWHM", "[pix]");
2065 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT FWHM_ERR",
2066 medsigma_err * 2.355);
2067 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT PEAK", medpeak);
2068 cpl_propertylist_set_comment(qclist, "ESO QC GAUSSFIT PEAK", "[adu/s]");
2069 cpl_propertylist_append_double(qclist, "ESO QC GAUSSFIT PEAK_ERR",
2070 medpeak_err);
2071 cpl_vector_unwrap(sigv);
2072 cpl_vector_unwrap(peakv);
2073
2074 return cpl_error_get_code();
2075}
2076
2077/* ---------------------------------------------------------------------------*/
2084/* ---------------------------------------------------------------------------*/
2085static cpl_error_code
2086add_qc_background_sigma(const cpl_image * flipped, cpl_propertylist * qclist)
2087{
2088 cpl_size lly, ury;
2089 /* use approximate good wavelength range */
2090 if (cpl_image_get_size_y(flipped) > VISIR_AQU_APPROX_WLEN13) {
2091 lly = VISIR_AQU_APPROX_WLEN8;
2092 ury = VISIR_AQU_APPROX_WLEN13;
2093 }
2094 else {
2095 lly = 1;
2096 ury = cpl_image_get_size_y(flipped);
2097 }
2098
2099 cpl_image * cutimg =
2100 cpl_image_extract(flipped, 1, lly, cpl_image_get_size_x(flipped), ury);
2101
2102 /* clip to remove signal */
2103 double bkgmad, bkgmed;
2104 bkgmed = cpl_image_get_mad(cutimg, &bkgmad);
2105 for (size_t i = 0; i < 3; i++) {
2106 cpl_mask * rej =
2107 cpl_mask_threshold_image_create(cutimg,
2108 bkgmed - bkgmad * CPL_MATH_STD_MAD * 3,
2109 bkgmed + bkgmad * CPL_MATH_STD_MAD * 3);
2110 cpl_mask_not(rej);
2111 cpl_image_reject_from_mask(cutimg, rej);
2112 cpl_mask_delete(rej);
2113 bkgmed = cpl_image_get_mad(cutimg, &bkgmad);
2114 }
2115
2116 cpl_propertylist_append_double(qclist, "ESO QC BACKGD SIGMA",
2117 bkgmad * CPL_MATH_STD_MAD);
2118 cpl_propertylist_set_comment(qclist, "ESO QC BACKGD SIGMA",
2119 "[adu/s] background corrected");
2120 cpl_image_delete(cutimg);
2121
2122 return cpl_error_get_code();
2123}
2124
2125/*----------------------------------------------------------------------------*/
2131/*----------------------------------------------------------------------------*/
2132static double * visir_bkg_linfit(const cpl_image * row)
2133{
2134 double* rv = NULL;
2135 double* x = NULL;
2136 double* y = NULL;
2137
2138 const int n = cpl_image_get_size_x(row);
2139 const int ngood = n - cpl_image_count_rejected(row);
2140
2141 skip_if (0);
2142
2143 // generate the x & y buffers
2144 x = cpl_malloc(ngood * sizeof(double));
2145 y = cpl_malloc(ngood * sizeof(double));
2146
2147 skip_if (0);
2148
2149 for (int bad, i = 0, j = 0; i < n; ++i) {
2150 const double cand = cpl_image_get(row, i+1, 1, &bad);
2151 if (bad) continue;
2152 x[j] = i;
2153 y[j++] = cand;
2154 }
2155
2156 skip_if (0);
2157
2158 // linear least squares fit
2159 double c0, c1, cov00, cov01, cov11;
2160 gsl_fit_linear(x, 1, y, 1, ngood, &c0, &c1, &cov00, &cov01, &cov11, NULL);
2161
2162 // interpolate row using model
2163 rv = cpl_malloc(n * sizeof(double));
2164 for (int i = 0; i < n; ++i) {
2165 gsl_fit_linear_est(i, c0, c1, cov00, cov01, cov11, rv + i, NULL);
2166 }
2167
2168 end_skip;
2169
2170 cpl_free(x);
2171 cpl_free(y);
2172
2173 return rv;
2174}
2175
2176/*----------------------------------------------------------------------------*/
2195/*----------------------------------------------------------------------------*/
2196int visir_norm_coord(const bool rev, const float coord, const int lcol,
2197 const int rcol, const visir_apdefs * aps)
2198{
2199 const int x = coord < 0 ? -coord : coord;
2200 if (copysign(1.0, coord) > 0.0) return // positive == right
2201 rev ? rcol - aps->limits[x].l + 1 : aps->limits[x].r - lcol + 1;
2202 else return // negative == left
2203 rev ? rcol - aps->limits[x].r + 1 : aps->limits[x].l - lcol + 1;
2204}
2205
2206/*----------------------------------------------------------------------------*/
2214/*----------------------------------------------------------------------------*/
2215static cpl_image * visir_image_filter_median(const cpl_image * image,
2216 const int nx, const int ny)
2217{
2218 cpl_image* filtered = NULL;
2219 cpl_mask* kernel = NULL;
2220
2221 if (nx < 2) {
2222 return cpl_image_duplicate(image);
2223 }
2224
2225 if (!(nx % 2)) {
2226 cpl_msg_error(cpl_func, "kernel size must be odd");
2227 cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_INPUT);
2228 }
2229
2230 skip_if (0);
2231
2232 const cpl_size xsz = cpl_image_get_size_x(image);
2233 const cpl_size ysz = cpl_image_get_size_y(image);
2234 const cpl_type type = cpl_image_get_type(image);
2235
2236 skip_if (0);
2237
2238 filtered = cpl_image_new(xsz, ysz, type);
2239
2240 skip_if (0);
2241
2242 kernel = cpl_mask_new(nx, ny);
2243 cpl_mask_not(kernel);
2244 cpl_image_filter_mask(filtered, image, kernel, CPL_FILTER_MEDIAN,
2245 CPL_BORDER_FILTER);
2246
2247 end_skip;
2248
2249 if (cpl_error_get_code()) {
2250 cpl_msg_error(cpl_error_get_where(), "%s", cpl_error_get_message());
2251 cpl_image_delete(filtered); filtered = NULL;
2252 }
2253 cpl_mask_delete(kernel);
2254
2255 return filtered;
2256}
2257
2258/*----------------------------------------------------------------------------*/
2274/*----------------------------------------------------------------------------*/
2275static void * visir_extraction(const cpl_image * insci, const cpl_image * invar,
2276 const cpl_image * insky, cpl_vector * outext,
2277 cpl_vector * outsky, cpl_vector * outerr,
2278 cpl_image * outwgt, const visir_spc_config * cfg,
2279 const int method, const int ncomb, const int beg,
2280 const int end)
2281{
2282 cpl_image* smoothed = NULL;
2283 double* buf = NULL;
2284
2285 if (!insci || !invar || !insky || !cfg ||
2286 !outext || !outsky || !outerr || !outwgt) {
2287 cpl_error_set(cpl_func, CPL_ERROR_NULL_INPUT);
2288 }
2289
2290 skip_if (0);
2291
2292 const int specLen = cpl_image_get_size_x(insci);
2293 const int numRows = cpl_image_get_size_y(insci);
2294 if (beg < 0 || beg >= numRows || end < 0 || end >= numRows || beg > end) {
2295 cpl_error_set(cpl_func, CPL_ERROR_INCOMPATIBLE_INPUT);
2296 }
2297
2298 skip_if (0);
2299
2300 double * oext_d = cpl_vector_get_data(outext);
2301 double * osky_d = cpl_vector_get_data(outsky);
2302 double * oerr_d = cpl_vector_get_data(outerr);
2303 double * owgt_d = cpl_image_get_data(outwgt);
2304
2305 skip_if (0);
2306
2307 const double * const isci_d = cpl_image_get_data_const(insci);
2308 const double * const isky_d = cpl_image_get_data_const(insky);
2309 const double * const ivar_d = invar ? cpl_image_get_data_const(invar) : NULL;
2310
2311 skip_if (0);
2312
2313 /* Initial spectrum estimate */
2314 //if (isci_d[i + j * specLen] > 0.0)
2315
2316 if (method && abs(end-beg) > cfg->ox_kernel + 2 /* numRows > 5 */) {
2317 cpl_image* smoothed = visir_image_filter_median(
2318 insci, cfg->ox_kernel, cfg->ox_kernel);
2319 double * smoo_d = cpl_image_get_data(smoothed);
2320 for (int i = 0; i < specLen; i++) {
2321 oext_d[i] = 0.0;
2322 for (int j = beg; j <= end; j++)
2323 oext_d[i] += smoo_d[i + j * specLen];
2324 }
2325 } else {
2326 for (int i = 0; i < specLen; i++) {
2327 oext_d[i] = 0.0;
2328 for (int j = beg; j <= end; j++)
2329 oext_d[i] += isci_d[i + j * specLen];
2330 }
2331 }
2332
2333 skip_if (0);
2334
2335 if (method) {
2336
2337 buf = cpl_calloc(specLen, sizeof(double));
2338 for (int iter = 0; iter < cfg->ox_niters; iter++) {
2339
2340 /* Normalised spatial profile */
2341 for (int i = 0; i < specLen; i++) {
2342 for (int j = beg; j <= end; j++) {
2343 const int index = i + j * specLen;
2344 //owgt_d[index] = n_sci[index] > 0.0 && oext_d[i] > 0.00001
2345 owgt_d[index] = fabs(oext_d[i]) > 0.00001
2346 ? isci_d[index] / oext_d[i] : 0.0;
2347 }
2348 }
2349
2350 cpl_vector* wrap = NULL;
2351 for (int j = beg; j <= end; j++) {
2352
2353 /* Smooth each row in the dispersion direction, and enforce
2354 * positivity */
2355 for (int i = 0; i < specLen - cfg->ox_smooth; i++) {
2356 wrap = cpl_vector_wrap(cfg->ox_smooth, owgt_d +
2357 i + j * specLen);
2358 double value = cpl_vector_get_median_const(wrap);
2359 if (value < 0) value = 0.0;
2360 buf[i + cfg->ox_smooth / 2] = value;
2361 cpl_vector_unwrap(wrap);
2362 }
2363
2364 skip_if (0);
2365
2366 /* left edge escaped filtering: replace with mean */
2367 wrap = cpl_vector_wrap(cfg->ox_smooth / 2, owgt_d +
2368 j * specLen);
2369 double value = cpl_vector_get_mean(wrap);
2370 cpl_vector_unwrap(wrap);
2371 if (value < 0) value = 0.0;
2372 for (int i = 0; i < cfg->ox_smooth / 2; i++) {
2373 buf[i] = value;
2374 }
2375
2376 skip_if (0);
2377
2378 /* right edge escaped filtering: replace with mean */
2379 wrap = cpl_vector_wrap(cfg->ox_smooth / 2, owgt_d +
2380 specLen - cfg->ox_smooth / 2 + j * specLen);
2381 value = cpl_vector_get_mean(wrap);
2382 cpl_vector_unwrap(wrap);
2383 if (value < 0) value = 0.0;
2384 for (int i = 0; i < cfg->ox_smooth / 2; i++)
2385 buf[i + specLen - cfg->ox_smooth / 2] = value;
2386 for (int i = 0; i < specLen; i++)
2387 owgt_d[i + j * specLen] = buf[i];
2388
2389 skip_if (0);
2390 }
2391
2392 /* Enforce normalization of spatial profile after smoothing */
2393 for (int i = 0; i < specLen; i++) {
2394 double value = 0.0;
2395 for (int j = beg; j <= end; j++)
2396 value += owgt_d[i + j * specLen];
2397 if (value > 0.00001)
2398 for (int j = beg; j <= end; j++)
2399 owgt_d[i + j * specLen] /= value;
2400 else
2401 for (int j = beg; j <= end; j++)
2402 owgt_d[i + j * specLen] = 0.0;
2403 }
2404
2405
2406 /* Optimal extraction */
2407 for (int i = 0; i < specLen; i++) {
2408 double sumSci, sumSky, sumWgt, sumProf, sumVar;
2409 sumSci = sumSky = sumWgt = sumProf = sumVar = 0.0;
2410 for (int j = beg; j <= end; j++) {
2411 const int index = i + j * specLen;
2412 //if (isci_d[index] > 0.0)
2413
2414 // This is the theoretical estimated variance. In principle,
2415 // since we have the propagated variance, we could use that
2416 // one, but I leave this as this is the original algorithm
2417 // (cgarcia)
2418 double var = cfg->ron * cfg->ron + fabs(oext_d[i] *
2419 owgt_d[index] + isky_d[index]) / cfg->gain;
2420 // next line necessary for when input dataset is sum of
2421 // ncomb images
2422 var /= ncomb;
2423
2424 double value = isci_d[index] - oext_d[i] * owgt_d[index];
2425 if (fabs(value) / sqrt(var) < cfg->ox_sigma) {
2426 const double weight = 1000000 * owgt_d[index] / var;
2427 sumSci += weight * isci_d[index];
2428 sumSky += weight * isky_d[index];
2429 sumWgt += weight * owgt_d[index];
2430 sumProf += owgt_d[index];
2431 // This is how we propagated the variance. We assume
2432 // that the weigth has no error, although in has been
2433 // computed from the profile and the theoretical var-
2434 // iance (which also includes the data)
2435 if (ivar_d) sumVar += weight * weight * ivar_d[index];
2436 }
2437 }
2438
2439 if (sumWgt > 0.00001) {
2440 oext_d[i] = sumSci / sumWgt;
2441 osky_d[i] = sumSky / sumWgt;
2442 if (ivar_d)
2443 // This is the error, not the variance.
2444 oerr_d[i] = sqrt(sumVar / sumWgt / sumWgt);
2445 else
2446 // This was the old formula, which is not a real error
2447 // propagation
2448 oerr_d[i] = 1000 * sqrt(sumProf / sumWgt);
2449 }
2450 else {
2451 //oext_d[i] = osky_d[i] = oerr_d[i] = 0.0;
2452 //oerr_d[i] = sqrt(cfg->ron * cfg->ron + fabs(oext_d[i] +
2453 // osky_d[i]) / cfg->gain);
2454 }
2455 }
2456 }
2457 }
2458 else {
2459
2460 /* Add sky estimation for the simple aperture extraction. */
2461 //if (isky_d[i + j * specLen] > 0.0)
2462
2463 for (int i = 0; i < specLen; i++) {
2464 osky_d[i] = 0.0;
2465 for (int j = beg; j <= end; j++)
2466 osky_d[i] += isky_d[i + j * specLen];
2467 }
2468
2469 /* Add error estimation for the simple aperture extraction. */
2470 for (int i = 0; i < specLen; i++) {
2471 if (ivar_d) {
2472 // propagate the variance of a simple addition
2473 oerr_d[i] = 0.0;
2474 for (int j = beg; j <= end; j++)
2475 oerr_d[i] += ivar_d[i + j * specLen];
2476 oerr_d[i] = sqrt(oerr_d[i]); // return error not variance
2477 }
2478 else
2479 oerr_d[i] = sqrt(cfg->ron * cfg->ron + fabs(oext_d[i] +
2480 osky_d[i]) / cfg->gain);
2481 }
2482 }
2483
2484 end_skip;
2485
2486 cpl_image_delete(smoothed);
2487 cpl_free(buf);
2488
2489 if (cpl_error_get_code()) {
2490 cpl_msg_error(cpl_error_get_where(), "%s", cpl_error_get_message());
2491 }
2492
2493 return NULL;
2494}
2495
2496static cpl_bivector * visir_spc_extract(cpl_image * flipped,
2497 int lcol, int rcol,
2498 cpl_propertylist * qclist,
2499 cpl_image ** pweight2d,
2500 const visir_spc_config * cfg,
2501 const visir_apdefs * aps,
2502 const bool rev, const cpl_size ncomb)
2503{
2504 extract_func * meth = aps->ident < 0 ? visir_spc_oldex : visir_spc_newex;
2505 return meth(flipped, lcol, rcol, qclist, pweight2d, cfg, aps, rev, ncomb);
2506}
2507
2508/*----------------------------------------------------------------------------*/
2520/*----------------------------------------------------------------------------*/
2521static cpl_bivector * visir_spc_newex(cpl_image * flipped,
2522 int lcol, int rcol,
2523 cpl_propertylist * qclist,
2524 cpl_image ** pweight2d,
2525 const visir_spc_config * cfg,
2526 const visir_apdefs * aps,
2527 const bool rev, const cpl_size ncomb)
2528{
2529 cpl_bivector* rv = NULL;
2530 cpl_image* bkg = NULL;
2531 cpl_image* diff = NULL;
2532 cpl_image* var = NULL;
2533 cpl_vector* spc = NULL;
2534 cpl_vector* sky = NULL;
2535 cpl_vector* err = NULL;
2536 cpl_image* wgt = NULL;
2537 char* line = NULL;
2538 char* key = NULL;
2539
2540 if (!flipped || !qclist || !cfg || !aps) {
2541 cpl_error_set(cpl_func, CPL_ERROR_NULL_INPUT);
2542 }
2543
2544 skip_if (0);
2545
2546 const int ncol = cpl_image_get_size_x(flipped);
2547 const int specLen = cpl_image_get_size_y(flipped);
2548 const int oo = cfg->orderoffset;
2549 const size_t xn = cfg->extract;
2550
2551 if (aps->nlimits < 1) {
2552 cpl_error_set(cpl_func, CPL_ERROR_INCOMPATIBLE_INPUT);
2553 }
2554 if (!pweight2d || *pweight2d) {
2555 cpl_error_set(cpl_func, CPL_ERROR_INCOMPATIBLE_INPUT);
2556 }
2557 if (ncol != rcol-lcol+1) {
2558 cpl_error_set(cpl_func, CPL_ERROR_INCOMPATIBLE_INPUT);
2559 }
2560
2561 skip_if (0);
2562
2563 MSG_DBG(":%s:%ld: > [%d;%d] ([%d;%d]) <", pn(oo), xn, 1, ncol, rcol, lcol);
2564
2565 // write aperture into PHU
2566 line = visir_apdefs_dump(aps);
2567 key = cpl_sprintf("ESO DRS APDEF%d", aps->ident);
2568 if (cfg->phu) {
2569 cpl_propertylist_append_string(cfg->phu, key, line);
2570 }
2571
2572 skip_if (0);
2573
2574 /* Compute ESO QC BACKGD SIGMA */
2575 add_qc_background_sigma(flipped, qclist);
2576
2577 skip_if (0);
2578
2579 const bool apex = aps->extract_method == VISIR_EXTRACT_METHOD_APERTURE;
2580
2581 diff = cpl_image_duplicate(flipped);
2582
2583 skip_if (0);
2584
2585 if (!cfg->bkgcorrect) {
2586 const cpl_type type = cpl_image_get_type(flipped);
2587 bkg = cpl_image_new(ncol, specLen, type); // init'd to zero
2588 MSG_WARN("Sky subtraction is not enabled: extraction results may be "
2589 "degraded");
2590 } else {
2591 /* make background image */
2592 bkg = cpl_image_duplicate(flipped);
2593 int lp = -9999;
2594
2595 // begin with 1 (or nlimits-1 in reversed case) to skip obj ap
2596 int beg = rev ? aps->nlimits - 1 : 1;
2597 int end = rev ? 0 : aps->nlimits;
2598 const int inc = rev ? -1 : 1;
2599
2600 // reject pixels outside the sky aperture windows
2601 for (int a = beg; a != end; a += inc) {
2602 int l = visir_norm_coord(rev, -a, lcol, rcol, aps);
2603 int r = visir_norm_coord(rev, +a, lcol, rcol, aps);
2604 MSG_DBG(":%s:%ld: [%d;%d] ([%d;%d])", pn(oo), xn, l, r,
2605 aps->limits[a].r, aps->limits[a].l);
2606
2607 --l; ++r;
2608 if ((1 <= lp && lp <= ncol) || (1 <= l && l <= ncol)) {
2609 const int trunc_lp = lp < 1 ? 1 : lp;
2610 const int trunc_l = l > ncol ? ncol : l;
2611 if (trunc_lp <= trunc_l) {
2612 cpl_image_fill_window(bkg, trunc_lp, 1, trunc_l,
2613 specLen, -INFINITY);
2614 MSG_DBG(":%s:%ld: [%d;%d] rejected", pn(oo), xn, trunc_lp,
2615 trunc_l);
2616 }
2617 }
2618 lp = r;
2619 }
2620
2621 skip_if (0);
2622
2623 if (1 <= lp && lp <= ncol) {
2624 cpl_image_fill_window(bkg, lp, 1, ncol, specLen, -INFINITY);
2625 MSG_DBG(":%s:%ld: [%d;%d] rejected", pn(oo), xn, lp, ncol);
2626 }
2627 cpl_image_reject_value(bkg, CPL_VALUE_MINUSINF);
2628
2629 skip_if (0);
2630
2631 // set method of sky background determination (called on extracted row)
2632 double (*method)(const cpl_image *) = cpl_image_get_median; // default
2633 if (apex && aps->sky_method == VISIR_SKY_METHOD_AVERAGE)
2634 method = cpl_image_get_mean;
2635 const bool linear = apex && aps->sky_method == VISIR_SKY_METHOD_LINFIT;
2636
2637 // determine bkg on raw row data and write it into row (overwriting raw)
2638 for (int r = 0; r < specLen; ++r) {
2639 cpl_image* row = cpl_image_extract(bkg, 1, r+1, ncol, r+1);
2640 if (linear) {
2641 double* levels = visir_bkg_linfit(row);
2642 for (cpl_size c = 0; c < ncol; ++c) {
2643 cpl_image_set(bkg, c+1, r+1, levels[c]);
2644 }
2645 cpl_free(levels);
2646 }
2647 else {
2648 double level = method(row);
2649 cpl_image_fill_window(bkg, 1, r+1, ncol, r+1, level);
2650 }
2651 cpl_image_delete(row);
2652 }
2653
2654 skip_if (0);
2655
2656 // line below not needed: cpl_image_fill_window or cpl_image_set (above)
2657 // does this for us
2658 //cpl_image_accept_all _(bkg->o); // clear rejection flags set earlier
2659
2660 // subtract sky background
2661 cpl_image_subtract(diff, bkg);
2662 }
2663
2664 skip_if (0);
2665
2666 /* initial variance estimate */
2667 var = cpl_image_duplicate(flipped);
2668 cpl_image_abs(var);
2669 cpl_image_divide_scalar(var, cfg->gain);
2670 cpl_image_add_scalar(var, cfg->ron * cfg->ron);
2671
2672 skip_if (0);
2673
2674 // prep for extraction (routine assumes a horizontal spectral axis)
2675 cpl_image_turn(diff, 1);
2676 cpl_image_turn(var, 1);
2677 cpl_image_turn(bkg, 1);
2678
2679 skip_if (0);
2680
2681 // perform extraction
2682 spc = cpl_vector_new(specLen);
2683 sky = cpl_vector_new(specLen);
2684 err = cpl_vector_new(specLen);
2685 wgt = cpl_image_new(specLen, ncol, CPL_TYPE_DOUBLE);
2686 const int beg = ncol - visir_norm_coord(rev, +0.0, lcol, rcol, aps);
2687 const int end = ncol - visir_norm_coord(rev, -0.0, lcol, rcol, aps);
2688
2689 skip_if (0);
2690
2691 visir_extraction(diff, var, bkg, spc, sky, err, wgt,
2692 cfg, apex ? 0 : 1, ncomb, beg, end);
2693
2694 skip_if (0);
2695
2696 cpl_image_turn(wgt, -1); // rotate result back to vert spectral axis
2697 rv = cpl_bivector_wrap_vectors(spc, err);
2698 *pweight2d = wgt;
2699
2700 end_skip;
2701
2702 cpl_free(line);
2703 cpl_free(key);
2704 cpl_image_delete(bkg);
2705 cpl_image_delete(diff);
2706 cpl_image_delete(var);
2707 cpl_vector_delete(sky);
2708 if (!rv) {
2709 // Only tidy up these vectors if they didn't get
2710 // wrapped into the return value
2711 cpl_vector_delete(spc);
2712 cpl_vector_delete(err);
2713 }
2714
2715 return rv;
2716}
2717
2718/*----------------------------------------------------------------------------*/
2739/*----------------------------------------------------------------------------*/
2740static cpl_bivector * visir_spc_oldex(cpl_image * flipped,
2741 int lcol, int rcol,
2742 cpl_propertylist * qclist,
2743 cpl_image ** pweight2d,
2744 const visir_spc_config * cfg,
2745 const visir_apdefs * aps,
2746 const bool rev, const cpl_size ncomb)
2747{
2748 cpl_bivector* rv = NULL;
2749 char* line = NULL;
2750 char* key = NULL;
2751 cpl_image* orig = NULL;
2752 cpl_image* spatial = NULL;
2753 cpl_image* iweight = NULL;
2754 cpl_mask* binary = NULL;
2755 cpl_image* locnoise = NULL;
2756 cpl_vector* error = NULL;
2757 cpl_vector* ntor = NULL;
2758 cpl_vector* dtor = NULL;
2759 cpl_vector* spectrum = NULL;
2760 cpl_vector* divisor = NULL;
2761
2762 if (!flipped || !qclist || !cfg || !aps) {
2763 cpl_error_set(cpl_func, CPL_ERROR_NULL_INPUT);
2764 }
2765
2766 skip_if (0);
2767
2768 const int ncol = cpl_image_get_size_x(flipped);
2769 const int nrow = cpl_image_get_size_y(flipped);
2770 const int oo = cfg->orderoffset;
2771 const size_t xn = cfg->extract;
2772
2773 skip_if (0);
2774
2775 /* This is hard-coded to 3.0 */
2776 const double sigma = VISIR_SPECTRO_SIGMA; /* Assume signal at this level */
2777
2778 if (sigma <= 0.0) {
2779 cpl_error_set(cpl_func, CPL_ERROR_UNSUPPORTED_MODE);
2780 }
2781 if (aps->nlimits < 1) {
2782 cpl_error_set(cpl_func, CPL_ERROR_INCOMPATIBLE_INPUT);
2783 }
2784 if (!pweight2d || *pweight2d) {
2785 cpl_error_set(cpl_func, CPL_ERROR_INCOMPATIBLE_INPUT);
2786 }
2787 if (ncol != rcol-lcol+1) {
2788 cpl_error_set(cpl_func, CPL_ERROR_INCOMPATIBLE_INPUT);
2789 }
2790
2791 skip_if (0);
2792
2793 MSG_DBG(":%s:%ld: > [%d;%d] ([%d;%d]) <", pn(oo), xn, 1, ncol, rcol, lcol);
2794
2795 // write aperture into PHU
2796 line = visir_apdefs_dump(aps);
2797 key = cpl_sprintf("ESO DRS APDEF%d", aps->ident);
2798 if (cfg->phu) {
2799 cpl_propertylist_append_string(cfg->phu, key, line);
2800 }
2801
2802 /* Compute ESO QC BACKGD SIGMA */
2803 add_qc_background_sigma(flipped, qclist);
2804
2805 // will need the following later for optimal ex
2806 orig = cpl_image_duplicate(flipped);
2807
2808
2809 /* Compute spatial weights:
2810 mean-subtract each row and average + normalize */
2811
2812 if (cfg->bkgcorrect) { /* Background correction */
2813
2814 // make a working copy of the input frame
2815 cpl_image* work = cpl_image_duplicate(flipped);
2816
2817 for (int r = 0; r < nrow; ++r) {
2818 cpl_image* row = cpl_image_extract(work, 1, r+1, ncol, r+1);
2819 double level = cpl_image_get_median(row);
2820 cpl_image_fill_window(work, 1, r+1, ncol, r+1, level);
2821 cpl_image_delete(row);
2822 }
2823
2824 // perform the sky subtraction & cleanup
2825 cpl_image_subtract(flipped, work);
2826 cpl_image_delete(work);
2827 }
2828
2829 skip_if (0);
2830
2831 const int is_echelle = ncol <= 2 * (whechelle + 1);
2832 if (!is_echelle) {
2833 /* All but HR Grism has a negative signal equal to the positive i.e. the
2834 * mean is zero. FIXME: Not true for large offsets (or very extended
2835 * objects) */
2836 double mean = cpl_image_get_mean(flipped);
2837 MSG_INFO("Combined image has mean: %g", mean);
2838
2839 cpl_vector* col = cpl_vector_new(nrow);
2840
2841 /* Subtract the mean from each row/wavelength */
2842 double * pweight = cpl_image_get_data_double(flipped);
2843 for (int r=0; r < nrow; r++, pweight += ncol) {
2844
2845 /* Get the next row of the input image */
2846 cpl_image* imrow = cpl_image_wrap_double(ncol, 1, pweight);
2847
2848 /* Set the corresponding pixel of col to the row mean value */
2849 mean = cpl_image_get_mean(imrow);
2850 cpl_vector_set(col, r, mean);
2851
2852 /* Subtract this value from the row */
2853 cpl_image_subtract_scalar(imrow, mean);
2854
2855 cpl_image_unwrap(imrow);
2856 }
2857
2858 /* col is a column vector, where each pixel contains the mean of the
2859 * corresponding row of the input image. */
2860 if (cfg->plot > 1) {
2861 visir_vector_plot(
2862 "set grid;", "t 'Estimated Background' w linespoints", "", col);
2863 }
2864
2865 cpl_vector_delete(col);
2866 }
2867
2868 skip_if (0);
2869
2870 /* Average the spectral dimension */
2871 spatial = cpl_image_collapse_create(flipped, 0);
2872 cpl_image_divide_scalar(spatial, nrow);
2873
2874 skip_if (0);
2875
2876 /* Create weights that have an absolute sum of 1 - as an image */
2877 iweight = cpl_image_duplicate(spatial);
2878 cpl_image_normalise(iweight, CPL_NORM_ABSFLUX);
2879 const double sqflux = cpl_image_get_sqflux(iweight);
2880 const double weight_2norm = sqrt(sqflux);
2881 MSG_INFO("2-norm of weights: %g", weight_2norm);
2882
2883 skip_if (0);
2884
2885 if (cfg->plot > 1) {
2886 visir_image_row_plot(
2887 "set grid;", "t 'Cleaned, normalized combined image with spectral "
2888 "direction averaged' w linespoints", "", iweight, 1, 1, 1);
2889 }
2890
2891 skip_if (0);
2892
2893 /* compute spatial median & noise stdev */
2894 const double sp_median = cpl_image_get_median(spatial);
2895 double stdev2d = visir_img_phot_sigma_clip(flipped);
2896 stdev2d /= sqrt(nrow); /* The st.dev. of the noise */
2897 MSG_INFO("spatial median %g and stdev %g", sp_median, stdev2d);
2898
2899 skip_if (0);
2900
2901
2902 /* Reject noise from spatial */
2903 binary = cpl_mask_threshold_image_create(spatial,
2904 sp_median - sigma * stdev2d, sp_median + sigma * stdev2d);
2905 int mspix = cpl_mask_count(binary);
2906 if (mspix == ncol) {
2907 cpl_msg_error(cpl_func, "%d spatial "
2908 "weights too noisy. sigma=%g. stdev2d=%g. Spatial median=%g", ncol,
2909 sigma, stdev2d, sp_median);
2910 cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND);
2911 }
2912
2913 skip_if (0);
2914
2915 MSG_INFO("Pixels of noise (%g +/- %g*%g): %d", sp_median, stdev2d, sigma,
2916 mspix);
2917 cpl_image_reject_from_mask(spatial, binary);
2918
2919 skip_if (0);
2920
2921 /* get position & magnitude of largest value in the spatial image */
2922 cpl_size ifwhmx, ifwhmy; /* position of widest signal region */
2923 int rejected;
2924
2925 cpl_image_get_maxpos(spatial, &ifwhmx, &ifwhmy);
2926 if (ifwhmy != 1) {
2927 cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT);
2928 }
2929
2930 skip_if (0);
2931
2932 const double max = cpl_image_get(spatial, ifwhmx, 1, &rejected);
2933 if (rejected) {
2934 cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT);
2935 } else if (max <= 0.0) {
2936 cpl_msg_error(cpl_func, "Cannot compute "
2937 "FWHM on a collapsed spectrum with a non-positive maximum: %g (at "
2938 "i=%lld)", max, ifwhmx);
2939 cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND);
2940 }
2941
2942 skip_if (0);
2943
2944 if (cfg->plot > 1) {
2945 visir_image_col_plot("","t 'Most intense column' w linespoints",
2946 "", flipped, ifwhmx, ifwhmx, 1);
2947 visir_image_row_plot("set grid;", "t 'Combined image with spectral "
2948 "direction collapsed' w linespoints",
2949 "", spatial, 1, 1, 1);
2950 }
2951
2952 skip_if (0);
2953
2954 /* Find edges of centroid in spatial */
2955 int ilnoise, ihnoise; // Low/High pixel of the widest signal-less region
2956 // Step the low position back until we reach the noise
2957 for (ilnoise = ifwhmx; ilnoise > 0 &&
2958 !cpl_image_is_rejected(spatial, ilnoise, 1); ilnoise--);
2959 // Step the high position up until we reach the noise
2960 for (ihnoise = ifwhmx; ihnoise <= ncol &&
2961 !cpl_image_is_rejected(spatial, ihnoise, 1); ihnoise++);
2962 // There may be no negative weights at all
2963 if (!ilnoise) ilnoise = 1;
2964 if (ihnoise > ncol) ihnoise = ncol;
2965
2966 /* get x-centroid of brightest object within the window of good pixels */
2967 const double xcentro = cpl_image_get_centroid_x_window(spatial,
2968 ilnoise, 1, ihnoise, 1);
2969 double xfwhm, yfwhm; // FWHM around maximum pixel / brightest object
2970 cpl_image_get_fwhm(spatial, ifwhmx, 1, &xfwhm, &yfwhm);
2971 visir_spectro_qclist_obs(qclist, xfwhm, xcentro);
2972 MSG_INFO("Spatial FWHM(%d:%lld:%d:%g): %g", ilnoise, ifwhmx, ihnoise,
2973 xcentro, xfwhm);
2974 cpl_image_delete(spatial); spatial = NULL; // free up some memory early
2975
2976 skip_if (0);
2977
2978 /* Determine st.dev. on noise at signal-less pixels */
2979 if (is_echelle) {
2980 int ileft = 5;
2981 int iright = ncol - 5;
2982
2983 if (ileft > xcentro - xfwhm * 2) ileft = xcentro - xfwhm * 2;
2984 if (iright < xcentro + xfwhm * 2) iright = xcentro + xfwhm * 2;
2985 MSG_INFO("HRG pixels of noise: [1 %d] [%d %d]", ileft, iright, ncol);
2986
2987 // "binary" is the mask showing pixels rejected as noise in the spatial
2988 // image But this operation just zeroes it out
2989 cpl_mask_xor(binary, binary);
2990
2991 // Reset the mask so that the pixels around the centroid are flagged
2992 // as good, and those that are more than 2 * xfwhm are bad
2993 cpl_binary * pbin = cpl_mask_get_data(binary);
2994 for (int i = 0; i < ncol; i++) pbin[i] = CPL_BINARY_0;
2995 for (int i = 0; i < ileft; i++) pbin[i] = CPL_BINARY_1;
2996 for (int i = iright; i < ncol; i++) pbin[i] = CPL_BINARY_1;
2997
2998 mspix = cpl_mask_count(binary);
2999 MSG_INFO("Pixels of noise (post-echelle refinement): %d", mspix);
3000 }
3001
3002 skip_if (0);
3003
3004 if (mspix < 2) {
3005 cpl_msg_error(cpl_func, "Cannot estimate "
3006 "spectrum noise with just %d pixels of noise", mspix);
3007 cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND);
3008 }
3009
3010 skip_if (0);
3011
3012 /* Turn the mask into an image */
3013 locnoise = cpl_image_new_from_mask(binary);
3014
3015 /* not needed anymore: might as well free up some mem */
3016 cpl_mask_delete(binary); binary = NULL;
3017
3018 /* Compute the noise for each wavelength */
3019 error = cpl_vector_new(nrow);
3020 for (int r = 0; r < nrow; r++) {
3021
3022 // Grab the next row of the image (remember that the spectra are
3023 // oriented so that a row is roughly equivalent to a wavelength)
3024 cpl_image* imrow = cpl_image_extract(flipped, 1, r+1, ncol, r+1);
3025
3026 // Using the mask, which shows the location of noise pixels for every
3027 // row, calculate the details of the noise for this particular row
3028 cpl_apertures* objs = cpl_apertures_new_from_image(imrow, locnoise);
3029
3030 // We actually just want the standard deviation of the noise pixels for
3031 // this row
3032 double stdev1d = cpl_apertures_get_stdev(objs, 1);
3033
3034 // The noise per pixel is defined as the Standard Deviation on the noise
3035 // (computed from the part of the signal that has no object signal)
3036 // multiplied by the 2-norm of the noise-thresholded spatial weights
3037 double npp = weight_2norm * stdev1d;
3038
3039 // For this row, the noise per pixel is set in the error vector (remember
3040 // that nrow is the number of pixels in the wavelength direction)
3041 cpl_vector_set(error, r, npp);
3042
3043 cpl_apertures_delete(objs);
3044 cpl_image_delete(imrow);
3045 }
3046
3047 skip_if (0);
3048
3049 /* Calculate some QC parameters from the image */
3050 fit_gaussians(flipped, error, ifwhmx - 20, ifwhmx + 20, qclist);
3051
3052 /* Spectrum noise computation done:
3053 * "error" contains the error value per row (i.e. per wavelength) */
3054
3055 /* Iterate through the spatial dimension - sum up the weighted columns
3056 * to create the output spectrum. */
3057 for (int c = 1; c <= ncol; c++) {
3058 // Grab the column out of the image
3059 ntor = cpl_vector_new_from_image_column(flipped, c);
3060 dtor = NULL; // denominator
3061
3062 // multiply col by its iweight (same size as spatial dim)
3063 const double weight = cpl_image_get(iweight, c, 1, &rejected);
3064 if (rejected) {
3065 cpl_error_set(cpl_func, CPL_ERROR_DATA_NOT_FOUND);
3066 break;
3067 }
3068 // The sigma-clipping may cause many columns to be zero
3069 if (weight == 0) {
3070 cpl_vector_delete(ntor); ntor = NULL;
3071 continue;
3072 }
3073 cpl_vector_multiply_scalar(ntor, weight);
3074
3075 // Keep a (potentially weighted) sum of columns
3076 if (spectrum) {
3077 cpl_vector_add(spectrum, ntor);
3078 cpl_vector_delete(ntor); ntor = NULL;
3079 } else {
3080 spectrum = ntor;
3081 }
3082
3083 if (divisor) {
3084 cpl_vector_add(divisor, dtor);
3085 cpl_vector_delete(dtor); dtor = NULL;
3086 } else {
3087 divisor = dtor;
3088 }
3089 }
3090
3091 skip_if (0);
3092
3093 if (!spectrum) {
3094 cpl_error_set(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT);
3095 }
3096
3097 skip_if (0);
3098
3099 if (divisor) {
3100 cpl_vector_divide(spectrum, divisor);
3101 }
3102 double min = cpl_vector_get_min(spectrum);
3103 if (min < 0) MSG_WARN("Extracted spectrum has negative intensity: %g", min);
3104
3105 /* Create 2D-weight map by replicating the 1D-weights over the wavelengths */
3106 *pweight2d = cpl_image_new(ncol, nrow, CPL_TYPE_DOUBLE);
3107 for (int r=1; r <= nrow; r++) {
3108 cpl_image_copy(*pweight2d, iweight, 1, r);
3109 }
3110 if (cfg->plot > 0) {
3111 visir_image_plot("", "t 'The weight map'", "", *pweight2d);
3112 }
3113
3114 rv = cpl_bivector_wrap_vectors(spectrum, error);
3115
3116 if (cfg->plot > 2) {
3117 visir_bivector_plot("", "t 'error versus spectrum'", "", rv);
3118 }
3119
3120 end_skip;
3121
3122 cpl_free(line);
3123 cpl_free(key);
3124 cpl_image_delete(orig);
3125 cpl_image_delete(spatial);
3126 cpl_image_delete(iweight);
3127 cpl_mask_delete(binary);
3128 cpl_image_delete(locnoise);
3129
3130 if (!rv) {
3131 // Only delete these if we failed to create the final
3132 // return value
3133 cpl_vector_delete(spectrum);
3134 cpl_vector_delete(error);
3135 }
3136
3137 if (cpl_error_get_code()) {
3138 cpl_msg_error(cpl_error_get_where(), "%s", cpl_error_get_message());
3139 }
3140
3141 return rv;
3142}
3143
3144/*----------------------------------------------------------------------------*/
3166/*----------------------------------------------------------------------------*/
3167static cpl_error_code visir_spectro_fill(cpl_vector * self,
3168 const cpl_polynomial * disp,
3169 irplib_base_spectrum_model * model)
3170{
3171
3172 visir_spectrum_model * mymodel = (visir_spectrum_model*)model;
3173 const cpl_size npix = cpl_vector_get_size(self);
3174
3175 cpl_ensure_code(self, CPL_ERROR_NULL_INPUT);
3176 cpl_ensure_code(model, CPL_ERROR_NULL_INPUT);
3177 cpl_ensure_code(disp, CPL_ERROR_NULL_INPUT);
3178
3179 cpl_vector * wavelength = cpl_vector_new(npix);
3180 cpl_bivector * emission = cpl_bivector_wrap_vectors(wavelength, self);
3181 cpl_vector * boundary = cpl_vector_new(npix + 1);
3182
3183 /* Compute the wavelengths of the spectrum
3184 according to the physical model */
3185 skip_if (cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
3186 disp, 1, 1));
3187 skip_if (cpl_vector_fill_polynomial(boundary, disp, 0.5, 1));
3188
3189 /* Get the emission at those wavelengths */
3190 skip_if (visir_spc_emission(emission, boundary, mymodel->lines,
3191 mymodel->tqeff, mymodel->vsymm,
3192 mymodel->temp));
3193 end_skip;
3194
3195 cpl_bivector_unwrap_vectors(emission);
3196 cpl_vector_delete(wavelength);
3197 cpl_vector_delete(boundary);
3198
3199 return cpl_error_get_code();
3200}
3201
3202
3203
3204/*----------------------------------------------------------------------------*/
3219/*----------------------------------------------------------------------------*/
3220static cpl_error_code visir_spectro_refine(cpl_polynomial * self,
3221 const cpl_vector * xc_vector,
3222 visir_spectrum_model * pmymodel,
3223 const cpl_polynomial * phdisp,
3224 int hsize, cpl_boolean doplot,
3225 visir_spc_resol resol,
3226 double * pxc,
3227 cpl_boolean * pdidshift,
3228 double * pdelta)
3229{
3230 const int subres = VISIR_XC_SUBSEARCH;
3231 cpl_polynomial * shifted = NULL;
3232#ifdef VISIR_SPC_CAL_HIGH
3233 const int fitdeg = 2;
3234 double pixstep = 0.5;
3235 double pixtol = 1e-5;
3236 const int maxite = fitdeg * 200;
3237 int maxfail = 3;
3238 int maxcont = 3;
3239 const int clines = (int)(cpl_bivector_get_size(pmymodel->lines) *
3240 cpl_vector_get_size(xc_vector));
3241 cpl_errorstate prestate = cpl_errorstate_get();
3242#endif
3243
3244 cpl_ensure_code(self, CPL_ERROR_NULL_INPUT);
3245 cpl_ensure_code(xc_vector, CPL_ERROR_NULL_INPUT);
3246 cpl_ensure_code(pmymodel, CPL_ERROR_NULL_INPUT);
3247 cpl_ensure_code(phdisp, CPL_ERROR_NULL_INPUT);
3248 cpl_ensure_code(pxc, CPL_ERROR_NULL_INPUT);
3249 cpl_ensure_code(pdidshift, CPL_ERROR_NULL_INPUT);
3250 cpl_ensure_code(pdelta, CPL_ERROR_NULL_INPUT);
3251
3252 skip_if(cpl_polynomial_copy(self, phdisp));
3253
3254#ifdef VISIR_SPC_CAL_HIGH
3255 if (irplib_polynomial_find_1d_from_correlation_all
3256 (self, fitdeg, xc_vector, 1, clines,
3257 (irplib_base_spectrum_model*)pmymodel,
3258 visir_spectro_fill, pixtol, pixstep,
3259 hsize, maxite, maxfail, maxcont, doplot, pxc) || *pxc <= 0.0) {
3260
3261 irplib_error_recover(prestate, "Could not optimize %d "
3262 "coefficients, trying shifting", fitdeg);
3263 skip_if(cpl_polynomial_copy(self, phdisp));
3264
3265 skip_if(visir_polynomial_shift_1d_from_correlation
3266 (self, xc_vector, (irplib_base_spectrum_model*) pmymodel,
3267 visir_spectro_fill, hsize, subres, doplot, pxc, pdelta));
3268 *pdidshift = CPL_TRUE;
3269
3270 /* Retry optimization */
3271 shifted = cpl_polynomial_duplicate(self);
3272
3273 if (irplib_polynomial_find_1d_from_correlation_all
3274 (self, fitdeg, xc_vector, 1, clines,
3275 (irplib_base_spectrum_model*)pmymodel,
3276 visir_spectro_fill, pixtol, pixstep,
3277 hsize, maxite, maxfail, maxcont, doplot, pxc) || *pxc <= 0.0) {
3278
3279 irplib_error_recover(prestate, "Could not re-optimize %d "
3280 "coefficients, keeping shifted", fitdeg);
3281 skip_if(cpl_polynomial_copy(self, shifted));
3282 }
3283 }
3284
3285#else
3286 cpl_size clow = 0, chigh = 0;
3287 /* skip highly nonlinear areas */
3288 if (resol == VISIR_SPC_R_LRP) {
3289 clow = 155;
3290 chigh = 155;
3291 }
3292 cpl_vector * xc_vector_cut = cpl_vector_extract(xc_vector, clow,
3293 cpl_vector_get_size(xc_vector)
3294 - chigh - 1, 1);
3295 cpl_polynomial_shift_1d(self, 0, clow);
3296 skip_if(visir_polynomial_shift_1d_from_correlation
3297 (self, xc_vector_cut, (irplib_base_spectrum_model*) pmymodel,
3298 visir_spectro_fill, hsize, subres, doplot, pxc, pdelta));
3299 cpl_polynomial_shift_1d(self, 0, -clow);
3300 cpl_vector_delete(xc_vector_cut);
3301 *pdidshift = CPL_TRUE;
3302#endif
3303
3304 error_if (*pxc <= 0.0, CPL_ERROR_DATA_NOT_FOUND, "Atmospheric and Model "
3305 "Spectra have non-positive cross-correlation (%g pixel shift): "
3306 "%g", *pdelta, *pxc);
3307
3308 end_skip;
3309
3310 cpl_polynomial_delete(shifted);
3311
3312 return cpl_error_get_code();
3313
3314}
3315
3316/*----------------------------------------------------------------------------*/
3339/*----------------------------------------------------------------------------*/
3340static cpl_error_code
3341visir_polynomial_shift_1d_from_correlation(cpl_polynomial * self,
3342 const cpl_vector * obs,
3343 irplib_base_spectrum_model * model,
3344 cpl_error_code (*filler)
3345 (cpl_vector *,
3346 const cpl_polynomial *,
3347 irplib_base_spectrum_model *),
3348 int hsize,
3349 int subres,
3350 cpl_boolean doplot,
3351 double * pxc, double *pshift)
3352{
3353 const int nobs = cpl_vector_get_size(obs);
3354 cpl_polynomial * cand = NULL;
3355 cpl_bivector * xcplot = NULL;
3356 double * xcplotx = NULL;
3357 double * xcploty = NULL;
3358 cpl_vector * mspec1d = NULL;
3359 cpl_vector * vxc;
3360 double bestxc = -1.0;
3361 double bestdelta = -1.0; /* avoid false unint warning */
3362 int bestxxc = -1; /* avoid false unint warning */
3363 int i;
3364
3365 cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
3366 cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
3367 cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
3368 cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
3369 cpl_ensure_code(subres > 0, CPL_ERROR_ILLEGAL_INPUT);
3370 cpl_ensure_code(hsize > 0, CPL_ERROR_ILLEGAL_INPUT);
3371
3372 cand = cpl_polynomial_new(1);
3373 mspec1d = cpl_vector_new(2 * hsize + nobs);
3374 vxc = cpl_vector_new(2 * hsize + 1);
3375 if (doplot) {
3376 xcplot = cpl_bivector_new(subres * (2 * hsize + 1));
3377 xcplotx = cpl_bivector_get_x_data(xcplot);
3378 xcploty = cpl_bivector_get_y_data(xcplot);
3379 }
3380
3381 /* subdelta search is in the range [0; 1[ */
3382 for (i = 0; i < subres; i++) {
3383 const double delta = i / (double)subres;
3384 double xc;
3385 int ixc;
3386
3387 bug_if (cpl_polynomial_copy(cand, self));
3388 bug_if (cpl_polynomial_shift_1d(cand, 0, delta - hsize));
3389
3390 skip_if (filler(mspec1d, cand, model));
3391
3392 ixc = cpl_vector_correlate(vxc, mspec1d, obs);
3393 xc = cpl_vector_get(vxc, ixc);
3394
3395 if (xc > bestxc) {
3396 bestxc = xc;
3397 bestxxc = ixc - hsize;
3398 bestdelta = delta + bestxxc;
3399 cpl_msg_debug(cpl_func, "Shifting %g = %d + %g pixels (XC=%g)",
3400 bestdelta, bestxxc, delta, bestxc);
3401 }
3402 if (doplot) {
3403 int j;
3404 for (j = 0; j <= 2 * hsize; j++) {
3405 const double xcj = cpl_vector_get(vxc, j);
3406 xcplotx[i + j * subres] = (double)(j - hsize) + delta;
3407 xcploty[i + j * subres] = xcj;
3408 }
3409 }
3410 }
3411
3412#ifdef IRPLIB_SPC_DUMP
3413 /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
3414 irplib_polynomial_dump_corr_step(self, vxc, "Shift");
3415#endif
3416
3417 skip_if(cpl_polynomial_shift_1d(self, 0, bestdelta));
3418
3419 /* Verify correctness of shift, at hsize = 0 */
3420 cpl_vector_set_size(vxc, 1);
3421 cpl_vector_set_size(mspec1d, nobs);
3422 skip_if (filler(mspec1d, self, model));
3423 bug_if(cpl_vector_correlate(vxc, mspec1d, obs));
3424
3425 if (doplot) {
3426 char * title = cpl_sprintf("t 'Cross-correlation of %d-pixel spectrum "
3427 "(max=%.4g at %g pixel)' w points", nobs,
3428 cpl_vector_get(vxc, 0), bestdelta);
3429
3430 cpl_plot_bivector("set grid;set xlabel 'Offset [pixel]';set ylabel "
3431 "'Cross-correlation';", title, "", xcplot);
3432 cpl_free(title);
3433
3434 irplib_plot_spectrum_and_model(obs, self, model, filler);
3435 }
3436
3437 cpl_msg_info(cpl_func, "Shifting %g = %d + %g pixels (XC: %g <=> %g)",
3438 bestdelta, bestxxc, bestdelta - (double)bestxxc,
3439 cpl_vector_get(vxc, 0), bestxc);
3440
3441 if (pxc != NULL) *pxc = cpl_vector_get(vxc, 0);
3442 if (pshift != NULL) *pshift = bestdelta;
3443
3444 end_skip;
3445
3446 cpl_vector_delete(mspec1d);
3447 cpl_polynomial_delete(cand);
3448 cpl_vector_delete(vxc);
3449 cpl_bivector_delete(xcplot);
3450
3451 return cpl_error_get_code();
3452
3453}
3454
3455/*----------------------------------------------------------------------------*/
3460/*----------------------------------------------------------------------------*/
3461static cpl_polynomial * visir_spc_phys_lrp(void)
3462{
3463 const double xval[] = {161, 307, 336, 449, 491, 518, 623, 760, 795, 839};
3464 const double yval[] = {8.22e-6, 9.50e-06, 9.660e-06, 10.5e-06, 10.82e-6,
3465 11.e-06, 11.7e-06, 12.54e-06, 12.76e-06,
3466 13.02e-06 };
3467
3468 const cpl_size maxdeg1d = 2; /* The polynomial degree */
3469
3470 cpl_polynomial * self = cpl_polynomial_new(1);
3471 const cpl_boolean sampsym = CPL_FALSE;
3472 const size_t nvals = sizeof(xval)/sizeof(*xval);
3473
3474 IRPLIB_DIAG_PRAGMA_PUSH_IGN(-Wcast-qual)
3475 cpl_matrix * xmatrix = cpl_matrix_wrap(1, nvals, (double*)xval);
3476 cpl_vector * yvector = cpl_vector_wrap(nvals, (double*)yval);
3477 IRPLIB_DIAG_PRAGMA_POP;
3478 cpl_vector * fitres = cpl_vector_new(nvals);
3479
3480 const cpl_error_code error = cpl_polynomial_fit(self, xmatrix, &sampsym,
3481 yvector, NULL,
3482 CPL_FALSE, NULL, &maxdeg1d)
3483 || cpl_vector_fill_polynomial_fit_residual(fitres, yvector, NULL, self,
3484 xmatrix, NULL);
3485
3486 const double mse = cpl_vector_product(fitres, fitres) / (double)nvals;
3487
3488 (void)cpl_matrix_unwrap(xmatrix);
3489 (void)cpl_vector_unwrap(yvector);
3490 cpl_vector_delete(fitres);
3491
3492 if (error) {
3493 cpl_error_set_where(cpl_func);
3494 cpl_polynomial_delete(self);
3495 self = NULL;
3496 } else {
3497 cpl_msg_info(cpl_func, "Fitted %d degree 1D-polynomial to %u "
3498 "wavelengths with a root mean square error [m]: %g",
3499 (int)maxdeg1d, (unsigned)nvals, sqrt(mse));
3500 }
3501
3502 return self;
3503}
3504
3505/*----------------------------------------------------------------------------*/
3512/*----------------------------------------------------------------------------*/
3513static double visir_spc_get_dispersion(const cpl_polynomial * self, double xval)
3514{
3515
3516 cpl_errorstate prestate = cpl_errorstate_get();
3517 double disp;
3518
3519 (void)cpl_polynomial_eval_1d(self, xval, &disp);
3520
3521 if (!cpl_errorstate_is_equal(prestate)) {
3522 (void)cpl_error_set_where(cpl_func);
3523 }
3524
3525 return disp;
3526}
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