UVES Pipeline Reference Manual  5.4.0
uves_extract.c
1 /* *
2  * This file is part of the ESO UVES Pipeline *
3  * Copyright (C) 2004,2005 European Southern Observatory *
4  * *
5  * This library 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, 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA *
18  * */
19 
20 /*
21  * $Author: amodigli $
22  * $Date: 2013-08-08 13:36:46 $
23  * $Revision: 1.196 $
24  * $Name: not supported by cvs2svn $
25  *
26  */
27 
28 #ifdef HAVE_CONFIG_H
29 # include <config.h>
30 #endif
31 
32 /*----------------------------------------------------------------------------*/
39 /*----------------------------------------------------------------------------*/
40 
41 /*-----------------------------------------------------------------------------
42  Includes
43  -----------------------------------------------------------------------------*/
44 #include <string.h>
45 #include <uves_extract.h>
46 
47 #include <uves_extract_iterate.h>
48 #include <uves_extract_profile.h>
49 #include <uves_parameters.h>
50 #include <uves_utils.h>
51 #include <uves_utils_cpl.h>
52 #include <uves_utils_wrappers.h>
53 #include <uves_dfs.h>
54 #include <uves_plot.h>
55 
56 #include <uves_dump.h>
57 #include <uves_error.h>
58 #include <uves.h>
59 
60 #include <irplib_utils.h>
61 
62 #include <cpl.h>
63 
64 #include <stdbool.h>
65 
66 /*-----------------------------------------------------------------------------
67  Defines
68  -----------------------------------------------------------------------------*/
70 #define DATA(name, pos) (name[((pos)->x-1)+((pos)->y-1)*(pos)->nx])
71 
73 #define SPECTRUM_DATA(name, pos) (name[((pos)->x-1)+((pos)->order-(pos)->minorder)*(pos)->nx])
74 
76 #define ISBAD(weights, pos) (weights[((pos)->x-1)+((pos)->y-1)*(pos)->nx] < 0)
77 
79 #define SETBAD(weights, image_bpm, pos) \
80  do { \
81  weights [((pos)->x-1)+((pos)->y-1)*(pos)->nx] = -1.0; \
82  image_bpm[((pos)->x-1)+((pos)->y-1)*(pos)->nx] = CPL_BINARY_1;\
83  } \
84  while (false)
85 
86 #define ISGOOD(bpm, pos) (bpm[((pos)->x-1)+((pos)->y-1)*(pos)->nx] == CPL_BINARY_0)
87 
88 /* Enable experimental algorithm that fits profile to all data in all orders
89  at once */
90 #define NEW_METHOD 0
91 
92 #if NEW_METHOD
93 #define CREATE_DEBUGGING_TABLE 1
94 /* else not used */
95 #endif
96 
97 /*-----------------------------------------------------------------------------
98  Functions prototypes
99  -----------------------------------------------------------------------------*/
102 static int
103 extract_order_simple(const cpl_image *image, const cpl_image *image_noise,
104  const polynomial *order_locations,
105  int order, int minorder,
106  int spectrum_row,
107  double offset,
108  double slit_length,
109  extract_method method,
110  const cpl_image *weights,
111  bool extract_partial,
112  cpl_image *spectrum,
113  cpl_image *spectrum_noise,
114  cpl_binary*spectrum_badmap,
115  cpl_table **info_tbl,
116  double *sn);
117 
118 static double area_above_line(int y, double left, double right);
119 
120 static cpl_table *opt_define_sky(const cpl_image *image, const cpl_image *weights,
121  uves_iterate_position *pos);
122 
123 static cpl_image *opt_extract_sky(const cpl_image *image, const cpl_image *image_noise,
124  const cpl_image *weights,
125  uves_iterate_position *pos,
126  cpl_image *sky_spectrum,
127  cpl_image *sky_spectrum_noise);
128 
129 static cpl_image * opt_subtract_sky(
130  const cpl_image *image, const cpl_image *image_noise,
131  const cpl_image *weights,
132  uves_iterate_position *pos,
133  const cpl_table *sky_map,
134  cpl_image *sky_spectrum,
135  cpl_image *sky_spectrum_noise);
136 
137 static cpl_table **opt_sample_spatial_profile(
138  const cpl_image *image, const cpl_image *weights,
139  uves_iterate_position *pos,
140  int chunk,
141  int sampling_factor,
142  int *nbins);
143 
144 static uves_extract_profile *opt_measure_profile(
145  const cpl_image *image, const cpl_image *image_noise,
146  const cpl_image *weights,
147  uves_iterate_position *pos,
148  int chunk, int sampling_factor,
149  int (*f) (const double x[], const double a[], double *result),
150  int (*dfda)(const double x[], const double a[], double result[]),
151  int M,
152  const cpl_image *sky_spectrum,
153  cpl_table *info_tbl,
154  cpl_table **profile_global);
155 
156 static cpl_table *opt_measure_profile_order(
157  const cpl_image *image, const cpl_image *image_noise,
158  const cpl_binary *image_bpm,
159  uves_iterate_position *pos,
160  int chunk,
161  int (*f) (const double x[], const double a[], double *result),
162  int (*dfda)(const double x[], const double a[], double result[]),
163  int M,
164  const cpl_image *sky_spectrum);
165 
166 static void
167 revise_noise(cpl_image *image_noise,
168  const cpl_binary *image_bpm,
169  const uves_propertylist *image_header,
170  uves_iterate_position *pos,
171  const cpl_image *spectrum,
172  const cpl_image *sky_spectrum,
173  const uves_extract_profile *profile,
174  enum uves_chip chip);
175 
176 static int
177 opt_extract(cpl_image *image,
178  const cpl_image *image_noise,
179  uves_iterate_position *pos,
180  const uves_extract_profile *profile,
181  bool optimal_extract_sky,
182  double kappa,
183  cpl_table *blemish_mask,
184  cpl_table *cosmic_mask,
185  int *cr_row,
186  cpl_table *profile_table,
187  int *prof_row,
188  cpl_image *spectrum,
189  cpl_image *spectrum_noise,
190  cpl_image *weights,
191  cpl_image *sky_spectrum,
192  cpl_image *sky_spectrum_noise,
193  double *sn);
194 
195 static int opt_get_order_width(const uves_iterate_position *pos);
196 static double
197 estimate_sn(const cpl_image *image, const cpl_image *image_noise,
198  uves_iterate_position *pos);
199 
200 static double opt_get_sky(const double *image_data,
201  const double *noise_data,
202  const double *weights_data,
203  uves_iterate_position *pos,
204  const cpl_table *sky_map,
205  double buffer_flux[], double buffer_noise[],
206  double *sky_background_noise);
207 
208 static double opt_get_noise_median(const double *noise_data,
209  const cpl_binary *image_bpm,
210  uves_iterate_position *pos,
211  double noise_buffer[]);
212 
213 static double opt_get_flux_sky_variance(const double *image_data,
214  const double *noise_data,
215  double *weights_data,
216  uves_iterate_position *pos,
217  const uves_extract_profile *profile,
218  bool optimal_extract_sky,
219  double median_noise,
220  double *variance,
221  double *sky_background,
222  double *sky_background_noise);
223 
224 static bool opt_reject_outlier(const double *image_data,
225  const double *noise_data,
226  cpl_binary *image_bpm,
227  double *weights_data,
228  uves_iterate_position *pos,
229  const uves_extract_profile *profile,
230  double kappa,
231  double flux,
232  double sky_background,
233  double red_chisq,
234  cpl_table *cosmic_mask, int *cr_row,
235  int *hot_pixels, int *cold_pixels);
236 
237 static double opt_get_redchisq(const uves_extract_profile *profile,
238  const uves_iterate_position *pos);
239 
240 static polynomial *repeat_orderdef(const cpl_image *image, const cpl_image *image_noise,
241  const polynomial *guess_locations,
242  int minorder, int maxorder, slit_geometry sg,
243  cpl_table *info_tbl);
244 
245 static double
246 detect_ripples(const cpl_image *spectrum, const uves_iterate_position *pos,
247  double sn);
248 
249 /*-----------------------------------------------------------------------------
250  Implementation
251  -----------------------------------------------------------------------------*/
252 
253 /*----------------------------------------------------------------------------*/
261 /*----------------------------------------------------------------------------*/
262 
263 cpl_parameterlist *
265 {
266  const char *name = "";
267  char *full_name = NULL;
268  cpl_parameter *p = NULL;
269  cpl_parameterlist *parameters = NULL;
270 
271  parameters = cpl_parameterlist_new();
272 
273  {
274  name = "method";
275  full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
276 
277  uves_parameter_new_enum(p, full_name,
278  CPL_TYPE_STRING,
279  "Extraction method. (2d/optimal not supported by uves_cal_wavecal, weighted supported only by uves_cal_wavecal, 2d not supported by uves_cal_response)",
280  UVES_EXTRACT_ID,
281  "optimal",
282  5,
283  "average",
284  "linear",
285  "2d",
286  "weighted",
287  "optimal");
288 
289  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
290  cpl_parameterlist_append(parameters, p);
291  cpl_free(full_name);
292  }
293 
294  {
295  name = "kappa";
296  full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
297 
298  uves_parameter_new_range(p, full_name,
299  CPL_TYPE_DOUBLE,
300  "In optimal extraction mode, this is the "
301  "threshold for bad (i.e. hot/cold) "
302  "pixel rejection. If a pixel deviates more than "
303  "kappa*sigma (where sigma is "
304  "the uncertainty of the pixel flux) from "
305  "the inferred spatial profile, its "
306  "weight is set to zero. Range: [-1,100]. If this parameter "
307  "is negative, no rejection is performed.",
308  UVES_EXTRACT_ID,
309  10.0,-1.,100.);
310 
311  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
312  cpl_parameterlist_append(parameters, p);
313  cpl_free(full_name);
314  }
315 
316  {
317  name = "chunk";
318  full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
319 
320  uves_parameter_new_range(p, full_name,
321  CPL_TYPE_INT,
322  "In optimal extraction mode, the chunk size (in pixels) "
323  "used for fitting the analytical profile (a fit of the "
324  "analytical profile to single bins would suffer from "
325  "low statistics).",
326  UVES_EXTRACT_ID,
327  32,
328  1, INT_MAX);
329 
330  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
331  cpl_parameterlist_append(parameters, p);
332  cpl_free(full_name);
333  }
334 
335  {
336  name = "profile";
337  full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
338 
339  uves_parameter_new_enum(p, full_name,
340  CPL_TYPE_STRING,
341  "In optimal extraction mode, the kind of profile to use. "
342  "'gauss' gives a Gaussian profile, 'moffat' gives "
343  "a Moffat profile with beta=4 and a possible linear sky "
344  "contribution. 'virtual' uses "
345  "a virtual resampling algorithm (i.e. measures and "
346  "uses the actual object profile). "
347  "'constant' assumes a constant spatial profile and "
348  "allows optimal extraction of wavelength "
349  "calibration frames. 'auto' will automatically "
350  "select the best method based on the estimated S/N of the "
351  "object. For low S/N, 'moffat' or 'gauss' are "
352  "recommended (for robustness). For high S/N, 'virtual' is "
353  "recommended (for accuracy). In the case of virtual resampling, "
354  "a precise determination of the order positions is required; "
355  "therefore the order-definition is repeated "
356  "using the (assumed non-low S/N) science frame",
357  UVES_EXTRACT_ID,
358  "auto",
359  5,
360  "constant",
361  "gauss",
362  "moffat",
363  "virtual",
364  "auto");
365 
366  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
367  cpl_parameterlist_append(parameters, p);
368  cpl_free(full_name);
369  }
370 
371  {
372  name = "skymethod";
373  full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
374 
375  uves_parameter_new_enum(p, full_name,
376  CPL_TYPE_STRING,
377  "In optimal extraction mode, the sky subtraction method "
378  "to use. 'median' estimates the sky as the median of pixels "
379  "along the slit (ignoring pixels close to the object), whereas "
380  "'optimal' does a chi square minimization along the slit "
381  "to obtain the best combined object and sky levels. The optimal "
382  "method gives the most accurate sky determination but is also "
383  "a bit slower than the median method",
384  UVES_EXTRACT_ID,
385  "optimal",
386  2,
387  "median",
388  "optimal");
389 
390  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
391  cpl_parameterlist_append(parameters, p);
392  cpl_free(full_name);
393  }
394 
395  {
396  name = "oversample";
397  full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
398 
399  uves_parameter_new_range(p, full_name,
400  CPL_TYPE_INT,
401  "The oversampling factor used for the virtual "
402  "resampling algorithm. If negative, the value 5 is "
403  "used for S/N <=200, and the value 10 is used if the estimated "
404  "S/N is > 200",
405  UVES_EXTRACT_ID,
406  -1,
407  -2, INT_MAX);
408 
409  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
410  cpl_parameterlist_append(parameters, p);
411  cpl_free(full_name);
412  }
413 
414  {
415  name = "best";
416  full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
417 
418  uves_parameter_new_value(p, full_name,
419  CPL_TYPE_BOOL,
420  "(optimal extraction only) "
421  "If false (fastest), the spectrum is extracted only once. "
422  "If true (best), the spectrum is extracted twice, the "
423  "second time using improved variance estimates "
424  "based on the first iteration. Better variance "
425  "estimates slightly improve the obtained signal to "
426  "noise but at the cost of increased execution time",
427  UVES_EXTRACT_ID,
428  true);
429 
430  cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
431  cpl_parameterlist_append(parameters, p);
432  cpl_free(full_name);
433  }
434 
435  if (cpl_error_get_code() != CPL_ERROR_NONE)
436  {
437  cpl_msg_error(__func__, "Creation of extraction parameters failed: '%s'",
438  cpl_error_get_where());
439  cpl_parameterlist_delete(parameters);
440  return NULL;
441  }
442  else
443  {
444  return parameters;
445  }
446 }
447 
448 
449 
450 /*----------------------------------------------------------------------------*/
460 /*----------------------------------------------------------------------------*/
461 extract_method
462 uves_get_extract_method(const cpl_parameterlist *parameters,
463  const char *context, const char *subcontext)
464 {
465  const char *method = "";
466  extract_method result = 0;
467 
468  check( uves_get_parameter(parameters, context, subcontext, "method",
469  CPL_TYPE_STRING, &method),
470  "Could not read parameter");
471 
472  if (strcmp(method, "average" ) == 0) result = EXTRACT_AVERAGE;
473  else if (strcmp(method, "linear" ) == 0) result = EXTRACT_LINEAR;
474  else if (strcmp(method, "2d" ) == 0) result = EXTRACT_2D;
475  else if (strcmp(method, "weighted") == 0) result = EXTRACT_WEIGHTED;
476  else if (strcmp(method, "optimal" ) == 0) result = EXTRACT_OPTIMAL;
477  else
478  {
479  assure(false, CPL_ERROR_ILLEGAL_INPUT, "No such extraction method: '%s'", method);
480  }
481 
482  cleanup:
483  return result;
484 }
485 
486 /*----------------------------------------------------------------------------*/
567 /*----------------------------------------------------------------------------*/
568 cpl_image *
569 uves_extract(cpl_image *image,
570  cpl_image *image_noise,
571  const uves_propertylist *image_header,
572  const cpl_table *ordertable,
573  const polynomial *order_locations_raw,
574  double slit_length,
575  double offset,
576  const cpl_parameterlist *parameters,
577  const char *context,
578  const char *mode,
579  bool extract_partial,
580  bool debug_mode,
581  enum uves_chip chip,
582  uves_propertylist **header,
583  cpl_image **spectrum_noise,
584  cpl_image **sky_spectrum,
585  cpl_image **sky_spectrum_noise,
586  cpl_table **cosmic_mask,
587  cpl_image **cosmic_image,
588  cpl_table **profile_table,
589  cpl_image **weights,
590  cpl_table **info_tbl,
591  cpl_table **order_trace)
592 {
593  cpl_image *spectrum = NULL; /* Result */
594  cpl_mask *spectrum_bad = NULL;
595  cpl_binary*spectrum_badmap = NULL;
596  cpl_image *sky_subtracted = NULL;
597  cpl_image *temp = NULL;
598  cpl_image *reconstruct = NULL;
599  slit_geometry sg;
600 
601  /* Recipe parameters */
602  extract_method method;
603  double kappa;
604  int chunk;
605  const char *p_method;
606  int sampling_factor;
607  bool best;
608  bool optimal_extract_sky;
609  int (*prof_func) (const double x[], const double a[], double *result) = NULL;
610  int (*prof_func_der)(const double x[], const double a[], double result[]) = NULL;
611  int prof_pars = 0;
612 
613  polynomial *order_locations = NULL;/* Improved order positions (or duplicate
614  of input polynomial) */
615  int n_traces; /* The number of traces to extract
616  * within each order, only relevant
617  * for 2D extraction */
618  int iteration, trace; /* Current iteration, order, trace */
619  int n_iterations;
620  int cr_row = 0; /* Points to first unused row in cr table */
621  int prof_row = 0; /* Next unsused row of profile_table */
622  uves_extract_profile *profile = NULL;
623  uves_iterate_position *pos = NULL; /* Iterator over input image */
624  char ex_context[80];
625  cpl_table* blemish_mask=NULL;
626 
627  /* Check input */
628  assure(image != NULL, CPL_ERROR_NULL_INPUT, "Missing input image");
629  /* header may be NULL */
630  assure( spectrum_noise == NULL || image_noise != NULL, CPL_ERROR_DATA_NOT_FOUND,
631  "Need image noise in order to calculate spectrum errors");
632  assure( ordertable != NULL, CPL_ERROR_NULL_INPUT, "Missing order table");
633  assure( order_locations_raw != NULL, CPL_ERROR_NULL_INPUT, "Missing order polynomial");
634  assure( parameters != NULL, CPL_ERROR_NULL_INPUT, "Null parameter list");
635  assure( context != NULL, CPL_ERROR_NULL_INPUT, "Missing context string!");
636  assure( cpl_table_has_column(ordertable, "Order"),
637  CPL_ERROR_DATA_NOT_FOUND, "No 'Order' column in order table!");
638  passure( uves_polynomial_get_dimension(order_locations_raw) == 2, "%d",
639  uves_polynomial_get_dimension(order_locations));
640  assure( slit_length > 0, CPL_ERROR_ILLEGAL_INPUT,
641  "Slit length must a be positive number! It is %e", slit_length);
642  /* sky_spectrum may be NULL */
643  assure( (sky_spectrum == NULL) == (sky_spectrum_noise == NULL), CPL_ERROR_INCOMPATIBLE_INPUT,
644  "Need 0 or 2 of sky spectrum + sky noise spectrum");
645 
646  /* info_tbl may be NULL */
647 
648  sg.length = slit_length;
649  sg.offset = offset;
650 
651 
652  if(strcmp(mode,".efficiency")==0) {
653  sprintf(ex_context,"uves_cal_response%s.reduce",mode);
654  } else {
655  sprintf(ex_context,"%s",context);
656  }
657 
658 
659 
660  /* Get recipe parameters */
661  check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID,
662  "kappa" , CPL_TYPE_DOUBLE, &kappa) ,
663  "Could not read parameter");
664  check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID,
665  "chunk" , CPL_TYPE_INT, &chunk) ,
666  "Could not read parameter");
667 
668  check_nomsg( method = uves_get_extract_method(parameters, ex_context, UVES_EXTRACT_ID) );
669 
670  {
671  char *s_method;
672 
673  check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID,
674  "skymethod", CPL_TYPE_STRING, &s_method),
675  "Could not read parameter");
676  if (strcmp(s_method, "median" ) == 0) optimal_extract_sky = false;
677  else if (strcmp(s_method, "optimal") == 0) optimal_extract_sky = true;
678  else
679  {
680  assure( false, CPL_ERROR_ILLEGAL_INPUT,
681  "Unrecognized sky extraction method: '%s'", s_method);
682  }
683 
684  }
685 
686  {
687  int minorder, maxorder;
688  check(( minorder = cpl_table_get_column_min(ordertable, "Order"),
689  maxorder = cpl_table_get_column_max(ordertable, "Order")),
690  "Error getting order range");
691 
692  pos = uves_iterate_new(cpl_image_get_size_x(image),
693  cpl_image_get_size_y(image),
694  order_locations_raw,
695  minorder, maxorder, sg);
696  /* needed for estimate_sn */
697  }
698  if (method == EXTRACT_OPTIMAL)
699  {
700  assure( image_noise != NULL, CPL_ERROR_ILLEGAL_INPUT,
701  "Extraction method is optimal, but no noise image is provided");
702 
703  assure( weights != NULL, CPL_ERROR_ILLEGAL_INPUT,
704  "Extraction method is optimal, but no weight image is provided");
705 
706  assure( cosmic_mask != NULL, CPL_ERROR_ILLEGAL_INPUT,
707  "Extraction method is optimal, but no cosmic ray mask table is provided");
708 
709  assure( cosmic_image != NULL, CPL_ERROR_ILLEGAL_INPUT,
710  "Extraction method is optimal, but no cosmic ray mask image is provided");
711 
712  assure( order_trace != NULL, CPL_ERROR_ILLEGAL_INPUT,
713  "Extraction method is optimal, but no order trace table is provided");
714 
715  assure( *weights == NULL, CPL_ERROR_ILLEGAL_INPUT,
716  "Weight image already exists");
717 
718  check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID, "oversample",
719  CPL_TYPE_INT, &sampling_factor),
720  "Could not read parameter");
721 
722  check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID, "best",
723  CPL_TYPE_BOOL, &best),
724  "Could not read parameter");
725 
726  check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID, "profile",
727  CPL_TYPE_STRING, &p_method),
728  "Could not read parameter");
729 
730  assure( strcmp(p_method, "constant") == 0 ||
731  sky_spectrum != NULL, CPL_ERROR_ILLEGAL_INPUT,
732  "Extraction method is optimal, but no sky spectrum is provided");
733 
734  if (strcmp(p_method, "auto" ) == 0)
735  {
736  /* Auto-select profile measuring method.
737  At low S/N a model with fewer free
738  parameters is needed */
739 
740  double sn_estimate;
741 
742  check( sn_estimate = estimate_sn(image, image_noise,
743  pos),
744  "Could not estimate image S/N");
745 
746  if (sn_estimate < 10)
747  {
748  p_method = "gauss";
749  }
750  else
751  {
752  p_method = "virtual";
753  }
754 
755  uves_msg("Estimated S/N is %.2f, "
756  "auto-selecting profile measuring method '%s'", sn_estimate,
757  p_method);
758  }
759 
760  if (strcmp(p_method, "gauss" ) == 0)
761  {prof_func = uves_gauss ; prof_func_der = uves_gauss_derivative ; prof_pars = 4;}
762  else if (strcmp(p_method, "moffat" ) == 0)
763  {prof_func = uves_moffat; prof_func_der = uves_moffat_derivative; prof_pars = 5;}
764  else if (strcmp(p_method, "virtual") == 0)
765  {prof_func = NULL ; prof_func_der = NULL ; prof_pars = 0;}
766  else if (strcmp(p_method, "constant") != 0)
767  {
768  assure( false, CPL_ERROR_ILLEGAL_INPUT,
769  "Unrecognized profile method: '%s'", p_method);
770  }
771 
772  assure( sampling_factor != 0, CPL_ERROR_ILLEGAL_INPUT,
773  "Illegal oversampling factor = %d", sampling_factor);
774 
775  if (strcmp(p_method, "virtual") == 0 && sampling_factor < 0)
776  /* Auto-select value */
777  {
778  double sn_estimate;
779 
780  check( sn_estimate = estimate_sn(image, image_noise,
781  pos),
782  "Could not estimate image S/N");
783 
784  if (sn_estimate <= 200)
785  {
786  sampling_factor = 5;
787  }
788  else
789  {
790  sampling_factor = 10;
791  }
792 
793  uves_msg("Estimated S/N is %.2f, "
794  "auto-selecting oversampling factor = %d", sn_estimate,
795  sampling_factor);
796  }
797  }
798 
799  assure( method != EXTRACT_WEIGHTED || weights != NULL, CPL_ERROR_ILLEGAL_INPUT,
800  "Extraction method is weighted, but no weight image is provided");
801 
802  if (method == EXTRACT_2D)
803  {
804  /* 1 trace is just 1 pixel */
805  n_traces = uves_round_double(slit_length);
806 
807  assure( n_traces % 2 == 0, CPL_ERROR_ILLEGAL_INPUT,
808  "For 2d extraction slit length (%d) must be an even number", n_traces);
809  }
810  else
811  {
812  n_traces = 1;
813  }
814 
815  if (method == EXTRACT_2D)
816  {
817  uves_msg_low("Slit length = %.1f pixels", slit_length);
818  }
819  else
820  {
821  uves_msg_low("Slit length = %.1f pixels; offset = %.1f pixel(s)",
822  sg.length, sg.offset);
823  }
824 
825  /* Initialize result images */
826  check(( spectrum = cpl_image_new(pos->nx,
827  n_traces*(pos->maxorder - pos->minorder + 1),
828  CPL_TYPE_DOUBLE),
829  spectrum_bad = cpl_image_get_bpm(spectrum),
830  spectrum_badmap = cpl_mask_get_data(spectrum_bad)),
831  "Error creating spectrum image");
832 
833 
834  if (spectrum_noise != NULL)
835  {
836  check( *spectrum_noise = cpl_image_new(cpl_image_get_size_x(spectrum),
837  cpl_image_get_size_y(spectrum),
838  CPL_TYPE_DOUBLE),
839  "Could not create image");
840  }
841 
842  if (info_tbl != NULL &&
843  (method == EXTRACT_LINEAR || method == EXTRACT_AVERAGE ||
844  method == EXTRACT_OPTIMAL)
845  )
846  {
847  *info_tbl = cpl_table_new(pos->maxorder-pos->minorder+1);
848  cpl_table_new_column(*info_tbl, "Order", CPL_TYPE_INT);
849  cpl_table_new_column(*info_tbl, "ObjSnBlzCentre", CPL_TYPE_DOUBLE);
850  cpl_table_new_column(*info_tbl, "Ripple", CPL_TYPE_DOUBLE);
851  /* Pos+FWHM columns are calculated differently,
852  based on optimal extraction method,
853  and simple extraction */
854 
855  cpl_table_new_column(*info_tbl, "ObjPosOnSlit", CPL_TYPE_DOUBLE); /* From bottom of slit */
856  cpl_table_new_column(*info_tbl, "ObjFwhmAvg", CPL_TYPE_DOUBLE);
857  }
858 
859  /* Extra input validation + initialization for optimal extraction */
860  if (method == EXTRACT_OPTIMAL)
861  {
862  /* Initialize weights to zero (good pixels) */
863  check( *weights = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE),
864  "Could not allocate weight image");
865 
866  /* Initialize cr and profile tables */
867  check(( *cosmic_mask = cpl_table_new(1),
868  cpl_table_new_column(*cosmic_mask, "Order", CPL_TYPE_INT),
869  cpl_table_new_column(*cosmic_mask, "X" , CPL_TYPE_INT),
870  cpl_table_new_column(*cosmic_mask, "Y" , CPL_TYPE_INT),
871  cpl_table_new_column(*cosmic_mask, "Flux" , CPL_TYPE_DOUBLE),
872  cr_row = 0),
873  "Error creating cosmic ray table");
874 
875  /* We need to flag detector detector blemishes if present */
876  if(*cosmic_image!=NULL) {
877  int sx=0;
878  int sy=0;
879  int nblemish=0;
880  int i=0;
881  int j=0;
882  int row=0;
883 
884  double flux=0;
885  int* px=NULL;
886  int* py=NULL;
887 
888  double* pcmask=NULL;
889  double blemish_frac=0;
890 
891  /* we count how many blemishes we got */
892  flux=cpl_image_get_flux(*cosmic_image);
893  sx=cpl_image_get_size_x(*cosmic_image);
894  sy=cpl_image_get_size_y(*cosmic_image);
895  nblemish=sx*sy-(int)flux;
896  blemish_frac=(sx*sy-flux)/(sx*sy);
897  uves_msg("nblemish=%d frac=%g",nblemish,blemish_frac);
898 
899  if(blemish_frac< 0.02) {
900 
901  /* we copy blemishes in a table, for efficiency */
902  blemish_mask=cpl_table_new(nblemish);
903  cpl_table_new_column(blemish_mask,"X",CPL_TYPE_INT);
904  cpl_table_new_column(blemish_mask,"Y",CPL_TYPE_INT);
905  cpl_table_fill_column_window_int(blemish_mask,"X",
906  0,nblemish,0);
907  cpl_table_fill_column_window_int(blemish_mask,"Y",
908  0,nblemish,0);
909 
910  pcmask=cpl_image_get_data_double(*cosmic_image);
911  px=cpl_table_get_data_int(blemish_mask,"X");
912  py=cpl_table_get_data_int(blemish_mask,"Y");
913 
914  for(j=0;j<sy;j++) {
915  for(i=0;i<sx;i++) {
916  if(pcmask[j*sx+i]==0) {
917  px[row]=i;
918  py[row]=j;
919  row++;
920  }
921  }
922  }
923  /*
924  check_nomsg(cpl_table_save(blemish_mask,NULL,NULL,
925  "blemish_mask.fits",CPL_IO_DEFAULT));
926  */
927  cr_row=nblemish;
928  } else {
929  uves_msg_warning("%d pixels affected by detector blemishes %g (>0.02) of total. Not flag them in optimal extraction",nblemish,blemish_frac);
930 
931  }
932  } /* end special case for detector blemishes */
933 
934 
935  if (profile_table != NULL)
936  {
937  check( (*profile_table = cpl_table_new((pos->maxorder - pos->minorder + 1) *
938  pos->nx *
939  (3+uves_round_double(sg.length))),
940  cpl_table_new_column(*profile_table, "Order" , CPL_TYPE_INT),
941  cpl_table_new_column(*profile_table, "X" , CPL_TYPE_INT),
942  cpl_table_new_column(*profile_table, "DY" , CPL_TYPE_DOUBLE),
943  cpl_table_new_column(*profile_table, "Profile_raw", CPL_TYPE_DOUBLE),
944  cpl_table_new_column(*profile_table, "Profile_int", CPL_TYPE_DOUBLE)),
945  "Error creating profile table");
946  prof_row = 0;
947  }
948 
949  if (strcmp(p_method, "constant") != 0) {
950  check( *sky_spectrum = cpl_image_new(
951  pos->nx, pos->maxorder - pos->minorder + 1, CPL_TYPE_DOUBLE),
952  "Could not allocate sky spectrum");
953  check( *sky_spectrum_noise = cpl_image_new(
954  pos->nx, pos->maxorder - pos->minorder + 1, CPL_TYPE_DOUBLE),
955  "Could not allocate sky spectrum noise");
956  }
957  }
958 
959  if (method == EXTRACT_OPTIMAL &&
960  strcmp(p_method, "constant") != 0 && prof_func == NULL)
961  {
962  /* Virtual method needs accurate order definition.
963  * Some calibration order tables are inaccurate because
964  * the poly-degree used (2,3) is too low.
965  *
966  * Besides, the (science) spectrum might be shifted compared
967  * to the order-flat-narrow frame.
968  */
969 
970  uves_msg("Refining order definition using the object frame");
971 
972  check( order_locations = repeat_orderdef(image, image_noise, order_locations_raw,
973  pos->minorder, pos->maxorder,
974  pos->sg,
975  *info_tbl),
976  "Could not refine order definition");
977  }
978  else
979  {
980  order_locations = uves_polynomial_duplicate(order_locations_raw);
981  }
982 
983  pos->order_locations = order_locations;
984 
985  /* Input checking + output initialization done. */
986 
987 
988  /* Do the processing, pseudocode for optimal extraction:
989 
990  extract+subtract sky (median method)
991  globally measure profile
992 
993  two times
994  for each order
995  extract object+sky, reject hot/cold pixels
996  revise variances
997  */
998  if (method == EXTRACT_OPTIMAL)
999  {
1000  if (strcmp(p_method, "constant") == 0) {
1001 
1002  uves_msg("Assuming constant spatial profile");
1003 
1004  profile = uves_extract_profile_new_constant(sg.length);
1005 
1006  /* Pretend that we subtracted the sky here */
1007  sky_subtracted = cpl_image_duplicate(image);
1008  optimal_extract_sky = false;
1009 
1010  }
1011  else {
1012  check( sky_subtracted = opt_extract_sky(
1013  image, image_noise, *weights,
1014  pos,
1015  *sky_spectrum,
1016  *sky_spectrum_noise),
1017  "Could not extract sky");
1018  if (prof_func != NULL)
1019  {
1020  uves_msg("Measuring spatial profile "
1021  "(method = %s, chunk = %d bins)",
1022  p_method, chunk);
1023  }
1024  else
1025  {
1026  uves_msg("Measuring spatial profile "
1027  "(method = %s, oversampling = %d)",
1028  p_method, sampling_factor);
1029  }
1030 
1031  uves_extract_profile_delete(&profile);
1032  /* the new profile measuring method should use this one
1033  check( profile = opt_measure_profile(image, image_noise, *weights, */
1034  check( profile = opt_measure_profile(sky_subtracted, image_noise, *weights,
1035  pos,
1036  chunk, sampling_factor,
1037  prof_func, prof_func_der, prof_pars,
1038  *sky_spectrum,
1039  *info_tbl,
1040  order_trace),
1041  "Could not measure profile");
1042 
1043  /* In previous versions, the sky was subtracted (again) at this point
1044  using the knowledge of the analytical profile.
1045  But this is not needed anymore, now that the sky is
1046  extracted simultaneously with the flux (which is equivalent
1047  but much faster).
1048  */
1049  }
1050  }
1051 
1052  /* The loop over traces is trivial, unless method = 2d. */
1053  passure( method == EXTRACT_2D || n_traces == 1, "%d", n_traces);
1054 
1055  n_iterations = (method == EXTRACT_OPTIMAL &&
1056  best &&
1057  strcmp(p_method, "constant") != 0) ? 2 : 1;
1058  //cpl_table_dump(*cosmic_mask,0,cr_row,stdout);
1059  //uves_msg("cr_row=%d table size=%d",cr_row,cpl_table_get_nrow(*cosmic_mask));
1060  int cr_row_max=0;
1061  /* in case of blemishes cr_row> 0 */
1062  //cr_row_max=(cr_row>cr_row_max) ? cr_row: cr_row_max;
1063 
1064  //cpl_table_dump(*cosmic_mask,1,2,stdout);
1065 
1066  for (iteration = 1;
1067  iteration <= n_iterations;
1068  iteration++)
1069  {
1070  uves_msg("Extracting object %s(method = %s)",
1071  (method == EXTRACT_OPTIMAL && optimal_extract_sky)
1072  ? "and sky " : "",
1073  (method == EXTRACT_OPTIMAL) ? "optimal" :
1074  (method == EXTRACT_AVERAGE) ? "average" :
1075  (method == EXTRACT_LINEAR ) ? "linear" :
1076  (method == EXTRACT_2D ) ? "2d" :
1077  (method == EXTRACT_WEIGHTED) ? "weighted" : "???");
1078 
1079  /* Clear cosmic ray + profile table + S/N table */
1080  //uves_msg("cr_row=%d table size=%d",cr_row,cpl_table_get_nrow(*cosmic_mask));
1081  cr_row = cr_row_max;
1082  //uves_msg("cr_row=%d table size=%d",cr_row,cpl_table_get_nrow(*cosmic_mask));
1083  prof_row = 0;
1084  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++) {
1085  for (trace = 1; trace <= n_traces; trace++) {
1086  int spectrum_row; /* Spectrum image row to write to */
1087  int bins_extracted;
1088 
1089  double sn = 0;
1090 
1091  spectrum_row = (pos->order - pos->minorder)*n_traces + trace;
1092  /* Always count from order=1 in the extracted spectrum */
1093 
1094  if (method == EXTRACT_OPTIMAL)
1095  {
1096  /*
1097  * We already know the spatial profile.
1098  * Extract object+sky
1099  */
1100 
1101  check( bins_extracted = opt_extract(
1102  optimal_extract_sky ?
1103  image : sky_subtracted,
1104  image_noise,
1105  pos,
1106  profile,
1107  optimal_extract_sky,
1108  kappa,
1109  blemish_mask,
1110  *cosmic_mask,
1111  &cr_row,
1112  (profile_table != NULL) ?
1113  *profile_table : NULL,
1114  &prof_row,
1115  spectrum,
1116  (spectrum_noise != NULL) ?
1117  *spectrum_noise : NULL,
1118  *weights,
1119  optimal_extract_sky ? *sky_spectrum : NULL,
1120  optimal_extract_sky ? *sky_spectrum_noise : NULL,
1121  &sn),
1122  "Error extracting order #%d", pos->order);
1123  cr_row_max=(cr_row>cr_row_max) ? cr_row:cr_row_max;
1124  }
1125  else
1126  {
1127  /* Average, linear, 2d, weighted */
1128 
1129  /* A 2d extraction is implemented
1130  * as a repeated linear extraction
1131  * with slit_length = 1.
1132  *
1133  * For 2d mode, map
1134  * trace = 1, 2, ..., n_traces
1135  * to something that is symmetric around 0
1136  * (notice that n_traces is an even number)
1137  * offset = -n_traces/2 + 1/2, ..., n_traces/2 - 1/2
1138  */
1139 
1140  double offset_2d = trace - (n_traces+1)/2.0;
1141  double slit_2d = 1;
1142 
1143  check( bins_extracted = extract_order_simple(
1144  image, image_noise,
1145  order_locations,
1146  pos->order, pos->minorder,
1147  spectrum_row,
1148  (method == EXTRACT_2D) ? offset_2d : sg.offset,
1149  (method == EXTRACT_2D) ? slit_2d : sg.length,
1150  (method == EXTRACT_2D) ? EXTRACT_LINEAR : method,
1151  (weights != NULL) ? *weights : NULL,
1152  extract_partial,
1153  spectrum,
1154  (spectrum_noise != NULL) ? *spectrum_noise : NULL,
1155  spectrum_badmap,
1156  info_tbl,
1157  &sn),
1158  "Could not extract order #%d ; trace #%d",
1159  pos->order, trace);
1160  }
1161 
1162 
1163  if (info_tbl != NULL &&
1164  (method == EXTRACT_LINEAR || method == EXTRACT_AVERAGE ||
1165  method == EXTRACT_OPTIMAL)
1166  )
1167  {
1168  /* Do post extraction measurements of any ripples */
1169  double ripple_index = detect_ripples(spectrum, pos, sn);
1170  uves_msg("Order #%d: S/N = %.2f",
1171  pos->order, sn);
1172  uves_msg_debug("Ripple index = %.2f (should be less than 2)",
1173  ripple_index);
1174 
1175  if (false && ripple_index > 3) {
1176  /* Disabled. This would also produce warnings about arc
1177  lamp frames which have short period ripples (a.k.a ThAr emmision
1178  lines), which is just silly.
1179  */
1180  uves_msg_warning("Short period ripples detected (index = %f). "
1181  "It might help to use average or linear extraction "
1182  "or optimal/virtual extraction with larger "
1183  "oversampling factor", ripple_index);
1184  }
1185 
1186  cpl_table_set_int (*info_tbl, "Order",
1187  pos->order - pos->minorder, pos->order);
1188  cpl_table_set_double(*info_tbl, "ObjSnBlzCentre" ,
1189  pos->order - pos->minorder, sn);
1190  cpl_table_set_double(*info_tbl, "Ripple",
1191  pos->order - pos->minorder,
1192  (ripple_index > -0.5) ? ripple_index : -1);
1193  }
1194 
1196  "Order #%d; trace #%d: %d of %d bins extracted",
1197  pos->order, trace, bins_extracted, pos->nx);
1198 
1199  }/* for trace ... */
1200 
1201  }/* for order ... */
1202 
1203 
1204  if (method == EXTRACT_OPTIMAL)
1205  {
1206  if (spectrum_noise != NULL)
1207  {
1208  uves_free_image(&temp);
1209  temp = cpl_image_divide_create(spectrum, *spectrum_noise);
1210  uves_msg("Average S/N = %.3f", cpl_image_get_median(temp));
1211  }
1212 
1213  if (iteration == 1 && n_iterations >= 2)
1214  {
1215  /* If optimal extraction, repeat with more accurate error bars */
1216  uves_msg_low("Recomputing pixel variances");
1217 
1218  check( revise_noise(image_noise,
1219  cpl_mask_get_data(
1220  cpl_image_get_bpm(sky_subtracted)),
1221  image_header, pos,
1222  spectrum, *sky_spectrum, profile,
1223  chip),
1224  "Error refining input image variances");
1225  }
1226  }
1227  // AMO noise computation: put back noise bias & dark contributes
1228 
1229  }/* for iteration */
1230 
1231  /* Set cosmic mask + profile table size, and weights to non-negative */
1232  if (method == EXTRACT_OPTIMAL)
1233  {
1234  int i;
1235  /* AMO: change CRH mask start raw to include all detected CRHs */
1236  check( cpl_table_set_size(*cosmic_mask, cr_row_max),
1237  "Error setting cosmic ray table size to %d", cr_row_max);
1238  if(*cosmic_image==NULL) {
1239  *cosmic_image = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
1240  }
1241  assure_mem(*cosmic_image);
1242 
1243  for (i = 0; i < cpl_table_get_nrow(*cosmic_mask); i++)
1244  {
1245  cpl_image_set(*cosmic_image,
1246  cpl_table_get_int(*cosmic_mask, "X", i, NULL),
1247  cpl_table_get_int(*cosmic_mask, "Y", i, NULL),
1248  cpl_table_get_double(*cosmic_mask, "Flux", i, NULL));
1249  }
1250 
1251  if (profile_table != NULL)
1252  {
1253  check( cpl_table_set_size(*profile_table, prof_row),
1254  "Error setting profile table size to %d", prof_row);
1255  }
1256 
1257  /* There are still pixels outside the extraction bins
1258  which have not been touched after creating
1259  the weights image. They are negative; set to zero. */
1260 
1261  check( cpl_image_threshold(*weights,
1262  0, DBL_MAX,
1263  0, DBL_MAX),
1264  "Error thresholding weight image");
1265 
1266  /* Normalize weights (to 1) to get a
1267  * more informative weight image
1268  * This is not needed for the algorithm
1269  * but is computationally cheap
1270  */
1271 
1272  {
1273  double *weights_data = cpl_image_get_data_double(*weights);
1274 
1275  for (uves_iterate_set_first(pos,
1276  1, pos->nx,
1277  pos->minorder, pos->maxorder,
1278  NULL, false);
1279  !uves_iterate_finished(pos);
1281  {
1282  double sum_weights = 0.0;
1283 
1284  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
1285  {
1286  double weight = DATA(weights_data, pos);
1287  sum_weights += weight;
1288  }
1289 
1290  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
1291  {
1292  if (sum_weights > 0)
1293  {
1294  DATA(weights_data, pos) /= sum_weights;
1295  }
1296  }
1297  }
1298  }
1299  } /* if optimal */
1300 
1301  /* Copy bad pixel map from spectrum to error bar spectrum */
1302  uves_msg_debug("Rejecting %" CPL_SIZE_FORMAT " bins", cpl_mask_count(spectrum_bad));
1303 
1304  if (spectrum_noise != NULL)
1305  {
1306  check( cpl_image_reject_from_mask(*spectrum_noise, spectrum_bad),
1307  "Error setting bad pixels");
1308  }
1309 
1310  /* Create spectrum header */
1311  if (header != NULL)
1312  {
1313  /* (pixel, pixel) or (pixel, order) space */
1315  "PIXEL", (method == EXTRACT_2D) ? "PIXEL" : "ORDER",
1316  "PIXEL", (method == EXTRACT_2D) ? "PIXEL" : "ORDER",
1317  "ADU",0,
1318  1.0, pos->minorder, /* CRVAL */
1319  1.0, 1.0, /* CRPIX */
1320  1.0, 1.0), /* CDELT (this should really be the x-binning) */
1321  "Error initializing spectrum header");
1322  }
1323 
1324  if (debug_mode && header != NULL) {
1325  if (profile == NULL) {
1326  /* If profile was not measured (i.e. linear/average etc.),
1327  set to constant */
1328  profile = uves_extract_profile_new_constant(sg.length);
1329  }
1330 
1331  check_nomsg( reconstruct =
1332  uves_create_image(pos, chip,
1333  spectrum,
1334  sky_spectrum != NULL ? *sky_spectrum : NULL,
1335  cosmic_image != NULL ? *cosmic_image : NULL,
1336  profile,
1337  NULL, NULL)); /* error bars, header */
1338 
1339  /*
1340  check(uves_propertylist_copy_property_regexp(*header, image_header, "^ESO ", 0),
1341  "Error copying hieararch keys");
1342  */
1343  check( uves_save_image_local("Reconstructed image", "simulate",
1344  reconstruct, chip, -1, -1, *header, true),
1345  "Error saving image");
1346 
1347  }
1348 
1349  if (spectrum_noise != NULL)
1350  {
1351  cpl_size x, y;
1352 
1353  /* Assert that produced noise spectrum is
1354  always positive.
1355 
1356  For efficiency, cpl_image_get_minpos
1357  is called only in case of error (using
1358  a comma expression)
1359  */
1360 
1361  /* ... then this assertion should not fail */
1362  assure( cpl_image_get_min(*spectrum_noise) > 0, CPL_ERROR_ILLEGAL_OUTPUT,
1363  "Non-positive noise: %e at (%" CPL_SIZE_FORMAT ", %" CPL_SIZE_FORMAT ")",
1364  cpl_image_get_min(*spectrum_noise),
1365  (cpl_image_get_minpos(*spectrum_noise, &x, &y), x),
1366  (cpl_image_get_minpos(*spectrum_noise, &x, &y), y));
1367 
1368  /* For debugging: this code dumps S/N statistics (and leaks memory)
1369  cpl_stats_dump(cpl_stats_new_from_image(
1370  cpl_image_divide_create(spectrum, *spectrum_noise),
1371  CPL_STATS_ALL), CPL_STATS_ALL, stdout);
1372  */
1373  }
1374 
1375 
1376  cleanup:
1377  uves_free_image(&reconstruct);
1378  uves_free_image(&sky_subtracted);
1379  uves_extract_profile_delete(&profile);
1380  uves_polynomial_delete(&order_locations);
1381  uves_iterate_delete(&pos);
1382  uves_free_image(&temp);
1383  uves_free_table(&blemish_mask);
1384 
1385  if (cpl_error_get_code() != CPL_ERROR_NONE)
1386  {
1387  uves_free_image(&spectrum);
1388  uves_free_image(spectrum_noise);
1389  uves_free_table(profile_table);
1390  }
1391 
1392  return spectrum;
1393 }
1394 
1395 /*----------------------------------------------------------------------------*/
1405 /*----------------------------------------------------------------------------*/
1406 static double
1407 detect_ripples(const cpl_image *spectrum, const uves_iterate_position *pos,
1408  double sn)
1409 {
1410  double ratio = -1; /* result */
1411  int n_traces = 1; /* Not 2d extraction */
1412  int trace = 1;
1413  int nx = cpl_image_get_size_x(spectrum);
1414  cpl_image *spectrum_order = NULL;
1415  cpl_vector *tempx = NULL;
1416  cpl_vector *tempy = NULL;
1417  double *auto_corr = NULL;
1418 
1419  int spectrum_row = (pos->order - pos->minorder)*n_traces + trace;
1420  int n_rejected;
1421 
1422  uves_free_image(&spectrum_order);
1423 
1424  check( spectrum_order = cpl_image_extract(spectrum,
1425  1, spectrum_row,
1426  nx, spectrum_row),
1427  "Error extracting order %d from spectrum", pos->order);
1428 
1429  n_rejected = cpl_image_count_rejected(spectrum_order);
1430  uves_msg_debug("Order %d: %d/%d invalid values", pos->order,
1431  n_rejected,
1432  nx);
1433 
1434  if (n_rejected == 0) /* Skip partial orders */
1435  /* Compute auto-correlation function */
1436  {
1437  double order_slope = /* dy/dx at x = nx/2 */
1438  uves_polynomial_derivative_2d(pos->order_locations, nx/2, pos->order, 1);
1439 
1440  int expected_period = uves_round_double(1.0/order_slope);
1441  int max_period = 2*expected_period;
1442  int shift; /* in pixels */
1443 
1444  uves_msg_debug("Estimated ripple period = %d pixels", expected_period);
1445 
1446  auto_corr = cpl_calloc(sizeof(double), 1+max_period);
1447 
1448  for (shift = 0; shift <= max_period; shift += 1) {
1449  int N = 0;
1450  int x;
1451 
1452  auto_corr[shift] = 0;
1453 
1454  for (x = 1; x <= nx - max_period; x++) {
1455  int rejected1, rejected2;
1456  double val1, val2;
1457 
1458  val1 = cpl_image_get(spectrum_order, x, 1, &rejected1);
1459  val2 = cpl_image_get(spectrum_order, x+shift, 1, &rejected2);
1460 
1461  if (!rejected1 && !rejected2)
1462  {
1463  auto_corr[shift] += val1*val2;
1464  N++;
1465  }
1466  }
1467 
1468  if (N != 0)
1469  {
1470  auto_corr[shift] /= N;
1471  }
1472  else
1473  {
1474  auto_corr[shift] = 0;
1475  }
1476 
1477  if (shift > 0 && auto_corr[0] > 0)
1478  {
1479  auto_corr[shift] /= auto_corr[0];
1480  }
1481 
1482  uves_msg_debug("Auto-correlation (%d pixels, %d samples) = %f",
1483  shift, N, (shift == 0) ? 1 : auto_corr[shift]);
1484  }
1485  auto_corr[0] = 1;
1486  /* Done compute auto correlation function for this order */
1487 
1488  {
1489  /* Get amplitude of normalized auto correlation function */
1490  double auto_amplitude;
1491  int imax = expected_period;
1492  int imin1 = expected_period/2;
1493  int imin2 = (expected_period*3)/2;
1494 
1495  /* Measuring the ACF maxima + minima would be non-robust to
1496  the case where there is no peak. Therefore use simply
1497  the predicted positions: */
1498 
1499  auto_amplitude = auto_corr[imax] -
1500  (auto_corr[imin1] + auto_corr[imin2])/2.0;
1501 
1502  /* The autocorrelation function is used to estimate the ripple amplitude.
1503  * Not caring too much about numerical factors and the specific
1504  * analytical form of the oscillations, the following relation holds:
1505  *
1506  * autocorrelation function relative amplitude =
1507  * (ripple relative amplitude)^2
1508  *
1509  * To convert from this amplitude to a stdev we can assume a
1510  * sine curve i.e. divide the amplitude by 2 to get the stdev
1511  * (or alternatively multiply the spectrum error bars by 2)
1512  */
1513 
1514  if (auto_amplitude > 0 && sn > 0)
1515  {
1516  double rel_ripple = sqrt(auto_amplitude);
1517  uves_msg_debug("Order %d: Relative ripple amplitude = %f, "
1518  "relative error bars = %f",
1519  pos->order, rel_ripple, 2.0*1/sn);
1520 
1521  ratio = rel_ripple * sn/2.0;
1522  }
1523  }
1524  } /* Done measuring auto correlation function */
1525 
1526  cleanup:
1527  uves_free_double(&auto_corr);
1528  uves_free_vector(&tempx);
1529  uves_unwrap_vector(&tempy);
1530  uves_free_image(&spectrum_order);
1531 
1532 
1533  return ratio;
1534 }
1535 
1536 /*----------------------------------------------------------------------------*/
1548 /*----------------------------------------------------------------------------*/
1549 static double
1550 estimate_sn(const cpl_image *image, const cpl_image *image_noise,
1551  uves_iterate_position *pos)
1552 {
1553  double sn = -1;
1554  int range = 5; /* Use central (2*range+1) bins in each order */
1555  cpl_table *sn_temp = NULL;
1556  cpl_table *sky_temp = NULL;
1557  int sn_row, sky_row;
1558  int sky_size = 2 + 2*uves_round_double(pos->sg.length); /* allocate enough rows
1559  to store all values
1560  across the slit */
1561 
1562  passure( image_noise != NULL, " ");
1563 
1564  assure( pos->nx >= 2*(range+1), CPL_ERROR_ILLEGAL_INPUT,
1565  "Input image is too small. Width = %d", pos->nx);
1566 
1567  sn_temp = cpl_table_new((pos->maxorder - pos->minorder + 1) * (2*range + 1));
1568  cpl_table_new_column(sn_temp, "SN", CPL_TYPE_DOUBLE);
1569  sn_row = 0;
1570 
1571  sky_temp = cpl_table_new(sky_size);
1572  cpl_table_new_column(sky_temp, "Sky", CPL_TYPE_DOUBLE);
1573 
1574  for (uves_iterate_set_first(pos,
1575  pos->nx/2 - range, pos->nx/2 + range,
1576  pos->minorder, pos->maxorder,
1577  NULL, false);
1578  !uves_iterate_finished(pos);
1580  {
1581  double flux = 0;
1582  double error = 0;
1583  int N = 0;
1584 
1585  sky_row = 0;
1586 
1587  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
1588  {
1589  int pis_rejected1, pis_rejected2;
1590  double pixel = cpl_image_get(image,
1591  pos->x, pos->y, &pis_rejected1);
1592  double pixel_noise = cpl_image_get(image_noise,
1593  pos->x, pos->y, &pis_rejected2);
1594 
1595  if (!pis_rejected1 && !pis_rejected2)
1596  {
1597  flux += pixel;
1598  error += pixel_noise*pixel_noise;
1599  N++;
1600 
1601  cpl_table_set_double(sky_temp, "Sky",
1602  sky_row, pixel);
1603  sky_row++;
1604  }
1605  }
1606 
1607  if (N > 0)
1608  {
1609  double sky; /* Sky level of one pixel, not full slit */
1610 
1611  while(sky_row < sky_size)
1612  /* Mark remaining values as bad before getting median */
1613  {
1614  cpl_table_set_invalid(sky_temp, "Sky",
1615  sky_row);
1616 
1617  sky_row++;
1618  }
1619 
1620  sky = cpl_table_get_column_median(sky_temp, "Sky");
1621 
1622  flux = flux - N*sky;
1623  error = sqrt(error); /* Don't propagate the (small) error
1624  from the sky subtraction */
1625 
1626  if (error > 0)
1627  {
1628  uves_msg_debug("Order %d: S/N estimate = %f",
1629  pos->order, flux/error);
1630 
1631  cpl_table_set_double(sn_temp, "SN",
1632  sn_row, flux/error);
1633  sn_row++;
1634  }
1635  }
1636  }
1637 
1638  assure(sn_row > 0, CPL_ERROR_DATA_NOT_FOUND,
1639  "Extraction of central bins failed!");
1640 
1641  cpl_table_set_size(sn_temp, sn_row);
1642 
1643  sn = cpl_table_get_column_median(sn_temp, "SN");
1644 
1645  cleanup:
1646  uves_free_table(&sn_temp);
1647  uves_free_table(&sky_temp);
1648  return sn;
1649 }
1650 
1651 /*----------------------------------------------------------------------------*/
1683 /*----------------------------------------------------------------------------*/
1684 
1685 static int
1686 extract_order_simple(const cpl_image *image,
1687  const cpl_image *image_noise,
1688  const polynomial *order_locations,
1689  int order,
1690  int minorder,
1691  int spectrum_row,
1692  double offset,
1693  double slit_length,
1694  extract_method method,
1695  const cpl_image *weights,
1696  bool extract_partial,
1697  cpl_image *spectrum,
1698  cpl_image *spectrum_noise,
1699  cpl_binary*spectrum_badmap,
1700  cpl_table **info_tbl,
1701  double *sn)
1702 {
1703  int bins_extracted = 0;
1704  double *spectrum_data;
1705  int x, nx, ny;
1706  double flux_y, flux_yy, flux_tot;
1707  int sn_row = 0; /* Number of rows in 'signal_to_noise'
1708  actually used */
1709  cpl_table *signal_to_noise = NULL;
1710 
1711  passure( method == EXTRACT_AVERAGE ||
1712  method == EXTRACT_LINEAR ||
1713  method == EXTRACT_WEIGHTED, "%d", method);
1714 
1715  /* It's probably a bug if there's a weight image and method = linear/average */
1716  passure( (method == EXTRACT_WEIGHTED) == (weights != NULL), "%d", method);
1717 
1718  nx = cpl_image_get_size_x(image);
1719  ny = cpl_image_get_size_y(image);
1720 
1721  check( (signal_to_noise = cpl_table_new(nx),
1722  cpl_table_new_column(signal_to_noise, "SN", CPL_TYPE_DOUBLE)),
1723  "Error allocating S/N table");
1724 
1725  spectrum_data = cpl_image_get_data_double(spectrum);
1726 
1727  flux_y = 0;
1728  flux_yy = 0;
1729  flux_tot = 0;
1730  /* Extract the entire image width */
1731  for (x = 1 ; x <= nx; x++) {
1732  double slope, ycenter; /* Running slope, bin center */
1733  int ylo, yhi; /* Lowest, highest pixel to look at */
1734  double flux = 0;
1735  double flux_variance = 0;
1736  double sum = 0; /* (Fractional) number of pixels extracted so far */
1737  int y;
1738 
1739  /* Get local order slope */
1740  check(( slope = (uves_polynomial_evaluate_2d(order_locations, x+1, order) -
1741  uves_polynomial_evaluate_2d(order_locations, x-1, order) ) / 2,
1742  /* Center of order */
1743  ycenter = uves_polynomial_evaluate_2d(order_locations, x, order) + offset),
1744  "Error evaluating polynomial");
1745 
1746  assure( 0 < slope && slope < 1, CPL_ERROR_ILLEGAL_INPUT,
1747  "At (x, order)=(%d, %d) slope is %f. Must be positive", x, order, slope);
1748 
1749  /* Lowest and highest pixels partially inside the slit */
1750  ylo = uves_round_double(ycenter - slit_length/2 - 0.5*slope);
1751  yhi = uves_round_double(ycenter + slit_length/2 + 0.5*slope);
1752 
1753  /* If part of the bin is outside the image... */
1754  if (ylo < 1 || ny < yhi)
1755  {
1756  if (extract_partial)
1757  {
1758  ylo = uves_max_int(ylo, 1);
1759  yhi = uves_min_int(yhi, ny);
1760  }
1761  else
1762  {
1763  /* Don't extract the bin if 'extract_partial' is false */
1764  ylo = yhi + 1;
1765  }
1766  }
1767 
1768  /* Extract */
1769  for (y = ylo; y <= yhi; y++) {
1770  /* Calculate area of pixel inside order */
1771  int pis_rejected;
1772  double pixelval;
1773  double pixelvariance;
1774  double weight;
1775 
1776  /* Read pixel flux */
1777  pixelval = cpl_image_get(image, x, y, &pis_rejected);
1778 
1779  /* Uncomment to disallow negative fluxes
1780  assure( MIDAS || pis_rejected || pixelval >= 0, CPL_ERROR_ILLEGAL_INPUT,
1781  "Negative flux: %e at (x, y) = (%d, %d)", pixelval, x, y);
1782  */
1783 
1784  /* Read pixel noise */
1785  if (spectrum_noise != NULL && !pis_rejected)
1786  {
1787  pixelvariance = cpl_image_get(image_noise, x, y, &pis_rejected);
1788  pixelvariance *= pixelvariance;
1789  }
1790  else
1791  {
1792  pixelvariance = 1;
1793  }
1794 
1795  if (!pis_rejected) {
1796  /* Get weight */
1797  if (method == EXTRACT_WEIGHTED)
1798  {
1799  /* Use already defined weight
1800  (from previous optimal extraction) */
1801 
1802  weight = cpl_image_get(weights, x, y, &pis_rejected);
1803 
1804  assure( weight >= 0, CPL_ERROR_ILLEGAL_INPUT,
1805  "Illegal weight: %e at (x, y) = (%d, %d)",
1806  weight, x, y);
1807 
1808  if (weight == 0)
1809  {
1810  /* To avoid ~100 MB log file this is commented out:
1811  uves_msg_debug("Ignoring bad pixel at (order, x, y) "
1812  "= (%d, %d, %d)", order, x, y);
1813  */
1814  }
1815  }
1816  else if (method == EXTRACT_ARCLAMP) {
1817  weight = 1.0 / pixelvariance;
1818  }
1819  else {
1820  /* Linear / average extraction */
1821  double area_outside_order_top;
1822  double area_outside_order_bottom;
1823  double left = ycenter + slit_length/2 - 0.5*slope;
1824  double right = ycenter + slit_length/2 + 0.5*slope;
1825 
1826  check( area_outside_order_top =
1827  area_above_line(y, left, right),
1828  "Error calculating area");
1829 
1830  left = ycenter - slit_length/2 - 0.5*slope;
1831  right = ycenter - slit_length/2 + 0.5*slope;
1832 
1833  check( area_outside_order_bottom =
1834  1 - area_above_line(y, left, right),
1835  "Error calculationg area");
1836 
1837  weight = 1 - (area_outside_order_top + area_outside_order_bottom);
1838 
1839  if (1 < y && y < ny && weight < 1)
1840  {
1841  /* Interpolate the flux profile at edge of slit */
1842 
1843  /* Use a piecewise linear profile like this
1844  *
1845  * C
1846  * intrp.profile => / \
1847  * ---/---\-- <= measured pixelval
1848  * | / \|
1849  * |/ B
1850  * A |________ <= measured (integrated) profile
1851  * /|
1852  * __________|
1853  *
1854  * The flux levels A and B are midway between the
1855  * current pixel flux and its neighbours' levels.
1856  * C is chosen so that the integrated over the
1857  * current pixel is consistent with the measured flux.
1858  *
1859  * This guess profile is continous as well as flux conserving
1860  */
1861 
1862  int pis_rejected_prev, pis_rejected_next;
1863 
1864  /* Define flux at pixel borders (A and B) as
1865  mean value of this and neighbouring pixel */
1866  double flux_minus = (pixelval + cpl_image_get(
1867  image, x, y - 1, &pis_rejected_prev)) / 2.0;
1868  double flux_plus = (pixelval + cpl_image_get(
1869  image, x, y + 1, &pis_rejected_next)) / 2.0;
1870  if (!pis_rejected_prev && !pis_rejected_next)
1871  {
1872  /* Define flux at pixel center, fluxc, so that the average
1873  * flux is equal to the measured value 'pixelval':
1874  *
1875  * ((flux- + fluxc)/2 + (flux+ + fluxc)/2) / 2 = pixelval
1876  * => flux- + flux+ + 2fluxc = 4pixelval
1877  * => fluxc = ...
1878  */
1879 
1880  double flux_center =
1881  2*pixelval - (flux_minus + flux_plus) / 2.0;
1882 
1883  /* Line slopes */
1884  double slope_minus =
1885  (flux_center - flux_minus )/ 0.5;
1886  double slope_plus =
1887  (flux_plus - flux_center) / 0.5;
1888 
1889  /* Define interval in [-0.5 ; 0] . Pixel center is at 0.*/
1890  double lo1 =
1891  uves_min_double(0, -0.5 + area_outside_order_bottom);
1892  double hi1 =
1893  uves_min_double(0, 0.5 - area_outside_order_top );
1894  double dy1 = hi1-lo1;
1895 
1896  /* Define interval in [0 ; 0.5] */
1897  double lo2 =
1898  uves_max_double(0, -0.5 + area_outside_order_bottom);
1899  double hi2 =
1900  uves_max_double(0, 0.5 - area_outside_order_top );
1901  double dy2 = hi2-lo2;
1902 
1903  if (dy1 + dy2 > 0)
1904  {
1905  /* Get average flux over the two intervals */
1906  pixelval = (
1907  (flux_center + slope_minus * (lo1+hi1)/2.0) * dy1
1908  +
1909  (flux_center + slope_plus * (lo2+hi2)/2.0) * dy2
1910  ) / (dy1 + dy2);
1911 
1912  /* Don't update/interpolate 'pixelvariance'
1913  * correspondingly (for simplicity) .
1914  */
1915  }
1916  /* else { don't change pixelval } */
1917  }/* Neighbours are good */
1918  }/* Profile interpolation */
1919  else
1920  {
1921  /* Neighbours not available, don't change flux */
1922  }
1923  } /* Get weight */
1924 
1925  /*
1926  * Accumulate weighted sum (linear/average):
1927  *
1928  * Flux = [ sum weight_i * flux_i ]
1929  * Variance = [ sum weight_i^2 * variance_i ]
1930  *
1931  * Arclamp:
1932  *
1933  * Flux = [ sum flux_i / variance_i ] /
1934  * [ sum 1 / variance_i ]
1935  * Variance = 1 /
1936  * = [ sum 1 / variance_i ]
1937  *
1938  * For the entire order, accumulate
1939  *
1940  * Flux_y = [ sum weight_i * flux_i * (y-ymin) ]
1941  * Flux_yy = [ sum weight_i * flux_i * (y-ymin)^2 ]
1942  * Flux_tot = [ sum weight_i * flux_i ]
1943  */
1944 
1945  flux += weight*pixelval;
1946  flux_variance += weight*weight * pixelvariance;
1947  sum += weight;
1948 
1949  /* For measuring object position + FWHM */
1950 
1951  if (method != EXTRACT_ARCLAMP)
1952  {
1953  flux_y += weight * pixelval * (y-ylo);
1954  flux_yy += weight * pixelval * (y-ylo)*(y-ylo);
1955  flux_tot+= weight * pixelval;
1956  }
1957  }/* If pixel was good */
1958  }/* for y ... */
1959 
1960  /* This debugging message significantly increases the execution time
1961  * uves_msg_debug("Order %d, x=%d: %d - %d pixels = %f flux = %f",
1962  order, x, ylo, yhi, sum, flux);
1963  */
1964 
1965  /* If any pixels were extracted */
1966  if (sum > 0)
1967  {
1968  bins_extracted += 1;
1969 
1970  if (method == EXTRACT_ARCLAMP && flux_variance > 0) {
1971  flux *= 1.0 / sum;
1972  flux_variance = 1.0 / sum;
1973  }
1974  else if (method == EXTRACT_AVERAGE || method == EXTRACT_WEIGHTED)
1975  {
1976  /* Divide by sum of weights */
1977  flux *= 1.0 / sum;
1978  flux_variance *= 1.0 / (sum*sum);
1979  }
1980  else {
1981  /* Linear extraction */
1982 
1983  /* Normalize to slit length in the case of bad pixels */
1984  flux *= slit_length / sum;
1985  flux_variance *= (slit_length*slit_length) / (sum*sum);
1986  }
1987 
1988  /* Write result */
1989 
1990  /* This will make the spectrum bad map pointer invalid:
1991  check( cpl_image_set(spectrum, x, spectrum_row, flux),
1992  "Could not write extracted flux at (%d, %d)", x, spectrum_row);
1993  */
1994  spectrum_data [(x-1) + (spectrum_row-1) * nx] = flux;
1995  spectrum_badmap[(x-1) + (spectrum_row-1) * nx] = CPL_BINARY_0;
1996 
1997  if (spectrum_noise != NULL)
1998  {
1999  check( cpl_image_set(
2000  spectrum_noise, x, spectrum_row, sqrt(flux_variance)),
2001  "Could not write noise at (%d, %d)", x, spectrum_row);
2002  }
2003 
2004  check_nomsg( cpl_table_set_double(
2005  signal_to_noise, "SN", sn_row, flux / sqrt(flux_variance)) );
2006  sn_row++;
2007 
2008  }/* if sum... */
2009  else
2010  {
2011  /* Nothing extracted, reject bin */
2012 
2013  /* This is slow:
2014  check( cpl_image_reject(spectrum, x, spectrum_row),
2015  "Could not reject bin at (x, row) = (%d, %d)", x, spectrum_row);
2016 
2017  if (spectrum_noise != NULL)
2018  {
2019  check( cpl_image_reject(spectrum_noise, x, spectrum_row),
2020  "Could not reject bin at (x, row) = (%d, %d)", x, spectrum_row);
2021  }
2022  */
2023 
2024  spectrum_badmap[(x-1) + (spectrum_row-1) * nx] = CPL_BINARY_1;
2025  }
2026 
2027  }/* for x... */
2028 
2029  if (info_tbl != NULL && *info_tbl != NULL && method != EXTRACT_ARCLAMP)
2030  {
2031  double objpos = 0;
2032  double fwhm =0;
2033  if(flux_tot != 0) {
2034  objpos = flux_y / flux_tot;
2035  } else {
2036  objpos = -1; //we set to a negative value, which won't affect
2037  //the median of positive values
2038  }
2039  if (flux_yy/flux_tot - objpos*objpos >= 0)
2040  {
2041  fwhm = sqrt(flux_yy/flux_tot - objpos*objpos) * TWOSQRT2LN2;
2042  }
2043  else
2044  {
2045  fwhm = 0;
2046  }
2047  cpl_table_set_double(*info_tbl, "ObjPosOnSlit" , order - minorder, objpos);
2048  cpl_table_set_double(*info_tbl, "ObjFwhmAvg" , order - minorder, fwhm);
2049  }
2050 
2051  /* Get S/N */
2052  check_nomsg( cpl_table_set_size(signal_to_noise, sn_row) );
2053 
2054  if (sn_row > 0)
2055  {
2056  check_nomsg( *sn = cpl_table_get_column_median(signal_to_noise, "SN"));
2057  }
2058  else
2059  {
2060  *sn = 0;
2061  }
2062 
2063  cleanup:
2064  uves_free_table(&signal_to_noise);
2065  return bins_extracted;
2066 }
2067 
2068 /*----------------------------------------------------------------------------*/
2082 /*----------------------------------------------------------------------------*/
2083 static double
2084 area_above_line(int y, double left, double right)
2085 {
2086  double area = -1; /* Result */
2087  double pixeltop = y + .5; /* Top and bottom edges of pixel */
2088  double pixelbot = y - .5;
2089  double slope = right - left;
2090 
2091  assure( 0 <= slope && slope <= 1, CPL_ERROR_ILLEGAL_INPUT, "Slope is %f", slope);
2092 
2093 /* There are 5 cases to consider
2094 
2095  Case 1:
2096  (line below pixel)
2097  ___
2098  | |
2099  | |
2100  |___|/
2101  /
2102  /
2103  /
2104 
2105  Case 2:
2106  ___
2107  | |
2108  | _|/
2109  |_/_|
2110  /
2111  Case 3:
2112  ___
2113  | _|/
2114  |_/ |
2115  /|___|
2116 
2117  Case 4:
2118  ___
2119  | / |
2120  |/ |
2121  |___|
2122 
2123  Case 5:
2124  (line above pixel)
2125  /
2126  / ___
2127  | |
2128  | |
2129  |___|
2130 
2131 */
2132 
2133  if (pixelbot > right)
2134  { /* 1 */
2135  area = 1;
2136  }
2137  else if (pixelbot > left)
2138  { /* 2. Area of triangle is height^2/(2*line_slope) */
2139  area = 1 -
2140  (right - pixelbot) *
2141  (right - pixelbot) / (2*slope);
2142  }
2143  else if (pixeltop > right)
2144  { /* 3 */
2145  area = pixeltop - (left + right)/2;
2146  }
2147  else if (pixeltop > left)
2148  { /* 4. See 2 */
2149  area =
2150  (pixeltop - left) *
2151  (pixeltop - left) / (2*slope);
2152  }
2153  else
2154  {
2155  /* 5 */
2156  area = 0;
2157  }
2158 
2159  cleanup:
2160  return area;
2161 }
2162 
2163 
2164 /*----------------------------------------------------------------------------*/
2180 /*----------------------------------------------------------------------------*/
2181 
2182 static void
2183 revise_noise(cpl_image *image_noise,
2184  const cpl_binary *image_bpm,
2185  const uves_propertylist *image_header,
2186  uves_iterate_position *pos,
2187  const cpl_image *spectrum,
2188  const cpl_image *sky_spectrum,
2189  const uves_extract_profile *profile,
2190  enum uves_chip chip)
2191 {
2192  cpl_image *revised = NULL;
2193  cpl_image *simulated = NULL;
2194  const cpl_binary *spectrum_bpm =
2195  cpl_mask_get_data_const(cpl_image_get_bpm_const(spectrum));
2196  double *simul_data;
2197  const double *spectrum_data;
2198  const double *sky_data;
2199 
2200  simulated = cpl_image_new(pos->nx, pos->ny,
2201  CPL_TYPE_DOUBLE);
2202  assure_mem( simulated );
2203 
2204  simul_data = cpl_image_get_data_double(simulated);
2205  spectrum_data = cpl_image_get_data_double_const(spectrum);
2206  sky_data = cpl_image_get_data_double_const(sky_spectrum);
2207 
2208  for (uves_iterate_set_first(pos,
2209  1, pos->nx,
2210  pos->minorder, pos->maxorder,
2211  NULL, false);
2212  !uves_iterate_finished(pos);
2214  {
2215  if (SPECTRUM_DATA(spectrum_bpm, pos) == CPL_BINARY_0)
2216  {
2217  /* Need this before calling uves_extract_profile_evaluate() */
2218  uves_extract_profile_set(profile, pos, NULL);
2219 
2220  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
2221  if (ISGOOD(image_bpm, pos))
2222  {
2223  /* Set pixel(x,y) = sky(x) + profile(x,y)*flux(x) */
2224  DATA(simul_data, pos) =
2225  SPECTRUM_DATA(sky_data, pos)/pos->sg.length +
2226  SPECTRUM_DATA(spectrum_data, pos) *
2227  uves_extract_profile_evaluate(profile, pos);
2228  }
2229  }
2230  }
2231 
2232  /* For debugging:
2233  cpl_image_save(simulated, "/tmp/simul.fits", CPL_BPP_IEEE_FLOAT, NULL, CPL_IO_DEFAULT);
2234  */
2235 
2236  {
2237  int ncom = 1; /* no median stacking is involved */
2238 
2239  /* Note! Assumes de-biased, non-flatfielded data */
2240  check( revised = uves_define_noise(simulated,
2241  image_header,
2242  ncom, chip),
2243  "Error computing noise image");
2244  }
2245 
2246  /* Copy relevant parts to the input noise image */
2247  {
2248  double *revised_data = cpl_image_get_data_double(revised);
2249  double *input_data = cpl_image_get_data_double(image_noise);
2250 
2251  for (uves_iterate_set_first(pos,
2252  1, pos->nx,
2253  pos->minorder, pos->maxorder,
2254  image_bpm, true);
2255  !uves_iterate_finished(pos);
2257  {
2258  DATA(input_data, pos) = DATA(revised_data, pos);
2259  }
2260  }
2261 
2262  cleanup:
2263  uves_free_image(&simulated);
2264  uves_free_image(&revised);
2265 
2266  return;
2267 }
2268 
2269 /*----------------------------------------------------------------------------*/
2286 /*----------------------------------------------------------------------------*/
2287 static cpl_image *
2288 opt_extract_sky(const cpl_image *image, const cpl_image *image_noise,
2289  const cpl_image *weights,
2290  uves_iterate_position *pos,
2291  cpl_image *sky_spectrum,
2292  cpl_image *sky_spectrum_noise)
2293 {
2294  cpl_image *sky_subtracted = NULL; /* Result */
2295  cpl_table *sky_map = NULL; /* Bitmap of sky/object (true/false)
2296  pixels */
2297  uves_msg("Defining sky region");
2298 
2299  check( sky_map = opt_define_sky(image, weights,
2300  pos),
2301  "Error determining sky window");
2302 
2303  uves_msg_low("%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " sky pixels",
2304  cpl_table_count_selected(sky_map),
2305  cpl_table_get_nrow(sky_map));
2306 
2307  /* Extract the sky */
2308  uves_msg("Subtracting sky (method = median of sky channels)");
2309 
2310  check( sky_subtracted = opt_subtract_sky(image, image_noise, weights,
2311  pos,
2312  sky_map,
2313  sky_spectrum,
2314  sky_spectrum_noise),
2315  "Could not subtract sky");
2316 
2317  cleanup:
2318  uves_free_table(&sky_map);
2319 
2320  return sky_subtracted;
2321 }
2322 
2323 /*----------------------------------------------------------------------------*/
2335 /*----------------------------------------------------------------------------*/
2336 static cpl_table *
2337 opt_define_sky(const cpl_image *image, const cpl_image *weights,
2338  uves_iterate_position *pos)
2339 
2340 {
2341  cpl_table *sky_map = NULL; /* Result */
2342 
2343  cpl_table **resampled = NULL;
2344  int nbins = 0;
2345  int i;
2346 
2347  /* Measure at all orders, resolution = 1 pixel */
2348  check( resampled = opt_sample_spatial_profile(image, weights,
2349  pos,
2350  50, /* stepx */
2351  1, /* sampling resolution */
2352  &nbins),
2353  "Error measuring spatial profile");
2354 
2355  sky_map = cpl_table_new(nbins);
2356  cpl_table_new_column(sky_map, "DY" , CPL_TYPE_INT); /* Bin id */
2357  cpl_table_new_column(sky_map, "Prof", CPL_TYPE_DOUBLE); /* Average profile */
2358 
2359  for (i = 0; i < nbins; i++)
2360  {
2361  cpl_table_set_int(sky_map, "DY" , i, i - nbins/2);
2362  if (cpl_table_has_valid(resampled[i], "Prof"))
2363  {
2364  /* Use 90 percentile. If the median is used, we
2365  will miss the object when the order definition
2366  is not good.
2367 
2368  (The average wouldn't work as we need to reject
2369  cosmic rays.)
2370  */
2371  int row = (cpl_table_get_nrow(resampled[i]) * 9) / 10;
2372 
2373  uves_sort_table_1(resampled[i], "Prof", false);
2374 
2375  cpl_table_set_double(sky_map, "Prof", i,
2376  cpl_table_get_double(resampled[i], "Prof", row, NULL));
2377  }
2378  else
2379  {
2380  cpl_table_set_invalid(sky_map, "Prof", i);
2381  }
2382  }
2383 
2384  /* Fail cleanly in the unlikely case that input image had
2385  too few good pixels */
2386  assure( cpl_table_has_valid(sky_map, "Prof"), CPL_ERROR_DATA_NOT_FOUND,
2387  "Too many (%" CPL_SIZE_FORMAT "/%d ) bad pixels. Could not measure sky profile",
2388  cpl_image_count_rejected(image),
2389  pos->nx * pos->ny);
2390 
2391 
2392  /* Select sky channels = bins where profile < min + 2*(median-min)
2393  * but less than (min+max)/2
2394  */
2395  {
2396  double prof_min = cpl_table_get_column_min(sky_map, "Prof");
2397  double prof_max = cpl_table_get_column_max(sky_map, "Prof");
2398  double prof_med = cpl_table_get_column_median(sky_map, "Prof");
2399  double sky_threshold = prof_min + 2*(prof_med - prof_min);
2400 
2401  sky_threshold = uves_min_double(sky_threshold, (prof_min + prof_max)/2);
2402 
2403  check( uves_plot_table(sky_map, "DY", "Prof",
2404  "Globally averaged spatial profile (sky threshold = %.5f)",
2405  sky_threshold),
2406  "Plotting failed");
2407 
2408  uves_select_table_rows(sky_map, "Prof", CPL_NOT_GREATER_THAN, sky_threshold);
2409  }
2410 
2411  cleanup:
2412  if (resampled != NULL)
2413  {
2414  for (i = 0; i < nbins; i++)
2415  {
2416  uves_free_table(&(resampled[i]));
2417  }
2418  cpl_free(resampled);
2419  }
2420 
2421  return sky_map;
2422 }
2423 
2424 /*----------------------------------------------------------------------------*/
2442 /*----------------------------------------------------------------------------*/
2443 static cpl_table **
2444 opt_sample_spatial_profile(const cpl_image *image, const cpl_image *weights,
2445  uves_iterate_position *pos,
2446  int stepx,
2447  int sampling_factor,
2448  int *nbins)
2449 
2450 {
2451  cpl_table **resampled = NULL; /* Array of tables,
2452  one table per y-bin.
2453  Contains the spatial profile
2454  for each y */
2455  int *resampled_row = NULL; /* First unused row of above */
2456 
2457  const double *image_data;
2458  const double *weights_data;
2459 
2460  assure( stepx >= 1, CPL_ERROR_ILLEGAL_INPUT, "Step size = %d", stepx);
2461  assure( sampling_factor >= 1, CPL_ERROR_ILLEGAL_INPUT,
2462  "Sampling factor = %d", sampling_factor);
2463 
2464  image_data = cpl_image_get_data_double_const(image);
2465  weights_data = cpl_image_get_data_double_const(weights);
2466 
2467  *nbins = uves_extract_profile_get_nbins(pos->sg.length, sampling_factor);
2468 
2469  resampled = cpl_calloc(*nbins, sizeof(cpl_table *));
2470  resampled_row = cpl_calloc(*nbins, sizeof(int));
2471 
2472  assure_mem(resampled );
2473  assure_mem(resampled_row);
2474 
2475  {
2476  int i;
2477  for (i = 0; i < *nbins; i++)
2478  {
2479  resampled[i] = cpl_table_new((pos->nx/stepx+1)*
2480  (pos->maxorder-pos->minorder+1));
2481 
2482  resampled_row[i] = 0;
2483  assure_mem( resampled[i] );
2484 
2485  cpl_table_new_column(resampled[i], "X" , CPL_TYPE_INT);
2486  cpl_table_new_column(resampled[i], "Order", CPL_TYPE_INT);
2487  cpl_table_new_column(resampled[i], "Prof" , CPL_TYPE_DOUBLE);
2488  /* Don't store order number */
2489  }
2490  }
2491 
2492  for (uves_iterate_set_first(pos,
2493  1, pos->nx,
2494  pos->minorder, pos->maxorder,
2495  NULL, false);
2496  !uves_iterate_finished(pos);
2497  uves_iterate_increment(pos)) {
2498  if ((pos->x - 1) % stepx == 0)
2499  /* Look only at bins divisible by stepx */
2500  {
2501  /* Linear extract bin */
2502  double flux = 0;
2503 
2504  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
2505  if (!ISBAD(weights_data, pos)) {
2506  flux += DATA(image_data, pos);
2507  }
2508  }
2509 
2510  if (flux != 0) {
2511  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
2512  if (!ISBAD(weights_data, pos)) {
2513  double f = DATA(image_data, pos);
2514 
2515  /* Nearest bin */
2516  int bin = uves_round_double(
2517  uves_extract_profile_get_bin(pos, sampling_factor));
2518 
2519  passure( bin < *nbins, "%d %d", bin, *nbins);
2520 
2521  /* Here the 'virtual resampling' consists
2522  of simply rounding to the nearest bin
2523  (nearest-neighbour interpolation)
2524  */
2525  cpl_table_set_int (resampled[bin], "X" ,
2526  resampled_row[bin], pos->x);
2527  cpl_table_set_int (resampled[bin], "Order",
2528  resampled_row[bin], pos->order);
2529  cpl_table_set_double(resampled[bin], "Prof" ,
2530  resampled_row[bin], f/flux);
2531 
2532  resampled_row[bin]++;
2533  }
2534  }
2535  }
2536  }
2537  }
2538 
2539  {
2540  int i;
2541  for (i = 0; i < *nbins; i++)
2542  {
2543  cpl_table_set_size(resampled[i], resampled_row[i]);
2544  }
2545  }
2546 
2547  /* This is what we return */
2548  passure( cpl_table_get_ncol(resampled[0]) == 3, "%" CPL_SIZE_FORMAT "",
2549  cpl_table_get_ncol(resampled[0]));
2550  passure( cpl_table_has_column(resampled[0], "X"), " ");
2551  passure( cpl_table_has_column(resampled[0], "Order"), " ");
2552  passure( cpl_table_has_column(resampled[0], "Prof"), " ");
2553 
2554  cleanup:
2555  cpl_free(resampled_row);
2556 
2557  return resampled;
2558 }
2559 
2560 
2561 
2562 /*----------------------------------------------------------------------------*/
2584 /*----------------------------------------------------------------------------*/
2585 static cpl_image *
2586 opt_subtract_sky(const cpl_image *image, const cpl_image *image_noise,
2587  const cpl_image *weights,
2588  uves_iterate_position *pos,
2589  const cpl_table *sky_map,
2590  cpl_image *sky_spectrum,
2591  cpl_image *sky_spectrum_noise)
2592 {
2593  cpl_image *sky_subtracted = cpl_image_duplicate(image); /* Result, bad pixels
2594  are inherited */
2595  double *sky_subtracted_data;
2596  const double *image_data;
2597  const double *noise_data;
2598  const double *weights_data;
2599  double *buffer_flux = NULL; /* These buffers exist for efficiency reasons, to */
2600  double *buffer_noise = NULL; /* avoid malloc/free for every bin */
2601 
2602  /* Needed because cpl_image_set() is slow */
2603  double *sky_spectrum_data = NULL;
2604  double *sky_noise_data = NULL;
2605  cpl_binary *sky_spectrum_bpm = NULL;
2606  cpl_binary *sky_noise_bpm = NULL;
2607  cpl_mask *temp = NULL;
2608 
2609  assure_mem( sky_subtracted );
2610 
2611  image_data = cpl_image_get_data_double_const(image);
2612  noise_data = cpl_image_get_data_double_const(image_noise);
2613  weights_data = cpl_image_get_data_double_const(weights);
2614  sky_subtracted_data = cpl_image_get_data(sky_subtracted);
2615 
2616  buffer_flux = cpl_malloc(uves_round_double(pos->sg.length + 5)*sizeof(double));
2617  buffer_noise = cpl_malloc(uves_round_double(pos->sg.length + 5)*sizeof(double));
2618 
2619 
2620  if (sky_spectrum != NULL)
2621  {
2622  sky_spectrum_data = cpl_image_get_data_double(sky_spectrum);
2623  sky_noise_data = cpl_image_get_data_double(sky_spectrum_noise);
2624 
2625  /* Reject all bins in the extracted sky spectrum,
2626  then mark pixels as good if/when they are calculated later */
2627 
2628  temp = cpl_mask_new(cpl_image_get_size_x(sky_spectrum),
2629  cpl_image_get_size_y(sky_spectrum));
2630  cpl_mask_not(temp); /* Set all pixels to CPL_BINARY_1 */
2631 
2632  cpl_image_reject_from_mask(sky_spectrum , temp);
2633  cpl_image_reject_from_mask(sky_spectrum_noise, temp);
2634 
2635  sky_spectrum_bpm = cpl_mask_get_data(cpl_image_get_bpm(sky_spectrum));
2636  sky_noise_bpm = cpl_mask_get_data(cpl_image_get_bpm(sky_spectrum_noise));
2637  }
2638 
2639  UVES_TIME_START("Subtract sky");
2640 
2641  for (uves_iterate_set_first(pos,
2642  1, pos->nx,
2643  pos->minorder, pos->maxorder,
2644  NULL, false);
2645  !uves_iterate_finished(pos);
2647  {
2648  double sky_background, sky_background_noise;
2649 
2650  /* Get sky */
2651  sky_background = opt_get_sky(image_data, noise_data,
2652  weights_data,
2653  pos,
2654  sky_map,
2655  buffer_flux, buffer_noise,
2656  &sky_background_noise);
2657 
2658  /* Save sky */
2659  if (sky_spectrum != NULL)
2660  {
2661  /* Change normalization of sky from 1 pixel to full slit,
2662  (i.e. same normalization as the extracted object)
2663 
2664  Error propagation is trivial (just multiply
2665  by same factor) because the
2666  uncertainty of 'slit_length' is negligible.
2667  */
2668 
2669  /*
2670  cpl_image_set(sky_spectrum , x, spectrum_row,
2671  slit_length * sky_background);
2672  cpl_image_set(sky_spectrum_noise, x, spectrum_row,
2673  slit_length * sky_background_noise);
2674  */
2675  SPECTRUM_DATA(sky_spectrum_data, pos) =
2676  pos->sg.length * sky_background;
2677  SPECTRUM_DATA(sky_noise_data, pos) =
2678  pos->sg.length * sky_background_noise;
2679 
2680  SPECTRUM_DATA(sky_spectrum_bpm, pos) = CPL_BINARY_0;
2681  SPECTRUM_DATA(sky_noise_bpm , pos) = CPL_BINARY_0;
2682  }
2683 
2684  /* Subtract sky */
2685  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
2686  {
2687  DATA(sky_subtracted_data, pos) =
2688  DATA(image_data, pos) - sky_background;
2689  /* Don't update noise image. Error
2690  on sky determination is small. */
2691 
2692  /* BPM is duplicate of input image */
2693  }
2694  }
2695 
2696  UVES_TIME_END;
2697 
2698  cleanup:
2699  uves_free_mask(&temp);
2700  cpl_free(buffer_flux);
2701  cpl_free(buffer_noise);
2702 
2703  return sky_subtracted;
2704 }
2705 
2706 
2707 /*----------------------------------------------------------------------------*/
2742 /*----------------------------------------------------------------------------*/
2743 
2744 static uves_extract_profile *
2745 opt_measure_profile(const cpl_image *image, const cpl_image *image_noise,
2746  const cpl_image *weights,
2747  uves_iterate_position *pos,
2748  int chunk, int sampling_factor,
2749  int (*f) (const double x[], const double a[], double *result),
2750  int (*dfda)(const double x[], const double a[], double result[]),
2751  int M,
2752  const cpl_image *sky_spectrum,
2753  cpl_table *info_tbl,
2754  cpl_table **profile_global)
2755 {
2756  uves_extract_profile *profile = NULL; /* Result */
2757  int *stepx = NULL; /* per order or per spatial bin */
2758  int *good_bins = NULL; /* per order or per spatial bin */
2759  cpl_table **profile_data = NULL; /* per order or per spatial bin */
2760  bool cont; /* continue? */
2761 
2762  cpl_mask *image_bad = NULL;
2763  cpl_binary*image_bpm = NULL;
2764 
2765  cpl_vector *plot0x = NULL;
2766  cpl_vector *plot0y = NULL;
2767  cpl_vector *plot1x = NULL;
2768  cpl_vector *plot1y = NULL;
2769  cpl_bivector *plot[] = {NULL, NULL};
2770  char *plot_titles[] = {NULL, NULL};
2771 
2772  int sample_bins = 100; /* Is this used?? */
2773 
2774  /* Needed for virtual method */
2775  int spatial_bins = uves_extract_profile_get_nbins(pos->sg.length, sampling_factor);
2776 
2777  /* Convert weights image to bpm needed for 1d_fit.
2778  * The virtual resampling measurement will use the weights image
2779  */
2780  if (f != NULL)
2781  {
2782  image_bad = cpl_mask_new(pos->nx, pos->ny);
2783  assure_mem(image_bad);
2784  image_bpm = cpl_mask_get_data(image_bad);
2785  {
2786  const double *weights_data = cpl_image_get_data_double_const(weights);
2787 
2788  for (pos->y = 1; pos->y <= pos->ny; pos->y++)
2789  {
2790  for (pos->x = 1; pos->x <= pos->nx; pos->x++)
2791  {
2792  if (ISBAD(weights_data, pos))
2793  {
2794  DATA(image_bpm, pos) = CPL_BINARY_1;
2795  }
2796  }
2797  }
2798  }
2799  }
2800 
2801  if (f != NULL)
2802  {
2803  stepx = cpl_malloc((pos->maxorder-pos->minorder+1) * sizeof(int));
2804  good_bins = cpl_malloc((pos->maxorder-pos->minorder+1) * sizeof(int));
2805  profile_data = cpl_calloc( pos->maxorder-pos->minorder+1, sizeof(cpl_table *));
2806 
2807  assure_mem(stepx);
2808  assure_mem(good_bins);
2809  assure_mem(profile_data);
2810 
2811  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
2812  {
2813  /*
2814  * Get width of order inside image,
2815  * and set stepx according to the
2816  * total number of sample bins
2817  */
2818  int order_width;
2819 
2820  check( order_width = opt_get_order_width(pos),
2821  "Error estimating width of order #%d", pos->order);
2822 
2823  /* If no bins were rejected, the
2824  step size to use would be
2825  order_width/sample_bins
2826  Add 1 to make stepx always positive
2827  */
2828 
2829  stepx [pos->order-pos->minorder] = order_width / sample_bins + 1;
2830  good_bins[pos->order-pos->minorder] = (2*sample_bins)/3;
2831  }
2832  }
2833  else
2834  {
2835  int i;
2836 
2837  passure( f == NULL, " ");
2838 
2839  stepx = cpl_malloc(sizeof(int) * spatial_bins);
2840  good_bins = cpl_malloc(sizeof(int) * spatial_bins);
2841  /* No, they are currently allocated by opt_sample_spatial_profile:
2842  profile_data = cpl_calloc(spatial_bins, sizeof(cpl_table *));
2843  */
2844  profile_data = NULL;
2845 
2846  assure_mem(stepx);
2847  assure_mem(good_bins);
2848 
2849  for (i = 0; i < spatial_bins; i++)
2850  {
2851  /* Across the full chip we have
2852  nx * norders * sg.ength / stepx
2853  measure positions.
2854  We want (only):
2855  sample_bins * spatial_bins * norders
2856  so stepx = ...
2857  */
2858 /* stepx [i] = uves_round_double(
2859  (pos->nx)*(pos->maxorder-pos->minorder+1)*pos->sg.length)/
2860  (sample_bins*spatial_bins)
2861  ) + 1;
2862 */
2863  stepx [i] = uves_round_double(
2864  (pos->nx*pos->sg.length)/(sample_bins*spatial_bins)
2865  ) + 1;
2866 
2867  good_bins[i] = sample_bins - 1;
2868  }
2869  }
2870 
2871  /* Initialization done */
2872 
2873  /* Measure the object profile.
2874  * Iterate until we have at least 'sample_bins' good
2875  * measure points in each order,
2876  * or until the step size has decreased to 1
2877  *
2878  * For gauss/moffat methods, the profile is measured
2879  * in chunks of fixed size (using all the information
2880  * inside each chunk), and there are no iterations.
2881  *
2882  * For virtual method, the iteration is currently
2883  * not implemented (i.e. also no iterations here)
2884  *
2885  * do
2886  * update stepx
2887  * measure using stepx
2888  * until (for every order (and every spatial bin): good_bins >= sample_bins)
2889  *
2890  * fit global polynomials to profile parameters
2891  */
2892 
2893  do {
2894  /* Update stepx */
2895  int i;
2896 
2897  for (i = 0; i < ((f == NULL) ? spatial_bins : pos->maxorder-pos->minorder+1); i++)
2898  {
2899  if (f == NULL || profile_data[i] == NULL)
2900  /* If we need to measure this order/spatial-bin (again) */
2901  /* fixme: currently no iterations for virtual resampling */
2902  {
2903  passure(good_bins[i] < sample_bins,
2904  "%d %d", good_bins[i], sample_bins);
2905 
2906  stepx[i] = (int) (stepx[i]*(good_bins[i]*0.8/sample_bins));
2907  if (stepx[i] == 0)
2908  {
2909  stepx[i] = 1;
2910  }
2911  /* Example of above formula:
2912  If we need sample_bins=200,
2913  but have only good_bins=150,
2914  then decrease stepsize to 150/200 = 75%
2915  and then by another factor 0.8 (so we are
2916  more likely to end up with a few more
2917  bins than needed, rather than a few less
2918  bins than needed).
2919 
2920  Also note that stepx always decreases, so
2921  the loop terminates.
2922  */
2923  }
2924  }
2925 
2926  cont = false;
2927 
2928  /* Measure */
2929  if (f != NULL) {
2930 #if NEW_METHOD
2931  for (pos->order = pos->minorder; pos->order <= pos->minorder; pos->order++) {
2932 #else
2933  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++) {
2934 #endif
2935  /* Zero resampling */
2936  if (profile_data[pos->order-pos->minorder] == NULL) {
2937  int bins;
2938 
2939  check( profile_data[pos->order-pos->minorder] =
2940  opt_measure_profile_order(image, image_noise, image_bpm,
2941  pos,
2942  chunk,
2943  f, dfda, M,
2944  sky_spectrum),
2945  "Error measuring profile of order #%d using chunk size = %d",
2946  pos->order, chunk);
2947 
2948  bins = cpl_table_get_nrow(profile_data[pos->order-pos->minorder]);
2949 
2950  uves_msg("Order %-2d: Chi^2/N = %.2f; FWHM = %.2f pix; Offset = %.2f pix",
2951  pos->order,
2952  (bins > 0) ? cpl_table_get_column_median(
2953  profile_data[pos->order-pos->minorder],
2954  "Reduced_chisq") : 0,
2955  /* Gaussian: fwhm = 2.35 sigma */
2956  (bins > 0) ? cpl_table_get_column_median(
2957  profile_data[pos->order-pos->minorder],
2958  "Sigma") * TWOSQRT2LN2 : 0,
2959  (bins > 0) ? cpl_table_get_column_median(
2960  profile_data[pos->order-pos->minorder],
2961  "Y0") : 0);
2962 
2963  /* Old way of doing things:
2964  good_bins[pos->order-minorder] = bins;
2965 
2966  Continue if there are not enough good bins for this order
2967  if (good_bins[pos->order-minorder] < sample_bins &&
2968  stepx[pos->order-minorder] >= 2)
2969  {
2970  cont = true;
2971  uves_free_table(&(profile_data[pos->order-minorder]));
2972  }
2973  */
2974 
2975  /* New method */
2976  cont = false;
2977 
2978  } /* if we needed to measure this order again */
2979  }
2980  }
2981  else
2982  /* Virtual method */
2983  {
2984  int nbins = 0;
2985 
2986  int step = 0; /* average of stepx */
2987  for (i = 0; i < spatial_bins; i++)
2988  {
2989  step += stepx[i];
2990  }
2991  step /= spatial_bins;
2992 
2993  *profile_global = cpl_table_new(0);
2994  assure_mem( *profile_global );
2995  cpl_table_new_column(*profile_global, "Dummy" , CPL_TYPE_DOUBLE);
2996 
2997  check( profile_data = opt_sample_spatial_profile(image, weights,
2998  pos,
2999  step,
3000  sampling_factor,
3001  &nbins),
3002  "Error measuring profile (virtual method)");
3003 
3004  passure( nbins == spatial_bins, "%d %d", nbins, spatial_bins);
3005 
3006  for (i = 0; i < spatial_bins; i++)
3007  {
3008  good_bins[i] = cpl_table_get_nrow(profile_data[i]);
3009 
3010  uves_msg_debug("Bin %d (%-3d samples): Prof = %f %d",
3011  i,
3012  good_bins[i],
3013  (good_bins[i] > 0) ?
3014  cpl_table_get_column_median(profile_data[i], "Prof") : 0,
3015  stepx[i]);
3016 
3017  /* Continue if there are not enough measure points for this spatial bin */
3018  //fixme: disabled for now, need to cleanup and only measure
3019  //bins when necessary
3020  //if (false && good_bins[i] < sample_bins && stepx[i] >= 2)
3021  // {
3022  // cont = true;
3023  // uves_free_table(&(profile_data[i]));
3024  // }
3025  }
3026  }
3027 
3028  } while(cont);
3029 
3030 
3031  /* Fit a global polynomial to each profile parameter */
3032  if (f == NULL)
3033  {
3034  int max_degree = 8;
3035  double kappa = 3.0;
3036  int i;
3037 
3038  uves_msg_low("Fitting global polynomials to "
3039  "resampled profile (%d spatial bins)",
3040  spatial_bins);
3041 
3042  uves_extract_profile_delete(&profile);
3043  profile = uves_extract_profile_new(NULL,
3044  NULL,
3045  0,
3046  pos->sg.length,
3047  sampling_factor);
3048 
3049  for (i = 0; i < spatial_bins; i++)
3050  {
3051  /* Do not make the code simpler by:
3052  * int n = cpl_table_get_nrow(profile_data[i]);
3053  * because the table size is generally non-constant
3054  */
3055 
3056  bool enough_points = (
3057  cpl_table_get_nrow(profile_data[i]) >= (max_degree + 1)*(max_degree + 1));
3058 
3059  if (enough_points)
3060  {
3061  uves_msg_debug("Fitting 2d polynomial to spatial bin %d", i);
3062 
3063  if (true) {
3064  /* Clever but slow: */
3065 
3066  double min_reject = -0.01; /* negative value means disabled.
3067  This optimization made the
3068  unit test fail. That should be
3069  investigated before enabling this
3070  optimization (is the unit test too strict?
3071  or does the quality actually decrease?).
3072  A good value is probably ~0.01
3073  */
3074  profile->dy_poly[i] = uves_polynomial_regression_2d_autodegree(
3075  profile_data[i],
3076  "X", "Order", "Prof", NULL,
3077  "Proffit", NULL, NULL, /* new columns */
3078  NULL, NULL, NULL, /* mse, red_chisq, variance */
3079  kappa,
3080  max_degree, max_degree, -1, min_reject,
3081  false, /* verbose? */
3082  NULL, NULL, 0, NULL);
3083  } else {
3084  /* For testing only. Don't do like this. */
3085  /* This is no good at high S/N where a
3086  precise profile measurement is crucial */
3087 
3088  profile->dy_poly[i] =
3089  uves_polynomial_regression_2d(profile_data[i],
3090  "X", "Order", "Prof", NULL,
3091  0, 0,
3092  "Proffit", NULL, NULL, /* new columns */
3093  NULL, NULL, NULL, kappa, -1);
3094  }
3095 
3096  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
3097  {
3098  uves_error_reset();
3099  uves_msg_debug("Fitting bin %d failed", i);
3100 
3101  uves_polynomial_delete(&(profile->dy_poly[i]));
3102  enough_points = false;
3103  }
3104 
3105  assure( cpl_error_get_code() == CPL_ERROR_NONE,
3106  cpl_error_get_code(),
3107  "Could not fit polynomial to bin %d", i);
3108 
3109  }/* if enough points */
3110 
3111  if (!enough_points)
3112  {
3113  /* Not enough points for fit (usually at edges of slit) */
3114 
3115  profile->dy_poly[i] = uves_polynomial_new_zero(2);
3116 
3117  cpl_table_new_column(profile_data[i], "Proffit", CPL_TYPE_DOUBLE);
3118  if (cpl_table_get_nrow(profile_data[i]) > 0)
3119  {
3120  cpl_table_fill_column_window_double(
3121  profile_data[i], "Proffit",
3122  0, cpl_table_get_nrow(profile_data[i]),
3123  0);
3124  }
3125  }
3126 
3127  /* Optimization:
3128  If zero degree, do quick evaluations later
3129  */
3130  profile->is_zero_degree[i] = (uves_polynomial_get_degree(profile->dy_poly[i]) == 0);
3131  if (profile->is_zero_degree[i])
3132  {
3133  profile->dy_double[i] = uves_polynomial_evaluate_2d(profile->dy_poly[i], 0, 0);
3134  }
3135  } /* for each spatial bin */
3136  }
3137  else
3138  /* Analytical profile */
3139  {
3140  int max_degree;
3141  double min_rms = 0.1; /* pixels, stop if this precision is achieved */
3142  double kappa = 3.0; /* The fits to individual chunks can be noisy (due
3143  to low statistics), so use a rather low kappa */
3144 
3145  bool enough_points; /* True iff the data allows fitting a polynomial */
3146 
3147  /* Merge individual order tables to global table before fitting */
3148  uves_free_table(profile_global);
3149 
3150 #if NEW_METHOD
3151  for (pos->order = pos->minorder; order <= pos->minorder; pos->order++)
3152 #else
3153  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
3154 #endif
3155  {
3156  if (pos->order == pos->minorder)
3157  {
3158  *profile_global = cpl_table_duplicate(profile_data[0]);
3159  }
3160  else
3161  {
3162  /* Insert at top */
3163  cpl_table_insert(*profile_global,
3164  profile_data[pos->order-pos->minorder], 0);
3165  }
3166  }
3167 
3168  uves_extract_profile_delete(&profile);
3169  profile = uves_extract_profile_new(f, dfda, M, 0, 0);
3170 
3171  /*
3172  For robustness against
3173  too small (i.e. wrong) uncertainties (which would cause
3174  single points to have extremely high weight 1/sigma^2),
3175  raise uncertainties to median before fitting.
3176  */
3177 
3178  max_degree = 5;
3179 
3180 #if ORDER_PER_ORDER
3181  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
3182  {
3183  int degree = 4;
3184 #else
3185 #endif
3186 
3187  enough_points =
3188 #if ORDER_PER_ORDER
3189  (cpl_table_get_nrow(profile_data[pos->order-pos->minorder])
3190  >= (degree + 1));
3191 #else
3192  (cpl_table_get_nrow(*profile_global) >= (max_degree + 1)*(max_degree + 1));
3193 #endif
3194  if (enough_points)
3195  {
3196  double mse;
3197  /* Make sure the fit has sensible values at the following positions */
3198  double min_val = -pos->sg.length/2;
3199  double max_val = pos->sg.length/2;
3200  double minmax_pos[4][2];
3201  minmax_pos[0][0] = 1 ; minmax_pos[0][1] = pos->minorder;
3202  minmax_pos[1][0] = 1 ; minmax_pos[1][1] = pos->maxorder;
3203  minmax_pos[2][0] = pos->nx; minmax_pos[2][1] = pos->minorder;
3204  minmax_pos[3][0] = pos->nx; minmax_pos[3][1] = pos->maxorder;
3205 
3206  uves_msg_low("Fitting profile centroid = polynomial(x, order)");
3207 
3208 #if ORDER_PER_ORDER
3209  check_nomsg( uves_raise_to_median_frac(
3210  profile_data[pos->order-pos->minorder], "dY0", 1.0) );
3211 
3212  profile->y0[pos->order - pos->minorder] =
3214  profile_data[pos->order-pos->minorder],
3215  "X", "Y0", "dY0", degree,
3216  "Y0fit", NULL,
3217  &mse, kappa);
3218 #else
3219  check_nomsg( uves_raise_to_median_frac(*profile_global, "dY0", 1.0) );
3220 
3221  profile->y0 =
3223  *profile_global,
3224  "X", "Order", "Y0", "dY0",
3225  "Y0fit", NULL, NULL,
3226  &mse, NULL, NULL,
3227  kappa,
3228  max_degree, max_degree, min_rms, -1,
3229  true,
3230  &min_val, &max_val, 4, minmax_pos);
3231 #endif
3232  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
3233  {
3234  uves_error_reset();
3235 #if ORDER_PER_ORDER
3236  uves_polynomial_delete(&(profile->y0[pos->order - pos->minorder]));
3237 #else
3238  uves_polynomial_delete(&(profile->y0));
3239 #endif
3240 
3241  enough_points = false;
3242  }
3243  else
3244  {
3245  assure( cpl_error_get_code() == CPL_ERROR_NONE,
3246  cpl_error_get_code(),
3247  "Error fitting object position");
3248 
3249  /* Fit succeeded */
3250 #if ORDER_PER_ORDER
3251 #else
3252  uves_msg_low("Object offset at chip center = %.2f pixels",
3254  profile->y0,
3255  pos->nx/2,
3256  (pos->minorder+pos->maxorder)/2));
3257 #endif
3258 
3259  if (sqrt(mse) > 0.5) /* Pixels */
3260  {
3261  uves_msg_warning("Problem localizing object "
3262  "(usually RMS ~= 0.1 pixels)");
3263  }
3264  }
3265  }
3266 
3267  if (!enough_points)
3268  {
3269 #if ORDER_PER_ORDER
3270  uves_msg_warning("Too few points (%d) to fit global polynomial to "
3271  "object centroid. Setting offset to zero",
3272  cpl_table_get_nrow(profile_data[pos->order - pos->minorder]));
3273 #else
3274  uves_msg_warning("Too few points (%" CPL_SIZE_FORMAT ") to fit global polynomial to "
3275  "object centroid. Setting offset to zero",
3276  cpl_table_get_nrow(*profile_global));
3277 #endif
3278 
3279  /* Set y0(x, m) := 0 */
3280 #if ORDER_PER_ORDER
3281  profile->y0[pos->order - pos->minorder] = uves_polynomial_new_zero(1);
3282 
3283  cpl_table_new_column(profile_data[pos->order-pos->minorder], "Y0fit", CPL_TYPE_DOUBLE);
3284  if (cpl_table_get_nrow(profile_data[pos->order-pos->minorder]) > 0)
3285  {
3286  cpl_table_fill_column_window_double(
3287  profile_data[pos->order-pos->minorder], "Y0fit",
3288  0, cpl_table_get_nrow(profile_data[pos->order-pos->minorder]),
3289  0);
3290  }
3291 #else
3292  profile->y0 = uves_polynomial_new_zero(2);
3293 
3294  cpl_table_new_column(*profile_global, "Y0fit", CPL_TYPE_DOUBLE);
3295  if (cpl_table_get_nrow(*profile_global) > 0)
3296  {
3297  cpl_table_fill_column_window_double(
3298  *profile_global, "Y0fit",
3299  0, cpl_table_get_nrow(*profile_global),
3300  0);
3301  }
3302 #endif
3303  }
3304 #if ORDER_PER_ORDER
3305  } /* for order */
3306 #else
3307 #endif
3308  max_degree = 3;
3309 
3310 #if ORDER_PER_ORDER
3311  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
3312  {
3313  int degree = 4;
3314 #else
3315 #endif
3316  enough_points =
3317 #if ORDER_PER_ORDER
3318  (cpl_table_get_nrow(profile_data[pos->order-pos->minorder])
3319  >= (degree + 1));
3320 #else
3321  (cpl_table_get_nrow(*profile_global) >= (max_degree + 1)*(max_degree + 1));
3322 #endif
3323  if (enough_points)
3324  {
3325  double min_val = 0.1;
3326  double max_val = pos->sg.length;
3327  double minmax_pos[4][2];
3328  minmax_pos[0][0] = 1 ; minmax_pos[0][1] = pos->minorder;
3329  minmax_pos[1][0] = 1 ; minmax_pos[1][1] = pos->maxorder;
3330  minmax_pos[2][0] = pos->nx; minmax_pos[2][1] = pos->minorder;
3331  minmax_pos[3][0] = pos->nx; minmax_pos[3][1] = pos->maxorder;
3332 
3333  uves_msg_low("Fitting profile width = polynomial(x, order)");
3334 
3335 #if ORDER_PER_ORDER
3336  check_nomsg( uves_raise_to_median_frac(
3337  profile_data[pos->order-pos->minorder], "dSigma", 1.0) );
3338 
3339 
3340  profile->sigma[pos->order - pos->minorder] =
3342  profile_data[pos->order-pos->minorder],
3343  "X", "Sigma", "dSigma", degree,
3344  "Sigmafit", NULL,
3345  NULL, kappa);
3346 #else
3347  check_nomsg( uves_raise_to_median_frac(*profile_global, "dSigma", 1.0) );
3348 
3349  profile->sigma =
3351  *profile_global,
3352  "X", "Order", "Sigma", "dSigma",
3353  "Sigmafit", NULL, NULL,
3354  NULL, NULL, NULL,
3355  kappa,
3356  max_degree, max_degree, min_rms, -1,
3357  true,
3358  &min_val, &max_val, 4, minmax_pos);
3359 #endif
3360 
3361  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
3362  {
3363  uves_error_reset();
3364 #if ORDER_PER_ORDER
3365  uves_polynomial_delete(&(profile->sigma[pos->order - pos->minorder]));
3366 #else
3367  uves_polynomial_delete(&(profile->sigma));
3368 #endif
3369 
3370  enough_points = false;
3371  }
3372  else
3373  {
3374  assure( cpl_error_get_code() == CPL_ERROR_NONE,
3375  cpl_error_get_code(),
3376  "Error fitting profile width");
3377 
3378 #if ORDER_PER_ORDER
3379 #else
3380  uves_msg_low("Profile FWHM at chip center = %.2f pixels",
3381  TWOSQRT2LN2 * uves_polynomial_evaluate_2d(
3382  profile->sigma,
3383  pos->nx/2,
3384  (pos->minorder+pos->maxorder)/2));
3385 #endif
3386  }
3387  }
3388 
3389  if (!enough_points)
3390  {
3391 #if ORDER_PER_ORDER
3392  uves_msg_warning("Too few points (%d) to fit global polynomial to "
3393  "object width. Setting std.dev. to 1 pixel",
3394  cpl_table_get_nrow(profile_data[pos->order - pos->minorder]));
3395 #else
3396  uves_msg_warning("Too few points (%" CPL_SIZE_FORMAT ") to fit global polynomial to "
3397  "object width. Setting std.dev. to 1 pixel",
3398  cpl_table_get_nrow(*profile_global));
3399 #endif
3400 
3401  /* Set sigma(x, m) := 1 */
3402 #if ORDER_PER_ORDER
3403  profile->sigma[pos->order - pos->minorder] = uves_polynomial_new_zero(1);
3404  uves_polynomial_shift(profile->sigma[pos->order - pos->minorder], 0, 1.0);
3405 
3406  cpl_table_new_column(profile_data[pos->order-pos->minorder], "Sigmafit", CPL_TYPE_DOUBLE);
3407  if (cpl_table_get_nrow(profile_data[pos->order-pos->minorder]) > 0)
3408  {
3409  cpl_table_fill_column_window_double(
3410  profile_data[pos->order-pos->minorder], "Sigmafit",
3411  0, cpl_table_get_nrow(profile_data[pos->order-pos->minorder]),
3412  1.0);
3413  }
3414 #else
3415  profile->sigma = uves_polynomial_new_zero(2);
3416  uves_polynomial_shift(profile->sigma, 0, 1.0);
3417 
3418  cpl_table_new_column(*profile_global, "Sigmafit", CPL_TYPE_DOUBLE);
3419  if (cpl_table_get_nrow(*profile_global) > 0)
3420  {
3421  cpl_table_fill_column_window_double(
3422  *profile_global, "Sigmafit",
3423  0, cpl_table_get_nrow(*profile_global),
3424  1.0);
3425  }
3426 #endif
3427 
3428  }
3429 
3430  /* Don't fit a 2d polynomial to chi^2/N. Just use a robust average
3431  (i.e. a (0,0) degree polynomial) */
3432 
3433 #if ORDER_PER_ORDER
3434  profile->red_chisq[pos->order - pos->minorder] = uves_polynomial_new_zero(1);
3435  uves_polynomial_shift(profile->red_chisq[pos->order - pos->minorder], 0,
3436  cpl_table_get_nrow(profile_data[pos->order - pos->minorder]) > 0 ?
3437  cpl_table_get_column_median(profile_data[pos->order - pos->minorder],
3438  "Reduced_chisq") : 1.0);
3439 #else
3440  profile->red_chisq = uves_polynomial_new_zero(2);
3441  uves_polynomial_shift(profile->red_chisq, 0,
3442  cpl_table_get_nrow(*profile_global) > 0 ?
3443  cpl_table_get_column_median(*profile_global,
3444  "Reduced_chisq") : 1.0);
3445 #endif
3446 
3447  /*
3448  if (cpl_table_get_nrow(*profile_global) >= (max_degree + 1)*(max_degree + 1))
3449  {
3450  uves_msg_low("Fitting chi^2/N = polynomial(x, order)");
3451 
3452  check( profile->red_chisq =
3453  uves_polynomial_regression_2d_autodegree(
3454  *profile_global,
3455  "X", "Order", "Reduced_chisq", NULL,
3456  NULL, NULL, NULL,
3457  NULL, NULL, NULL,
3458  kappa,
3459  max_degree, max_degree, -1, true),
3460  "Error fitting chi^2/N");
3461  }
3462  else
3463  {
3464  uves_msg_warning("Too few points (%d) to fit global polynomial to "
3465  "chi^2/N. Setting chi^2/N to 1",
3466  cpl_table_get_nrow(*profile_global));
3467 
3468  profile->red_chisq = uves_polynomial_new_zero(2);
3469  uves_polynomial_shift(profile->red_chisq, 0, 1.0);
3470  }
3471  */
3472 #if ORDER_PER_ORDER
3473  } /* for order */
3474 
3475  /* Make sure the global table is consistent */
3476  uves_free_table(profile_global);
3477  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
3478  {
3479  if (pos->order == pos->minorder)
3480  {
3481  *profile_global = cpl_table_duplicate(profile_data[0]);
3482  }
3483  else
3484  {
3485  /* Insert at top */
3486  cpl_table_insert(*profile_global,
3487  profile_data[pos->order-pos->minorder], 0);
3488  }
3489  }
3490 #else
3491 #endif
3492 
3493  } /* if f != NULL */
3494 
3495  /* Done fitting */
3496 
3497  /* Plot inferred profile at center of chip */
3498  {
3499  int xmin = uves_max_int(1 , pos->nx/2-100);
3500  int xmax = uves_min_int(pos->nx, pos->nx/2+100);
3501  int order = (pos->minorder + pos->maxorder)/2;
3502  int indx;
3503 
3504  plot0x = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
3505  plot0y = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
3506  plot1x = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
3507  plot1y = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
3508  indx = 0;
3509  assure_mem( plot0x );
3510  assure_mem( plot0y );
3511  assure_mem( plot1x );
3512  assure_mem( plot1y );
3513 
3514  for (uves_iterate_set_first(pos,
3515  xmin, xmax,
3516  order, order,
3517  NULL, false);
3518  !uves_iterate_finished(pos);
3520 
3521  {
3522  /* Linear extract (to enable plotting raw profile) */
3523  double flux = 0;
3524  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
3525  {
3526  int pis_rejected;
3527  double pixelval = cpl_image_get(image, pos->x, pos->y, &pis_rejected);
3528  if (!pis_rejected)
3529  {
3530  flux += pixelval;
3531  }
3532  }
3533 
3534  uves_extract_profile_set(profile, pos, NULL);
3535 
3536  /* Get empirical and model profile */
3537  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
3538  {
3539  double dy = pos->y - pos->ycenter;
3540  int pis_rejected;
3541  double pixelval = cpl_image_get(
3542  image, pos->x, uves_round_double(pos->y), &pis_rejected);
3543 
3544  if (!pis_rejected && flux != 0)
3545  {
3546  pixelval /= flux;
3547  }
3548  else
3549  {
3550  pixelval = 0; /* Plot something anyway, if pixel is bad */
3551  }
3552 
3553  cpl_vector_set(plot0x, indx, dy);
3554  cpl_vector_set(plot0y, indx, uves_extract_profile_evaluate(profile, pos));
3555 
3556  cpl_vector_set(plot1x, indx, dy);
3557  cpl_vector_set(plot1y, indx, pixelval);
3558 
3559  indx++;
3560  }
3561  }
3562 
3563  if (indx > 0)
3564  {
3565  cpl_vector_set_size(plot0x, indx);
3566  cpl_vector_set_size(plot0y, indx);
3567  cpl_vector_set_size(plot1x, indx);
3568  cpl_vector_set_size(plot1y, indx);
3569 
3570  plot[0] = cpl_bivector_wrap_vectors(plot0x, plot0y);
3571  plot[1] = cpl_bivector_wrap_vectors(plot1x, plot1y);
3572 
3573  plot_titles[0] = uves_sprintf(
3574  "Model spatial profile at (order, x) = (%d, %d)", order, pos->nx/2);
3575  plot_titles[1] = uves_sprintf(
3576  "Empirical spatial profile at (order, x) = (%d, %d)", order, pos->nx/2);
3577 
3578  check( uves_plot_bivectors(plot, plot_titles, 2, "DY", "Profile"), "Plotting failed");
3579  }
3580  else
3581  {
3582  uves_msg_warning("No points to plot. This may happen if the order "
3583  "polynomial is ill-formed");
3584  }
3585  } /* end plotting */
3586 
3587  if (f != NULL)
3588  {
3589  /*
3590  * Create column 'y0fit_world' (fitted value in absolute coordinate),
3591  * add order location center to y0fit
3592  */
3593  int i;
3594 
3595  for (i = 0; i < cpl_table_get_nrow(*profile_global); i++)
3596  {
3597  double y0fit = cpl_table_get_double(*profile_global, "Y0fit", i, NULL);
3598  int order = cpl_table_get_int (*profile_global, "Order", i, NULL);
3599  int x = cpl_table_get_int (*profile_global, "X" , i, NULL);
3600 
3601  /* This will calculate ycenter */
3603  x, x,
3604  order, order,
3605  NULL,
3606  false);
3607 
3608  cpl_table_set_double(*profile_global, "Y0fit_world", i, y0fit + pos->ycenter);
3609  }
3610 
3611  /* Warn about bad detection */
3612 #if NEW_METHOD
3613  for (pos->order = pos->minorder; pos->order <= pos->minorder; pos->order++)
3614 #else
3615  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
3616 #endif
3617  {
3618  if (good_bins[pos->order-pos->minorder] == 0)
3619  {
3620  uves_msg_warning("Order %d: Failed to detect object!", pos->order);
3621  }
3622  }
3623 
3624  /* Store parameters for QC
3625  (in virtual mode these are calculated elsewhere) */
3626  for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
3627  {
3628 #if ORDER_PER_ORDER
3629  double objpos=0;
3630  check_nomsg(
3631  objpos =
3632  uves_polynomial_evaluate_1d(profile->y0[pos->order-pos->minorder],
3633  pos->nx/2)
3634  - ( - pos->sg.length/2 ));
3635  double fwhm =0;
3636  check_nomsg(fwhm=uves_polynomial_evaluate_1d(profile->sigma[pos->order-pos->minorder],
3637  pos->nx/2) * TWOSQRT2LN2);
3638 
3639 
3640  check_nomsg(cpl_table_set_double(info_tbl, "ObjPosOnSlit" , pos->order - pos->minorder, objpos));
3641  check_nomsg(cpl_table_set_double(info_tbl, "ObjFwhmAvg" , pos->order - pos->minorder, fwhm));
3642 #else
3643  double objpos = 0;
3644  check_nomsg(objpos=uves_polynomial_evaluate_2d(profile->y0,
3645  pos->nx/2, pos->order)
3646  - ( - pos->sg.length/2 ));
3647  double fwhm = 0;
3648  check_nomsg(fwhm=uves_polynomial_evaluate_2d(profile->sigma ,
3649  pos->nx/2, pos->order)*
3650  TWOSQRT2LN2);
3651 
3652  check_nomsg(cpl_table_set_double(info_tbl, "ObjPosOnSlit" , pos->order - pos->minorder, objpos));
3653  check_nomsg(cpl_table_set_double(info_tbl, "ObjFwhmAvg" , pos->order - pos->minorder, fwhm));
3654 #endif
3655  }
3656 
3657  /* Quality check on assumed profile (good fit: red.chisq ~= 1) */
3658  if (cpl_table_get_nrow(*profile_global) > 0)
3659  {
3660  double med_chisq = cpl_table_get_column_median(
3661  *profile_global, "Reduced_chisq");
3662  double limit = 5.0;
3663 
3664  if (med_chisq > limit || med_chisq < 1/limit)
3665  {
3666  /* The factor 5 is somewhat arbitrary.
3667  * As an empirical fact, red_chisq ~= 1 for
3668  * virtually resampled profiles (high and low
3669  * S/N). This indicates that 1) the noise
3670  * model and 2) the inferred profile are
3671  * both correct. (If one or both of them
3672  * were wrong it would a strange coincidence
3673  * that we get red_chisq ~= 1.)
3674  */
3675  uves_msg_warning("Assumed spatial profile might not be a "
3676  "good fit to the data: median(Chi^2/N) = %f",
3677  med_chisq);
3678 
3679  if (f != NULL && med_chisq > limit)
3680  {
3681  uves_msg_warning("Recommended profile "
3682  "measuring method: virtual");
3683  }
3684  }
3685  else
3686  {
3687  uves_msg("Median(reduced Chi^2) is %f", med_chisq);
3688  }
3689  }
3690  }
3691  else
3692  {
3693  /* fixme: calculate and report chi^2 (requires passing noise image
3694  to the profile sampling function) */
3695  }
3696 
3697  cleanup:
3698  uves_free_mask(&image_bad);
3699  cpl_free(stepx);
3700  cpl_free(good_bins);
3701  if (profile_data != NULL)
3702  {
3703  int i;
3704  for (i = 0; i < ((f == NULL) ? spatial_bins : pos->maxorder-pos->minorder+1); i++)
3705  {
3706  if (profile_data[i] != NULL)
3707  {
3708  uves_free_table(&(profile_data[i]));
3709  }
3710  }
3711  cpl_free(profile_data);
3712  }
3713  cpl_bivector_unwrap_vectors(plot[0]);
3714  cpl_bivector_unwrap_vectors(plot[1]);
3715  cpl_free(plot_titles[0]);
3716  cpl_free(plot_titles[1]);
3717  uves_free_vector(&plot0x);
3718  uves_free_vector(&plot0y);
3719  uves_free_vector(&plot1x);
3720  uves_free_vector(&plot1y);
3721 
3722  return profile;
3723 }
3724 
3725 #if NEW_METHOD
3726 struct
3727 {
3728  double *flux; /* Array [0..nx][minorder..maxorder] x = 0 is not used */
3729  double *sky; /* As above */
3730  int minorder, nx; /* Needed for indexing of arrays above */
3731 
3732  int (*f) (const double x[], const double a[], double *result);
3733  int (*dfda)(const double x[], const double a[], double result[]);
3734 
3735  int deg_y0_x;
3736  int deg_y0_m;
3737  int deg_sigma_x;
3738  int deg_sigma_m;
3739 } profile_params;
3740 
3741 /*
3742  Evaluate 2d polynomial
3743  degrees must be zero or more
3744 */
3745 static double
3746 eval_pol(const double *coeffs,
3747  int degree1, int degree2,
3748  double x1, double x2)
3749 {
3750  double result = 0;
3751  double x2j; /* x2^j */
3752  int j;
3753 
3754  for (j = 0, x2j = 1;
3755  j <= degree2;
3756  j++, x2j *= x2)
3757  {
3758  /* Use Horner's scheme to sum the coefficients
3759  involving x2^j */
3760 
3761  int i = degree1;
3762  double r = coeffs[i + (degree1+1)*j];
3763 
3764  while(i > 0)
3765  {
3766  r *= x1;
3767  i -= 1;
3768  r += coeffs[i + (degree1+1)*j];
3769  }
3770 
3771  /* Finished using Horner. Add to grand result */
3772  result += x2j*r;
3773  }
3774 
3775  return result;
3776 }
3777 
3778 /*
3779  @brief evaluate 2d profile
3780  @param x length 3 array of (xi, yi, mi)
3781  @param a all polynomial coefficients
3782  @param result (output) result
3783  @return zero iff success
3784 
3785  This function evaluates
3786 
3787  P(xi, yi ; a) = S_xi + F_xi * (normalized profile)
3788 
3789  using the data in 'profile_params' which must have been
3790  already initialized
3791 */
3792 static int
3793 profile_f(const double x[], const double a[], double *result)
3794 {
3795  int xi = uves_round_double(x[0]);
3796  double yi = x[1];
3797  int mi = uves_round_double(x[2]);
3798  int idx;
3799 
3800  double y_0 = eval_pol(a,
3801  profile_params.deg_y0_x,
3802  profile_params.deg_y0_m,
3803  xi, mi);
3804  double sigma = eval_pol(a + (1 + profile_params.deg_y0_x)*(1 + profile_params.deg_y0_m),
3805  profile_params.deg_sigma_x,
3806  profile_params.deg_sigma_m,
3807  xi, mi);
3808 
3809  /* Now evaluate normalized profile */
3810  double norm_prof;
3811 
3812  double xf[1]; /* Point of evaluation */
3813 
3814  double af[5]; /* Parameters */
3815  af[0] = y_0; /* centroid */
3816  af[1] = sigma; /* stdev */
3817  af[2] = 1; /* norm */
3818  af[3] = 0; /* offset */
3819  af[4] = 0; /* non-linear sky */
3820 
3821  xf[0] = yi;
3822 
3823  if (profile_params.f(xf, af, &norm_prof) != 0)
3824  {
3825  return 1;
3826  }
3827 
3828  idx = xi + (mi - profile_params.minorder)*(profile_params.nx + 1);
3829 
3830  *result = profile_params.sky[idx] + profile_params.flux[idx] * norm_prof;
3831 
3832  return 0;
3833 }
3834 
3835 /*
3836  @brief evaluate 2d profile partial derivatives
3837  @param x length 3 array of (xk, yk, mk)
3838  @param a all polynomial coefficients
3839  @param result (output) result
3840  @return zero iff success
3841 
3842  This function evaluates the partial derivatives
3843  (with respect to the polynomial coefficients) of the function above
3844 
3845  (1) dP/da_ij(xk, yk ; a) = F_xk * d(normalized profile)/dy0 * xk^i mk^j
3846  (2) dP/da_ij(xk, yk ; a) = F_xk * d(normalized profile)/dsigma * xk^ii mk^jj
3847 
3848  (using the chain rule on the 1d profile function)
3849 
3850  Here (1) is used for the coefficients that y0 depend on, i.e.
3851  for (i + (deg_y0_x+1)*j) < (deg_y0_x+1)(deg_y0_m+1)
3852 
3853  and (2) is used for the remaining coefficients which sigma depend on
3854  (ii and jj are appropriate functions of i and j)
3855 
3856 */
3857 static int
3858 profile_dfda(const double x[], const double a[], double result[])
3859 {
3860  int xi = uves_round_double(x[0]);
3861  double yi = x[1];
3862  int mi = uves_round_double(x[2]);
3863 
3864  double y_0 = eval_pol(a,
3865  profile_params.deg_y0_x,
3866  profile_params.deg_y0_m,
3867  xi, mi);
3868  double sigma = eval_pol(a + (1 + profile_params.deg_y0_x)*(1 + profile_params.deg_y0_m),
3869  profile_params.deg_sigma_x,
3870  profile_params.deg_sigma_m,
3871  xi, mi);
3872 
3873  double norm_prof_derivatives[5];
3874 
3875  double xf[1]; /* Point of evaluation */
3876 
3877  double af[5]; /* Parameters */
3878  af[0] = y_0; /* centroid */
3879  af[1] = sigma; /* stdev */
3880  af[2] = 1; /* norm */
3881  af[3] = 0; /* offset */
3882  af[4] = 0; /* non-linear sky */
3883 
3884  xf[0] = yi;
3885 
3886  if (profile_params.dfda(xf, af, norm_prof_derivatives) != 0)
3887  {
3888  return 1;
3889  }
3890 
3891  {
3892  int idx = xi + (mi - profile_params.minorder)*(profile_params.nx + 1);
3893 
3894  /* Need only these two */
3895  double norm_prof_dy0 = norm_prof_derivatives[0];
3896  double norm_prof_dsigma = norm_prof_derivatives[1];
3897  int i, j;
3898 
3899  /* Compute all the derivatives
3900  flux(xk)*df/dy0 * x^i m^j
3901 
3902  It is only the product (x^i m^j) that changes, so use
3903  recurrence to caluculate the coefficients, in
3904  this order (starting from (i,j) = (0,0))):
3905 
3906  (0,0) -> (1,0) -> (2,0) -> ...
3907  V
3908  (0,1) -> (1,1) -> (2,1) -> ...
3909  V
3910  (0,2) -> (1,2) -> (2,2) -> ...
3911  V
3912  :
3913  */
3914  i = 0;
3915  j = 0;
3916  result[i + (profile_params.deg_y0_x + 1) * j] = profile_params.flux[idx] * norm_prof_dy0;
3917  for (j = 0; j <= profile_params.deg_y0_m; j++) {
3918  if (j >= 1)
3919  {
3920  i = 0;
3921  result[i + (profile_params.deg_y0_x + 1) * j] =
3922  result[i + (profile_params.deg_y0_x + 1) * (j-1)] * mi;
3923  }
3924  for (i = 1; i <= profile_params.deg_y0_x; i++) {
3925  result[i + (profile_params.deg_y0_x + 1) * j] =
3926  result[i-1 + (profile_params.deg_y0_x + 1) * j] * xi;
3927  }
3928  }
3929 
3930 
3931  /* Calculate the derivatives flux(xk)*df/dsigma * x^i m^j,
3932  like above (but substituting y0->sigma where relevant).
3933  Insert the derivatives in the result
3934  array starting after the derivatives related to y0,
3935  i.e. at index (deg_y0_x+1)(deg_y0_m+1).
3936  */
3937 
3938  result += (profile_params.deg_y0_x + 1) * (profile_params.deg_y0_m + 1);
3939  /* Pointer arithmetics which skips
3940  the first part of the array */
3941 
3942  i = 0;
3943  j = 0;
3944  result[i + (profile_params.deg_sigma_x + 1) * j] =
3945  profile_params.flux[idx] * norm_prof_dsigma;
3946  for (j = 0; j <= profile_params.deg_sigma_m; j++) {
3947  if (j >= 1)
3948  {
3949  i = 0;
3950  result[i + (profile_params.deg_sigma_x + 1) * j] =
3951  result[i + (profile_params.deg_sigma_x + 1) * (j-1)] * mi;
3952  }
3953  for (i = 1; i <= profile_params.deg_sigma_x; i++) {
3954  result[i + (profile_params.deg_sigma_x + 1) * j] =
3955  result[i-1 + (profile_params.deg_sigma_x + 1) * j] * xi;
3956  }
3957  }
3958  }
3959 
3960  return 0;
3961 }
3962 #endif /* NEW_METHOD */
3963 /*----------------------------------------------------------------------------*/
3983 /*----------------------------------------------------------------------------*/
3984 static cpl_table *
3985 opt_measure_profile_order(const cpl_image *image, const cpl_image *image_noise,
3986  const cpl_binary *image_bpm,
3987  uves_iterate_position *pos,
3988  int chunk,
3989  int (*f) (const double x[], const double a[], double *result),
3990  int (*dfda)(const double x[], const double a[], double result[]),
3991  int M,
3992  const cpl_image *sky_spectrum)
3993 {
3994  cpl_table *profile_data = NULL; /* Result */
3995  int profile_row;
3996  cpl_matrix *covariance = NULL;
3997 
3998 #if NEW_METHOD
3999  cpl_matrix *eval_points = NULL;
4000  cpl_vector *eval_data = NULL;
4001  cpl_vector *eval_err = NULL;
4002  cpl_vector *coeffs = NULL;
4003 #if CREATE_DEBUGGING_TABLE
4004  cpl_table *temp = NULL;
4005 #endif
4006  double *fluxes = NULL;
4007  double *skys = NULL;
4008  int *ia = NULL;
4009  /* For initial estimates of y0,sigma: */
4010  cpl_table *estimate = NULL;
4011  cpl_table *estimate_dup = NULL;
4012  polynomial *y0_estim_pol = NULL;
4013  polynomial *sigma_estim_pol = NULL;
4014 #endif
4015 
4016 
4017  cpl_vector *dy = NULL; /* spatial position */
4018  cpl_vector *prof = NULL; /* normalized profile */
4019  cpl_vector *prof2= NULL; /* kill me */
4020  cpl_vector *dprof = NULL; /* uncertainty of 'prof' */
4021  cpl_vector **data = NULL; /* array of vectors */
4022  int *size = NULL; /* array of vector sizes */
4023  double *hicut = NULL; /* array of vector sizes */
4024  double *locut = NULL; /* array of vector sizes */
4025  int nbins = 0;
4026 
4027  const double *image_data;
4028  const double *noise_data;
4029 
4030  int x;
4031 
4032 #if NEW_METHOD
4033  int norders = pos->maxorder-pos->minorder+1;
4034 #else
4035  /* eliminate warning */
4036  sky_spectrum = sky_spectrum;
4037 #endif
4038 
4039  passure( f != NULL, " ");
4040 
4041  image_data = cpl_image_get_data_double_const(image);
4042  noise_data = cpl_image_get_data_double_const(image_noise);
4043 
4044 #if NEW_METHOD
4045  profile_data = cpl_table_new((nx/chunk + 3) * norders);
4046 #else
4047  profile_data = cpl_table_new(pos->nx);
4048 #endif
4049  assure_mem( profile_data );
4050 
4051  check( (cpl_table_new_column(profile_data, "Order", CPL_TYPE_INT),
4052  cpl_table_new_column(profile_data, "X", CPL_TYPE_INT),
4053  cpl_table_new_column(profile_data, "Y0", CPL_TYPE_DOUBLE),
4054  cpl_table_new_column(profile_data, "Sigma", CPL_TYPE_DOUBLE),
4055  cpl_table_new_column(profile_data, "Norm", CPL_TYPE_DOUBLE),
4056  cpl_table_new_column(profile_data, "dY0", CPL_TYPE_DOUBLE),
4057  cpl_table_new_column(profile_data, "dSigma", CPL_TYPE_DOUBLE),
4058  cpl_table_new_column(profile_data, "dNorm", CPL_TYPE_DOUBLE),
4059  cpl_table_new_column(profile_data, "Y0_world", CPL_TYPE_DOUBLE),
4060  cpl_table_new_column(profile_data, "Y0fit_world", CPL_TYPE_DOUBLE),
4061  cpl_table_new_column(profile_data, "Reduced_chisq", CPL_TYPE_DOUBLE)),
4062  "Error initializing order trace table for order #%d", pos->order);
4063 
4064  /* For msg-output purposes, only */
4065  cpl_table_set_column_unit(profile_data, "X" , "pixels");
4066  cpl_table_set_column_unit(profile_data, "Y0", "pixels");
4067  cpl_table_set_column_unit(profile_data, "Sigma", "pixels");
4068  cpl_table_set_column_unit(profile_data, "dY0", "pixels");
4069  cpl_table_set_column_unit(profile_data, "dSigma", "pixels");
4070 
4071  profile_row = 0;
4072 
4073  UVES_TIME_START("Measure loop");
4074 
4075  nbins = uves_round_double(pos->sg.length + 5); /* more than enough */
4076  data = cpl_calloc(nbins, sizeof(cpl_vector *));
4077  size = cpl_calloc(nbins, sizeof(int));
4078  locut = cpl_calloc(nbins, sizeof(double));
4079  hicut = cpl_calloc(nbins, sizeof(double));
4080  {
4081  int i;
4082  for (i = 0; i < nbins; i++)
4083  {
4084  data[i] = cpl_vector_new(1);
4085  }
4086  }
4087 
4088 
4089 #if NEW_METHOD
4090  /* new method:
4091 
4092  for each order
4093  for each chunk
4094  bin data in spatial bins parallel to order trace
4095  define hicut/locut for each bin
4096  get the data points within locut/hicut
4097 
4098  fit model to all orders
4099  */
4100  {
4101  /* 4 degrees are needed for the model
4102  y0 = pol(x, m)
4103  sigma = pol(x, m)
4104  */
4105  int deg_y0_x = 0;
4106  int deg_y0_m = 0;
4107  int deg_sigma_x = 0;
4108  int deg_sigma_m = 0;
4109 
4110  int ncoeffs =
4111  (deg_y0_x +1)*(deg_y0_m +1) +
4112  (deg_sigma_x+1)*(deg_sigma_m+1);
4113 
4114  double red_chisq;
4115  int n = 0; /* Number of points (matrix rows) */
4116  int nbad = 0; /* Number of hot/cold pixels (full chip) */
4117 
4118 #if CREATE_DEBUGGING_TABLE
4119  temp = cpl_table_new(norders*nx*uves_round_double(pos->sg.length+3));
4120  cpl_table_new_column(temp, "x", CPL_TYPE_DOUBLE);
4121  cpl_table_new_column(temp, "y", CPL_TYPE_DOUBLE);
4122  cpl_table_new_column(temp, "order", CPL_TYPE_DOUBLE);
4123  cpl_table_new_column(temp, "dat", CPL_TYPE_DOUBLE);
4124  cpl_table_new_column(temp, "err", CPL_TYPE_DOUBLE);
4125 
4126 #endif
4127 
4128  /*
4129  uves_msg_error("Saving 'sky_subtracted.fits'");
4130  cpl_image_save(image, "sky_subtracted.fits", CPL_BPP_IEEE_FLOAT, NULL,
4131  CPL_IO_DEFAULT);
4132  */
4133 
4134 
4135 
4136 
4137 
4138 
4139 
4140  /* Allocate max. number of storage needed (and resize/shorten later when we
4141  know how much was needed).
4142 
4143  One might get the idea to allocate storage for (nx*ny) points, but this
4144  is only a maximum if the orders are non-overlapping (which cannot a priori
4145  be assumed)
4146  */
4147  eval_points = cpl_matrix_new(norders*nx*uves_round_double(pos->sg.length+3), 3);
4148  eval_data = cpl_vector_new(norders*nx*uves_round_double(pos->sg.length+3));
4149  eval_err = cpl_vector_new(norders*nx*uves_round_double(pos->sg.length+3));
4150 
4151  fluxes = cpl_calloc((nx+1)*norders, sizeof(double));
4152  skys = cpl_calloc((nx+1)*norders, sizeof(double));
4153  /* orders (m) are index'ed starting from 0,
4154  columns (x) are index'ed starting from 1 (zero'th index is not used) */
4155 
4156  estimate = cpl_table_new(norders);
4157  cpl_table_new_column(estimate, "Order", CPL_TYPE_INT);
4158  cpl_table_new_column(estimate, "Y0" , CPL_TYPE_DOUBLE);
4159  cpl_table_new_column(estimate, "Sigma", CPL_TYPE_DOUBLE);
4160 
4161  coeffs = cpl_vector_new(ncoeffs); /* Polynomial coefficients */
4162  ia = cpl_calloc(ncoeffs, sizeof(int));
4163  {
4164  int i;
4165  for (i = 0; i < ncoeffs; i++)
4166  {
4167  cpl_vector_set(coeffs, i, 0); /* First guess */
4168 
4169  ia[i] = 1; /* Yes, fit this parameter */
4170  }
4171  }
4172 
4173 // for (order = minorder; order <= maxorder; order++) {
4174  for (order = 17; order <= 17; order++) {
4175  /* For estimates of y0, sigma for
4176  this order (pixel data values are
4177  used as weights)
4178  */
4179  double sumw = 0; /* sum data */
4180  double sumwy = 0; /* sum data*y */
4181  double sumwyy = 0; /* sum data*y*y */
4182 
4183  for (x = chunk/2; x <= nx - chunk/2; x += chunk) {
4184 // for (x = 900; x <= 1100; x += chunk)
4185  /* Find cosmic rays */
4186  int i;
4187  for (i = 0; i < nbins; i++)
4188  {
4189  /* Each wavel.bin contributes with one data point
4190  to each spatial bin. Therefore each spatial
4191  bin must be able to hold (chunk+1) points. But
4192  to be *completely* safe against weird rounding
4193  (depending on the architecture), make the vectors
4194  a bit longer. */
4195  cpl_vector_set_size(data[i], 2*(chunk + 1));
4196  size[i] = 0;
4197  }
4198 
4199  /* Bin data in this chunk */
4200  for (uves_iterate_set_first(pos,
4201  x - chunk/2 + 1, x + chunk/2,
4202  order, order,
4203  image_bpm, true);
4204  !uves_iterate_finished(pos);
4206  {
4207  int bin = pos->y - pos->ylow;
4208 
4209  check_nomsg(cpl_vector_set(data[bin], size[bin],
4210  DATA(image_data, pos)));
4211  size[bin]++;
4212  }
4213 
4214  /* Get threshold values for each spatial bin in this chunk */
4215  for (i = 0; i < nbins; i++)
4216  {
4217  if (size[i] == 0)
4218  {
4219  /* locut[i] hicut[i] are not used */
4220  }
4221  else if (size[i] <= chunk/2)
4222  {
4223  /* Not enough statistics to verify that the
4224  points are not outliers. Mark them as bad.*/
4225  locut[i] = cpl_vector_get_max(data[i]) + 1;
4226  hicut[i] = cpl_vector_get_min(data[i]) - 1;
4227  }
4228  else
4229  {
4230  /* Iteratively do kappa-sigma clipping to
4231  find the threshold for the current bin */
4232  double median, stdev;
4233  double kappa = 3.0;
4234  double *data_data;
4235  int k;
4236 
4237  k = size[i];
4238 
4239  do {
4240  cpl_vector_set_size(data[i], k);
4241  size[i] = k;
4242  data_data = cpl_vector_get_data(data[i]);
4243 
4244  median = cpl_vector_get_median_const(data[i]);
4245  stdev = cpl_vector_get_stdev(data[i]);
4246  locut[i] = median - kappa*stdev;
4247  hicut[i] = median + kappa*stdev;
4248 
4249  /* Copy good points to beginning of vector */
4250  k = 0;
4251  {
4252  int j;
4253  for (j = 0; j < size[i]; j++)
4254  {
4255  if (locut[i] <= data_data[j] &&
4256  data_data[j] <= hicut[i])
4257  {
4258  data_data[k] = data_data[j];
4259  k++;
4260  }
4261  }
4262  }
4263  }
4264  while (k < size[i] && k > 1);
4265  /* while more points rejected */
4266  }
4267  }
4268 
4269  /* Collect data points in this chunk.
4270  * At the same time compute estimates of
4271  * y0, sigma for this order
4272  */
4273 
4274  for (uves_iterate_set_first(pos,
4275  x - chunk/2 + 1, x + chunk/2,
4276  order, order,
4277  NULL, false)
4278  !uves_iterate_finished(pos);
4280  {
4281  int pis_rejected;
4282  double flux = 0; /* Linear extract bin */
4283  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
4284  {
4285  int bin = pos->y - pos->ylow;
4286 
4287  if (ISGOOD(image_bpm, pos) &&
4288  (locut[bin] <= DATA(image_data, pos) &&
4289  DATA(image_data, pos) <= hicut[bin])
4290  )
4291  {
4292  double pix = DATA(image_data, pos);
4293  double dy = pos->y - pos->ycenter;
4294  flux += pix;
4295 
4296  cpl_matrix_set(eval_points, n, 0, pos->x);
4297  cpl_matrix_set(eval_points, n, 1, dy);
4298  cpl_matrix_set(eval_points, n, 2, order);
4299  cpl_vector_set(eval_data, n, pix);
4300  cpl_vector_set(eval_err , n,
4301  DATA(noise_data, pos));
4302 
4303  sumw += pix;
4304  sumwy += pix * dy;
4305  sumwyy += pix * dy * dy;
4306 #if CREATE_DEBUGGING_TABLE
4307  cpl_table_set_double(temp, "x", n, pos->x);
4308  cpl_table_set_double(temp, "y", n, dy);
4309  cpl_table_set_double(temp, "order", n, order);
4310  cpl_table_set_double(temp, "dat", n, pix);
4311  cpl_table_set_double(temp, "err", n,
4312  DATA(noise_data, pos));
4313 
4314 #endif
4315  n++;
4316  }
4317  else
4318  {
4319  nbad += 1;
4320  /* uves_msg_error("bad pixel at (%d, %d)", i, pos->y);*/
4321  }
4322  }
4323  fluxes[pos->x + (order-pos->minorder)*(pos->nx+1)] = flux;
4324  skys [pos->x + (order-pos->minorder)*(pos->nx+1)] =
4325  cpl_image_get(sky_spectrum,
4326  pos->x, order-pos->minorder+1, &pis_rejected);
4327 
4328  /* Buffer widths are nx+1, not nx */
4329  skys [pos->x + (order-pos->minorder)*(pos->nx+1)] = 0;
4330  /* need non-sky-subtracted as input image */
4331 
4332  } /* collect data */
4333  } /* for each chunk */
4334 
4335  /* Estimate fit parameters */
4336  {
4337  double y0_estim;
4338  double sigma_estim;
4339  bool y0_is_good; /* Is the estimate valid, or should it be ignored? */
4340  bool sigma_is_good;
4341 
4342  if (sumw != 0)
4343  {
4344  y0_is_good = true;
4345  y0_estim = sumwy/sumw;
4346 
4347  sigma_estim = sumwyy/sumw - (sumwy/sumw)*(sumwy/sumw);
4348  if (sigma_estim > 0)
4349  {
4350  sigma_estim = sqrt(sigma_estim);
4351  sigma_is_good = true;
4352  }
4353  else
4354  {
4355  sigma_is_good = false;
4356  }
4357  }
4358  else
4359  {
4360 
4361  y0_is_good = false;
4362  sigma_is_good = false;
4363  }
4364 
4365  cpl_table_set_int (estimate, "Order", order - pos->minorder, order);
4366 
4367  if (y0_is_good)
4368  {
4369  cpl_table_set_double(estimate, "Y0" , order - pos->minorder, y0_estim);
4370  }
4371  else
4372  {
4373  cpl_table_set_invalid(estimate, "Y0", order - pos->minorder);
4374  }
4375 
4376  if (sigma_is_good)
4377  {
4378  cpl_table_set_double(estimate, "Sigma",
4379  order - pos->minorder, sigma_estim);
4380  }
4381  else
4382  {
4383  cpl_table_set_invalid(estimate, "Sigma", order - pos->minorder);
4384  }
4385 
4386 
4387  /* There's probably a nicer way of printing this... */
4388  if (y0_is_good && sigma_is_good) {
4389  uves_msg_error("Order #%d: Offset = %.2f pix; FWHM = %.2f pix",
4390  order, y0_estim, sigma_estim*TWOSQRT2LN2);
4391  }
4392  else if (y0_is_good && !sigma_is_good) {
4393  uves_msg_error("Order #%d: Offset = %.2f pix; FWHM = -- pix",
4394  order, y0_estim);
4395  }
4396  else if (!y0_is_good && sigma_is_good) {
4397  uves_msg_error("Order #%d: Offset = -- pix; FWHM = %.2f pix",
4398  order, sigma_estim);
4399  }
4400  else {
4401  uves_msg_error("Order #%d: Offset = -- pix; FWHM = -- pix",
4402  order);
4403  }
4404  } /* end estimating */
4405 
4406  } /* for each order */
4407 
4408  cpl_matrix_set_size(eval_points, n, 3);
4409  cpl_vector_set_size(eval_data, n);
4410  cpl_vector_set_size(eval_err , n);
4411 
4412 #if CREATE_DEBUGGING_TABLE
4413  cpl_table_set_size(temp, n);
4414 #endif
4415 
4416  /* Get estimates of constant + linear coefficients
4417  (as function of order (m), not x) */
4418  {
4419  double kappa = 3.0;
4420  int degree;
4421 
4422  cpl_table_dump(estimate, 0, cpl_table_get_nrow(estimate), stdout);
4423 
4424  /* Remove rows with invalid y0, but keep rows with
4425  valid sigma (therefore we need a copy) */
4426  estimate_dup = cpl_table_duplicate(estimate);
4427  assure_mem( estimate_dup );
4428  uves_erase_invalid_table_rows(estimate_dup, "Y0");
4429 
4430  /* Linear fit, or zero'th if only one position to fit */
4431  degree = (cpl_table_get_nrow(estimate_dup) > 1) ? 1 : 0;
4432 
4433  y0_estim_pol = uves_polynomial_regression_1d(
4434  estimate_dup, "Order", "Y0", NULL,
4435  degree,
4436  NULL, NULL, /* New columns */
4437  NULL, /* mse */
4438  kappa);
4439 
4440  uves_polynomial_dump(y0_estim_pol, stdout); fflush(stdout);
4441 
4442  if (cpl_error_get_code() != CPL_ERROR_NONE)
4443  {
4444  uves_msg_warning("Could not estimate object centroid (%s). "
4445  "Setting initial offset to zero",
4446  cpl_error_get_message());
4447 
4448  uves_error_reset();
4449 
4450  /* Set y0(m) := 0 */
4451  uves_polynomial_delete(&y0_estim_pol);
4452  y0_estim_pol = uves_polynomial_new_zero(1); /* dimension = 1 */
4453  }
4454 
4455  uves_free_table(&estimate_dup);
4456  estimate_dup = cpl_table_duplicate(estimate);
4457  assure_mem( estimate_dup );
4458  uves_erase_invalid_table_rows(estimate_dup, "Sigma");
4459 
4460  degree = (cpl_table_get_nrow(estimate_dup) > 1) ? 1 : 0;
4461 
4462  sigma_estim_pol = uves_polynomial_regression_1d(
4463  estimate_dup, "Order", "Sigma", NULL,
4464  degree,
4465  NULL, NULL, /* New columns */
4466  NULL, /* mse */
4467  kappa);
4468 
4469  if (cpl_error_get_code() != CPL_ERROR_NONE)
4470  {
4471  uves_msg_warning("Could not estimate object width (%s). "
4472  "Setting initial sigma to 1 pixel",
4473  cpl_error_get_message());
4474 
4475  uves_error_reset();
4476 
4477  /* Set sigma(m) := 1 */
4478  uves_polynomial_delete(&sigma_estim_pol);
4479  sigma_estim_pol = uves_polynomial_new_zero(1);
4480  uves_polynomial_shift(sigma_estim_pol, 0, 1.0);
4481  }
4482  } /* end estimating */
4483 
4484  /* Copy estimate to 'coeffs' vector */
4485 
4486  /* Centroid, constant term x^0 m^0 */
4487  cpl_vector_set(coeffs, 0,
4488  uves_polynomial_get_coeff_1d(y0_estim_pol, 0));
4489  /* Centroid, linear term x^0 m^1 */
4490  if (deg_y0_m >= 1)
4491  {
4492  cpl_vector_set(coeffs, 0 + (deg_y0_x+1)*1,
4493  uves_polynomial_get_coeff_1d(y0_estim_pol, 1));
4494 
4495  uves_msg_error("Estimate: y0 ~= %g + %g * m",
4496  cpl_vector_get(coeffs, 0),
4497  cpl_vector_get(coeffs, 0 + (deg_y0_x+1)*1));
4498  }
4499  else
4500  {
4501  uves_msg_error("Estimate: y0 ~= %g",
4502  cpl_vector_get(coeffs, 0));
4503  }
4504 
4505 
4506  /* Sigma, constant term x^0 m^0 */
4507  cpl_vector_set(coeffs, (deg_y0_x+1)*(deg_y0_m+1),
4508  uves_polynomial_get_coeff_1d(sigma_estim_pol, 0));
4509  /* Sigma, linear term x^0 m^1 */
4510  if (deg_sigma_m >= 1)
4511  {
4512  cpl_vector_set(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
4513  0 + (deg_sigma_x+1)*1,
4514  uves_polynomial_get_coeff_1d(sigma_estim_pol, 1));
4515 
4516  uves_msg_error("Estimate: sigma ~= %g + %g * m",
4517  cpl_vector_get(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
4518  0),
4519  cpl_vector_get(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
4520  0 + (deg_y0_x+1)*1));
4521  }
4522  else
4523  {
4524  uves_msg_error("Estimate: sigma ~= %g",
4525  cpl_vector_get(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
4526  0));
4527 
4528  }
4529  /* Remaining coeff.s were set to 0 */
4530 
4531  /* Fill struct used for fitting */
4532  profile_params.flux = fluxes;
4533  profile_params.sky = skys;
4534  profile_params.minorder = pos->minorder;
4535  profile_params.nx = nx;
4536 
4537  profile_params.f = f;
4538  profile_params.dfda = dfda;
4539 
4540  profile_params.deg_y0_x = deg_y0_x;
4541  profile_params.deg_y0_m = deg_y0_m;
4542  profile_params.deg_sigma_x = deg_sigma_x;
4543  profile_params.deg_sigma_m = deg_sigma_m;
4544 
4545 // cpl_msg_set_level(CPL_MSG_DEBUG_MODE);
4546 
4547  /* Unweighted fit: */
4548  cpl_vector_fill(eval_err,
4549  cpl_vector_get_median_const(eval_err));
4550 
4551  uves_msg_error("Fitting model to %d positions; %d bad pixels found",
4552  n, nbad);
4553 
4554  uves_fit(eval_points, NULL,
4555  eval_data, eval_err,
4556  coeffs, ia,
4557  profile_f,
4558  profile_dfda,
4559  NULL, /* mse, red_chisq, covariance */
4560  &red_chisq,
4561  &covariance);
4562 // cpl_msg_set_level(CPL_MSG_INFO);
4563 
4564  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX ||
4565  cpl_error_get_code() == CPL_ERROR_CONTINUE)
4566  {
4567  uves_msg_warning("Fitting global model failed (%s)", cpl_error_get_message());
4568  uves_error_reset();
4569 #if CREATE_DEBUGGING_TABLE
4570  cpl_table_save(temp, NULL, NULL, "tab.fits", CPL_IO_DEFAULT);
4571 #endif
4572  }
4573  else
4574  {
4575  assure( cpl_error_get_code() == CPL_ERROR_NONE,
4576  cpl_error_get_code(), "Fitting global model failed");
4577 
4578  cpl_matrix_dump(covariance, stdout); fflush(stdout);
4579 
4580  uves_msg_error("Solution: y0 ~= %g", eval_pol(cpl_vector_get_data(coeffs),
4581  deg_y0_x, deg_y0_m,
4582  pos->nx/2,
4583  (pos->minorder+pos->maxorder)/2));
4584  uves_msg_error("Solution: sigma ~= %g", eval_pol(cpl_vector_get_data(coeffs)+
4585  (deg_y0_x+1)*(deg_y0_m+1),
4586  deg_y0_x, deg_y0_m,
4587  pos->nx/2,
4588  (pos->minorder+pos->maxorder)/2));
4589 
4590  /* Fill table with solution */
4591  for (order = pos->minorder; order <= pos->maxorder; order++) {
4592  for (x = chunk/2; x <= nx - chunk/2; x += chunk)
4593  {
4594  double y_0 = eval_pol(cpl_vector_get_data(coeffs),
4595  deg_y0_x, deg_y0_m, x, order);
4596  double sigma = fabs(eval_pol(cpl_vector_get_data(coeffs)+
4597  (deg_y0_x+1)*(deg_y0_m+1),
4598  deg_sigma_x, deg_sigma_m, x, order));
4599 
4600  /* Use error propagation formula to get variance of polynomials:
4601 
4602  We have p(x,m) = sum_ij a_ij x^i m^j,
4603 
4604  and thus a quadruple sum for the variance,
4605 
4606  V(x,m) = sum_i1j1i2j2 Cov(a_i1j1, a_i2j2), x^(i1+i2) m^(j1+j2)
4607 
4608  (for both y0(x,m) and sigma(x,m))
4609  */
4610  double dy0 = 0;
4611  double dsigma = 0;
4612  int i1, i2, j_1, j2; /* because POSIX 1003.1-2001 defines 'j1' */
4613 
4614  for (i1 = 0; i1 < (deg_y0_x+1); i1++)
4615  for (j_1 = 0; j_1 < (deg_y0_m+1); j_1++)
4616  for (i2 = 0; i2 < (deg_y0_x+1); i2++)
4617  for (j2 = 0; j2 < (deg_y0_m+1); j2++)
4618  {
4619  dy0 += cpl_matrix_get(covariance,
4620  i1+(deg_y0_x+1)*j_1,
4621  i2+(deg_y0_x+1)*j2) *
4622  uves_pow_int(x, i1+i2) *
4623  uves_pow_int(order, j_1+j2);
4624  }
4625  if (dy0 > 0)
4626  {
4627  dy0 = sqrt(dy0);
4628  }
4629  else
4630  /* Should not happen */
4631  {
4632  dy0 = 1.0;
4633  }
4634 
4635  for (i1 = 0; i1 < (deg_sigma_x+1); i1++)
4636  for (j_1 = 0; j_1 < (deg_sigma_m+1); j_1++)
4637  for (i2 = 0; i2 < (deg_sigma_x+1); i2++)
4638  for (j2 = 0; j2 < (deg_sigma_m+1); j2++)
4639  {
4640  /* Ignore the upper left part of the covariance
4641  matrix (the covariances related to y0)
4642  */
4643  dsigma += cpl_matrix_get(
4644  covariance,
4645  (deg_y0_x+1)*(deg_y0_m+1) + i1+(deg_sigma_x+1)*j_1,
4646  (deg_y0_x+1)*(deg_y0_m+1) + i2+(deg_sigma_x+1)*j2) *
4647  uves_pow_int(x, i1+i1) *
4648  uves_pow_int(order, j_1+j2);
4649  }
4650  if (dsigma > 0)
4651  {
4652  dsigma = sqrt(dsigma);
4653  }
4654  else
4655  /* Should not happen */
4656  {
4657  dsigma = 1.0;
4658  }
4659 
4660  check((cpl_table_set_int (profile_data, "Order", profile_row, order),
4661  cpl_table_set_int (profile_data, "X" , profile_row, x),
4662  cpl_table_set_double(profile_data, "Y0" , profile_row, y_0),
4663  cpl_table_set_double(profile_data, "Sigma", profile_row, sigma),
4664  cpl_table_set_double(profile_data, "Norm" , profile_row, 1),
4665  cpl_table_set_double(profile_data, "dY0" , profile_row, dy0),
4666  cpl_table_set_double(profile_data, "dSigma", profile_row, dsigma),
4667  cpl_table_set_double(profile_data, "dNorm", profile_row, 1),
4668  cpl_table_set_double(profile_data, "Y0_world", profile_row, -1),
4669  cpl_table_set_double(profile_data, "Reduced_chisq", profile_row,
4670  red_chisq)),
4671  "Error writing table row %d", profile_row+1);
4672  profile_row += 1;
4673  } /* For each chunk */
4674  } /* For each order */
4675 #if CREATE_DEBUGGING_TABLE
4676  cpl_table_new_column(temp, "pemp", CPL_TYPE_DOUBLE); /* empirical profile */
4677  cpl_table_new_column(temp, "fit", CPL_TYPE_DOUBLE); /* fitted profile */
4678  cpl_table_new_column(temp, "pfit", CPL_TYPE_DOUBLE); /* fitted profile, normalized */
4679  {int i;
4680  for (i = 0; i < cpl_table_get_nrow(temp); i++)
4681  {
4682  double y = cpl_table_get_double(temp, "y", i, NULL);
4683  int xi = uves_round_double(cpl_table_get_double(temp, "x", i, NULL));
4684  int mi = uves_round_double(cpl_table_get_double(temp, "order", i, NULL));
4685  double dat = cpl_table_get_double(temp, "dat", i, NULL);
4686  int idx = xi + (mi - profile_params.minorder)*(profile_params.nx + 1);
4687  double flux_fit;
4688  double xar[3];
4689  xar[0] = xi;
4690  xar[1] = y;
4691  xar[2] = mi;
4692 
4693  profile_f(xar,
4694  cpl_vector_get_data(coeffs), &flux_fit);
4695 
4696  cpl_table_set(temp, "pemp", i,
4697  (dat - profile_params.sky[idx])/profile_params.flux[idx]);
4698 
4699  cpl_table_set(temp, "fit", i, flux_fit);
4700 
4701  cpl_table_set(temp, "pfit", i,
4702  (flux_fit - profile_params.sky[idx])/profile_params.flux[idx]);
4703  }
4704  }
4705  check_nomsg(
4706  cpl_table_save(temp, NULL, NULL, "tab.fits", CPL_IO_DEFAULT));
4707 #endif
4708  }
4709  }
4710 
4711 #else /* if NEW_METHOD */
4712  dy = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
4713  prof = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
4714  prof2 = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
4715  dprof = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
4716 
4717  for (x = 1 + chunk/2; x + chunk/2 <= pos->nx; x += chunk) {
4718  /* Collapse chunk [x-chunk/2 ; x+chunk/2],
4719  then fit profile (this is to have better
4720  statistics than if fitting individual bins). */
4721  const int points_needed_for_fit = 6;
4722  int n = 0;
4723  int nbad = 0;
4724  int i;
4725 
4726  /* Use realloc rather than malloc (for each chunk) */
4727  cpl_vector_set_size(dy, (chunk+1) * ((int)(pos->sg.length + 3)));
4728  cpl_vector_set_size(prof, (chunk+1) * ((int)(pos->sg.length + 3)));
4729  cpl_vector_set_size(prof2, (chunk+1) * ((int)(pos->sg.length + 3)));
4730  cpl_vector_set_size(dprof, (chunk+1) * ((int)(pos->sg.length + 3)));
4731  n = 0; /* Number of points inserted in dy, prof, dprof */
4732 
4733  for (i = 0; i < nbins; i++)
4734  {
4735  /* Each wavel.bin contributes with one data point
4736  to each spatial bin. Therefore each spatial
4737  bin must be able to hold (chunk+1) points. But
4738  to be *completely* safe against weird rounding
4739  (depending on the architecture), make the vectors
4740  a bit longer. */
4741  cpl_vector_set_size(data[i], 2*(chunk + 1));
4742  size[i] = 0;
4743  }
4744 
4745 
4746  /* Bin data in this chunk */
4747  for (uves_iterate_set_first(pos,
4748  x - chunk/2 + 1,
4749  x + chunk/2,
4750  pos->order, pos->order,
4751  image_bpm, true);
4752  !uves_iterate_finished(pos);
4754  {
4755  int bin = pos->y - pos->ylow;
4756 
4757  /* Group into spatial bins */
4758  check_nomsg(cpl_vector_set(data[bin], size[bin],
4759  DATA(image_data, pos)));
4760  size[bin]++;
4761  }
4762 
4763  /* Get threshold values for each spatial bin in this chunk */
4764  for (i = 0; i < nbins; i++)
4765  {
4766  if (size[i] == 0)
4767  {
4768  /* locut[i] hicut[i] are not used */
4769  }
4770  else if (size[i] <= chunk/2)
4771  {
4772  /* Not enough statistics to verify that the
4773  points are not outliers. Mark them as bad.*/
4774  locut[i] = cpl_vector_get_max(data[i]) + 1;
4775  hicut[i] = cpl_vector_get_min(data[i]) - 1;
4776  }
4777  else
4778  {
4779  /* Iteratively do kappa-sigma clipping to
4780  find the threshold for the current bin */
4781  double median, stdev;
4782  double kappa = 3.0;
4783  double *data_data;
4784  int k;
4785 
4786  k = size[i];
4787 
4788  do {
4789  cpl_vector_set_size(data[i], k);
4790  size[i] = k;
4791  data_data = cpl_vector_get_data(data[i]);
4792 
4793  median = cpl_vector_get_median_const(data[i]);
4794  stdev = cpl_vector_get_stdev(data[i]);
4795  locut[i] = median - kappa*stdev;
4796  hicut[i] = median + kappa*stdev;
4797 
4798  /* Copy good points to beginning of vector */
4799  k = 0;
4800  {
4801  int j;
4802  for (j = 0; j < size[i]; j++)
4803  {
4804  if (locut[i] <= data_data[j] &&
4805  data_data[j] <= hicut[i])
4806  {
4807  data_data[k] = data_data[j];
4808  k++;
4809  }
4810  }
4811  }
4812  }
4813  while (k < size[i] && k > 1);
4814  /* while still more points rejected */
4815  }
4816  } /* for each bin */
4817 
4818  /* Collect good data in this chunk */
4819  for (uves_iterate_set_first(pos,
4820  x - chunk/2 + 1,
4821  x + chunk/2,
4822  pos->order, pos->order,
4823  NULL, false);
4824  !uves_iterate_finished(pos);
4826  {
4827  double flux = 0;
4828  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
4829  {
4830  int bin = pos->y - pos->ylow;
4831 
4832  if (ISGOOD(image_bpm, pos) &&
4833  (locut[bin] <= DATA(image_data, pos) &&
4834  DATA(image_data, pos) <= hicut[bin])
4835  )
4836  {
4837  flux += DATA(image_data, pos);
4838  }
4839  }
4840 
4841  if (flux != 0)
4842  {
4843  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
4844  {
4845  int bin = pos->y - pos->ylow;
4846 
4847  if (ISGOOD(image_bpm, pos) &&
4848  (locut[bin] <= DATA(image_data, pos) &&
4849  DATA(image_data, pos) <= hicut[bin])
4850  )
4851  {
4852  double pix = DATA(image_data, pos);
4853 
4854  cpl_vector_set(dy , n, pos->y - pos->ycenter);
4855  cpl_vector_set(prof , n, pix/flux);
4856  cpl_vector_set(dprof, n, (flux > 0) ?
4857  DATA(noise_data, pos)/flux :
4858  -DATA(noise_data, pos)/flux);
4859  n++;
4860  }
4861  else
4862  {
4863  nbad += 1;
4864  /* uves_msg_debug("Bad pixel at (%d, %d)",
4865  pos->x, pos->y); */
4866  }
4867  }
4868  }
4869  } /* collect data */
4870 
4871  if (n >= points_needed_for_fit) {
4872  double y_0, norm, background, slope, sigma, red_chisq;
4873 
4874  cpl_vector_set_size(dy, n);
4875  cpl_vector_set_size(prof, n);
4876  cpl_vector_set_size(prof2, n);
4877  cpl_vector_set_size(dprof, n);
4878 
4879  /* Fit */
4880  uves_msg_debug("Fitting chunk (%d, %d)",
4881  x-chunk/2, x+chunk/2);
4882 
4883 // cpl_vector_dump(dy, stdout);
4884 // cpl_vector_dump(prof, stdout);
4885 
4886  uves_free_matrix(&covariance);
4887 
4888  background = 0; /* The sky was already subtracted */
4889  norm = 1.0; /* We are fitting the normalized profile.
4890  Reducing the number of free parameters
4891  gives a better fit.
4892  */
4893 
4894  /* Use constant uncertainty */
4895 if (0) {
4896  /* This gives a better fit (narrower profile at low S/N)
4897  but overestimates chi^2
4898  */
4899  double median = cpl_vector_get_median_const(dprof);
4900 
4901  cpl_vector_fill(dprof, median);
4902  }
4903  uves_fit_1d(dy, NULL,
4904 #if 1
4905  prof, dprof,
4906 #else
4907  prof, NULL,
4908 #endif
4909  CPL_FIT_CENTROID |
4910  CPL_FIT_STDEV,
4911  false,
4912  &y_0, &sigma, &norm, &background, &slope,
4913 #if 1
4914  NULL, &red_chisq, /* mse, red_chisq */
4915  &covariance,
4916 #else
4917  NULL, NULL,
4918  NULL,
4919 #endif
4920  f, dfda, M);
4921 #if 1
4922 #else
4923  covariance = cpl_matrix_new(4,4);
4924  cpl_matrix_set(covariance, 0, 0, 1);
4925  cpl_matrix_set(covariance, 1, 1, 1);
4926  cpl_matrix_set(covariance, 2, 2, 1);
4927  cpl_matrix_set(covariance, 3, 3, 1);
4928  red_chisq = 1;
4929 #endif
4930  if (false) /* && 800-chunk/2 <= x && x <= 800+chunk/2 && order == 17) */
4931  {
4932 /* uves_msg_error("dumping chunk at x,order = %d, %d", x, order);
4933  uves_msg_error("dy = ");
4934  cpl_vector_dump(dy, stderr);
4935  uves_msg_error("prof = ");
4936  cpl_vector_dump(prof, stderr);
4937 */
4938 
4939 /*
4940  cpl_bivector *b = cpl_bivector_wrap_vectors(dy, prof);
4941  cpl_plot_bivector("set grid;set yrange[-1:1];set xlabel 'Wavelength [m]';",
4942  "t 'Spatial profile' w points",
4943  "",b);
4944  cpl_bivector_unwrap_vectors(b);
4945 */
4946 
4947  cpl_vector *pl[] = {NULL, NULL, NULL};
4948 
4949  cpl_vector *fit = cpl_vector_new(cpl_vector_get_size(dy));
4950  {
4951  for (i = 0; i < cpl_vector_get_size(dy); i++)
4952  {
4953  double yy = cpl_vector_get(dy, i);
4954  cpl_vector_set(fit, i,
4955  exp(-(yy-y_0)*(yy-y_0)/(2*sigma*sigma))
4956  /(sigma*sqrt(2*M_PI)));
4957  }
4958  }
4959 
4960  /* uves_msg_error("result is %f, %f, %f, %f %d %f",
4961  y_0, sigma, norm, background, cpl_error_get_code(), sigma*TWOSQRT2LN2);
4962  */
4963 
4964  pl[0] = prof2;
4965  pl[1] = dprof;
4966  pl[2] = dprof;
4967 // pl[0] = dy;
4968 // pl[1] = prof;
4969 // pl[2] = fit;
4970  uves_error_reset();
4971  cpl_plot_vectors("set grid;set yrange[0:0.5];set xlabel 'dy';",
4972  "t 'Spatial profile' w points",
4973  "",
4974  (const cpl_vector **)pl, 3);
4975 
4976 
4977  pl[0] = prof;
4978  pl[1] = dprof;
4979  pl[2] = dprof;
4980 
4981  cpl_plot_vectors("set grid;set xrange[-2:2];"
4982  "set yrange[0:0.5];set xlabel 'dy';",
4983  "t 'Spatial profile' w points",
4984  "",
4985  (const cpl_vector **)pl, 3);
4986 
4987  uves_free_vector(&fit);
4988 
4989  }
4990 
4991  /* Convert to global coordinate (at middle of chunk) */
4993  x, x,
4994  pos->order, pos->order,
4995  NULL,
4996  false);
4997  y_0 += pos->ycenter;
4998 
4999  /* Recover from a failed fit.
5000  *
5001  * The gaussian fitting routine itself guarantees
5002  * that, on success, sigma < slit_length.
5003  * Tighten this constraint by requiring that also 4sigma < slit_length (see below).
5004  * This is to avoid detecting
5005  * sky-on-top-of-interorder
5006  * rather than
5007  * object-on-top-of-sky
5008  * (observed to happen in low-S/N cases when
5009  * the sky flux dominates the object flux )
5010  *
5011  * object
5012  * /\
5013  * |-sky-/ \--sky-|
5014  * | |
5015  * | |
5016  * -----| s l i t |---interorder--
5017  *
5018  *
5019  * Also avoid fits with sigma < 0.2 which are probably CRs
5020  *
5021  */
5022  if (cpl_error_get_code() == CPL_ERROR_CONTINUE ||
5023  cpl_error_get_code()== CPL_ERROR_SINGULAR_MATRIX ||
5024  4.0*sigma >= pos->sg.length || sigma < 0.2) {
5025 
5026  uves_msg_debug("Profile fitting failed at (order, x) = (%d, %d) "
5027  "(%s), ignoring chunk",
5028  pos->order, x, cpl_error_get_message());
5029 
5030  uves_error_reset();
5031  }
5032  else {
5033  assure( cpl_error_get_code() == CPL_ERROR_NONE, cpl_error_get_code(),
5034  "Gaussian fitting failed");
5035 
5036  check(
5037  (cpl_table_set_int (profile_data, "Order", profile_row, pos->order),
5038  cpl_table_set_int (profile_data, "X" , profile_row, x),
5039  cpl_table_set_double(profile_data, "Y0" , profile_row, y_0 - pos->ycenter),
5040  cpl_table_set_double(profile_data, "Sigma", profile_row, sigma),
5041  cpl_table_set_double(profile_data, "Norm" , profile_row, norm),
5042  cpl_table_set_double(profile_data, "dY0" , profile_row,
5043  sqrt(cpl_matrix_get(covariance, 0, 0))),
5044  cpl_table_set_double(profile_data, "dSigma", profile_row,
5045  sqrt(cpl_matrix_get(covariance, 1, 1))),
5046  cpl_table_set_double(profile_data, "dNorm", profile_row,
5047  sqrt(cpl_matrix_get(covariance, 2, 2))),
5048  cpl_table_set_double(profile_data, "Y0_world", profile_row, y_0),
5049  cpl_table_set_double(profile_data, "Reduced_chisq", profile_row,
5050  red_chisq)),
5051  "Error writing table");
5052 
5053  profile_row += 1;
5054  /* uves_msg_debug("y0 = %f sigma = %f norm = %f "
5055  "background = %f", y_0, sigma, norm, background); */
5056  }
5057  }
5058  else
5059  {
5060  uves_msg_debug("Order #%d: Too few (%d) points available in "
5061  "at x = %d - %d, ignoring chunk",
5062  pos->order, n,
5063  x - chunk/2, x + chunk/2);
5064  }
5065  } /* for each chunk */
5066 
5067 #endif /* old method */
5068 
5069  cpl_table_set_size(profile_data, profile_row);
5070 
5071  UVES_TIME_END;
5072 
5073 
5074 cleanup:
5075 #if NEW_METHOD
5076  uves_free_matrix(&eval_points);
5077  uves_free_vector(&eval_data);
5078  uves_free_vector(&eval_err);
5079  uves_free_vector(&coeffs);
5080  cpl_free(fluxes);
5081  cpl_free(skys);
5082  cpl_free(ia);
5083 #if CREATE_DEBUGGING_TABLE
5084  uves_free_table(&temp);
5085 #endif
5086  uves_free_table(&estimate);
5087  uves_free_table(&estimate_dup);
5088  uves_polynomial_delete(&y0_estim_pol);
5089  uves_polynomial_delete(&sigma_estim_pol);
5090 #endif
5091 
5092  uves_free_matrix(&covariance);
5093  uves_free_vector(&dy);
5094  uves_free_vector(&prof);
5095  uves_free_vector(&prof2);
5096  uves_free_vector(&dprof);
5097  {
5098  int i;
5099  for (i = 0; i < nbins; i++)
5100  {
5101  uves_free_vector(&(data[i]));
5102  }
5103  }
5104  cpl_free(data);
5105  cpl_free(size);
5106  cpl_free(locut);
5107  cpl_free(hicut);
5108 
5109  if (cpl_error_get_code() != CPL_ERROR_NONE)
5110  {
5111  uves_free_table(&profile_data);
5112  }
5113 
5114  return profile_data;
5115 }
5116 
5117 
5118 /*----------------------------------------------------------------------------*/
5127 /*----------------------------------------------------------------------------*/
5128 static int
5129 opt_get_order_width(const uves_iterate_position *pos)
5130 {
5131  int result = -1;
5132 
5133  double x1 = 1;
5134  double x2 = pos->nx;
5135  double y_1 = uves_polynomial_evaluate_2d(pos->order_locations, x1, pos->order);
5136  double y2 = uves_polynomial_evaluate_2d(pos->order_locations, x2, pos->order);
5137  double slope = (y2 - y_1)/(x2 - x1);
5138 
5139  if (slope != 0)
5140  {
5141  /* Solve
5142  slope * x + y1 = 1 and
5143  slope * x + y1 = ny
5144  for x
5145 
5146  ... then get exact solution
5147  */
5148  double x_yeq1 = ( 1 - y_1)/slope;
5149  double x_yeqny = (pos->ny - y_1)/slope;
5150 
5151  if (1 <= x_yeq1 && x_yeq1 <= pos->nx) /* If order is partially below image */
5152  {
5153  double guess = x_yeq1;
5154 
5155  uves_msg_debug("Guess value (y = 1) x = %f", guess);
5156  /* Get exact value of x_yeq1 */
5157  x_yeq1 = uves_polynomial_solve_2d(pos->order_locations,
5158  1, /* Solve p = 1 */
5159  guess, /* guess value */
5160  1, /* multiplicity */
5161  2, /* fix this
5162  variable number */
5163  pos->order);/* ... to this value */
5164 
5165  if (cpl_error_get_code() != CPL_ERROR_NONE)
5166  {
5167  uves_error_reset();
5168  uves_msg_warning("Could not solve order polynomial = 1 at order #%d. "
5169  "Order polynomial may be ill-formed", pos->order);
5170  x_yeq1 = guess;
5171  }
5172  else
5173  {
5174  uves_msg_debug("Exact value (y = 1) x = %f", x_yeq1);
5175  }
5176  }
5177 
5178  if (1 <= x_yeqny && x_yeqny <= pos->nx) /* If order is partially above image */
5179  {
5180  double guess = x_yeqny;
5181 
5182  uves_msg_debug("Guess value (y = %d) = %f", pos->ny, guess);
5183  /* Get exact value of x_yeqny */
5184  x_yeqny = uves_polynomial_solve_2d(pos->order_locations,
5185  pos->ny, /* Solve p = ny */
5186  guess, /* guess value */
5187  1, /* multiplicity */
5188  2, /* fix this
5189  variable number */
5190  pos->order);/* ... to this value */
5191 
5192  if (cpl_error_get_code() != CPL_ERROR_NONE)
5193  {
5194  uves_error_reset();
5195  uves_msg_warning("Could not solve order polynomial = %d at order #%d. "
5196  "Order polynomial may be ill-formed",
5197  pos->ny, pos->order);
5198  x_yeqny = guess;
5199  }
5200  else
5201  {
5202  uves_msg_debug("Exact value (y = %d) x = %f", pos->ny, x_yeqny);
5203  }
5204  }
5205 
5206  if (slope > 0)
5207  {
5208  result = uves_round_double(
5209  uves_max_double(1,
5210  uves_min_double(pos->nx, x_yeqny) -
5211  uves_max_double(1, x_yeq1) + 1));
5212  }
5213  else
5214  {
5215  passure( slope < 0, "%f", slope);
5216  result = uves_round_double(
5217  uves_max_double(1,
5218  uves_min_double(pos->nx, x_yeq1 ) -
5219  uves_max_double(1, x_yeqny) + 1));
5220  }
5221  }
5222  else
5223  {
5224  result = pos->nx;
5225  }
5226 
5227  uves_msg_debug("Order width = %d pixels", result);
5228 
5229  cleanup:
5230 
5231  return result;
5232 }
5233 
5234 
5235 /*----------------------------------------------------------------------------*/
5274 /*----------------------------------------------------------------------------*/
5275 static int
5276 opt_extract(cpl_image *image,
5277  const cpl_image *image_noise,
5278  uves_iterate_position *pos,
5279  const uves_extract_profile *profile,
5280  bool optimal_extract_sky,
5281  double kappa,
5282  cpl_table *blemish_mask,
5283  cpl_table *cosmic_mask,
5284  int *cr_row,
5285  cpl_table *profile_table,
5286  int *prof_row,
5287  cpl_image *spectrum,
5288  cpl_image *spectrum_noise,
5289  cpl_image *weights,
5290  cpl_image *sky_spectrum,
5291  cpl_image *sky_spectrum_noise,
5292  double *sn)
5293 {
5294  cpl_table *signal_to_noise = NULL; /* S/N values of bins in this order
5295  * (table used as a variable length array)
5296  */
5297  int sn_row = 0; /* Number of rows in 'signal_to_noise'
5298  actually used */
5299 
5300  int bins_extracted = 0;
5301  int cold_pixels = 0; /* Number of hot/cold pixels in this order */
5302  int hot_pixels = 0;
5303  int warnings = 0; /* Warnings printed so far */
5304 
5305  const double *image_data;
5306  const double *noise_data;
5307  double *weights_data;
5308  cpl_mask *image_bad = NULL;
5309  cpl_binary*image_bpm = NULL;
5310  double *noise_buffer = NULL; /* For efficiency. To avoid allocating/deallocating
5311  space for each bin */
5312  int order_width;
5313  int spectrum_row = pos->order - pos->minorder + 1;
5314 
5315  int* px=0;
5316  int* py=0;
5317  int row=0;
5318 
5319  /* For efficiency, use direct pointer to pixel buffer,
5320  assume type double, support bad pixels */
5321 
5322  assure( cpl_image_get_type(image) == CPL_TYPE_DOUBLE &&
5323  cpl_image_get_type(image_noise) == CPL_TYPE_DOUBLE, CPL_ERROR_UNSUPPORTED_MODE,
5324  "Input image+noise must have type double. Types are %s + %s",
5325  uves_tostring_cpl_type(cpl_image_get_type(image)),
5326  uves_tostring_cpl_type(cpl_image_get_type(image_noise)));
5327 
5328  image_data = cpl_image_get_data_double_const(image);
5329  noise_data = cpl_image_get_data_double_const(image_noise);
5330  weights_data = cpl_image_get_data_double(weights);
5331 
5332  image_bad = cpl_image_get_bpm(image);
5333 
5334  /* flag blemishes as bad pixels */
5335  if(blemish_mask!=NULL) {
5336  check_nomsg(px=cpl_table_get_data_int(blemish_mask,"X"));
5337  check_nomsg(py=cpl_table_get_data_int(blemish_mask,"Y"));
5338 
5339  for(row=0;row<cpl_table_get_nrow(blemish_mask);row++) {
5340  check_nomsg(cpl_mask_set(image_bad,px[row]+1,py[row]+1,CPL_BINARY_1));
5341  }
5342  }
5343  /* end flag blemishes as bad pixels */
5344 
5345  image_bpm = cpl_mask_get_data(image_bad);
5346 
5347 
5348 
5349  noise_buffer = cpl_malloc(uves_round_double(pos->sg.length + 5)*sizeof(double));
5350 
5351  check( (signal_to_noise = cpl_table_new(pos->nx),
5352  cpl_table_new_column(signal_to_noise, "SN", CPL_TYPE_DOUBLE)),
5353  "Error allocating S/N table");
5354 
5355  check( order_width = opt_get_order_width(pos),
5356  "Error estimating width of order #%d", pos->order);
5357 
5358 
5359  /* First set all pixels in the extracted spectrum as bad,
5360  then mark them as good if/when the flux is calculated */
5361  {
5362  int x;
5363  for (x = 1; x <= pos->nx; x++)
5364  {
5365  cpl_image_reject(spectrum, x, spectrum_row);
5366  /* cpl_image_reject preserves the internal bad pixel map */
5367 
5368  if (spectrum_noise != NULL)
5369  {
5370  cpl_image_reject(spectrum_noise, x, spectrum_row);
5371  }
5372  if (optimal_extract_sky && sky_spectrum != NULL)
5373  {
5374  cpl_image_reject(sky_spectrum , x, spectrum_row);
5375  cpl_image_reject(sky_spectrum_noise, x, spectrum_row);
5376  }
5377  }
5378  }
5379 
5380  for (uves_iterate_set_first(pos,
5381  1, pos->nx,
5382  pos->order, pos->order,
5383  NULL, false);
5384  !uves_iterate_finished(pos);
5385  uves_iterate_increment(pos))
5386  {
5387  double flux = 0, variance = 0; /* Flux and variance of this bin */
5388  double sky_background = 0, sky_background_noise = 0;
5389 
5390  /*
5391  * Determine 'flux' and 'variance' of this bin.
5392  */
5393  int iteration;
5394 
5395  bool found_bad_pixel;
5396  double median_noise;
5397 
5398  double redchisq = 0;
5399 
5400  /* If rejection is asked for, get correction factor for this bin */
5401  if (kappa > 0)
5402  {
5403  redchisq = opt_get_redchisq(profile, pos);
5404  }
5405 
5406  /* Prepare for calls of uves_extract_profile_evaluate() */
5407  uves_extract_profile_set(profile, pos, &warnings);
5408 
5409  /* Pseudocode for optimal extraction of this bin:
5410  *
5411  * reset weights
5412  *
5413  * do
5414  * flux,variance := extract optimal
5415  * (only good pixels w. weight > 0)
5416  * (in first iteration, noise = max(noise, median(noise_i))
5417  *
5418  * reject the worst outlier by setting its weight to -1
5419  *
5420  * until there were no more outliers
5421  *
5422  *
5423  * Note that the first iteration increases the noise level
5424  * of each pixel to the median noise level. Otherwise, outlier
5425  * cold pixels would
5426  * would destroy the first flux estimate because of their very low
5427  * 'photonic' noise (i.e. they would have very large weight when their
5428  * uncertainties are taken into account). With the scheme above,
5429  * such a dead pixel will be rejected in the first iteration, and it is
5430  * safe to continue with optimal extractions until convergence.
5431  *
5432  */
5433 
5434  /*
5435  * Clear previously detected cosmic rays.
5436  */
5437  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
5438  {
5439  if (DATA(image_bpm, pos) == CPL_BINARY_1)
5440  {
5441  DATA(weights_data, pos) = -1.0;
5442  }
5443  else
5444  {
5445  DATA(weights_data, pos) = 0.0;
5446  }
5447  }
5448 
5449  /* Get median noise level (of all object + sky bins) */
5450  median_noise = opt_get_noise_median(noise_data, image_bpm,
5451  pos, noise_buffer);
5452 
5453  /* Extract optimally,
5454  reject outliers ... while found_bad_pixel (but at least twice) */
5455  found_bad_pixel = false;
5456 
5457  for (iteration = 0; iteration < 2 || found_bad_pixel; iteration++)
5458  {
5459  /* Get (flux,variance). In first iteration
5460  raise every noise value to median.
5461  */
5462  flux = opt_get_flux_sky_variance(image_data, noise_data,
5463  weights_data,
5464  pos,
5465  profile,
5466  optimal_extract_sky,
5467  (iteration == 0) ?
5468  median_noise : -1,
5469  &variance,
5470  &sky_background,
5471  &sky_background_noise);
5472 
5473  /* If requested, find max outlier among remaining good pixels */
5474  if (kappa > 0)
5475  {
5476  check( found_bad_pixel =
5477  opt_reject_outlier(image_data,
5478  noise_data,
5479  image_bpm,
5480  weights_data,
5481  pos,
5482  profile,
5483  kappa,
5484  flux,
5485  optimal_extract_sky ? sky_background : 0,
5486  redchisq,
5487  cosmic_mask,
5488  cr_row,
5489  &hot_pixels,
5490  &cold_pixels),
5491  "Error rejecting outlier pixel");
5492 
5493  }
5494  else
5495  {
5496  found_bad_pixel = false;
5497  }
5498 
5499  } /* while there was an outlier or iteration < 2 */
5500  //uves_msg("AMO crh tab size=%d",cpl_table_get_nrow(cosmic_mask));
5501  /* Update profile table */
5502  if (profile_table != NULL) {
5503  double lin_flux = 0; /* Linearly extracted flux */
5504  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
5505  /* If pixel is not rejected */
5506  if (DATA(weights_data, pos) > 0)
5507  {
5508  double pixelval = DATA(image_data, pos);
5509  lin_flux += pixelval;
5510  }
5511  }
5512 
5513  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
5514  /* If pixel is not rejected */
5515  if (DATA(weights_data, pos) > 0)
5516  {
5517  double dy = pos->y - pos->ycenter;
5518  double pixelval = DATA(image_data, pos);
5519 
5520  check_nomsg(
5521  (cpl_table_set_int (profile_table, "Order" ,
5522  *prof_row, pos->order),
5523  cpl_table_set_int (profile_table, "X" ,
5524  *prof_row, pos->x),
5525  cpl_table_set_double(profile_table, "DY" ,
5526  *prof_row, dy),
5527  cpl_table_set_double(profile_table, "Profile_raw",
5528  *prof_row, pixelval/lin_flux),
5529  cpl_table_set_double(profile_table, "Profile_int",
5530  *prof_row,
5531  uves_extract_profile_evaluate(profile, pos))));
5532  (*prof_row)++;
5533  }
5534  }
5535  }
5536 
5537  bins_extracted += 1;
5538 
5539  /* Don't do the following!! It changes the internal bpm with a low probability.
5540  That's bad because we already got a pointer to that so next time
5541  we follow that pointer the object might not exist. This is true
5542  for CPL3.0, it should be really be fixed in later versions.
5543 
5544  cpl_image_set(spectrum, pos->x, spectrum_row, flux);
5545 
5546  We don't have a pointer 'spectrum_noise', so calling cpl_image_set
5547  on that one is safe.
5548  */
5549  SPECTRUM_DATA(cpl_image_get_data_double(spectrum), pos) = flux;
5550  SPECTRUM_DATA(cpl_mask_get_data(cpl_image_get_bpm(spectrum)), pos)
5551  = CPL_BINARY_0;
5552  /* The overhead of these function calls is negligible */
5553 
5554  if (spectrum_noise != NULL)
5555  {
5556  cpl_image_set(spectrum_noise, pos->x, spectrum_row, sqrt(variance));
5557  }
5558 
5559 
5560  /* Save sky (if extracted again) */
5561  if (optimal_extract_sky)
5562  {
5563  /* Change normalization of sky from 1 pixel to full slit,
5564  (i.e. same normalization as the extracted object)
5565 
5566  Error propagation is trivial (just multiply
5567  by same factor) because the
5568  uncertainty of 'slit_length' is negligible.
5569  */
5570 
5571  cpl_image_set(sky_spectrum , pos->x, spectrum_row,
5572  pos->sg.length * sky_background);
5573  cpl_image_set(sky_spectrum_noise, pos->x, spectrum_row,
5574  pos->sg.length * sky_background_noise);
5575  }
5576 
5577  /* Update S/N. Use only central 10% (max of blaze function)
5578  * to calculate S/N.
5579  * If order is partially without image, use all bins in order.
5580  */
5581  if (order_width < pos->nx ||
5582  (0.45*pos->nx <= pos->x && pos->x <= 0.55*pos->nx)
5583  )
5584  {
5585  cpl_table_set_double(
5586  signal_to_noise, "SN", sn_row, flux / sqrt(variance));
5587  sn_row++;
5588  }
5589 
5590  } /* for each x... */
5591  uves_msg_debug("%d/%d hot/cold pixels rejected", hot_pixels, cold_pixels);
5592 
5593  /* Return S/N */
5594  check_nomsg( cpl_table_set_size(signal_to_noise, sn_row) );
5595  if (sn_row > 0)
5596  {
5597  check_nomsg( *sn = cpl_table_get_column_median(signal_to_noise, "SN"));
5598  }
5599  else
5600  {
5601  *sn = 0;
5602  }
5603 
5604  cleanup:
5605  uves_free_table(&signal_to_noise);
5606  cpl_free(noise_buffer);
5607 
5608  return bins_extracted;
5609 }
5610 
5611 /*----------------------------------------------------------------------------*/
5634 /*----------------------------------------------------------------------------*/
5635 static double
5636 opt_get_sky(const double *image_data,
5637  const double *noise_data,
5638  const double *weights_data,
5639  uves_iterate_position *pos,
5640  const cpl_table *sky_map,
5641  double buffer_flux[], double buffer_noise[],
5642  double *sky_background_noise)
5643 {
5644  double sky_background;
5645  bool found_good = false; /* Any good pixels in current bin? */
5646  double flux_max = 0; /* Of all pixels in current bin */
5647  double flux_min = 0;
5648  int ngood = 0; /* Number of elements in arrays (good sky pixels) */
5649 
5650  /* Get image data (sky pixels that are also good pixels) */
5651  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
5652  {
5653  int row = pos->y - pos->ylow;
5654 
5655  if (!ISBAD(weights_data, pos))
5656  {
5657  double fflux = DATA(image_data, pos);
5658  double noise = DATA(noise_data, pos);
5659 
5660  if (!found_good)
5661  {
5662  found_good = true;
5663  flux_max = fflux;
5664  flux_min = fflux;
5665  }
5666  else
5667  {
5668  flux_max = uves_max_double(flux_max, fflux);
5669  flux_min = uves_min_double(flux_min, fflux);
5670  }
5671 
5672  /*if (pos->order == 1 && pos->x == 2825)
5673  {
5674  uves_msg_error("%d: %f +- %f%s", pos->y, fflux, noise,
5675  cpl_table_is_selected(sky_map, row) ? " *" : "");
5676  }
5677  */
5678 
5679  if (cpl_table_is_selected(sky_map, row))
5680  {
5681  buffer_flux [ngood] = fflux;
5682  buffer_noise[ngood] = noise;
5683  ngood++;
5684  }
5685  }
5686  }
5687 
5688  /* Get median of valid rows */
5689  if (ngood > 0)
5690  {
5691  /* Get noise of one sky pixel (assumed constant for all sky pixels) */
5692  double avg_noise = uves_tools_get_median(buffer_noise, ngood);
5693 
5694  sky_background = uves_tools_get_median(buffer_flux, ngood);
5695 
5696  /* If only 1 valid sky pixel */
5697  if (ngood == 1)
5698  {
5699  *sky_background_noise = avg_noise;
5700  }
5701  else
5702  {
5703  /* 2 or more sky pixels.
5704  *
5705  * Uncertainty of median is (approximately)
5706  *
5707  * sigma_median = sigma / sqrt(N * 2/pi) ; N >= 2
5708  *
5709  * where sigma is the (constant) noise of each pixel
5710  */
5711  *sky_background_noise = avg_noise / sqrt(ngood * 2 / M_PI);
5712  }
5713  }
5714  else
5715  /* No sky pixels, set noise as max - min */
5716  {
5717  if (found_good)
5718  {
5719  sky_background = flux_min;
5720  *sky_background_noise = flux_max - flux_min;
5721 
5722  /* In the rare case where max==min, set noise to
5723  something that's not zero */
5724  if (*sky_background_noise <= 0) *sky_background_noise = 1;
5725  }
5726  else
5727  /* No good pixels in bin */
5728  {
5729  sky_background = 0;
5730  *sky_background_noise = 1;
5731  }
5732  }
5733 
5734  /* if (pos->order == 1 && pos->x == 2825) uves_msg_error("sky = %f", sky_background); */
5735  return sky_background;
5736 
5737 }
5738 
5739 
5740 /*----------------------------------------------------------------------------*/
5750 /*----------------------------------------------------------------------------*/
5751 static double
5752 opt_get_noise_median(const double *noise_data, const cpl_binary *image_bpm,
5753  uves_iterate_position *pos, double noise_buffer[])
5754 {
5755  double median_noise; /* Result */
5756  int ngood; /* Number of good pixels */
5757 
5758  ngood = 0;
5759  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
5760  {
5761  if (ISGOOD(image_bpm, pos))
5762  {
5763  noise_buffer[ngood] = DATA(noise_data, pos);
5764  ngood++;
5765  }
5766  }
5767 
5768  if (ngood >= 1)
5769  {
5770  median_noise = uves_tools_get_median(noise_buffer, ngood);
5771  }
5772  else
5773  {
5774  median_noise = 1;
5775  }
5776 
5777  return median_noise;
5778 }
5779 
5780 /*----------------------------------------------------------------------------*/
5853 /*----------------------------------------------------------------------------*/
5854 
5855 static double
5856 opt_get_flux_sky_variance(const double *image_data, const double *noise_data,
5857  double *weights_data,
5858  uves_iterate_position *pos,
5859  const uves_extract_profile *profile,
5860  bool optimal_extract_sky,
5861  double median_noise,
5862  double *variance,
5863  double *sky_background,
5864  double *sky_background_noise)
5865 {
5866  double flux; /* Result */
5867  double sumpfv = 0; /* Sum of profile*flux / variance */
5868  double sumppv = 0; /* Sum of profile^2/variance */
5869  double sum1v = 0; /* Sum of 1 / variance */
5870  double sumpv = 0; /* Sum of profile / variance */
5871  double sumfv = 0; /* Sum of flux / variance */
5872 
5873  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
5874  {
5875  /* If pixel is not rejected, set weight and accumulate */
5876  if (!ISBAD(weights_data, pos))
5877  {
5878  double pixel_variance, pixelval, weight;
5879  double prof = uves_extract_profile_evaluate(profile, pos); /* is positive */
5880 
5881  pixelval = DATA(image_data, pos);
5882  pixel_variance = DATA(noise_data, pos);
5883  pixel_variance *= pixel_variance;
5884 
5885  if (median_noise >= 0 && pixel_variance < median_noise*median_noise)
5886  {
5887  /* Increase noise to median (otherwise, 'dead' pixels
5888  that aren't yet rejected will get too much weight) */
5889  pixel_variance = median_noise*median_noise;
5890  }
5891 
5892  weight = prof / pixel_variance;
5893  DATA(weights_data, pos) = weight;
5894  /* Assuming Horne's traditional formula
5895  which is a good approximation
5896  */
5897 
5898  sumpfv += pixelval * weight;
5899  sumppv += prof * weight;
5900  if (optimal_extract_sky)
5901  /* Optimization. Don't calculate if not needed. */
5902  {
5903  sumpv += weight;
5904  sum1v += 1 / pixel_variance;
5905  sumfv += pixelval / pixel_variance;
5906  }
5907  }
5908 
5909  /*
5910  if (pos->order == 1 && pos->x == 2825){
5911  if (ISBAD(weights_data, pos))
5912  uves_msg_error("%d: *", pos->y);
5913  else
5914  uves_msg_error("%d: %f +- %f", pos->y, DATA(image_data, pos), DATA(noise_data, pos));
5915  }
5916  */
5917 
5918  }
5919 
5920  if (!optimal_extract_sky)
5921  {
5922  /* Horne's traditional formulas */
5923  if (sumppv > 0 && !irplib_isnan(sumppv) && !irplib_isinf(sumppv))
5924  {
5925  flux = sumpfv / sumppv;
5926  *variance = 1 / sumppv;
5927  }
5928  else
5929  {
5930  flux = 0;
5931  *variance = 1;
5932  }
5933  }
5934  else
5935  {
5936  /* Generalization of Horne explained above */
5937  long double denominator = (long double)sum1v*sumppv - (long double)sumpv*sumpv;
5938 /* to fix a problem on 64 bit due to the fact denominator can be very small, we cast iit to long double and then compare it abs value with a small number, like DBL_MIN */
5939  if (fabsl(denominator) > DBL_MIN)
5940  {
5941  flux = ((long double)sum1v * sumpfv - (long double)sumpv * sumfv) / denominator;
5942 /*
5943  if(flux > 1.e40 || flux < -1.e40) {
5944  uves_msg_warning("Very large optimally extracted flux=%g sum1v=%g sumpfv=%g sumpv=%g sumfv=%g denominator=%lg",flux,sum1v,sumpfv,sumpv,sumfv,denominator);
5945  }
5946 */
5947  /* Traditional formula, underestimates the error bars
5948  and results in a (false) higher S/N
5949  *variance = 1 / sumppv;
5950  */
5951 
5952  /* Formula which takes into account the uncertainty
5953  of the sky subtraction: */
5954  *variance = (long double)sum1v / denominator;
5955 
5956  *sky_background = (sumppv*sumfv - sumpv*sumpfv) / denominator;
5957  *sky_background_noise = sqrt(sumppv / denominator);
5958  }
5959  else
5960  {
5961  flux = 0;
5962  *variance = 1;
5963 
5964  *sky_background = 0;
5965  *sky_background_noise = 1;
5966  }
5967  }
5968 
5969  /*
5970  if (pos->order == 1 && pos->x == 2825)
5971  {if (sky_background)
5972  uves_msg_error("sky = %f", *sky_background);
5973  }
5974  */
5975 
5976  return flux;
5977 }
5978 
5979 
5980 /*---------------------------------------------------------------------------*/
6005 /*---------------------------------------------------------------------------*/
6006 static bool
6007 opt_reject_outlier(const double *image_data,
6008  const double *noise_data,
6009  cpl_binary *image_bpm,
6010  double *weights_data,
6011  uves_iterate_position *pos,
6012  const uves_extract_profile *profile,
6013  double kappa,
6014  double flux,
6015  double sky_background,
6016  double red_chisq,
6017  cpl_table *cosmic_mask,
6018  int *cr_row,
6019  int *hot_pixels,
6020  int *cold_pixels)
6021 {
6022  bool found_outlier = false; /* Result */
6023 
6024  int y_outlier = -1; /* Position of worst outlier */
6025  double max_residual_sq = 0; /* Residual^2/sigma^2 of
6026  worst outlier */
6027  bool outlier_is_hot = false; /* true iff residual is positive */
6028  int new_crh_tab_size=0;
6029  int crh_tab_size=0;
6030 
6031  /* Find worst outlier */
6032  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
6033  {
6034  double prof = uves_extract_profile_evaluate(profile, pos);
6035  double pixel_variance, pixelval;
6036  double best_fit;
6037 
6038  pixel_variance = DATA(noise_data, pos);
6039  pixel_variance *= pixel_variance;
6040 
6041  pixelval = DATA(image_data, pos);
6042 
6043  best_fit = flux * prof + sky_background;/* This part used to be a stupid
6044  bug: the sky contribution was
6045  forgotten
6046  -> most pixels were outliers
6047  This bug was in the MIDAS
6048  version and independently
6049  reimplemented in
6050  first CPL versions(!)
6051  */
6052 
6053  if (!ISBAD(weights_data, pos) &&
6054  /* for efficiency, don't:
6055  fabs(pixelval - flux * prof) / sigma >= sqrt(max_residual_sq)
6056  */
6057  (pixelval - best_fit)*(pixelval - best_fit) / pixel_variance
6058  >= max_residual_sq)
6059  {
6060  max_residual_sq =
6061  (pixelval - best_fit) *
6062  (pixelval - best_fit) / pixel_variance;
6063 
6064  y_outlier = pos->y;
6065 
6066  outlier_is_hot = (pixelval > best_fit);
6067  }
6068  }
6069 
6070  /* Reject outlier
6071  if residual is larger than kappa sigma sqrt(red_chisq), i.e.
6072  if res^2/sigma^2 > kappa^2 * chi^2/N
6073  */
6074  if (max_residual_sq > kappa*kappa * red_chisq)
6075  {
6076  uves_msg_debug("Order #%d: Bad pixel at (x, y) = (%d, %d) residual^2 = %.2f sigma^2",
6077  pos->order, pos->x, y_outlier, max_residual_sq);
6078 
6079  pos->y = y_outlier;
6080  SETBAD(weights_data, image_bpm, pos);
6081 
6082  found_outlier = true;
6083  if (outlier_is_hot)
6084  {
6085  *hot_pixels += 1;
6086 
6087  /* Update cosmic ray table. If it is too short, double the size */
6088  crh_tab_size=cpl_table_get_nrow(cosmic_mask);
6089  while (*cr_row >= crh_tab_size )
6090  {
6091  new_crh_tab_size=( *cr_row > 2*crh_tab_size) ? (*cr_row)+10: 2*crh_tab_size;
6092  cpl_table_set_size(cosmic_mask,new_crh_tab_size );
6093  crh_tab_size=cpl_table_get_nrow(cosmic_mask);
6094  }
6095 
6096  check(( cpl_table_set_int (cosmic_mask, "Order", *cr_row, pos->order),
6097  cpl_table_set_int (cosmic_mask, "X" , *cr_row, pos->x),
6098  cpl_table_set_int (cosmic_mask, "Y" , *cr_row, y_outlier),
6099  cpl_table_set_double(cosmic_mask, "Flux" , *cr_row,
6100  DATA(image_data, pos)),
6101  (*cr_row)++),
6102  "Error updating cosmic ray table");
6103  }
6104  else
6105  {
6106  *cold_pixels += 1;
6107  }
6108  }
6109 
6110 
6111  cleanup:
6112  return found_outlier;
6113 }
6114 
6115 /*----------------------------------------------------------------------------*/
6125 /*----------------------------------------------------------------------------*/
6126 static double
6127 opt_get_redchisq(const uves_extract_profile *profile,
6128  const uves_iterate_position *pos)
6129 {
6130  if (profile->constant) {
6131  return 1.0;
6132  }
6133  if (profile->f != NULL)
6134  {
6135  return uves_max_double(1,
6136 #if ORDER_PER_ORDER
6138  profile->red_chisq[pos->order-pos->minorder], pos->x));
6139 #else
6141  profile->red_chisq, pos->x, pos->order));
6142 #endif
6143  }
6144  else
6145  {
6146  /* Virtual resampling, don't adjust kappa */
6147  return 1.0;
6148  }
6149 }
6150 
6151 /*----------------------------------------------------------------------------*/
6171 /*----------------------------------------------------------------------------*/
6172 static polynomial *
6173 repeat_orderdef(const cpl_image *image, const cpl_image *image_noise,
6174  const polynomial *guess_locations,
6175  int minorder, int maxorder, slit_geometry sg,
6176  cpl_table *info_tbl)
6177 {
6178  polynomial *order_locations = NULL;
6179  int nx = cpl_image_get_size_x(image);
6180  int ny = cpl_image_get_size_y(image);
6181  double max_shift = sg.length/2; /* pixels in y-direction */
6182  int stepx = 10;
6183  int x, order;
6184  int ordertab_row; /* First unused row of ordertab */
6185  cpl_table *ordertab = NULL;
6186  cpl_table *temp = NULL;
6187 
6188  ordertab = cpl_table_new((maxorder - minorder + 1)*nx);
6189  ordertab_row = 0;
6190  cpl_table_new_column(ordertab, "X" , CPL_TYPE_INT);
6191  cpl_table_new_column(ordertab, "Order", CPL_TYPE_INT);
6192  cpl_table_new_column(ordertab, "Y" , CPL_TYPE_DOUBLE);
6193  cpl_table_new_column(ordertab, "Yold" , CPL_TYPE_DOUBLE);
6194  cpl_table_new_column(ordertab, "Sigma", CPL_TYPE_DOUBLE);
6195  cpl_table_set_column_unit(ordertab, "Y", "pixels");
6196 
6197  /* Measure */
6198  for (order = minorder; order <= maxorder; order++) {
6199  for (x = 1 + stepx/2; x <= nx; x += stepx) {
6200  double ycenter;
6201  int yhigh, ylow;
6202 
6203  double y_0, sigma, norm, background;
6204  check( ycenter = uves_polynomial_evaluate_2d(guess_locations, x, order),
6205  "Error evaluating polynomial");
6206 
6207  ylow = uves_round_double(ycenter - max_shift);
6208  yhigh = uves_round_double(ycenter + max_shift);
6209 
6210  if (1 <= ylow && yhigh <= ny) {
6211  uves_fit_1d_image(image, image_noise, NULL,
6212  false, /* Horizontal? */
6213  false, false, /* Fix/fit background? */
6214  ylow, yhigh, x, /* yrange, x */
6215  &y_0, &sigma, &norm, &background, NULL,
6216  NULL, NULL, NULL, /* mse, chi^2/N, covariance */
6218 
6219  if (cpl_error_get_code() == CPL_ERROR_CONTINUE) {
6220  uves_error_reset();
6221  uves_msg_debug("Profile fitting failed "
6222  "at (x,y) = (%d, %e), ignoring bin",
6223  x, ycenter);
6224  }
6225  else {
6226  assure(cpl_error_get_code() == CPL_ERROR_NONE,
6227  cpl_error_get_code(), "Gaussian fitting failed");
6228 
6229  cpl_table_set_int (ordertab, "X" , ordertab_row, x);
6230  cpl_table_set_int (ordertab, "Order" , ordertab_row, order);
6231  cpl_table_set_double(ordertab, "Y" , ordertab_row, y_0);
6232  cpl_table_set_double(ordertab, "Yold" , ordertab_row, ycenter);
6233  cpl_table_set_double(ordertab, "Sigma" , ordertab_row, sigma);
6234  ordertab_row += 1;
6235  }
6236  }
6237  }
6238  }
6239 
6240  cpl_table_set_size(ordertab, ordertab_row);
6241 
6242  /* Fit */
6243  if (ordertab_row < 300)
6244  {
6245  uves_msg_warning("Too few points (%d) to reliably fit order polynomial. "
6246  "Using calibration solution", ordertab_row);
6247 
6248  uves_polynomial_delete(&order_locations);
6249  order_locations = uves_polynomial_duplicate(guess_locations);
6250 
6251  cpl_table_duplicate_column(ordertab, "Yfit", ordertab, "Yold");
6252  }
6253  else
6254  {
6255  int max_degree = 10;
6256  double kappa = 4.0;
6257  double min_rms = 0.05; /* Pixels (stop at this point, for efficiency) */
6258 
6259  order_locations =
6261  "X", "Order", "Y", NULL,
6262  "Yfit", NULL, NULL,
6263  NULL, NULL, NULL,
6264  kappa,
6265  max_degree, max_degree, min_rms, -1,
6266  true,
6267  NULL, NULL, -1, NULL);
6268 
6269  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
6270  {
6271  uves_error_reset();
6272  uves_msg_warning("Could not fit new order polynomial. "
6273  "Using calibration solution");
6274 
6275  uves_polynomial_delete(&order_locations);
6276  order_locations = uves_polynomial_duplicate(guess_locations);
6277 
6278  cpl_table_duplicate_column(ordertab, "Yfit", ordertab, "Yold");
6279 
6280  /* Compute shift, also in this case */
6281  }
6282  else
6283  {
6284  assure( cpl_error_get_code() == CPL_ERROR_NONE,
6285  cpl_error_get_code(),
6286  "Error fitting orders polynomial");
6287  }
6288  }
6289 
6290  /* Yshift := Yfit - Yold */
6291  cpl_table_duplicate_column(ordertab, "Yshift", ordertab, "Yfit"); /* Yshift := Yfit */
6292  cpl_table_subtract_columns(ordertab, "Yshift", "Yold"); /* Yshift := Yshift - Yold */
6293 
6294  {
6295  double mean = cpl_table_get_column_mean(ordertab, "Yshift");
6296  double stdev = cpl_table_get_column_mean(ordertab, "Yshift");
6297  double rms = sqrt(mean*mean + stdev*stdev);
6298 
6299  uves_msg("Average shift with respect to calibration solution is %.2f pixels", rms);
6300  }
6301 
6302  /* Compute object postion+FWHM wrt old solution (for QC) */
6303  for (order = minorder; order <= maxorder; order++)
6304  {
6305  double pos =
6306  uves_polynomial_evaluate_2d(order_locations, nx/2, order)-
6307  uves_polynomial_evaluate_2d(guess_locations, nx/2, order);
6308 
6309  double fwhm;
6310 
6311 
6312  /* Extract rows with "Order" equal to current order,
6313  but avoid == comparison of floating point values */
6314  uves_free_table(&temp);
6315  temp = uves_extract_table_rows(ordertab, "Order",
6316  CPL_EQUAL_TO,
6317  order); /* Last argument is double, will
6318  be rounded to nearest integer */
6319 
6320  if (cpl_table_get_nrow(temp) < 1)
6321  {
6322  uves_msg_warning("Problem tracing object in order %d. "
6323  "Setting QC FHWM parameter to zero",
6324  order);
6325  fwhm = 0;
6326  }
6327  else
6328  {
6329  fwhm = cpl_table_get_column_median(temp, "Sigma") * TWOSQRT2LN2;
6330  }
6331 
6332 
6333  cpl_table_set_int (info_tbl, "Order", order - minorder, order);
6334  cpl_table_set_double(info_tbl, "ObjPosOnSlit" , order - minorder,
6335  pos - (-sg.length/2 + sg.offset));
6336  cpl_table_set_double(info_tbl, "ObjFwhmAvg" , order - minorder, fwhm);
6337  }
6338 
6339  cleanup:
6340  uves_free_table(&ordertab);
6341  uves_free_table(&temp);
6342 
6343  return order_locations;
6344 }
6345