CR2RE Pipeline Reference Manual 1.6.2
irplib_wlxcorr.c
1/*
2 * This file is part of the IRPLIB package
3 * Copyright (C) 2002,2003,2014 European Southern Observatory
4 *
5 * This program is free software; you can redistribute it and/or modify
6 * it under the terms of the GNU General Public License as published by
7 * the Free Software Foundation; either version 2 of the License, or
8 * (at your option) any later version.
9 *
10 * This program is distributed in the hope that it will be useful,
11 * but WITHOUT ANY WARRANTY; without even the implied warranty of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 * GNU General Public License for more details.
14 *
15 * You should have received a copy of the GNU General Public License
16 * along with this program; if not, write to the Free Software
17 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA
18 */
19
20#ifdef HAVE_CONFIG_H
21#include <config.h>
22#endif
23
24/*-----------------------------------------------------------------------------
25 Includes
26 -----------------------------------------------------------------------------*/
27
28#include "irplib_wavecal_impl.h"
29
30#include "irplib_wlxcorr.h"
31
32#include <cpl.h>
33
34#include <math.h>
35#include <string.h>
36
37/*----------------------------------------------------------------------------*/
47/*----------------------------------------------------------------------------*/
48
49/*-----------------------------------------------------------------------------
50 Defines
51 -----------------------------------------------------------------------------*/
52
53#ifndef inline
54#define inline /* inline */
55#endif
56
57#define IRPLIB_MAX(A,B) ((A) > (B) ? (A) : (B))
58#define IRPLIB_MIN(A,B) ((A) < (B) ? (A) : (B))
59
60#define IRPLIB_PTR_SWAP(a,b) \
61 do { void * irplib_ptr_swap =(a);(a)=(b);(b)=irplib_ptr_swap; } while (0)
62
63/*-----------------------------------------------------------------------------
64 Private functions
65 -----------------------------------------------------------------------------*/
66
67static void irplib_wlxcorr_estimate(cpl_vector *, cpl_vector *,
68 const cpl_vector *,
69 const cpl_bivector *,
70 const cpl_vector *,
71 const cpl_polynomial *,
72 double, double);
73
74static int irplib_wlxcorr_signal_resample(cpl_vector *, const cpl_vector *,
75 const cpl_bivector *) ;
76static cpl_error_code cpl_vector_fill_lss_profile_symmetric(cpl_vector *,
77 double, double);
78static cpl_error_code irplib_wlcalib_fill_spectrum(cpl_vector *,
79 const cpl_bivector *,
80 const cpl_vector *,
81 const cpl_polynomial *, int);
82
83static cpl_boolean irplib_wlcalib_is_lines(const cpl_vector *,
84 const cpl_polynomial *,
85 int, double);
86
90/*----------------------------------------------------------------------------*/
126/*----------------------------------------------------------------------------*/
127cpl_polynomial * irplib_wlxcorr_best_poly(const cpl_vector * spectrum,
128 const cpl_bivector * lines_catalog,
129 int degree,
130 const cpl_polynomial * guess_poly,
131 const cpl_vector * wl_error,
132 int nsamples,
133 double slitw,
134 double fwhm,
135 double * xc,
136 cpl_table ** wlres,
137 cpl_vector ** xcorrs)
138{
139 const int spec_sz = cpl_vector_get_size(spectrum);
140 const int nfree = cpl_vector_get_size(wl_error);
141 int ntests = 1;
142 cpl_vector * model;
143 cpl_vector * vxc;
144 cpl_vector * init_pts_wl;
145 cpl_matrix * init_pts_x;
146 cpl_vector * pts_wl;
147 cpl_vector * vxcorrs;
148 cpl_vector * conv_kernel = NULL;
149 cpl_polynomial * poly_sol;
150 cpl_polynomial * poly_candi;
151 const double * pwl_error = cpl_vector_get_data_const(wl_error);
152 const double * dxc;
153 cpl_size degree_loc ;
154 const cpl_boolean symsamp = CPL_TRUE; /* init_pts_x is symmetric */
155 const cpl_boolean is_lines
156 = irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
157 guess_poly, spec_sz, 1.0);
158 int i;
159
160 /* FIXME: Need mode parameter for catalogue type (lines <=> profile) */
161
162 /* In case of failure */
163 if (wlres != NULL) *wlres = NULL;
164 if (xcorrs != NULL) *xcorrs = NULL;
165
166 /* Useful for knowing if resampling is used */
167 cpl_msg_debug(cpl_func, "Checking %d^%d dispersion polynomials (slitw=%g, "
168 "fwhm=%g) against %d-point observed spectrum with%s "
169 "catalog resampling", nsamples, nfree, slitw, fwhm, spec_sz,
170 is_lines ? "out" : "");
171
172 cpl_ensure(xc != NULL, CPL_ERROR_NULL_INPUT, NULL);
173 *xc = -1.0;
174 cpl_ensure(spectrum != NULL, CPL_ERROR_NULL_INPUT, NULL);
175 cpl_ensure(lines_catalog != NULL, CPL_ERROR_NULL_INPUT, NULL);
176 cpl_ensure(guess_poly != NULL, CPL_ERROR_NULL_INPUT, NULL);
177 cpl_ensure(wl_error != NULL, CPL_ERROR_NULL_INPUT, NULL);
178 cpl_ensure(nfree >= 2, CPL_ERROR_ILLEGAL_INPUT, NULL);
179 cpl_ensure(nsamples > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
180 /* FIXME: degree is redundant */
181 cpl_ensure(1 + degree == nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
182
183 cpl_ensure(cpl_polynomial_get_dimension(guess_poly) == 1,
184 CPL_ERROR_ILLEGAL_INPUT, NULL);
185
186 if (nsamples > 1) {
187 /* Search place must consist of more than one point */
188 /* FIXME: The bounds should probably not be negative */
189 for (i = 0; i < nfree; i++) {
190 if (pwl_error[i] != 0.0) break;
191 }
192 cpl_ensure(i < nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
193 }
194
195 if (!is_lines) {
196 /* Create the convolution kernel */
197 conv_kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
198 cpl_ensure(conv_kernel != NULL, CPL_ERROR_ILLEGAL_INPUT, NULL);
199 }
200
201 /* Create initial test points */
202 init_pts_x = cpl_matrix_new(1, nfree);
203 init_pts_wl = cpl_vector_new(nfree);
204 pts_wl = cpl_vector_new(nfree);
205 for (i = 0; i < nfree; i++) {
206 const double xpos = spec_sz * i / (double)degree;
207 const double wlpos = cpl_polynomial_eval_1d(guess_poly, xpos, NULL)
208 - 0.5 * pwl_error[i];
209
210 cpl_matrix_set(init_pts_x, 0, i, xpos);
211 cpl_vector_set(init_pts_wl, i, wlpos);
212
213 ntests *= nsamples; /* Count number of tests */
214
215 }
216
217 vxcorrs = xcorrs != NULL ? cpl_vector_new(ntests) : NULL;
218
219 poly_sol = cpl_polynomial_new(1);
220 poly_candi = cpl_polynomial_new(1);
221 model = cpl_vector_new(spec_sz);
222 vxc = cpl_vector_new(1);
223 dxc = cpl_vector_get_data_const(vxc);
224
225 /* Create the polynomial candidates and estimate them */
226 for (i=0; i < ntests; i++) {
227 int idiv = i;
228 int deg;
229
230 /* Update wavelength at one anchor point - and reset wavelengths
231 to their default for any anchor point(s) at higher wavelengths */
232 for (deg = degree; deg >= 0; deg--, idiv /= nsamples) {
233 const int imod = idiv % nsamples;
234 const double wlpos = cpl_vector_get(init_pts_wl, deg)
235 + imod * pwl_error[deg] / nsamples;
236
237 /* FIXME: If wlpos causes pts_wl to be non-increasing, the
238 solution will be non-physical with no need for evaluation.
239 (*xc could be set to -1 in this case). */
240 cpl_vector_set(pts_wl, deg, wlpos);
241
242 if (imod > 0) break;
243 }
244
245 /* Generate */
246 degree_loc = (cpl_size)degree ;
247 cpl_polynomial_fit(poly_candi, init_pts_x, &symsamp, pts_wl,
248 NULL, CPL_FALSE, NULL, &degree_loc);
249 /* *** Estimate *** */
250 irplib_wlxcorr_estimate(vxc, model, spectrum, lines_catalog,
251 conv_kernel, poly_candi, slitw, fwhm);
252 if (vxcorrs != NULL) cpl_vector_set(vxcorrs, i, *dxc);
253 if (*dxc > *xc) {
254 /* Found a better solution */
255 *xc = *dxc;
256 IRPLIB_PTR_SWAP(poly_sol, poly_candi);
257 }
258 }
259
260 cpl_vector_delete(model);
261 cpl_vector_delete(vxc);
262 cpl_vector_delete(conv_kernel);
263 cpl_vector_delete(pts_wl);
264 cpl_matrix_delete(init_pts_x);
265 cpl_vector_delete(init_pts_wl);
266 cpl_polynomial_delete(poly_candi);
267
268#ifdef CPL_WLCALIB_FAIL_ON_CONSTANT
269 /* FIXME: */
270 if (cpl_polynomial_get_degree(poly_sol) == 0) {
271 cpl_polynomial_delete(poly_sol);
272 cpl_vector_delete(vxcorrs);
273 *xc = 0.0;
274 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
275 __FILE__, __LINE__, "Found a constant "
276 "dispersion");
277 cpl_errorstate_dump(prestate, CPL_FALSE, NULL);
278 return NULL;
279 }
280#endif
281
282 if (wlres != NULL) {
283 /* FIXME: A failure in the table creation is not considered a failure
284 of the whole function call (although all outputs may be useless) */
285
286 cpl_errorstate prestate = cpl_errorstate_get();
287 /* Create the spc_table */
288 *wlres = irplib_wlxcorr_gen_spc_table(spectrum, lines_catalog, slitw,
289 fwhm, guess_poly, poly_sol);
290 if (*wlres == NULL) {
291 cpl_polynomial_delete(poly_sol);
292 cpl_vector_delete(vxcorrs);
293 *xc = -1.0;
294 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
295 __FILE__, __LINE__, "Cannot generate "
296 "infos table");
297 /* cpl_errorstate_dump(prestate, CPL_FALSE, NULL); */
298 cpl_errorstate_set(prestate);
299 return NULL;
300 }
301 }
302
303 if (xcorrs != NULL) {
304 *xcorrs = vxcorrs;
305 } else {
306 /* assert(vxcorrs == NULL); */
307 }
308
309 return poly_sol;
310}
311
312/*
313TODO :
314 Merge irplib_wlxcorr_best_poly_prop() with irplib_wlxcorr_best_poly() by
315 adding a new parameter.
316 Need to coordinate with all pipelines.
317*/
318
319/*----------------------------------------------------------------------------*/
345/*----------------------------------------------------------------------------*/
346cpl_polynomial * irplib_wlxcorr_best_poly_prop(const cpl_vector * spectrum,
347 const cpl_bivector * lines_catalog,
348 int degree,
349 const cpl_polynomial * guess_poly,
350 const cpl_vector * wl_error,
351 int nsamples,
352 double slitw,
353 double fwhm,
354 double * xc,
355 cpl_table ** wlres,
356 cpl_vector ** xcorrs)
357{
358 const int spec_sz = cpl_vector_get_size(spectrum);
359 const int nfree = cpl_vector_get_size(wl_error);
360 int ntests = 1;
361 cpl_vector * model;
362 cpl_vector * vxc;
363 cpl_vector * init_pts_wl;
364 cpl_matrix * init_pts_x;
365 cpl_vector * pts_wl;
366 cpl_vector * vxcorrs;
367 cpl_vector * conv_kernel = NULL;
368 cpl_polynomial * poly_sol;
369 cpl_polynomial * poly_candi;
370 const double * pwl_error = cpl_vector_get_data_const(wl_error);
371 const double * dxc;
372 cpl_size degree_loc ;
373 const cpl_boolean symsamp = CPL_TRUE; /* init_pts_x is symmetric */
374 const cpl_boolean is_lines
375 = irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
376 guess_poly, spec_sz, 1.0);
377 int i;
378
379 /* FIXME: Need mode parameter for catalogue type (lines <=> profile) */
380
381 /* In case of failure */
382 if (wlres != NULL) *wlres = NULL;
383 if (xcorrs != NULL) *xcorrs = NULL;
384
385 /* Useful for knowing if resampling is used */
386 cpl_msg_debug(cpl_func, "Checking %d^%d dispersion polynomials (slitw=%g, "
387 "fwhm=%g) against %d-point observed spectrum with%s "
388 "catalog resampling", nsamples, nfree, slitw, fwhm, spec_sz,
389 is_lines ? "out" : "");
390
391 cpl_ensure(xc != NULL, CPL_ERROR_NULL_INPUT, NULL);
392 *xc = -1.0;
393 cpl_ensure(spectrum != NULL, CPL_ERROR_NULL_INPUT, NULL);
394 cpl_ensure(lines_catalog != NULL, CPL_ERROR_NULL_INPUT, NULL);
395 cpl_ensure(guess_poly != NULL, CPL_ERROR_NULL_INPUT, NULL);
396 cpl_ensure(wl_error != NULL, CPL_ERROR_NULL_INPUT, NULL);
397 cpl_ensure(nfree >= 1, CPL_ERROR_ILLEGAL_INPUT, NULL);
398 cpl_ensure(nsamples > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
399 /* FIXME: degree is redundant */
400 cpl_ensure(1 + degree == nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
401
402 cpl_ensure(cpl_polynomial_get_dimension(guess_poly) == 1,
403 CPL_ERROR_ILLEGAL_INPUT, NULL);
404
405 if (nsamples > 1) {
406 /* Search place must consist of more than one point */
407 /* FIXME: The bounds should probably not be negative */
408 for (i = 0; i < nfree; i++) {
409 if (pwl_error[i] != 0.0) break;
410 }
411 cpl_ensure(i < nfree, CPL_ERROR_ILLEGAL_INPUT, NULL);
412 }
413
414 if (!is_lines) {
415 /* Create the convolution kernel */
416 conv_kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
417 cpl_ensure(conv_kernel != NULL, CPL_ERROR_ILLEGAL_INPUT, NULL);
418 }
419
420 /* Create initial test points */
421 init_pts_x = cpl_matrix_new(1, nfree);
422 init_pts_wl = cpl_vector_new(nfree);
423 pts_wl = cpl_vector_new(nfree);
424 const double degree_loc2 = degree == 0 ? 1 : (double)degree ;
425 for (i = 0; i < nfree; i++) {
426 const double xpos = spec_sz * i / degree_loc2;
427 const double wlpos = cpl_polynomial_eval_1d(guess_poly, xpos, NULL)
428 - 0.5 * pwl_error[i];
429
430 cpl_matrix_set(init_pts_x, 0, i, xpos);
431 cpl_vector_set(init_pts_wl, i, wlpos);
432
433 ntests *= nsamples; /* Count number of tests */
434
435 }
436
437 vxcorrs = xcorrs != NULL ? cpl_vector_new(ntests) : NULL;
438
439 poly_sol = cpl_polynomial_new(1);
440 poly_candi = cpl_polynomial_new(1);
441 model = cpl_vector_new(spec_sz);
442 vxc = cpl_vector_new(1);
443 dxc = cpl_vector_get_data_const(vxc);
444
445 /* Create the polynomial candidates and estimate them */
446 for (i=0; i < ntests; i++) {
447 int idiv = i;
448 int deg;
449 cpl_size power;
450
451 /* Update wavelength at one anchor point - and reset wavelengths
452 to their default for any anchor point(s) at higher wavelengths */
453 for (deg = degree; deg >= 0; deg--, idiv /= nsamples) {
454 const int imod = idiv % nsamples;
455 const double wlpos = cpl_vector_get(init_pts_wl, deg)
456 + imod * pwl_error[deg] / nsamples;
457
458 /* FIXME: If wlpos causes pts_wl to be non-increasing, the
459 solution will be non-physical with no need for evaluation.
460 (*xc could be set to -1 in this case). */
461 cpl_vector_set(pts_wl, deg, wlpos);
462
463 if (imod > 0) break;
464 }
465
466 /* Generate */
467 degree_loc = (cpl_size)degree ;
468 cpl_polynomial_fit(poly_candi, init_pts_x, &symsamp, pts_wl,
469 NULL, CPL_FALSE, NULL, &degree_loc);
470
471 /* Use the degrees of the input guess */
472 degree_loc = cpl_polynomial_get_degree(guess_poly);
473 for (power = degree + 1; power < degree_loc + 1; power++){
474 cpl_polynomial_set_coeff(poly_candi, &power,
475 cpl_polynomial_get_coeff(guess_poly, &power));
476 }
477
478 /* *** Estimate *** */
479 irplib_wlxcorr_estimate(vxc, model, spectrum, lines_catalog,
480 conv_kernel, poly_candi, slitw, fwhm);
481 if (vxcorrs != NULL) cpl_vector_set(vxcorrs, i, *dxc);
482 if (*dxc > *xc) {
483 /* Found a better solution */
484 *xc = *dxc;
485 IRPLIB_PTR_SWAP(poly_sol, poly_candi);
486 }
487 }
488
489 /* This trunctates poly_sol to degree, not wanted for propagation */
490 /* degree_loc = cpl_polynomial_get_degree(guess_poly);
491 for (cpl_size power = degree_loc; power > degree; power--){
492 cpl_polynomial_set_coeff(poly_sol, &power, 0);
493 }
494 */
495
496 cpl_vector_delete(model);
497 cpl_vector_delete(vxc);
498 cpl_vector_delete(conv_kernel);
499 cpl_vector_delete(pts_wl);
500 cpl_matrix_delete(init_pts_x);
501 cpl_vector_delete(init_pts_wl);
502 cpl_polynomial_delete(poly_candi);
503
504#ifdef CPL_WLCALIB_FAIL_ON_CONSTANT
505 /* FIXME: */
506 if (cpl_polynomial_get_degree(poly_sol) == 0) {
507 cpl_polynomial_delete(poly_sol);
508 cpl_vector_delete(vxcorrs);
509 *xc = 0.0;
510 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
511 __FILE__, __LINE__, "Found a constant "
512 "dispersion");
513 cpl_errorstate_dump(prestate, CPL_FALSE, NULL);
514 return NULL;
515 }
516#endif
517
518 if (wlres != NULL) {
519 /* FIXME: A failure in the table creation is not considered a failure
520 of the whole function call (although all outputs may be useless) */
521
522 cpl_errorstate prestate = cpl_errorstate_get();
523 /* Create the spc_table */
524 *wlres = irplib_wlxcorr_gen_spc_table(spectrum, lines_catalog, slitw,
525 fwhm, guess_poly, poly_sol);
526 if (*wlres == NULL) {
527 cpl_polynomial_delete(poly_sol);
528 cpl_vector_delete(vxcorrs);
529 *xc = -1.0;
530 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_OUTPUT,
531 __FILE__, __LINE__, "Cannot generate "
532 "infos table");
533 /* cpl_errorstate_dump(prestate, CPL_FALSE, NULL); */
534 cpl_errorstate_set(prestate);
535 return NULL;
536 }
537 }
538
539 if (xcorrs != NULL) {
540 *xcorrs = vxcorrs;
541 } else {
542 /* assert(vxcorrs == NULL); */
543 }
544
545 return poly_sol;
546}
547
548/*----------------------------------------------------------------------------*/
566/*----------------------------------------------------------------------------*/
567cpl_table * irplib_wlxcorr_gen_spc_table(
568 const cpl_vector * spectrum,
569 const cpl_bivector * lines_catalog,
570 double slitw,
571 double fwhm,
572 const cpl_polynomial * guess_poly,
573 const cpl_polynomial * corr_poly)
574{
575
576 cpl_vector * conv_kernel = NULL;
577 cpl_bivector * gen_init ;
578 cpl_bivector * gen_corr ;
579 cpl_table * spc_table ;
580 const double * pgen ;
581 const double xtrunc = 0.5 * slitw + 5.0 * fwhm * CPL_MATH_SIG_FWHM;
582 const int spec_sz = cpl_vector_get_size(spectrum);
583 const cpl_boolean guess_resamp
584 = !irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
585 guess_poly, spec_sz, 1.0);
586 const cpl_boolean corr_resamp
587 = !irplib_wlcalib_is_lines(cpl_bivector_get_x_const(lines_catalog),
588 corr_poly, spec_sz, 1.0);
589 cpl_error_code error;
590
591 cpl_msg_debug(cpl_func, "Table for guess dispersion polynomial (slitw=%g, "
592 "fwhm=%g) with %d-point observed spectrum with%s catalog re"
593 "sampling", slitw, fwhm, spec_sz, guess_resamp ? "out" : "");
594 cpl_msg_debug(cpl_func, "Table for corr. dispersion polynomial (slitw=%g, "
595 "fwhm=%g) with %d-point observed spectrum with%s catalog re"
596 "sampling", slitw, fwhm, spec_sz, corr_resamp ? "out" : "");
597
598 /* Test inputs */
599 cpl_ensure(spectrum, CPL_ERROR_NULL_INPUT, NULL) ;
600 cpl_ensure(lines_catalog, CPL_ERROR_NULL_INPUT, NULL) ;
601 cpl_ensure(guess_poly, CPL_ERROR_NULL_INPUT, NULL) ;
602 cpl_ensure(corr_poly, CPL_ERROR_NULL_INPUT, NULL) ;
603
604 /* Create the convolution kernel */
605 if (guess_resamp || corr_resamp) {
606 conv_kernel = irplib_wlxcorr_convolve_create_kernel(slitw, fwhm);
607
608 if (conv_kernel == NULL) {
609 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
610 __FILE__, __LINE__, "Cannot create "
611 "convolution kernel") ;
612 return NULL ;
613 }
614 }
615
616 /* Get the emission at initial wavelengths */
617 gen_init = cpl_bivector_new(spec_sz);
618 if (guess_resamp) {
619 error = irplib_wlcalib_fill_spectrum(cpl_bivector_get_y(gen_init),
620 lines_catalog, conv_kernel,
621 guess_poly, 0);
622 } else {
624 (cpl_bivector_get_y(gen_init), NULL, NULL,
625 guess_poly, lines_catalog,
626 slitw, fwhm, xtrunc, 0, CPL_FALSE, CPL_FALSE, NULL);
627 }
628
629 if (error || cpl_vector_fill_polynomial(cpl_bivector_get_x(gen_init),
630 guess_poly, 1, 1)) {
631 cpl_vector_delete(conv_kernel);
632 cpl_bivector_delete(gen_init);
633 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
634 __FILE__, __LINE__, "Cannot get the "
635 "emission spectrum");
636 return NULL;
637 }
638
639 /* Get the emission at corrected wavelengths */
640 gen_corr = cpl_bivector_new(spec_sz);
641 if (corr_resamp) {
642 error = irplib_wlcalib_fill_spectrum(cpl_bivector_get_y(gen_corr),
643 lines_catalog, conv_kernel,
644 corr_poly, 0);
645 } else {
647 (cpl_bivector_get_y(gen_corr), NULL, NULL,
648 corr_poly, lines_catalog,
649 slitw, fwhm, xtrunc, 0, CPL_FALSE, CPL_FALSE, NULL);
650 }
651
652 if (error || cpl_vector_fill_polynomial(cpl_bivector_get_x(gen_corr),
653 corr_poly, 1, 1)) {
654 cpl_vector_delete(conv_kernel);
655 cpl_bivector_delete(gen_init);
656 cpl_bivector_delete(gen_corr) ;
657 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
658 __FILE__, __LINE__, "Cannot get the "
659 "emission spectrum");
660 return NULL;
661 }
662 cpl_vector_delete(conv_kernel) ;
663
664 /* Create the ouput table */
665 spc_table = cpl_table_new(spec_sz);
666 cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_WAVELENGTH,
667 CPL_TYPE_DOUBLE);
668 cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_CAT_INIT,
669 CPL_TYPE_DOUBLE);
670 cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_CAT_FINAL,
671 CPL_TYPE_DOUBLE);
672 cpl_table_new_column(spc_table, IRPLIB_WLXCORR_COL_OBS, CPL_TYPE_DOUBLE);
673
674 /* Update table */
675 pgen = cpl_bivector_get_x_data_const(gen_corr) ;
676 cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_WAVELENGTH, pgen) ;
677 pgen = cpl_bivector_get_y_data_const(gen_corr) ;
678 cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_CAT_FINAL, pgen) ;
679 pgen = cpl_vector_get_data_const(spectrum) ;
680 cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_OBS, pgen) ;
681 pgen = cpl_bivector_get_y_data_const(gen_init) ;
682 cpl_table_copy_data_double(spc_table, IRPLIB_WLXCORR_COL_CAT_INIT, pgen);
683 cpl_bivector_delete(gen_init);
684 cpl_bivector_delete(gen_corr);
685
686 return spc_table ;
687}
688
689/*----------------------------------------------------------------------------*/
701/*----------------------------------------------------------------------------*/
702cpl_bivector * irplib_wlxcorr_cat_extract(
703 const cpl_bivector * lines_catalog,
704 double wave_min,
705 double wave_max)
706{
707 const int nlines = cpl_bivector_get_size(lines_catalog);
708 int wave_min_id, wave_max_id ;
709 cpl_vector * sub_cat_wl ;
710 cpl_vector * sub_cat_int ;
711 const cpl_vector * xlines = cpl_bivector_get_x_const(lines_catalog);
712 const double * dxlines = cpl_vector_get_data_const(xlines);
713
714 cpl_ensure(lines_catalog != NULL, CPL_ERROR_NULL_INPUT, NULL);
715
716 /* Find the 1st line */
717 wave_min_id = (int)cpl_vector_find(xlines, wave_min);
718 if (wave_min_id < 0) {
719 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
720 __FILE__, __LINE__,
721 "The starting wavelength cannot be found") ;
722 return NULL ;
723 }
724
725 /* The first line must be greater than (at least?) wave_min */
726 if (dxlines[wave_min_id] <= wave_min) wave_min_id++;
727
728 /* Find the last line */
729 wave_max_id = (int)cpl_vector_find(xlines, wave_max);
730 if (wave_max_id < 0) {
731 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
732 __FILE__, __LINE__,
733 "The ending wavelength cannot be found") ;
734 return NULL ;
735 }
736 /* The last line must be less than wave_max */
737 if (dxlines[wave_max_id] >= wave_max) wave_max_id--;
738
739 /* Checking the wavelength range at this point via the indices also
740 verifies that they were not found using non-increasing wavelengths */
741 cpl_ensure(wave_min_id <= wave_max_id, CPL_ERROR_ILLEGAL_INPUT, NULL);
742
743 if (wave_min_id < 0 || wave_max_id == nlines) {
744 cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
745 __FILE__, __LINE__, "The %d-line catalogue "
746 "has no lines in the range %g -> %g",
747 nlines, wave_min, wave_max);
748 return NULL ;
749 }
750
751 sub_cat_wl = cpl_vector_extract(xlines, wave_min_id, wave_max_id, 1);
752 sub_cat_int = cpl_vector_extract(cpl_bivector_get_y_const(lines_catalog),
753 wave_min_id, wave_max_id, 1);
754
755 return cpl_bivector_wrap_vectors(sub_cat_wl, sub_cat_int);
756}
757
758/*----------------------------------------------------------------------------*/
775/*----------------------------------------------------------------------------*/
776cpl_vector * irplib_wlxcorr_convolve_create_kernel(double slitw,
777 double fwhm)
778{
779 const double sigma = fwhm * CPL_MATH_SIG_FWHM;
780 const int size = 1 + (int)(5.0 * sigma + 0.5*slitw);
781 cpl_vector * kernel = cpl_vector_new(size);
782
783
784 if (cpl_vector_fill_lss_profile_symmetric(kernel, slitw, fwhm)) {
785 cpl_vector_delete(kernel);
786 kernel = NULL;
787 (void)cpl_error_set_where(cpl_func);
788 }
789
790 return kernel;
791}
792
793/*----------------------------------------------------------------------------*/
806/*----------------------------------------------------------------------------*/
807int irplib_wlxcorr_convolve(
808 cpl_vector * smoothed,
809 const cpl_vector * conv_kernel)
810{
811 int nsamples ;
812 int ihwidth ;
813 cpl_vector * raw ;
814 double * psmoothe ;
815 double * praw ;
816 const double* psymm ;
817 int i, j ;
818
819 /* Test entries */
820 cpl_ensure(smoothed, CPL_ERROR_NULL_INPUT, -1) ;
821 cpl_ensure(conv_kernel, CPL_ERROR_NULL_INPUT, -1) ;
822
823 /* Initialise */
824 nsamples = cpl_vector_get_size(smoothed) ;
825 ihwidth = cpl_vector_get_size(conv_kernel) - 1 ;
826 cpl_ensure(ihwidth<nsamples, CPL_ERROR_ILLEGAL_INPUT, -1) ;
827 psymm = cpl_vector_get_data_const(conv_kernel) ;
828 psmoothe = cpl_vector_get_data(smoothed) ;
829
830 /* Create raw vector */
831 raw = cpl_vector_duplicate(smoothed) ;
832 praw = cpl_vector_get_data(raw) ;
833
834 /* Convolve with the symmetric function */
835 for (i=0 ; i<ihwidth ; i++) {
836 psmoothe[i] = praw[i] * psymm[0];
837 for (j=1 ; j <= ihwidth ; j++) {
838 const int k = i-j < 0 ? 0 : i-j;
839 psmoothe[i] += (praw[k]+praw[i+j]) * psymm[j];
840 }
841 }
842
843 for (i=ihwidth ; i<nsamples-ihwidth ; i++) {
844 psmoothe[i] = praw[i] * psymm[0];
845 for (j=1 ; j<=ihwidth ; j++)
846 psmoothe[i] += (praw[i-j]+praw[i+j]) * psymm[j];
847 }
848 for (i=nsamples-ihwidth ; i<nsamples ; i++) {
849 psmoothe[i] = praw[i] * psymm[0];
850 for (j=1 ; j<=ihwidth ; j++) {
851 const int k = i+j > nsamples-1 ? nsamples - 1 : i+j;
852 psmoothe[i] += (praw[k]+praw[i-j]) * psymm[j];
853 }
854 }
855 cpl_vector_delete(raw) ;
856 return 0 ;
857}
858
859/*----------------------------------------------------------------------------*/
869/*----------------------------------------------------------------------------*/
870int irplib_wlxcorr_plot_solution(
871 const cpl_polynomial * init,
872 const cpl_polynomial * comp,
873 const cpl_polynomial * sol,
874 int pix_start,
875 int pix_stop)
876{
877 int nsamples, nplots ;
878 cpl_vector ** vectors ;
879 int i ;
880
881 /* Test entries */
882 if (init == NULL || comp == NULL) return -1 ;
883
884 /* Initialise */
885 nsamples = pix_stop - pix_start + 1 ;
886 if (sol != NULL) nplots = 3 ;
887 else nplots = 2 ;
888
889 /* Create vectors */
890 vectors = cpl_malloc((nplots+1)*sizeof(cpl_vector*)) ;
891 for (i=0 ; i<nplots+1 ; i++) vectors[i] = cpl_vector_new(nsamples) ;
892
893 /* First plot with the lambda/pixel relation */
894 /* Fill vectors */
895 for (i=0 ; i<nsamples ; i++) {
896 cpl_vector_set(vectors[0], i, pix_start+i) ;
897 cpl_vector_set(vectors[1], i,
898 cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL)) ;
899 cpl_vector_set(vectors[2], i,
900 cpl_polynomial_eval_1d(comp, (double)(pix_start+i), NULL)) ;
901 if (sol != NULL)
902 cpl_vector_set(vectors[3], i,
903 cpl_polynomial_eval_1d(sol, (double)(pix_start+i), NULL)) ;
904 }
905
906 /* Plot */
907 cpl_plot_vectors("set grid;set xlabel 'Position (pixels)';",
908 "t '1-Initial / 2-Computed / 3-Solution' w lines",
909 "", (const cpl_vector **)vectors, nplots+1);
910
911 /* Free vectors */
912 for (i=0 ; i<nplots+1 ; i++) cpl_vector_delete(vectors[i]) ;
913 cpl_free(vectors) ;
914
915 /* Allocate vectors */
916 nplots -- ;
917 vectors = cpl_malloc((nplots+1)*sizeof(cpl_vector*)) ;
918 for (i=0 ; i<nplots+1 ; i++) vectors[i] = cpl_vector_new(nsamples) ;
919
920 /* Second plot with the delta-lambda/pixel relation */
921 /* Fill vectors */
922 for (i=0 ; i<nsamples ; i++) {
923 double diff ;
924 cpl_vector_set(vectors[0], i, pix_start+i) ;
925 diff = cpl_polynomial_eval_1d(comp, (double)(pix_start+i), NULL) -
926 cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL) ;
927 cpl_vector_set(vectors[1], i, diff) ;
928 if (sol != NULL) {
929 diff = cpl_polynomial_eval_1d(sol, (double)(pix_start+i), NULL) -
930 cpl_polynomial_eval_1d(init, (double)(pix_start+i), NULL) ;
931 cpl_vector_set(vectors[2], i, diff) ;
932 }
933 }
934
935 /* Plot */
936 if (sol == NULL) {
937 cpl_bivector * bivector ;
938 bivector = cpl_bivector_wrap_vectors(vectors[0], vectors[1]) ;
939 cpl_plot_bivector(
940"set grid;set xlabel 'Position (pixels)';set ylabel 'Wavelength difference';",
941 "t 'Computed-Initial wavelenth' w lines", "", bivector);
942 cpl_bivector_unwrap_vectors(bivector) ;
943 } else {
944 cpl_plot_vectors("set grid;set xlabel 'Position (pixels)';",
945 "t '1-Computed - Initial / 2--Solution - Initial' w lines",
946 "", (const cpl_vector **)vectors, nplots+1);
947 }
948
949 /* Free vectors */
950 for (i=0 ; i<nplots+1 ; i++) cpl_vector_delete(vectors[i]) ;
951 cpl_free(vectors) ;
952
953 /* Return */
954 return 0 ;
955}
956
957/*----------------------------------------------------------------------------*/
968/*----------------------------------------------------------------------------*/
969int irplib_wlxcorr_plot_spc_table(
970 const cpl_table * spc_table,
971 const char * title,
972 int first_plotted_line,
973 int last_plotted_line)
974{
975 char title_loc[1024] ;
976 cpl_vector ** vectors ;
977 cpl_vector ** sub_vectors ;
978 cpl_vector * tmp_vec ;
979 int nsamples ;
980 double mean1, mean3 ;
981 int start_ind, stop_ind, hsize_pix ;
982 int i, j ;
983
984 /* Test entries */
985 if (first_plotted_line > last_plotted_line) return -1 ;
986 if (spc_table == NULL) return -1 ;
987
988 /* Initialise */
989 nsamples = cpl_table_get_nrow(spc_table) ;
990 hsize_pix = 10 ;
991
992 sprintf(title_loc,
993 "t '%s - 1-Initial catalog/2-Corrected catalog/3-Observed' w lines",
994 title) ;
995 title_loc[1023] = (char)0 ;
996
997 vectors = cpl_malloc(4*sizeof(cpl_vector*)) ;
998 vectors[0] = cpl_vector_wrap(nsamples,
999 cpl_table_get_data_double((cpl_table*)spc_table,
1000 IRPLIB_WLXCORR_COL_WAVELENGTH));
1001 vectors[1] = cpl_vector_wrap(nsamples,
1002 cpl_table_get_data_double((cpl_table*)spc_table,
1003 IRPLIB_WLXCORR_COL_CAT_INIT));
1004 vectors[2] = cpl_vector_wrap(nsamples,
1005 cpl_table_get_data_double((cpl_table*)spc_table,
1006 IRPLIB_WLXCORR_COL_CAT_FINAL));
1007 vectors[3] = cpl_vector_wrap(nsamples,
1008 cpl_table_get_data_double((cpl_table*)spc_table,
1009 IRPLIB_WLXCORR_COL_OBS)) ;
1010
1011 /* Scale the signal for a bettre display */
1012 mean1 = cpl_vector_get_mean(vectors[1]) ;
1013 mean3 = cpl_vector_get_mean(vectors[3]) ;
1014 if (fabs(mean3) > 1)
1015 cpl_vector_multiply_scalar(vectors[3], fabs(mean1/mean3)) ;
1016
1017 cpl_plot_vectors("set grid;set xlabel 'Wavelength (nm)';", title_loc,
1018 "", (const cpl_vector **)vectors, 4);
1019
1020 /* Unscale the signal */
1021 if (fabs(mean3) > 1)
1022 cpl_vector_multiply_scalar(vectors[3], mean3/mean1) ;
1023
1024 /* Loop on the brightest lines and zoom on them */
1025 sprintf(title_loc,
1026"t '%s - 1-Initial catalog/2-Corrected catalog/3-Observed (ZOOMED)' w lines",
1027 title) ;
1028 title_loc[1023] = (char)0 ;
1029 tmp_vec = cpl_vector_duplicate(vectors[2]) ;
1030 for (i=0 ; i<last_plotted_line ; i++) {
1031 double max;
1032 /* Find the brightest line */
1033 if ((max = cpl_vector_get_max(tmp_vec)) <= 0.0) break ;
1034 for (j=0 ; j<nsamples ; j++) {
1035 if (cpl_vector_get(tmp_vec, j) == max) break ;
1036 }
1037 if (j-hsize_pix < 0) start_ind = 0 ;
1038 else start_ind = j-hsize_pix ;
1039 if (j+hsize_pix > nsamples-1) stop_ind = nsamples-1 ;
1040 else stop_ind = j+hsize_pix ;
1041 for (j=start_ind ; j<=stop_ind ; j++) cpl_vector_set(tmp_vec, j, 0.0) ;
1042
1043 if (i+1 >= first_plotted_line) {
1044 sub_vectors = cpl_malloc(4*sizeof(cpl_vector*)) ;
1045 sub_vectors[0]=cpl_vector_extract(vectors[0],start_ind,stop_ind,1);
1046 sub_vectors[1]=cpl_vector_extract(vectors[1],start_ind,stop_ind,1);
1047 sub_vectors[2]=cpl_vector_extract(vectors[2],start_ind,stop_ind,1);
1048 sub_vectors[3]=cpl_vector_extract(vectors[3],start_ind,stop_ind,1);
1049
1050 cpl_plot_vectors("set grid;set xlabel 'Wavelength (nm)';",
1051 title_loc, "", (const cpl_vector **)sub_vectors, 4);
1052
1053 cpl_vector_delete(sub_vectors[0]) ;
1054 cpl_vector_delete(sub_vectors[1]) ;
1055 cpl_vector_delete(sub_vectors[2]) ;
1056 cpl_vector_delete(sub_vectors[3]) ;
1057 cpl_free(sub_vectors) ;
1058 }
1059 }
1060 cpl_vector_delete(tmp_vec) ;
1061
1062 cpl_vector_unwrap(vectors[0]) ;
1063 cpl_vector_unwrap(vectors[1]) ;
1064 cpl_vector_unwrap(vectors[2]) ;
1065 cpl_vector_unwrap(vectors[3]) ;
1066 cpl_free(vectors) ;
1067
1068 return 0 ;
1069}
1070
1071/*----------------------------------------------------------------------------*/
1079/*----------------------------------------------------------------------------*/
1080int irplib_wlxcorr_catalog_plot(
1081 const cpl_bivector * cat,
1082 double wmin,
1083 double wmax)
1084{
1085 int start, stop ;
1086 cpl_bivector * subcat ;
1087 cpl_vector * subcat_x ;
1088 cpl_vector * subcat_y ;
1089 const double * pwave ;
1090 int nvals, nvals_tot ;
1091 int i ;
1092
1093 /* Test entries */
1094 if (cat == NULL) return -1 ;
1095 if (wmax <= wmin) return -1 ;
1096
1097 /* Initialise */
1098 nvals_tot = cpl_bivector_get_size(cat) ;
1099
1100 /* Count the nb of values */
1101 pwave = cpl_bivector_get_x_data_const(cat) ;
1102 if (pwave[0] >= wmin) start = 0 ;
1103 else start = -1 ;
1104 if (pwave[nvals_tot-1] <= wmax) stop = nvals_tot-1 ;
1105 else stop = -1 ;
1106 i=0 ;
1107 while ((i<nvals_tot-1) && (pwave[i] < wmin)) i++ ;
1108 start = i ;
1109 i= nvals_tot-1 ;
1110 while ((i>0) && (pwave[i] > wmax)) i-- ;
1111 stop = i ;
1112
1113 if (start>=stop) {
1114 cpl_msg_error(cpl_func, "Cannot plot the catalog") ;
1115 return -1 ;
1116 }
1117 nvals = stop - start + 1 ;
1118
1119 /* Create the bivector to plot */
1120 subcat_x = cpl_vector_extract(cpl_bivector_get_x_const(cat),start,stop, 1) ;
1121 subcat_y = cpl_vector_extract(cpl_bivector_get_y_const(cat),start,stop, 1) ;
1122 subcat = cpl_bivector_wrap_vectors(subcat_x, subcat_y) ;
1123
1124 /* Plot */
1125 if (nvals > 500) {
1126 cpl_plot_bivector(
1127 "set grid;set xlabel 'Wavelength (nm)';set ylabel 'Emission';",
1128 "t 'Catalog Spectrum' w lines", "", subcat);
1129 } else {
1130 cpl_plot_bivector(
1131 "set grid;set xlabel 'Wavelength (nm)';set ylabel 'Emission';",
1132 "t 'Catalog Spectrum' w impulses", "", subcat);
1133 }
1134 cpl_bivector_unwrap_vectors(subcat) ;
1135 cpl_vector_delete(subcat_x) ;
1136 cpl_vector_delete(subcat_y) ;
1137
1138 return 0 ;
1139}
1140
1143/*----------------------------------------------------------------------------*/
1158/*----------------------------------------------------------------------------*/
1159static void irplib_wlxcorr_estimate(cpl_vector * vxc,
1160 cpl_vector * model,
1161 const cpl_vector * spectrum,
1162 const cpl_bivector * lines_catalog,
1163 const cpl_vector * conv_kernel,
1164 const cpl_polynomial * poly_candi,
1165 double slitw,
1166 double fwhm)
1167{
1168 cpl_errorstate prestate = cpl_errorstate_get();
1169 const int hsize = cpl_vector_get_size(vxc) / 2;
1170
1171 if (conv_kernel != NULL) {
1172 irplib_wlcalib_fill_spectrum(model, lines_catalog, conv_kernel,
1173 poly_candi, hsize);
1174 } else {
1175 const double xtrunc = 0.5 * slitw + 5.0 * fwhm * CPL_MATH_SIG_FWHM;
1176
1177 irplib_vector_fill_line_spectrum_model(model, NULL, NULL, poly_candi,
1178 lines_catalog, slitw, fwhm,
1179 xtrunc, 0, CPL_FALSE, CPL_FALSE,
1180 NULL);
1181 }
1182
1183 if (cpl_errorstate_is_equal(prestate))
1184 cpl_vector_correlate(vxc, model, spectrum);
1185
1186 if (!cpl_errorstate_is_equal(prestate)) {
1187 cpl_vector_fill(vxc, 0.0);
1188
1189 /* cpl_errorstate_dump(prestate, CPL_FALSE, NULL); */
1190 cpl_errorstate_set(prestate);
1191
1192 }
1193
1194 return;
1195}
1196
1197
1198/*----------------------------------------------------------------------------*/
1208/*----------------------------------------------------------------------------*/
1209static cpl_boolean irplib_wlcalib_is_lines(const cpl_vector * wavelengths,
1210 const cpl_polynomial * disp1d,
1211 int spec_sz,
1212 double tol)
1213{
1214 const int nlines = cpl_vector_get_size(wavelengths);
1215 /* The dispersion on the detector center */
1216 const double dispersion = cpl_polynomial_eval_1d_diff(disp1d,
1217 0.5 * spec_sz + 1.0,
1218 0.5 * spec_sz,
1219 NULL);
1220 const double range = cpl_vector_get(wavelengths, nlines-1)
1221 - cpl_vector_get(wavelengths, 0);
1222
1223 cpl_ensure(wavelengths != NULL, CPL_ERROR_NULL_INPUT, CPL_FALSE);
1224 cpl_ensure(disp1d != NULL, CPL_ERROR_NULL_INPUT, CPL_FALSE);
1225 cpl_ensure(cpl_polynomial_get_dimension(disp1d) == 1,
1226 CPL_ERROR_ILLEGAL_INPUT, CPL_FALSE);
1227 cpl_ensure(range > 0.0, CPL_ERROR_ILLEGAL_INPUT, CPL_FALSE);
1228
1229 return nlines * fabs(dispersion) <= tol * fabs(range) ? CPL_TRUE
1230 : CPL_FALSE;
1231
1232}
1233
1234/*----------------------------------------------------------------------------*/
1249/*----------------------------------------------------------------------------*/
1250static
1251cpl_error_code irplib_wlcalib_fill_spectrum(cpl_vector * self,
1252 const cpl_bivector * lines_catalog,
1253 const cpl_vector * conv_kernel,
1254 const cpl_polynomial * poly,
1255 int search_hs)
1256{
1257
1258
1259 const int size = cpl_vector_get_size(self);
1260 const int nlines = cpl_bivector_get_size(lines_catalog);
1261 const cpl_vector * xlines = cpl_bivector_get_x_const(lines_catalog);
1262 const double * dxlines = cpl_vector_get_data_const(xlines);
1263 cpl_bivector * sub_cat ;
1264 cpl_vector * sub_cat_x;
1265 cpl_vector * sub_cat_y;
1266 cpl_vector * wl_limits;
1267 double wave_min, wave_max;
1268 int wave_min_id, wave_max_id;
1269 int nsub;
1270 int error;
1271
1272 cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1273 cpl_ensure_code(lines_catalog != NULL, CPL_ERROR_NULL_INPUT);
1274 cpl_ensure_code(conv_kernel != NULL, CPL_ERROR_NULL_INPUT);
1275 cpl_ensure_code(poly != NULL, CPL_ERROR_NULL_INPUT);
1276 cpl_ensure_code(size > 0, CPL_ERROR_ILLEGAL_INPUT);
1277
1278
1279 /* Resample the spectrum */
1280 wl_limits = cpl_vector_new(size + 1);
1281 cpl_vector_fill_polynomial(wl_limits, poly, 0.5 - search_hs, 1);
1282
1283 /* The spectrum wavelength bounds */
1284 wave_min = cpl_vector_get(wl_limits, 0);
1285 wave_max = cpl_vector_get(wl_limits, size);
1286
1287 /* Find the 1st line */
1288 wave_min_id = cpl_vector_find(xlines, wave_min);
1289 /* The first line must be less than or equal to wave_min */
1290 if (dxlines[wave_min_id] > wave_min) wave_min_id--;
1291
1292 if (wave_min_id < 0) {
1293 cpl_vector_delete(wl_limits);
1294 return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1295 __FILE__, __LINE__, "The %d-line "
1296 "catalogue only has lines above %g",
1297 nlines, wave_min);
1298 }
1299
1300 /* Find the last line */
1301 wave_max_id = cpl_vector_find(xlines, wave_max);
1302 /* The last line must be greater than or equal to wave_max */
1303 if (dxlines[wave_max_id] < wave_max) wave_max_id++;
1304
1305 if (wave_max_id == nlines) {
1306 cpl_vector_delete(wl_limits);
1307 return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1308 __FILE__, __LINE__, "The %d-line "
1309 "catalogue only has lines below %g",
1310 nlines, wave_max);
1311 }
1312
1313 /* Checking the wavelength range at this point via the indices also
1314 verifies that they were not found using non-increasing wavelengths */
1315 nsub = 1 + wave_max_id - wave_min_id;
1316 cpl_ensure_code(nsub > 1, CPL_ERROR_ILLEGAL_INPUT);
1317
1318 /* Wrap a new bivector around the relevant part of the catalog */
1319 /* The data is _not_ modified */
1320 sub_cat_x = cpl_vector_wrap(nsub, wave_min_id + (double*)dxlines);
1321 sub_cat_y = cpl_vector_wrap(nsub, wave_min_id + (double*)
1322 cpl_bivector_get_y_data_const(lines_catalog));
1323 sub_cat = cpl_bivector_wrap_vectors(sub_cat_x, sub_cat_y);
1324
1325 /* High resolution catalog */
1326 error = irplib_wlxcorr_signal_resample(self, wl_limits, sub_cat);
1327
1328 cpl_vector_delete(wl_limits);
1329 cpl_bivector_unwrap_vectors(sub_cat);
1330 (void)cpl_vector_unwrap(sub_cat_x);
1331 (void)cpl_vector_unwrap(sub_cat_y);
1332
1333 cpl_ensure_code(!error, CPL_ERROR_ILLEGAL_INPUT);
1334
1335 /* Smooth the instrument resolution */
1336 cpl_ensure_code(!irplib_wlxcorr_convolve(self, conv_kernel),
1337 cpl_error_get_code());
1338
1339 return CPL_ERROR_NONE;
1340}
1341
1342
1343/*----------------------------------------------------------------------------*/
1353/*----------------------------------------------------------------------------*/
1354static int irplib_wlxcorr_signal_resample(
1355 cpl_vector * resampled,
1356 const cpl_vector * xbounds,
1357 const cpl_bivector * hires)
1358{
1359 const int hrsize = cpl_bivector_get_size(hires);
1360 const cpl_vector* xhires ;
1361 const cpl_vector* yhires ;
1362 const double * pxhires ;
1363 const double * pyhires ;
1364 const double * pxbounds ;
1365 cpl_vector * ybounds ;
1366 cpl_bivector * boundary ;
1367 double * pybounds ;
1368 double * presampled ;
1369 int nsamples ;
1370 int i, itt ;
1371
1372 /* Test entries */
1373 if ((!resampled) || (!xbounds) || (!hires)) return -1 ;
1374
1375 /* Initialise */
1376 nsamples = cpl_vector_get_size(resampled) ;
1377
1378 /* Initialise */
1379 presampled = cpl_vector_get_data(resampled) ;
1380 pxbounds = cpl_vector_get_data_const(xbounds) ;
1381 xhires = cpl_bivector_get_x_const(hires) ;
1382 yhires = cpl_bivector_get_y_const(hires) ;
1383 pxhires = cpl_vector_get_data_const(xhires) ;
1384 pyhires = cpl_vector_get_data_const(yhires) ;
1385
1386 /* Create a new vector */
1387 ybounds = cpl_vector_new(cpl_vector_get_size(xbounds)) ;
1388 boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,ybounds) ;
1389 pybounds = cpl_vector_get_data(ybounds) ;
1390
1391 /* Test entries */
1392 if (cpl_bivector_get_size(boundary) != nsamples + 1) {
1393 cpl_bivector_unwrap_vectors(boundary) ;
1394 cpl_vector_delete(ybounds) ;
1395 return -1 ;
1396 }
1397
1398 /* Get the ind */
1399 itt = cpl_vector_find(xhires, pxbounds[0]);
1400
1401 /* Interpolate the signal */
1402 if (cpl_bivector_interpolate_linear(boundary, hires)) {
1403 cpl_bivector_unwrap_vectors(boundary) ;
1404 cpl_vector_delete(ybounds) ;
1405 return -1 ;
1406 }
1407
1408 /* At this point itt most likely points to element just below
1409 pxbounds[0] */
1410 while (pxhires[itt] < pxbounds[0]) itt++;
1411
1412 for (i=0; i < nsamples; i++) {
1413 /* The i'th signal is the weighted average of the two interpolated
1414 signals at the pixel boundaries and those table signals in
1415 between */
1416
1417 double xlow = pxbounds[i];
1418 double x = pxhires[itt];
1419
1420 if (x > pxbounds[i+1]) x = pxbounds[i+1];
1421 /* Contribution from interpolated value at wavelength at lower pixel
1422 boundary */
1423 presampled[i] = pybounds[i] * (x - xlow);
1424
1425 /* Contribution from table values in between pixel boundaries */
1426 while ((pxhires[itt] < pxbounds[i+1]) && (itt < hrsize)) {
1427 const double xprev = x;
1428 x = pxhires[itt+1];
1429 if (x > pxbounds[i+1]) x = pxbounds[i+1];
1430 presampled[i] += pyhires[itt] * (x - xlow);
1431 xlow = xprev;
1432 itt++;
1433 }
1434
1435 /* Contribution from interpolated value at wavelength at upper pixel
1436 boundary */
1437 presampled[i] += pybounds[i+1] * (pxbounds[i+1] - xlow);
1438
1439 /* Compute average by dividing integral by length of pixel range
1440 (the factor 2 comes from the contributions) */
1441 presampled[i] /= 2 * (pxbounds[i+1] - pxbounds[i]);
1442 }
1443 cpl_bivector_unwrap_vectors(boundary) ;
1444 cpl_vector_delete(ybounds) ;
1445 return 0 ;
1446}
1447
1448
1449
1450/*----------------------------------------------------------------------------*/
1471/*----------------------------------------------------------------------------*/
1472static cpl_error_code cpl_vector_fill_lss_profile_symmetric(cpl_vector * self,
1473 double slitw,
1474 double fwhm)
1475{
1476
1477 const double sigma = fwhm * CPL_MATH_SIG_FWHM;
1478 const int n = cpl_vector_get_size(self);
1479 int i;
1480
1481
1482 cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1483 cpl_ensure_code(slitw > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1484 cpl_ensure_code(fwhm > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1485
1486 /* Cannot fail now */
1487
1488 /* Special case for i = 0 */
1489 (void)cpl_vector_set(self, 0,
1490 (irplib_erf_antideriv(0.5*slitw + 0.5, sigma) -
1491 irplib_erf_antideriv(0.5*slitw - 0.5, sigma)) / slitw);
1492
1493 for (i = 1; i < n; i++) {
1494 /* FIXME: Reuse two irplib_erf_antideriv() calls from previous value */
1495 const double x1p = i + 0.5*slitw + 0.5;
1496 const double x1n = i - 0.5*slitw + 0.5;
1497 const double x0p = i + 0.5*slitw - 0.5;
1498 const double x0n = i - 0.5*slitw - 0.5;
1499 const double val = 0.5/slitw *
1500 (irplib_erf_antideriv(x1p, sigma) - irplib_erf_antideriv(x1n, sigma) -
1501 irplib_erf_antideriv(x0p, sigma) + irplib_erf_antideriv(x0n, sigma));
1502 (void)cpl_vector_set(self, i, val);
1503 }
1504
1505 return CPL_ERROR_NONE;
1506}
double irplib_erf_antideriv(double x, double sigma)
The antiderivative of erx(x/sigma/sqrt(2)) with respect to x.
cpl_error_code irplib_vector_fill_line_spectrum_model(cpl_vector *self, cpl_vector *linepix, cpl_vector *erftmp, const cpl_polynomial *disp, const cpl_bivector *lines, double wslit, double wfwhm, double xtrunc, int hsize, cpl_boolean dofast, cpl_boolean dolog, cpl_size *pulines)
Generate a 1D spectrum from (arc) lines and a dispersion relation.