SINFONI Pipeline Reference Manual  2.5.2
irplib_wavecal.c
1 /* $Id: irplib_wavecal.c,v 1.52 2012-08-03 21:05:32 llundin Exp $
2  *
3  * This file is part of the IRPLIB 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: llundin $
23  * $Date: 2012-08-03 21:05:32 $
24  * $Revision: 1.52 $
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 /* TEMPORARY SUPPORT OF CPL 5.x */
37 #include <cpl.h>
38 
39 #ifndef CPL_SIZE_FORMAT
40 #define CPL_SIZE_FORMAT "d"
41 #define cpl_size int
42 #endif
43 /* END TEMPORARY SUPPORT OF CPL 5.x */
44 
45 #include "irplib_wavecal_impl.h"
46 
47 /* Needed for irplib_errorstate_dump_debug() */
48 #include "irplib_utils.h"
49 
50 #include <string.h>
51 #include <math.h>
52 
53 #ifdef HAVE_GSL
54 #include <gsl/gsl_multimin.h>
55 #endif
56 
57 /*-----------------------------------------------------------------------------
58  Private types
59  -----------------------------------------------------------------------------*/
60 
61 typedef struct {
62 
63  const cpl_vector * observed;
64  cpl_polynomial * disp1d;
65  cpl_vector * spectrum;
66  irplib_base_spectrum_model * param;
67  cpl_error_code (* filler)(cpl_vector *, const cpl_polynomial *,
68  irplib_base_spectrum_model *);
69  cpl_vector * vxc;
70  double xc;
71  int maxxc;
72  double mxc;
73  cpl_polynomial * mdisp;
74  int ishift;
75 
76 } irplib_multimin;
77 
78 /*-----------------------------------------------------------------------------
79  Defines
80  -----------------------------------------------------------------------------*/
81 
82 #ifndef inline
83 #define inline /* inline */
84 #endif
85 
86 #define IRPLIB_MAX(A,B) ((A) > (B) ? (A) : (B))
87 #define IRPLIB_MIN(A,B) ((A) < (B) ? (A) : (B))
88 
89 /*-----------------------------------------------------------------------------
90  Private functions
91  -----------------------------------------------------------------------------*/
92 
93 #ifdef HAVE_GSL
94 static double irplib_gsl_correlation(const gsl_vector *, void *);
95 #endif
96 
97 static cpl_error_code
98 irplib_polynomial_find_1d_from_correlation_(cpl_polynomial *, int,
99  const cpl_vector *,
100  irplib_base_spectrum_model *,
101  cpl_error_code (*)
102  (cpl_vector *,
103  const cpl_polynomial *,
104  irplib_base_spectrum_model *),
105  double, double, int, int,
106  double *, cpl_boolean *);
107 
108 
109 /*----------------------------------------------------------------------------*/
113 /*----------------------------------------------------------------------------*/
114 
118 /*----------------------------------------------------------------------------*/
126 /*----------------------------------------------------------------------------*/
127 int irplib_bivector_count_positive(const cpl_bivector * self,
128  double x_min,
129  double x_max)
130 {
131 
132  const int nself = cpl_bivector_get_size(self);
133  const double * px = cpl_bivector_get_x_data_const(self);
134  const double * py = cpl_bivector_get_y_data_const(self);
135  int npos = 0;
136  int i = 0;
137 
138  cpl_ensure(self != NULL, CPL_ERROR_NULL_INPUT, -1);
139  cpl_ensure(x_min <= x_max, CPL_ERROR_ILLEGAL_INPUT, -2);
140 
141  /* FIXME: Use cpl_vector_find() */
142  while (i < nself && px[i] < x_min) i++;
143  while (i < nself && px[i] < x_max)
144  if (py[i++] > 0) npos++;
145 
146  return npos;
147 }
148 
149 /*----------------------------------------------------------------------------*/
159 /*----------------------------------------------------------------------------*/
160 cpl_error_code irplib_polynomial_fit_2d_dispersion(cpl_polynomial * self,
161  const cpl_image * imgwave,
162  int fitdeg, double * presid)
163 {
164 
165  const int nx = cpl_image_get_size_x(imgwave);
166  const int ny = cpl_image_get_size_y(imgwave);
167  const int nbad = cpl_image_count_rejected(imgwave);
168  const int nsamp = nx * ny - nbad;
169  cpl_matrix * xy_pos;
170  double * xdata;
171  double * ydata;
172  cpl_vector * wlen;
173  double * dwlen;
174  const cpl_size nfitdeg = (cpl_size)fitdeg;
175  int i, j;
176  int k = 0;
177 
178  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
179  cpl_ensure_code(imgwave != NULL, CPL_ERROR_NULL_INPUT);
180  cpl_ensure_code(presid != NULL, CPL_ERROR_NULL_INPUT);
181  cpl_ensure_code(fitdeg > 0, CPL_ERROR_ILLEGAL_INPUT);
182 
183  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 2,
184  CPL_ERROR_ILLEGAL_INPUT);
185 
186  xy_pos = cpl_matrix_new(2, nsamp);
187  xdata = cpl_matrix_get_data(xy_pos);
188  ydata = xdata + nsamp;
189 
190  dwlen = (double*)cpl_malloc(nsamp * sizeof(double));
191  wlen = cpl_vector_wrap(nsamp, dwlen);
192 
193  for (i=1; i <= nx; i++) {
194  for (j=1; j <= ny; j++) {
195  int is_bad;
196  const double value = cpl_image_get(imgwave, i, j, &is_bad);
197  if (!is_bad) {
198  xdata[k] = i;
199  ydata[k] = j;
200  dwlen[k] = value;
201  k++;
202  }
203  }
204  }
205 
206  cpl_msg_info(cpl_func, "Fitting 2D polynomial to %d X %d image, ignoring "
207  "%d poorly calibrated pixels", nx, ny, nbad);
208 
209  if (cpl_polynomial_fit(self, xy_pos, NULL, wlen, NULL, CPL_FALSE, NULL,
210  &nfitdeg) == CPL_ERROR_NONE && presid != NULL) {
211  cpl_vector_fill_polynomial_fit_residual(wlen, wlen, NULL, self, xy_pos,
212  NULL);
213  *presid = cpl_vector_product(wlen, wlen)/nsamp;
214  }
215  cpl_matrix_delete(xy_pos);
216  cpl_vector_delete(wlen);
217 
218  cpl_ensure_code(k == nsamp, CPL_ERROR_UNSPECIFIED);
219 
220  return CPL_ERROR_NONE;
221 }
222 
223 
224 /*----------------------------------------------------------------------------*/
242 /*----------------------------------------------------------------------------*/
243 cpl_error_code
245  int maxdeg,
246  const cpl_vector * obs,
247  irplib_base_spectrum_model * model,
248  cpl_error_code (* filler)
249  (cpl_vector *,
250  const cpl_polynomial *,
251  irplib_base_spectrum_model *),
252  double pixtol,
253  double pixstep,
254  int hsize,
255  int maxite,
256  double * pxc)
257 {
258  cpl_boolean restart = CPL_FALSE;
259  const cpl_error_code error = irplib_polynomial_find_1d_from_correlation_
260  (self, maxdeg, obs, model, filler, pixtol, pixstep, hsize, maxite, pxc,
261  &restart);
262 
263  return error ? cpl_error_set_where(cpl_func) :
264  (restart ? cpl_error_set(cpl_func, CPL_ERROR_CONTINUE)
265  : CPL_ERROR_NONE);
266 }
267 
268 /*----------------------------------------------------------------------------*/
289 /*----------------------------------------------------------------------------*/
290 static cpl_error_code
291 irplib_polynomial_find_1d_from_correlation_(cpl_polynomial * self,
292  int maxdeg,
293  const cpl_vector * obs,
294  irplib_base_spectrum_model * model,
295  cpl_error_code (* filler)
296  (cpl_vector *,
297  const cpl_polynomial *,
298  irplib_base_spectrum_model *),
299  double pixtol,
300  double pixstep,
301  int hsize,
302  int maxite,
303  double * pxc,
304  cpl_boolean * prestart)
305 {
306 
307 #ifdef HAVE_GSL
308  const gsl_multimin_fminimizer_type * T = gsl_multimin_fminimizer_nmsimplex;
309  gsl_multimin_fminimizer * minimizer;
310  gsl_multimin_function my_func;
311  irplib_multimin data;
312  gsl_vector * dispgsl;
313  gsl_vector * stepsize;
314  gsl_vector * dispprev;
315  int status = GSL_CONTINUE;
316  const int nobs = cpl_vector_get_size(obs);
317  const cpl_size nfit = maxdeg + 1;
318  cpl_errorstate prestate = cpl_errorstate_get();
319  /* Convert pixel step to wavelength step on detector center */
320  const double wlstep =
321  cpl_polynomial_eval_1d_diff(self, 0.5 * (nobs + pixstep),
322  0.5 * (nobs - pixstep), NULL);
323  double wlstepi = wlstep;
324  double size;
325  int iter;
326  cpl_size i;
327 
328 #endif
329 
330  cpl_ensure_code(prestart != NULL, CPL_ERROR_NULL_INPUT);
331  *prestart = CPL_FALSE;
332  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
333  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
334  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
335  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
336  cpl_ensure_code(pxc != NULL, CPL_ERROR_NULL_INPUT);
337 
338  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
339  CPL_ERROR_ILLEGAL_INPUT);
340 
341  cpl_ensure_code(cpl_polynomial_get_degree(self) > 0,
342  CPL_ERROR_ILLEGAL_INPUT);
343 
344  cpl_ensure_code(maxdeg >= 0, CPL_ERROR_ILLEGAL_INPUT);
345  cpl_ensure_code(pixtol > 0.0, CPL_ERROR_ILLEGAL_INPUT);
346  cpl_ensure_code(pixstep > 0.0, CPL_ERROR_ILLEGAL_INPUT);
347  cpl_ensure_code(hsize >= 0, CPL_ERROR_ILLEGAL_INPUT);
348  cpl_ensure_code(maxite >= 0, CPL_ERROR_ILLEGAL_INPUT);
349 
350 #ifndef HAVE_GSL
351  return cpl_error_set_message(cpl_func, CPL_ERROR_UNSUPPORTED_MODE,
352  "GSL is not available");
353 #else
354 
355  minimizer = gsl_multimin_fminimizer_alloc(T, (size_t)nfit);
356 
357  cpl_ensure_code(minimizer != NULL, CPL_ERROR_ILLEGAL_OUTPUT);
358 
359  dispgsl = gsl_vector_alloc((size_t)nfit);
360  stepsize = gsl_vector_alloc((size_t)nfit);
361  dispprev = gsl_vector_alloc((size_t)nfit);
362 
363  for (i=0; i < nfit; i++) {
364  const double value = cpl_polynomial_get_coeff(self, &i);
365  gsl_vector_set(dispgsl, (size_t)i, value);
366  gsl_vector_set(stepsize, (size_t)i, wlstepi);
367  wlstepi /= (double)nobs;
368  }
369 
370  my_func.n = nfit;
371  my_func.f = &irplib_gsl_correlation;
372  my_func.params = (void *)(&data);
373 
374  data.observed = obs;
375  data.disp1d = self;
376  data.spectrum = cpl_vector_new(nobs + 2 * hsize);
377  data.vxc = cpl_vector_new(1 + 2 * hsize);
378  data.param = model;
379  data.filler = filler;
380  data.maxxc = 0; /* Output */
381  data.ishift = 0; /* Output */
382  data.mxc = -1.0; /* Output */
383  data.mdisp = NULL; /* Output */
384 
385  gsl_multimin_fminimizer_set (minimizer, &my_func, dispgsl, stepsize);
386 
387  for (iter = 0; status == GSL_CONTINUE && iter < maxite; iter++) {
388 
389  const double fprev = minimizer->fval;
390 
391  gsl_vector_memcpy(dispprev, minimizer->x);
392  status = gsl_multimin_fminimizer_iterate(minimizer);
393 
394  if (status || !cpl_errorstate_is_equal(prestate)) break;
395 
396  size = gsl_multimin_fminimizer_size (minimizer);
397  status = gsl_multimin_test_size (size, pixtol);
398 
399  if (status == GSL_SUCCESS) {
400  cpl_msg_debug(cpl_func, "converged to minimum at");
401 
402  if (nfit == 0) {
403  cpl_msg_debug(cpl_func, "%5d %g df() = %g size = %g",
404  iter,
405  gsl_vector_get (minimizer->x, 0)
406  - gsl_vector_get (dispprev, 0),
407  minimizer->fval - fprev, size);
408  } else if (nfit == 1) {
409  cpl_msg_debug(cpl_func, "%5d %g %g df() = %g size = %g",
410  iter,
411  gsl_vector_get (minimizer->x, 0)
412  - gsl_vector_get (dispprev, 0),
413  gsl_vector_get (minimizer->x, 1)
414  - gsl_vector_get (dispprev, 1),
415  minimizer->fval - fprev, size);
416  } else {
417  cpl_msg_debug(cpl_func, "%5d %g %g %g df() = %g size = %g",
418  iter,
419  gsl_vector_get (minimizer->x, 0)
420  - gsl_vector_get (dispprev, 0),
421  gsl_vector_get (minimizer->x, 1)
422  - gsl_vector_get (dispprev, 1),
423  gsl_vector_get (minimizer->x, 2)
424  - gsl_vector_get (dispprev, 2),
425  minimizer->fval - fprev, size);
426  }
427  }
428  }
429 
430  if (status == GSL_SUCCESS && cpl_errorstate_is_equal(prestate)) {
431  if (data.mxc > -minimizer->fval) {
432  *pxc = data.mxc;
433  cpl_msg_warning(cpl_func, "Local maximum: %g(%d) > %g",
434  data.mxc, data.ishift, -minimizer->fval);
435  cpl_polynomial_shift_1d(data.mdisp, 0, (double)data.ishift);
436  cpl_polynomial_copy(self, data.mdisp);
437  *prestart = CPL_TRUE;
438  } else {
439  *pxc = -minimizer->fval;
440  for (i=0; i < nfit; i++) {
441  const double value = gsl_vector_get(minimizer->x, i);
442  cpl_polynomial_set_coeff(self, &i, value);
443  }
444  }
445  }
446 
447  cpl_vector_delete(data.spectrum);
448  cpl_vector_delete(data.vxc);
449  cpl_polynomial_delete(data.mdisp);
450  gsl_multimin_fminimizer_free(minimizer);
451  gsl_vector_free(dispgsl);
452  gsl_vector_free(dispprev);
453  gsl_vector_free(stepsize);
454 
455  cpl_ensure_code(status != GSL_CONTINUE, CPL_ERROR_CONTINUE);
456  cpl_ensure_code(status == GSL_SUCCESS, CPL_ERROR_DATA_NOT_FOUND);
457  cpl_ensure_code(cpl_errorstate_is_equal(prestate), cpl_error_get_code());
458 
459  return CPL_ERROR_NONE;
460 #endif
461 }
462 
463 
464 /*----------------------------------------------------------------------------*/
492 /*----------------------------------------------------------------------------*/
493 cpl_error_code
495  const cpl_polynomial * disp,
496  irplib_base_spectrum_model * lsslamp)
497 {
498 
499  irplib_line_spectrum_model * arclamp
500  = (irplib_line_spectrum_model *)lsslamp;
501  cpl_error_code error;
502 
503  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
504 
505  arclamp->cost++;
506 
508  arclamp->linepix,
509  arclamp->erftmp,
510  disp,
511  arclamp->lines,
512  arclamp->wslit,
513  arclamp->wfwhm,
514  arclamp->xtrunc,
515  0, CPL_FALSE, CPL_FALSE,
516  &(arclamp->ulines));
517  cpl_ensure_code(!error, error);
518 
519  arclamp->xcost++;
520 
521  return CPL_ERROR_NONE;
522 }
523 
524 /*----------------------------------------------------------------------------*/
537 /*----------------------------------------------------------------------------*/
538 cpl_error_code
540  const cpl_polynomial * disp,
541  irplib_base_spectrum_model * lsslamp)
542 {
543 
544  irplib_line_spectrum_model * arclamp
545  = (irplib_line_spectrum_model *)lsslamp;
546  cpl_error_code error;
547 
548  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
549 
550  arclamp->cost++;
551 
553  arclamp->linepix,
554  arclamp->erftmp,
555  disp,
556  arclamp->lines,
557  arclamp->wslit,
558  arclamp->wfwhm,
559  arclamp->xtrunc,
560  0, CPL_FALSE, CPL_TRUE,
561  &(arclamp->ulines));
562  cpl_ensure_code(!error, error);
563 
564  arclamp->xcost++;
565 
566  return CPL_ERROR_NONE;
567 }
568 
569 
570 /*----------------------------------------------------------------------------*/
583 /*----------------------------------------------------------------------------*/
584 cpl_error_code
586  const cpl_polynomial * disp,
587  irplib_base_spectrum_model * lsslamp)
588 {
589 
590  irplib_line_spectrum_model * arclamp
591  = (irplib_line_spectrum_model *)lsslamp;
592  cpl_error_code error;
593 
594  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
595 
596  arclamp->cost++;
597 
599  arclamp->linepix,
600  arclamp->erftmp,
601  disp,
602  arclamp->lines,
603  arclamp->wslit,
604  arclamp->wfwhm,
605  arclamp->xtrunc,
606  0, CPL_TRUE, CPL_FALSE,
607  &(arclamp->ulines));
608  cpl_ensure_code(!error, error);
609 
610  arclamp->xcost++;
611 
612  return CPL_ERROR_NONE;
613 }
614 
615 /*----------------------------------------------------------------------------*/
628 /*----------------------------------------------------------------------------*/
629 cpl_error_code
631  const cpl_polynomial * disp,
632  irplib_base_spectrum_model * lsslamp)
633 {
634 
635  irplib_line_spectrum_model * arclamp
636  = (irplib_line_spectrum_model *)lsslamp;
637  cpl_error_code error;
638 
639  cpl_ensure_code(arclamp != NULL, CPL_ERROR_NULL_INPUT);
640 
641  arclamp->cost++;
642 
644  arclamp->linepix,
645  arclamp->erftmp,
646  disp,
647  arclamp->lines,
648  arclamp->wslit,
649  arclamp->wfwhm,
650  arclamp->xtrunc,
651  0, CPL_TRUE, CPL_TRUE,
652  &(arclamp->ulines));
653  cpl_ensure_code(!error, error);
654 
655  arclamp->xcost++;
656 
657  return CPL_ERROR_NONE;
658 }
659 
660 /*----------------------------------------------------------------------------*/
671 /*----------------------------------------------------------------------------*/
672 cpl_error_code irplib_plot_spectrum_and_model(const cpl_vector * self,
673  const cpl_polynomial * disp1d,
674  irplib_base_spectrum_model * model,
675  cpl_error_code (* filler)
676  (cpl_vector *,
677  const cpl_polynomial *,
678  irplib_base_spectrum_model *))
679 {
680 
681  cpl_errorstate prestate = cpl_errorstate_get();
682  cpl_vector * wl;
683  cpl_vector * spectrum;
684  cpl_vector * vxc;
685  const int len = cpl_vector_get_size(self);
686  double maxval, xc;
687  int ixc;
688  int error = 0;
689 
690  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
691  cpl_ensure_code(disp1d != NULL, CPL_ERROR_NULL_INPUT);
692  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
693  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
694 
695  cpl_ensure_code(cpl_polynomial_get_dimension(disp1d) == 1,
696  CPL_ERROR_ILLEGAL_INPUT);
697 
698  cpl_ensure_code(cpl_polynomial_get_degree(disp1d) > 0,
699  CPL_ERROR_ILLEGAL_INPUT);
700 
701  wl = cpl_vector_new(len);
702  spectrum = cpl_vector_new(len);
703  vxc = cpl_vector_new(1);
704 
705  error |= (int)cpl_vector_fill_polynomial(wl, disp1d, 1.0, 1.0);
706  error |= filler(spectrum, disp1d, model);
707 
708  ixc = cpl_vector_correlate(vxc, self, spectrum);
709  xc = cpl_vector_get(vxc, ixc);
710 
711  maxval = cpl_vector_get_max(spectrum);
712  if (maxval != 0.0)
713  error |= cpl_vector_multiply_scalar(spectrum,
714  cpl_vector_get_max(self)/maxval);
715  if (!error) {
716  const cpl_vector * spair[] = {wl, self, spectrum};
717  char * pre = cpl_sprintf("set grid;set xlabel 'Wavelength (%g -> %g)'; "
718  "set ylabel 'Intensity';", cpl_vector_get(wl, 0),
719  cpl_vector_get(wl, len-1));
720  char * title = cpl_sprintf("t 'Observed and modelled spectra (%d pixel "
721  "XC=%g) ' w linespoints", len, xc);
722 
723  (void)cpl_plot_vectors(pre, title, "", spair, 3);
724  cpl_free(pre);
725  cpl_free(title);
726  }
727 
728  cpl_vector_delete(wl);
729  cpl_vector_delete(spectrum);
730  cpl_vector_delete(vxc);
731 
732  cpl_errorstate_set(prestate);
733 
734  return CPL_ERROR_NONE;
735 }
736 
737 /*----------------------------------------------------------------------------*/
757 /*----------------------------------------------------------------------------*/
758 cpl_error_code
760  const cpl_polynomial * disp,
761  const cpl_vector * obs,
762  irplib_base_spectrum_model * model,
763  cpl_error_code (*filler)
764  (cpl_vector *,
765  const cpl_polynomial *,
766  irplib_base_spectrum_model *),
767  int hsize,
768  cpl_boolean doplot,
769  double *pxc)
770 {
771 
772  const int nobs = cpl_vector_get_size(obs);
773  const int nmodel = 2 * hsize + nobs;
774  cpl_polynomial * shdisp;
775  cpl_vector * xself = cpl_bivector_get_x(self);
776  cpl_vector * yself = cpl_bivector_get_y(self);
777  cpl_vector * mspec1d;
778  cpl_vector * xcorr;
779  cpl_error_code error = CPL_ERROR_NONE;
780  double xcprev, xcnext;
781  int ixc, imax = 0;
782  int i;
783 
784  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
785  cpl_ensure_code(disp != NULL, CPL_ERROR_NULL_INPUT);
786  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
787  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
788  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
789  cpl_ensure_code(hsize > 0, CPL_ERROR_ILLEGAL_INPUT);
790 
791  shdisp = cpl_polynomial_duplicate(disp);
792 
793  /* Shift reference by -hsize so filler can be used without offset */
794  if (cpl_polynomial_shift_1d(shdisp, 0, -hsize)) {
795  cpl_polynomial_delete(shdisp);
796  return cpl_error_set_where(cpl_func);
797  }
798 
799  mspec1d = cpl_vector_new(nmodel);
800 
801  if (filler(mspec1d, shdisp, model)) {
802  cpl_vector_delete(mspec1d);
803  return cpl_error_set_where(cpl_func);
804  }
805 
806  /* Should not be able to fail now */
807  xcorr = cpl_vector_new(1 + 2 * hsize);
808  ixc = cpl_vector_correlate(xcorr, mspec1d, obs);
809 
810 #ifdef IRPLIB_SPC_DUMP
811  /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
812  irplib_polynomial_dump_corr_step(shdisp, xcorr, "Shift");
813 #endif
814 
815  cpl_vector_delete(mspec1d);
816  cpl_polynomial_delete(shdisp);
817 
818  /* Find local maxima. */
819  /* FIXME(?): Also include stationary points */
820  i = 0;
821  xcprev = cpl_vector_get(xcorr, i);
822  xcnext = cpl_vector_get(xcorr, i+1);
823 
824  if (xcprev >= xcnext) {
825  /* 1st data point is an extreme */
826  /* FIXME: This could also be an error, recoverable by caller by
827  increasing hsize */
828  imax++;
829 
830  cpl_vector_set(xself, 0, i - hsize);
831  cpl_vector_set(yself, 0, xcprev);
832 
833  }
834 
835  for (i = 1; i < 2 * hsize; i++) {
836  const double xc = xcnext;
837  xcnext = cpl_vector_get(xcorr, i+1);
838  if (xc >= xcprev && xc >= xcnext) {
839  /* Found (local) maximum at shift i - hsize */
840  int j;
841 
842  imax++;
843 
844  if (cpl_bivector_get_size(self) < imax) {
845  cpl_vector_set_size(xself, imax);
846  cpl_vector_set_size(yself, imax);
847  }
848 
849  for (j = imax-1; j > 0; j--) {
850  if (xc <= cpl_vector_get(yself, j-1)) break;
851  cpl_vector_set(xself, j, cpl_vector_get(xself, j-1));
852  cpl_vector_set(yself, j, cpl_vector_get(yself, j-1));
853  }
854  cpl_vector_set(xself, j, i - hsize);
855  cpl_vector_set(yself, j, xc);
856  }
857  xcprev = xc;
858  }
859 
860  /* assert( i == 2 * hsize ); */
861 
862  if (xcnext >= xcprev) {
863  /* Last data point is an extreme */
864  /* FIXME: This could also be an error, recoverable by caller by
865  increasing hsize */
866  int j;
867 
868  imax++;
869 
870  if (cpl_bivector_get_size(self) < imax) {
871  cpl_vector_set_size(xself, imax);
872  cpl_vector_set_size(yself, imax);
873  }
874 
875  for (j = imax-1; j > 0; j--) {
876  if (xcnext <= cpl_vector_get(yself, j-1)) break;
877  cpl_vector_set(xself, j, cpl_vector_get(xself, j-1));
878  cpl_vector_set(yself, j, cpl_vector_get(yself, j-1));
879  }
880  cpl_vector_set(xself, j, i - hsize);
881  cpl_vector_set(yself, j, xcnext);
882 
883  }
884 
885  if (doplot) {
886  /* Vector of -hsize, 1-hsize, 2-hsize, ..., 0, ..., hsize */
887  cpl_vector * xvals = cpl_vector_new(1 + 2 * hsize);
888  cpl_bivector * bcorr = cpl_bivector_wrap_vectors(xvals, xcorr);
889  double x = (double)-hsize;
890  char * title = cpl_sprintf("t 'Cross-correlation of shifted %d-pixel "
891  "spectrum (XCmax=%g at %d)' w linespoints",
892  nobs, cpl_vector_get(xcorr, ixc),
893  ixc - hsize);
894 
895  for (i = 0; i < 1 + 2 * hsize; i++, x += 1.0) {
896  cpl_vector_set(xvals, i, x);
897  }
898 
899  cpl_plot_bivector("set grid;set xlabel 'Offset [pixel]';", title,
900  "", bcorr);
901  cpl_bivector_unwrap_vectors(bcorr);
902  cpl_vector_delete(xvals);
903  cpl_free(title);
904  }
905 
906  if (pxc != NULL) *pxc = cpl_vector_get(xcorr, hsize);
907 
908  cpl_vector_delete(xcorr);
909 
910  if (imax < 1) {
911  error = CPL_ERROR_DATA_NOT_FOUND;
912  } else if (cpl_bivector_get_size(self) > imax) {
913  cpl_vector_set_size(xself, imax);
914  cpl_vector_set_size(yself, imax);
915  }
916 
917  /* Propagate error, if any */
918  return cpl_error_set(cpl_func, error);
919 }
920 
921 /*----------------------------------------------------------------------------*/
934 /*----------------------------------------------------------------------------*/
935 cpl_error_code
937  const cpl_vector * obs,
938  irplib_base_spectrum_model * model,
939  cpl_error_code (*filler)
940  (cpl_vector *,
941  const cpl_polynomial *,
942  irplib_base_spectrum_model *),
943  int hsize,
944  cpl_boolean doplot,
945  double * pxc)
946 {
947 
948  const int nobs = cpl_vector_get_size(obs);
949  const int nmodel = 2 * hsize + nobs;
950  cpl_vector * mspec1d;
951  cpl_vector * xcorr;
952  cpl_error_code error;
953  int ixc, xxc;
954  double xc;
955 
956  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
957  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
958  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
959  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
960  cpl_ensure_code(hsize > 0, CPL_ERROR_ILLEGAL_INPUT);
961 
962  /* Shift reference by -hsize so filler can be used without offset */
963  cpl_ensure_code(!cpl_polynomial_shift_1d(self, 0, -hsize),
964  cpl_error_get_code());
965 
966  mspec1d = cpl_vector_new(nmodel);
967 
968  if (filler(mspec1d, self, model)) {
969  cpl_vector_delete(mspec1d);
970  cpl_ensure_code(0, cpl_error_get_code());
971  }
972 
973  /* Should not be able to fail now */
974  xcorr = cpl_vector_new(1 + 2 * hsize);
975  ixc = cpl_vector_correlate(xcorr, mspec1d, obs);
976 
977 #ifdef IRPLIB_SPC_DUMP
978  /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
979  irplib_polynomial_dump_corr_step(self, xcorr, "Shift");
980 #endif
981 
982  cpl_vector_delete(mspec1d);
983 
984  error = cpl_polynomial_shift_1d(self, 0, (double)ixc);
985 
986  xc = cpl_vector_get(xcorr, ixc);
987 
988  xxc = ixc - hsize; /* The effect of the two shifts */
989 
990  cpl_msg_info(cpl_func, "Shifting %d pixels (%g < %g)", xxc,
991  cpl_vector_get(xcorr, hsize), xc);
992 
993  if (doplot) {
994  cpl_vector * xvals = cpl_vector_new(1 + 2 * hsize);
995  cpl_bivector * bcorr = cpl_bivector_wrap_vectors(xvals, xcorr);
996  int i;
997  double x = (double)-hsize;
998  char * title = cpl_sprintf("t 'Cross-correlation of shifted %d-pixel "
999  "spectrum (XCmax=%g at %d)' w linespoints",
1000  nobs, cpl_vector_get(xcorr, ixc), xxc);
1001 
1002  for (i = 0; i < 1 + 2 * hsize; i++, x += 1.0) {
1003  cpl_vector_set(xvals, i, x);
1004  }
1005 
1006  cpl_plot_bivector("set grid;set xlabel 'Offset [pixel]';", title,
1007  "", bcorr);
1008  cpl_bivector_unwrap_vectors(bcorr);
1009  cpl_vector_delete(xvals);
1010  cpl_free(title);
1011  }
1012 
1013  cpl_vector_delete(xcorr);
1014 
1015  cpl_ensure_code(!error, error);
1016 
1017  if (pxc != NULL) *pxc = xc;
1018 
1019  return CPL_ERROR_NONE;
1020 
1021 }
1022 
1023 
1024 /*----------------------------------------------------------------------------*/
1044 /*----------------------------------------------------------------------------*/
1045 cpl_error_code
1047  cpl_vector * linepix,
1048  cpl_vector * erftmp,
1049  const cpl_polynomial * disp,
1050  const cpl_bivector * lines,
1051  double wslit,
1052  double wfwhm,
1053  double xtrunc,
1054  int hsize,
1055  cpl_boolean dofast,
1056  cpl_boolean dolog,
1057  cpl_size * pulines)
1058 {
1059 
1060  cpl_errorstate prestate;
1061  const double sigma = wfwhm * CPL_MATH_SIG_FWHM;
1062  const cpl_vector * xlines = cpl_bivector_get_x_const(lines);
1063  const double * dxlines = cpl_vector_get_data_const(xlines);
1064  const double * dylines = cpl_bivector_get_y_data_const(lines);
1065  double * plinepix
1066  = linepix ? cpl_vector_get_data(linepix) : NULL;
1067  const int nlines = cpl_vector_get_size(xlines);
1068  const int nself = cpl_vector_get_size(self);
1069  double * dself = cpl_vector_get_data(self);
1070  cpl_polynomial * dispi;
1071  double * profile = NULL;
1072  const cpl_size i0 = 0;
1073  const double p0 = cpl_polynomial_get_coeff(disp, &i0);
1074  double wl;
1075  double xpos = (double)(1-hsize)-xtrunc;
1076  const double xmax = (double)(nself-hsize)+xtrunc;
1077  double xderiv, xextreme;
1078  cpl_error_code error = CPL_ERROR_NONE;
1079  int iline;
1080  cpl_size ulines = 0;
1081 
1082  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1083  cpl_ensure_code(disp != NULL, CPL_ERROR_NULL_INPUT);
1084  cpl_ensure_code(lines != NULL, CPL_ERROR_NULL_INPUT);
1085 
1086  cpl_ensure_code(wslit > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1087  cpl_ensure_code(wfwhm > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1088  cpl_ensure_code(hsize >= 0, CPL_ERROR_ILLEGAL_INPUT);
1089  cpl_ensure_code(xtrunc > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1090  cpl_ensure_code(nself > 2 * hsize, CPL_ERROR_ILLEGAL_INPUT);
1091 
1092  cpl_ensure_code(cpl_polynomial_get_dimension(disp) == 1,
1093  CPL_ERROR_ILLEGAL_INPUT);
1094  cpl_ensure_code(cpl_polynomial_get_degree(disp) > 0,
1095  CPL_ERROR_ILLEGAL_INPUT);
1096 
1097  /* The smallest wavelength contributing to the spectrum. */
1098  wl = cpl_polynomial_eval_1d(disp, xpos, &xderiv);
1099 
1100  if (wl <= 0.0) return
1101  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT, __FILE__,
1102  __LINE__, "Non-positive wavelength at x=%g: "
1103  "P(x)=%g, P'(x)=%g", xpos, wl, xderiv);
1104 
1105  if (xderiv <= 0.0) return
1106  cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT, __FILE__,
1107  __LINE__, "Non-increasing dispersion at "
1108  "x=%g: P'(x)=%g, P(x)=%g", xpos, xderiv, wl);
1109 
1110  /* Find the 1st line */
1111  iline = cpl_vector_find(xlines, wl);
1112 
1113  /* The first line must be at least at wl */
1114  if (dxlines[iline] < wl) iline++;
1115 
1116  if (iline >= nlines) return
1117  cpl_error_set_message_macro(cpl_func, CPL_ERROR_DATA_NOT_FOUND, __FILE__,
1118  __LINE__, "The %d-line catalogue has only "
1119  "lines below P(%g)=%g > %g", nlines, xpos,
1120  wl, dxlines[nlines-1]);
1121 
1122  memset(dself, 0, nself * sizeof(double));
1123 
1124  dispi = cpl_polynomial_duplicate(disp);
1125 
1126  /* Verify monotony of dispersion */
1127  cpl_polynomial_derivative(dispi, 0);
1128 
1129  prestate = cpl_errorstate_get();
1130 
1131  if (cpl_polynomial_solve_1d(dispi, 0.5*(nlines+1), &xextreme, 1)) {
1132  cpl_errorstate_set(prestate);
1133  } else if (xpos < xextreme && xextreme < xmax) {
1134  cpl_polynomial_delete(dispi);
1135  return cpl_error_set_message_macro(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
1136  __FILE__, __LINE__, "Non-monotone "
1137  "dispersion at x=%g: P'(x)=0, "
1138  "P(x)=%g", xextreme,
1139  cpl_polynomial_eval_1d(disp, xextreme,
1140  NULL));
1141  }
1142 
1143  if (dofast) {
1144  const int npix = 1+(int)xtrunc;
1145 
1146  if (erftmp != NULL && cpl_vector_get_size(erftmp) == npix &&
1147  cpl_vector_get(erftmp, 0) > 0.0) {
1148  profile = cpl_vector_get_data(erftmp);
1149  } else {
1150 
1151  const double yval = 0.5 / wslit;
1152  const double x0p = 0.5 * wslit + 0.5;
1153  const double x0n = -0.5 * wslit + 0.5;
1154  double x1diff
1155  = irplib_erf_antideriv(x0p, sigma)
1156  - irplib_erf_antideriv(x0n, sigma);
1157  int ipix;
1158 
1159  if (erftmp == NULL) {
1160  profile = (double*)cpl_malloc(sizeof(double)*(size_t)npix);
1161  } else {
1162  cpl_vector_set_size(erftmp, npix);
1163  profile = cpl_vector_get_data(erftmp);
1164  }
1165 
1166  profile[0] = 2.0 * yval * x1diff;
1167 
1168  for (ipix = 1; ipix < npix; ipix++) {
1169  const double x1 = (double)ipix;
1170  const double x1p = x1 + 0.5 * wslit + 0.5;
1171  const double x1n = x1 - 0.5 * wslit + 0.5;
1172  const double x0diff = x1diff;
1173 
1174  x1diff = irplib_erf_antideriv(x1p, sigma)
1175  - irplib_erf_antideriv(x1n, sigma);
1176 
1177  profile[ipix] = yval * (x1diff - x0diff);
1178 
1179  }
1180  }
1181  }
1182 
1183  cpl_polynomial_copy(dispi, disp);
1184 
1185  /* FIXME: A custom version of cpl_polynomial_solve_1d() which returns
1186  P'(xpos) can be used for the 1st NR-iteration. */
1187  /* Further, the sign of P'(xpos) could be checked for all lines. */
1188  /* Perform 1st NR-iteration in solving for P(xpos) = dxlines[iline] */
1189  xpos -= (wl - dxlines[iline]) / xderiv;
1190 
1191  /* Iterate through the lines */
1192  for (; !error && iline < nlines; iline++) {
1193 
1194  /* Lines may have a non-physical intensity (e.g. zero) to indicate some
1195  property of the line, e.g. unknown intensity due to blending */
1196  if (dylines[iline] <= 0.0) continue;
1197 
1198  /* Use 1st guess, if available (Use 0.0 to flag unavailable) */
1199  if (plinepix != NULL && plinepix[iline] > 0.0) xpos = plinepix[iline];
1200 
1201  if (xpos > xmax) xpos = xmax; /* FIXME: Better to limit xpos ? */
1202 
1203  /* Find the (sub-) pixel position of the line */
1204  error = cpl_polynomial_set_coeff(dispi, &i0, p0 - dxlines[iline]) ||
1205  cpl_polynomial_solve_1d(dispi, xpos, &xpos, 1);
1206 
1207  if (xpos > xmax) {
1208  if (error) {
1209  error = 0;
1210  cpl_msg_debug(cpl_func, "Stopping spectrum fill at line %d/%d "
1211  "at xpos=%g > xmax=%g",
1212  iline, nlines, xpos, xmax);
1213  cpl_errorstate_dump(prestate, CPL_FALSE,
1215  cpl_errorstate_set(prestate);
1216  }
1217  break;
1218  } else if (error) {
1219  if (linepix != NULL && ulines) (void)cpl_vector_fill(linepix, 0.0);
1220  (void)cpl_error_set_message_macro(cpl_func, cpl_error_get_code(),
1221  __FILE__, __LINE__,
1222  "Could not find pixel-position "
1223  "of line %d/%d at wavelength=%g."
1224  " xpos=%g, xmax=%g",
1225  iline, nlines, dxlines[iline],
1226  xpos, xmax);
1227  break;
1228  } else if (dofast) {
1229  const double frac = fabs(xpos - floor(xpos));
1230 #ifdef IRPLIB_WAVECAL_FAST_FAST
1231  const double frac0 = 1.0 - frac; /* Weight opposite of distance */
1232 #else
1233  /* Center intensity correctly */
1234  const double ep1pw = irplib_erf_antideriv(frac + 0.5 * wslit, sigma);
1235  const double en1pw = irplib_erf_antideriv(frac + 0.5 * wslit - 1.0,
1236  sigma);
1237  const double ep1nw = irplib_erf_antideriv(frac - 0.5 * wslit, sigma);
1238  const double en1nw = irplib_erf_antideriv(frac - 0.5 * wslit - 1.0,
1239  sigma);
1240  const double frac0
1241  = (en1nw - en1pw) / (ep1pw - en1pw - ep1nw + en1nw);
1242 
1243 #endif
1244  const double frac1 = 1.0 - frac0;
1245  const double yval0 = frac0 * dylines[iline];
1246  const double yval1 = frac1 * dylines[iline];
1247  const int npix = 1+(int)xtrunc;
1248  int ipix;
1249  int i0n = hsize - 1 + floor(xpos);
1250  int i0p = i0n;
1251  int i1n = i0n + 1;
1252  int i1p = i1n;
1253  cpl_boolean didline = CPL_FALSE;
1254 
1255 
1256  /* Update 1st guess for next time, if available */
1257  if (plinepix != NULL) plinepix[iline] = xpos;
1258 
1259  if (frac0 < 0.0) {
1260  (void)cpl_error_set_message_macro(cpl_func,
1261  CPL_ERROR_UNSPECIFIED,
1262  __FILE__, __LINE__,
1263  "Illegal split at x=%g: %g + "
1264  "%g = 1", xpos, frac0, frac1);
1265 #ifdef IRPLIB_WAVEVAL_DEBUG
1266  } else {
1267  cpl_msg_warning(cpl_func,"profile split at x=%g: %g + %g = 1",
1268  xpos, frac0, frac1);
1269 #endif
1270  }
1271 
1272  for (ipix = 0; ipix < npix; ipix++, i0n--, i0p++, i1n--, i1p++) {
1273 
1274  if (i0n >= 0 && i0n < nself) {
1275  dself[i0n] += yval0 * profile[ipix];
1276  didline = CPL_TRUE;
1277  }
1278  if (i1n >= 0 && i1n < nself && ipix + 1 < npix) {
1279  dself[i1n] += yval1 * profile[ipix+1];
1280  didline = CPL_TRUE;
1281  }
1282 
1283  if (ipix == 0) continue;
1284 
1285  if (i0p >= 0 && i0p < nself) {
1286  dself[i0p] += yval0 * profile[ipix];
1287  didline = CPL_TRUE;
1288  }
1289  if (i1p >= 0 && i1p < nself && ipix + 1 < npix) {
1290  dself[i1p] += yval1 * profile[ipix+1];
1291  didline = CPL_TRUE;
1292  }
1293  }
1294 
1295  if (didline) ulines++;
1296 
1297  } else {
1298  const double yval = 0.5 * dylines[iline] / wslit;
1299  const int ifirst = IRPLIB_MAX((int)(xpos-xtrunc+0.5), 1-hsize);
1300  const int ilast = IRPLIB_MIN((int)(xpos+xtrunc), nself-hsize);
1301  int ipix;
1302  const double x0 = (double)ifirst - xpos;
1303  const double x0p = x0 + 0.5*wslit - 0.5;
1304  const double x0n = x0 - 0.5*wslit - 0.5;
1305  double x1diff
1306  = irplib_erf_antideriv(x0p, sigma)
1307  - irplib_erf_antideriv(x0n, sigma);
1308 
1309  /* Update 1st guess for next time, if available */
1310  if (plinepix != NULL) plinepix[iline] = xpos;
1311 
1312  if (ilast >= ifirst) ulines++;
1313 
1314  for (ipix = ifirst; ipix <= ilast; ipix++) {
1315  const double x1 = (double)ipix - xpos;
1316  const double x1p = x1 + 0.5*wslit + 0.5;
1317  const double x1n = x1 - 0.5*wslit + 0.5;
1318  const double x0diff = x1diff;
1319 
1320  x1diff = irplib_erf_antideriv(x1p, sigma)
1321  - irplib_erf_antideriv(x1n, sigma);
1322 
1323  dself[ipix+hsize-1] += yval * (x1diff - x0diff);
1324 
1325  }
1326  }
1327  }
1328 
1329  cpl_polynomial_delete(dispi);
1330  if (erftmp == NULL) cpl_free(profile);
1331 
1332  cpl_ensure_code(!error, cpl_error_get_code());
1333 
1334  if (dolog) {
1335  int i;
1336  for (i = 0; i < nself; i++) {
1337  dself[i] = dself[i] > 0.0 ? log(1.0 + dself[i]) : 0.0;
1338  }
1339  }
1340 
1341  if (!ulines) return
1342  cpl_error_set_message_macro(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
1343  __FILE__, __LINE__, "The %d-line "
1344  "catalogue has no lines in the range "
1345  "%g -> P(%g)=%g", nlines, wl, xmax,
1346  cpl_polynomial_eval_1d(disp, xmax, NULL));
1347 
1348  if (pulines != NULL) *pulines = ulines;
1349 
1350  return CPL_ERROR_NONE;
1351 }
1352 
1353 /*----------------------------------------------------------------------------*/
1362 /*----------------------------------------------------------------------------*/
1363 inline double irplib_erf_antideriv(double x, double sigma)
1364 {
1365  return x * erf( x / (sigma * CPL_MATH_SQRT2))
1366  + 2.0 * sigma/CPL_MATH_SQRT2PI * exp(-0.5 * x * x / (sigma * sigma));
1367 }
1368 
1369 
1370 #ifdef HAVE_GSL
1371 
1372 /*----------------------------------------------------------------------------*/
1379 /*----------------------------------------------------------------------------*/
1380 static double irplib_gsl_correlation(const gsl_vector * self, void * data)
1381 {
1382 
1383  irplib_multimin * mindata = (irplib_multimin *)data;
1384  cpl_errorstate prestate = cpl_errorstate_get();
1385  int nobs, nmodel, ndiff;
1386  cpl_size i;
1387 
1388  cpl_ensure(self != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1389  cpl_ensure(data != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1390 
1391  cpl_ensure(mindata->filler != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1392  cpl_ensure(mindata->observed != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1393  cpl_ensure(mindata->spectrum != NULL, CPL_ERROR_NULL_INPUT, GSL_NAN);
1394 
1395  nobs = cpl_vector_get_size(mindata->observed);
1396  nmodel = cpl_vector_get_size(mindata->spectrum);
1397  ndiff = nmodel - nobs;
1398 
1399  cpl_ensure((ndiff & 1) == 0, CPL_ERROR_ILLEGAL_INPUT, GSL_NAN);
1400 
1401  cpl_ensure(cpl_vector_get_size(mindata->vxc) == 1 + ndiff,
1402  CPL_ERROR_ILLEGAL_INPUT, GSL_NAN);
1403 
1404  ndiff /= 2;
1405 
1406  for (i=0; i < (cpl_size)self->size; i++) {
1407  const double value = gsl_vector_get(self, (size_t)i);
1408  cpl_polynomial_set_coeff(mindata->disp1d, &i, value);
1409  }
1410 
1411  /* Shift reference by -ndiff so filler can be used without offset.
1412  The subsequent polynomial shift is reduced by -ndiff. */
1413  cpl_ensure_code(!cpl_polynomial_shift_1d(mindata->disp1d, 0, -ndiff),
1414  cpl_error_get_code());
1415 
1416  if (mindata->filler(mindata->spectrum, mindata->disp1d,
1417  mindata->param)
1418  || !cpl_errorstate_is_equal(prestate)) {
1419 
1420  /* The fill failed. Ensure the discarding of this candidate by
1421  setting the cross-correlation to its minimum possible value. */
1422 
1423  (void)cpl_vector_fill(mindata->vxc, -1.0);
1424 
1425  mindata->maxxc = ndiff;
1426 
1427  if (!cpl_errorstate_is_equal(prestate)) {
1428  cpl_msg_debug(cpl_func, "Spectrum fill failed:");
1429  cpl_errorstate_dump(prestate, CPL_FALSE,
1431  cpl_errorstate_set(prestate);
1432  }
1433  } else {
1434 
1435  mindata->maxxc = cpl_vector_correlate(mindata->vxc,
1436  mindata->spectrum,
1437  mindata->observed);
1438  }
1439 
1440 #ifdef IRPLIB_SPC_DUMP
1441  /* Need irplib_wavecal.c rev. 1.12 through 1.15 */
1442  irplib_polynomial_dump_corr_step(mindata->disp1d, mindata->vxc,
1443  "Optimize");
1444 #endif
1445 
1446  mindata->xc = cpl_vector_get(mindata->vxc, ndiff);
1447 
1448  if (mindata->maxxc != ndiff &&
1449  cpl_vector_get(mindata->vxc, mindata->maxxc) > mindata->mxc) {
1450  const irplib_base_spectrum_model * arclamp
1451  = (const irplib_base_spectrum_model *)mindata->param;
1452 
1453  if (mindata->mdisp == NULL) {
1454  mindata->mdisp = cpl_polynomial_duplicate(mindata->disp1d);
1455  } else {
1456  cpl_polynomial_copy(mindata->mdisp, mindata->disp1d);
1457  }
1458  mindata->mxc = cpl_vector_get(mindata->vxc, mindata->maxxc);
1459  mindata->ishift = mindata->maxxc; /* Offset -ndiff pre-shifted above */
1460  cpl_msg_debug(cpl_func, "Local maximum: %g(%d) > %g(%d) (cost=%u:%u. "
1461  "lines=%u)", mindata->mxc, mindata->maxxc, mindata->xc,
1462  ndiff, (unsigned)arclamp->cost, (unsigned)arclamp->xcost,
1463  (unsigned)arclamp->ulines);
1464  }
1465 
1466  return -mindata->xc;
1467 }
1468 
1469 #endif
1470 
1471 /*----------------------------------------------------------------------------*/
1494 /*----------------------------------------------------------------------------*/
1495 cpl_error_code
1497  int maxdeg,
1498  const cpl_vector * obs,
1499  int nmaxima,
1500  int linelim,
1501  irplib_base_spectrum_model* model,
1502  cpl_error_code (* filler)
1503  (cpl_vector *,
1504  const cpl_polynomial *,
1505  irplib_base_spectrum_model *),
1506  double pixtol,
1507  double pixstep,
1508  int hsize,
1509  int maxite,
1510  int maxfail,
1511  int maxcont,
1512  cpl_boolean doplot,
1513  double * pxc)
1514 {
1515 
1516 #ifdef HAVE_GSL
1517 
1518  cpl_errorstate prestate = cpl_errorstate_get();
1519  cpl_polynomial * start;
1520  cpl_polynomial * cand;
1521  cpl_polynomial * backup;
1522  cpl_error_code error = CPL_ERROR_NONE;
1523  double xc;
1524  cpl_bivector * xtshift = cpl_bivector_new(nmaxima ? nmaxima : 1);
1525  const cpl_vector * xtshiftx = cpl_bivector_get_x_const(xtshift);
1526  const cpl_vector * xtshifty = cpl_bivector_get_y_const(xtshift);
1527  int nshift;
1528  int imaximum = -1;
1529  int imaxima;
1530 
1531 #endif
1532 
1533  cpl_ensure_code(self != NULL, CPL_ERROR_NULL_INPUT);
1534  cpl_ensure_code(obs != NULL, CPL_ERROR_NULL_INPUT);
1535  cpl_ensure_code(model != NULL, CPL_ERROR_NULL_INPUT);
1536  cpl_ensure_code(filler != NULL, CPL_ERROR_NULL_INPUT);
1537  cpl_ensure_code(pxc != NULL, CPL_ERROR_NULL_INPUT);
1538 
1539  cpl_ensure_code(cpl_polynomial_get_dimension(self) == 1,
1540  CPL_ERROR_ILLEGAL_INPUT);
1541 
1542  cpl_ensure_code(cpl_polynomial_get_degree(self) > 0,
1543  CPL_ERROR_ILLEGAL_INPUT);
1544 
1545  cpl_ensure_code(maxdeg >= 0, CPL_ERROR_ILLEGAL_INPUT);
1546  cpl_ensure_code(pixtol > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1547  cpl_ensure_code(pixstep > 0.0, CPL_ERROR_ILLEGAL_INPUT);
1548  cpl_ensure_code(hsize >= 0, CPL_ERROR_ILLEGAL_INPUT);
1549  cpl_ensure_code(maxite >= 0, CPL_ERROR_ILLEGAL_INPUT);
1550  cpl_ensure_code(nmaxima >= 0, CPL_ERROR_ILLEGAL_INPUT);
1551  cpl_ensure_code(maxfail > 0, CPL_ERROR_ILLEGAL_INPUT);
1552  cpl_ensure_code(maxcont > 0, CPL_ERROR_ILLEGAL_INPUT);
1553  cpl_ensure_code(linelim >= 0, CPL_ERROR_ILLEGAL_INPUT);
1554 
1555 #ifndef HAVE_GSL
1556  /* Avoid unused variable warning */
1557  cpl_ensure_code(doplot == CPL_TRUE || doplot == CPL_FALSE,
1558  CPL_ERROR_ILLEGAL_INPUT);
1559  return cpl_error_set_message(cpl_func, CPL_ERROR_UNSUPPORTED_MODE,
1560  "GSL is not available");
1561 #else
1562 
1563  if (irplib_bivector_find_shift_from_correlation(xtshift, self, obs,
1564  model, filler,
1565  hsize, doplot, &xc)) {
1566  cpl_bivector_delete(xtshift);
1567  return cpl_error_set_where(cpl_func);
1568  }
1569 
1570  if (model->ulines > (cpl_size)linelim) {
1571  /* The initial, optimal (integer) shift */
1572  const double xxc = cpl_vector_get(xtshiftx, 0);
1573  const double xc0 = cpl_vector_get(xtshifty, 0);
1574 
1575  cpl_msg_warning(cpl_func, "Doing only shift=%g pixels with lines=%u > "
1576  "%d and XC=%g", xxc, (unsigned)model->ulines, linelim,
1577  xc0);
1578 
1579  cpl_polynomial_shift_1d(self, 0, xxc);
1580 
1581  *pxc = xc0;
1582 
1583  cpl_bivector_delete(xtshift);
1584 
1585  return CPL_ERROR_NONE;
1586  }
1587 
1588  start = cpl_polynomial_duplicate(self);
1589  cand = cpl_polynomial_new(1);
1590  backup = cpl_polynomial_new(1);
1591 
1592  /* Number of (local) maxima to use as starting point of the optimization */
1593  nshift = cpl_bivector_get_size(xtshift);
1594  if (nmaxima == 0 || nmaxima > nshift) nmaxima = nshift;
1595 
1596  cpl_msg_info(cpl_func, "Optimizing %d/%d local shift-maxima "
1597  "(no-shift xc=%g. linelim=%d)", nmaxima, nshift, xc, linelim);
1598  if (cpl_msg_get_level() <= CPL_MSG_DEBUG)
1599  cpl_bivector_dump(xtshift, stdout);
1600 
1601  for (imaxima = 0; imaxima < nmaxima; imaxima++) {
1602  /* The initial, optimal (integer) shift */
1603  const double xxc = cpl_vector_get(xtshiftx, imaxima);
1604  double xtpixstep = pixstep;
1605  double xtpixtol = pixtol;
1606  double xtxc;
1607  cpl_boolean ok = CPL_FALSE;
1608  int nfail;
1609 
1610 
1611  cpl_polynomial_copy(cand, start);
1612  cpl_polynomial_shift_1d(cand, 0, xxc);
1613  cpl_polynomial_copy(backup, cand);
1614 
1615  /* Increase tolerance until convergence */
1616  for (nfail = 0; nfail < maxfail; nfail++, xtpixtol *= 2.0,
1617  xtpixstep *= 2.0) {
1618  int restart = maxcont;
1619  cpl_boolean redo;
1620 
1621  do {
1622  if (error) {
1623  cpl_errorstate_dump(prestate, CPL_FALSE,
1625  cpl_errorstate_set(prestate);
1626  }
1627  error = irplib_polynomial_find_1d_from_correlation_
1628  (cand, maxdeg, obs, model,
1629  filler, xtpixtol, xtpixstep, 2,
1630  maxite, &xtxc, &redo);
1631  if (redo && !error) error = CPL_ERROR_CONTINUE;
1632  } while (((!error && redo) || error == CPL_ERROR_CONTINUE)
1633  && --restart);
1634 
1635  if (!error && !redo) {
1636  cpl_msg_debug(cpl_func, "XC(imax=%d/%d:xtpixtol=%g): %g "
1637  "(cost=%u:%u)", 1+imaxima, nmaxima, xtpixtol,
1638  xtxc, (unsigned)model->cost,
1639  (unsigned)model->xcost);
1640  break;
1641  }
1642  cpl_msg_warning(cpl_func, "Increasing xtpixtol from %g (%g, imax="
1643  "%d/%d)", xtpixtol, xtpixstep, 1+imaxima, nmaxima);
1644  if (model->ulines > (cpl_size)linelim) {
1645  cpl_msg_warning(cpl_func, "Stopping search-refinement via "
1646  "catalogue with %u lines > %d",
1647  (unsigned)model->ulines, linelim);
1648  break;
1649  }
1650  cpl_polynomial_copy(cand, start);
1651  }
1652 
1653  /* Decrease tolerance until divergence, keep previous */
1654  for (; !error && xtpixtol > 0.0; xtpixtol *= 0.25, xtpixstep *= 0.5) {
1655  int restart = maxcont;
1656  cpl_boolean redo;
1657 
1658  cpl_polynomial_copy(backup, cand);
1659  do {
1660  if (error) {
1661  cpl_errorstate_dump(prestate, CPL_FALSE,
1663  cpl_errorstate_set(prestate);
1664  }
1665  error = irplib_polynomial_find_1d_from_correlation_
1666  (cand, maxdeg, obs, model, filler,
1667  xtpixtol, xtpixstep, 2, maxite, &xtxc, &redo);
1668  if (redo && !error) error = CPL_ERROR_CONTINUE;
1669  } while (((!error && redo) || error == CPL_ERROR_CONTINUE)
1670  && --restart);
1671  if (error) break;
1672  ok = CPL_TRUE;
1673  if (redo) break;
1674  cpl_msg_debug(cpl_func, "XC(imax=%d/%d:xtpixtol=%g): %g (cost=%u:%u"
1675  ". ulines=%u)", 1+imaxima, nmaxima, xtpixtol, xtxc,
1676  (unsigned)model->cost, (unsigned)model->xcost,
1677  (unsigned)model->ulines);
1678  if (model->ulines > (cpl_size)linelim) {
1679  cpl_msg_info(cpl_func, "Stopping search-refinement via "
1680  "catalogue with %u lines > %u",
1681  (unsigned)model->ulines, linelim);
1682  break;
1683  }
1684  }
1685 
1686  if (error) {
1687  error = 0;
1688  cpl_errorstate_dump(prestate, CPL_FALSE,
1690  cpl_errorstate_set(prestate);
1691  cpl_polynomial_copy(cand, backup);
1692  }
1693  if (ok && xtxc > xc) {
1694  imaximum = imaxima;
1695  cpl_polynomial_copy(self, cand);
1696  xc = xtxc;
1697 
1698  cpl_msg_info(cpl_func, "XC(imax=%d/%d): %g -> %g (initial-shift=%g. "
1699  "cost=%u:%u. lines=%u)", 1+imaxima, nmaxima,
1700  cpl_vector_get(xtshifty, imaxima), xtxc,
1701  cpl_vector_get(xtshiftx, imaxima),
1702  (unsigned)model->cost, (unsigned)model->xcost,
1703  (unsigned)model->ulines);
1704  } else {
1705  cpl_msg_info(cpl_func, "xc(imax=%d/%d): %g -> %g (initial-shift=%g. "
1706  "cost=%u:%u. lines=%u)", 1+imaxima, nmaxima,
1707  cpl_vector_get(xtshifty, imaxima), xtxc,
1708  cpl_vector_get(xtshiftx, imaxima),
1709  (unsigned)model->cost, (unsigned)model->xcost,
1710  (unsigned)model->ulines);
1711  }
1712  }
1713 
1714  cpl_polynomial_delete(start);
1715  cpl_polynomial_delete(backup);
1716  cpl_polynomial_delete(cand);
1717 
1718  if (imaximum < 0) {
1719  /* The initial, optimal (integer) shift */
1720  const double xxc = cpl_vector_get(xtshiftx, 0);
1721  const double xc0 = cpl_vector_get(xtshifty, 0);
1722 
1723  error = cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
1724  "Could not improve XC=%g over %d "
1725  "local shift-maxima, best at shift %g",
1726  xc0, nmaxima, xxc);
1727  } else {
1728  cpl_msg_info(cpl_func, "Maximal XC=%g (up from %g, with initial pixel-"
1729  "shift of %g) at %d/%d local shift-maximi", xc,
1730  cpl_vector_get(xtshifty, imaximum),
1731  cpl_vector_get(xtshiftx, imaximum),
1732  1+imaximum, nmaxima);
1733 
1734  if (doplot) {
1735  irplib_plot_spectrum_and_model(obs, self, model, filler);
1736  }
1737 
1738  *pxc = xc;
1739  }
1740 
1741  cpl_bivector_delete(xtshift);
1742 
1743  return error;
1744 
1745 #endif
1746 
1747 }