uves_extract.c

00001 /*                                                                              *
00002  *   This file is part of the ESO UVES Pipeline                                 *
00003  *   Copyright (C) 2004,2005 European Southern Observatory                      *
00004  *                                                                              *
00005  *   This library is free software; you can redistribute it and/or modify       *
00006  *   it under the terms of the GNU General Public License as published by       *
00007  *   the Free Software Foundation; either version 2 of the License, or          *
00008  *   (at your option) any later version.                                        *
00009  *                                                                              *
00010  *   This program is distributed in the hope that it will be useful,            *
00011  *   but WITHOUT ANY WARRANTY; without even the implied warranty of             *
00012  *   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the              *
00013  *   GNU General Public License for more details.                               *
00014  *                                                                              *
00015  *   You should have received a copy of the GNU General Public License          *
00016  *   along with this program; if not, write to the Free Software                *
00017  *   Foundation, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA       *
00018  *                                                                              */
00019 
00020 /*
00021  * $Author: amodigli $
00022  * $Date: 2007/12/03 16:30:19 $
00023  * $Revision: 1.160 $
00024  * $Name: uves-3_9_0 $
00025  * $Log: uves_extract.c,v $
00026  * Revision 1.160  2007/12/03 16:30:19  amodigli
00027  * fixed typo in uves_propertylist_copy_property_regexp usage
00028  *
00029  * Revision 1.159  2007/12/03 07:59:37  amodigli
00030  * use uves_propertylist_copy_property_regexp to copy some HIERARCH keys to 'debug' product
00031  *
00032  * Revision 1.158  2007/08/30 07:56:54  amodigli
00033  * fixed some doxygen warnings
00034  *
00035  * Revision 1.157  2007/08/21 13:08:26  jmlarsen
00036  * Removed irplib_access module, largely deprecated by CPL-4
00037  *
00038  * Revision 1.156  2007/07/23 12:52:13  jmlarsen
00039  * Make work also with CPL3
00040  *
00041  * Revision 1.155  2007/07/19 09:55:01  jmlarsen
00042  * Renamed cpl_vector_get_median -> cpl_vector_get_median_const
00043  *
00044  * Revision 1.154  2007/06/22 09:28:42  jmlarsen
00045  * Changed interface of uves_save_image
00046  *
00047  * Revision 1.153  2007/06/06 08:17:33  amodigli
00048  * replace tab with 4 spaces
00049  *
00050  * Revision 1.152  2007/05/25 12:17:17  jmlarsen
00051  * Bugfix in readdition of ORDER_TRACE
00052  *
00053  * Revision 1.151  2007/05/25 11:50:32  jmlarsen
00054  * Re-added ORDER_TRACE_TABLE
00055  *
00056  * Revision 1.150  2007/05/22 14:09:56  amodigli
00057  * removed compilation warnings
00058  *
00059  * Revision 1.149  2007/05/22 11:32:38  jmlarsen
00060  * Removed MIDAS flag for good
00061  *
00062  * Revision 1.148  2007/05/16 13:40:02  amodigli
00063  * To prevent that objpos=flux_y / flux_tot is nan when flux_tot=0 we arbitrary set objpos=-1
00064  *
00065  * Revision 1.147  2007/05/14 13:51:04  jmlarsen
00066  * Include sky contribution in spectrum error bars
00067  *
00068  * Revision 1.146  2007/05/09 14:45:38  jmlarsen
00069  * Added debug message
00070  *
00071  * Revision 1.145  2007/05/03 15:20:46  jmlarsen
00072  * Fixed object offset QC for virtual method, non-zero slit offset
00073  *
00074  * Revision 1.144  2007/05/02 16:47:40  jmlarsen
00075  * Use also sky spectrum for reconstructed image
00076  *
00077  * Revision 1.143  2007/05/02 15:13:26  jmlarsen
00078  * Fixed introduced bug which caused slightly worse object tracing for analytical methods
00079  *
00080  * Revision 1.142  2007/05/02 13:16:59  jmlarsen
00081  * Added 'constant' profile method for arclamp spectra
00082  *
00083  * Revision 1.141  2007/04/26 06:55:35  amodigli
00084  * fixed mem leak adding uves_free_image(&spectrum_order)
00085  *
00086  * Revision 1.140  2007/04/24 12:50:29  jmlarsen
00087  * Replaced cpl_propertylist -> uves_propertylist which is much faster
00088  *
00089  * Revision 1.139  2007/04/24 09:40:37  jmlarsen
00090  * Removed deprecated irplib_string_concatenate_all
00091  *
00092  * Revision 1.138  2007/04/20 14:44:20  jmlarsen
00093  * Implemented QC parameter to measure small scale ripples
00094  *
00095  * Revision 1.137  2007/04/12 12:00:35  jmlarsen
00096  * Added testing code
00097  *
00098  * Revision 1.136  2007/04/10 11:34:14  jmlarsen
00099  * Removed debug message
00100  *
00101  * Revision 1.135  2007/04/10 08:05:49  jmlarsen
00102  * Disabled optimization (reduced kappa-sigma iterations, caught by unit test)
00103  *
00104  * Revision 1.134  2007/04/10 07:23:20  jmlarsen
00105  * Added commented out code to spline interpolate virtually resampled profile
00106  *
00107  * Revision 1.133  2007/03/28 11:38:38  jmlarsen
00108  * Removed dead code
00109  *
00110  * Revision 1.132  2007/03/19 15:12:14  jmlarsen
00111  * Optimization: use doubles rather than zero deg. poly.
00112  *
00113  * Revision 1.131  2007/03/19 13:50:18  jmlarsen
00114  * Fixed serious bug happening when object is at +-15 pixels
00115  *
00116  * Revision 1.130  2007/03/15 12:33:37  jmlarsen
00117  * Minor message change
00118  *
00119  * Revision 1.129  2007/03/13 15:33:30  jmlarsen
00120  * Use autodegree polynomials for virtual profile, not zero degree
00121  *
00122  * Revision 1.128  2007/03/05 10:16:37  jmlarsen
00123  * Support slope parameter in 1d fitting
00124  *
00125  * Revision 1.127  2007/02/26 13:29:40  jmlarsen
00126  * Don't use Gauss-Legendre 3 point interpolation, for efficiency
00127  *
00128  * Revision 1.126  2007/02/26 11:55:47  jmlarsen
00129  * Renamed and generalized function uves_raise_to_median() -> uves_raise_to_median_frac()
00130  *
00131  * Revision 1.125  2007/02/22 15:33:56  jmlarsen
00132  * Optimization: use double's rather than constant 2d polynomials
00133  *
00134  * Revision 1.124  2007/02/09 13:37:06  jmlarsen
00135  * Added bug in 2d extraction mode
00136  *
00137  * Revision 1.123  2007/02/09 08:14:16  jmlarsen
00138  * Do not use CPL_PIXEL_MAXVAL which works only for integer images
00139  *
00140  * Revision 1.122  2007/02/08 07:33:56  jmlarsen
00141  * Added doc
00142  *
00143  * Revision 1.121  2007/01/31 13:10:33  jmlarsen
00144  * Changed message
00145  *
00146  * Revision 1.120  2007/01/29 12:09:42  jmlarsen
00147  * Compute QC parameters (pos, fwhm, s/n) also for simple extraction
00148  *
00149  * Revision 1.119  2007/01/26 13:49:43  jmlarsen
00150  * Fixed sky subtraction residuals for optimal sky subtraction
00151  *
00152  * Revision 1.118  2007/01/15 08:46:01  jmlarsen
00153  * Made more robust against extended objects
00154  *
00155  * Revision 1.117  2007/01/05 07:22:07  jmlarsen
00156  * Eliminated compiler warnings
00157  *
00158  * Revision 1.116  2007/01/04 13:55:21  jmlarsen
00159  * Implemented order-by-order object tracing (disabled)
00160  *
00161  * Revision 1.115  2006/12/08 07:41:43  jmlarsen
00162  * Minor doc. change
00163  *
00164  * Revision 1.114  2006/11/16 09:48:30  jmlarsen
00165  * Renamed data type position -> uves_iterate_position, for namespace reasons
00166  *
00167  * Revision 1.113  2006/11/15 15:02:14  jmlarsen
00168  * Implemented const safe workarounds for CPL functions
00169  *
00170  * Revision 1.111  2006/11/15 14:04:08  jmlarsen
00171  * Removed non-const version of parameterlist_get_first/last/next which is already
00172  * in CPL, added const-safe wrapper, unwrapper and deallocator functions
00173  *
00174  * Revision 1.110  2006/11/08 14:04:34  jmlarsen
00175  * Implemented flag to select sky subtraction method
00176  *
00177  * Revision 1.109  2006/11/06 15:19:41  jmlarsen
00178  * Removed unused include directives
00179  *
00180  * Revision 1.108  2006/10/31 09:14:58  jmlarsen
00181  * Man page doc fix
00182  *
00183  * Revision 1.107  2006/10/02 08:34:40  jmlarsen
00184  * Do not recompute variance in last iteration
00185  *
00186  * Revision 1.106  2006/09/27 15:08:45  jmlarsen
00187  * Fixed doc. bug
00188  *
00189  * Revision 1.105  2006/09/27 13:08:49  jmlarsen
00190  * Use dynamic memory allocation to store bad pixels
00191  *
00192  * Revision 1.104  2006/09/20 12:53:57  jmlarsen
00193  * Replaced stringcat functions with uves_sprintf()
00194  *
00195  * Revision 1.103  2006/09/20 07:25:30  jmlarsen
00196  * Doc. bug fix
00197  *
00198  * Revision 1.102  2006/09/19 14:29:05  jmlarsen
00199  * Measure object position QC parameter from bottom of slit
00200  *
00201  * Revision 1.101  2006/09/19 07:15:35  jmlarsen
00202  * Added chip to argument list of uves_extract()
00203  *
00204  * Revision 1.100  2006/09/11 14:19:28  jmlarsen
00205  * Updated documentation
00206  *
00207  * Revision 1.99  2006/09/11 13:57:46  jmlarsen
00208  * Remove usage of cpl_image_set after getting bpm pointer
00209  *
00210  * Revision 1.98  2006/09/08 14:02:34  jmlarsen
00211  * Simplified code by using iterators, sky subtraction much optimized
00212  *
00213  * Revision 1.97  2006/09/06 15:35:51  jmlarsen
00214  * Changed indentations
00215  *
00216  * Revision 1.96  2006/09/06 14:50:23  jmlarsen
00217  * Worked on code to globally measure spatial profile
00218  *
00219  * Revision 1.95  2006/09/01 13:56:46  jmlarsen
00220  * Added commented out code (alternative way of measuring spatial profile)
00221  *
00222  * Revision 1.94  2006/08/23 15:08:56  jmlarsen
00223  * Improved plot of spatial profile
00224  *
00225  * Revision 1.93  2006/08/23 09:33:03  jmlarsen
00226  * Renamed local variables shadowing POSIX reserved names
00227  *
00228  * Revision 1.92  2006/08/22 15:35:48  jmlarsen
00229  * Auto-select profile method based on S/N estimate
00230  *
00231  * Revision 1.91  2006/08/22 14:20:56  jmlarsen
00232  * Implemented simultaneous optimal extraction of obj+sky
00233  *
00234  * Revision 1.90  2006/08/17 14:40:06  jmlarsen
00235  * Added missing documentation
00236  *
00237  * Revision 1.89  2006/08/17 14:11:25  jmlarsen
00238  * Use assure_mem macro to check for memory allocation failure
00239  *
00240  * Revision 1.88  2006/08/17 13:59:11  jmlarsen
00241  * Removed CPL2 const bug workaround
00242  *
00243  * Revision 1.87  2006/08/17 13:56:52  jmlarsen
00244  * Reduced max line length
00245  *
00246  * Revision 1.86  2006/08/17 09:17:42  jmlarsen
00247  * Removed CPL2 code
00248  *
00249  * Revision 1.85  2006/08/14 12:16:31  jmlarsen
00250  * Moved defines to top of file
00251  *
00252  * Revision 1.84  2006/08/11 14:56:05  amodigli
00253  * removed Doxygen warnings
00254  *
00255  * Revision 1.83  2006/08/11 09:20:06  jmlarsen
00256  * Implemented workaround for slow cpl_image_set
00257  *
00258  * Revision 1.82  2006/08/10 10:49:28  jmlarsen
00259  * Removed workaround for cpl_image_get_bpm
00260  *
00261  * Revision 1.81  2006/08/08 11:02:43  jmlarsen
00262  * Make temporary copy of image bad pixel map
00263  *
00264  * Revision 1.80  2006/08/08 08:19:17  amodigli
00265  * update to CPL3
00266  *
00267  * Revision 1.79  2006/08/07 11:35:35  jmlarsen
00268  * Disabled parameter environment variable mode
00269  *
00270  * Revision 1.78  2006/07/14 12:21:36  jmlarsen
00271  * Take bad pixels into account in sky subtraction
00272  *
00273  * Revision 1.77  2006/07/03 13:01:22  jmlarsen
00274  * Use analytical-fit sky subtraction method to improve S/N, use a
00275  * global model of chi square
00276  *
00277  * Revision 1.76  2006/06/16 08:23:04  jmlarsen
00278  * Added comment
00279  *
00280  * Revision 1.75  2006/06/05 08:51:55  amodigli
00281  * cleaned some warnings from static checks
00282  *
00283  * Revision 1.74  2006/06/02 06:41:59  jmlarsen
00284  * Added missing error code
00285  *
00286  * Revision 1.73  2006/06/01 14:43:17  jmlarsen
00287  * Added missing documentation
00288  *
00289  * Revision 1.72  2006/05/16 12:13:07  amodigli
00290  * added QC log
00291  *
00292  * Revision 1.71  2006/05/15 08:15:52  jmlarsen
00293  * Changed default kappa to 10.0
00294  *
00295  * Revision 1.70  2006/05/15 07:21:50  jmlarsen
00296  * Changed default kappa 3.5 -> 5.0
00297  *
00298  * Revision 1.69  2006/05/12 15:04:09  jmlarsen
00299  * Changed gauss/moffat/virtual profile measuring methods to use
00300  * global polynomials (rather than one polynomial per order)
00301  *
00302  * Revision 1.68  2006/04/24 09:21:18  jmlarsen
00303  * Implemented virtual resampling algorithm
00304  *
00305  * Revision 1.67  2006/04/10 12:36:35  jmlarsen
00306  * Fixed bug that caused extraction to halt if an order is completely 
00307  * outside an image
00308  *
00309  * Revision 1.66  2006/04/07 12:29:21  jmlarsen
00310  * Bugfix: in opt_evaluate_profile
00311  *
00312  * Revision 1.65  2006/04/07 07:10:12  jmlarsen
00313  * Use Gauss-Legendre rather than Simpson for profile integration
00314  *
00315  * Revision 1.64  2006/04/06 11:49:24  jmlarsen
00316  * Minor msg change
00317  *
00318  * Revision 1.63  2006/04/06 08:36:40  jmlarsen
00319  * Re-factored optimal extraction, added loop to measure 
00320  * profile until high statistics is achieved
00321  *
00322  * Revision 1.62  2006/03/24 14:46:39  jmlarsen
00323  * Doc. bugfix
00324  *
00325  * Revision 1.61  2006/03/24 14:17:37  jmlarsen
00326  * Mirror input image before/after extraction
00327  *
00328  * Revision 1.60  2006/03/03 13:54:11  jmlarsen
00329  * Changed syntax of check macro
00330  *
00331  * Revision 1.59  2006/02/28 09:15:22  jmlarsen
00332  * Minor update
00333  *
00334  * Revision 1.58  2006/02/15 13:19:15  jmlarsen
00335  * Reduced source code max. line length
00336  *
00337  * Revision 1.57  2006/01/25 16:13:20  jmlarsen
00338  * Changed interface of gauss.fitting routine
00339  *
00340  * Revision 1.56  2006/01/12 15:41:14  jmlarsen
00341  * Moved gauss. fitting to irplib
00342  *
00343  * Revision 1.55  2005/12/20 16:10:32  jmlarsen
00344  * Added some documentation
00345  *
00346  * Revision 1.54  2005/12/19 16:17:56  jmlarsen
00347  * Replaced bool -> int
00348  *
00349  */
00350 
00351 #ifdef HAVE_CONFIG_H
00352 #  include <config.h>
00353 #endif
00354 
00355 /*----------------------------------------------------------------------------*/
00362 /*----------------------------------------------------------------------------*/
00363 
00364 /*-----------------------------------------------------------------------------
00365                                 Includes
00366  -----------------------------------------------------------------------------*/
00367 
00368 #include <uves_extract.h>
00369 
00370 #include <uves_extract_iterate.h>
00371 #include <uves_extract_profile.h>
00372 #include <uves_parameters.h>
00373 #include <uves_utils.h>
00374 #include <uves_utils_cpl.h>
00375 #include <uves_utils_wrappers.h>
00376 #include <uves_dfs.h>
00377 #include <uves_plot.h>
00378 #include <uves_dump.h>
00379 #include <uves_error.h>
00380 #include <uves.h>
00381 
00382 #include <irplib_plot.h>
00383 #include <irplib_utils.h>
00384 
00385 #include <cpl.h>
00386 
00387 #include <stdbool.h>
00388 
00389 /*-----------------------------------------------------------------------------
00390                             Defines
00391  -----------------------------------------------------------------------------*/
00393 #define DATA(name, pos)      (name[((pos)->x-1)+((pos)->y-1)*(pos)->nx])
00394 
00396 #define SPECTRUM_DATA(name, pos) (name[((pos)->x-1)+((pos)->order-(pos)->minorder)*(pos)->nx])
00397 
00399 #define ISBAD(weights, pos)  (weights[((pos)->x-1)+((pos)->y-1)*(pos)->nx] < 0)
00400 
00402 #define SETBAD(weights, image_bpm, pos)                              \
00403       do {                                                           \
00404        weights  [((pos)->x-1)+((pos)->y-1)*(pos)->nx] = -1.0;        \
00405        image_bpm[((pos)->x-1)+((pos)->y-1)*(pos)->nx] = CPL_BINARY_1;\
00406       }                                             \
00407       while (false)
00408 
00409 #define ISGOOD(bpm, pos) (bpm[((pos)->x-1)+((pos)->y-1)*(pos)->nx] == CPL_BINARY_0)
00410 
00411 /* Enable experimental algorithm that fits profile to all data in all orders
00412    at once */
00413 #define NEW_METHOD 0
00414 
00415 #if NEW_METHOD
00416 #define CREATE_DEBUGGING_TABLE 1
00417 /* else not used */
00418 #endif
00419 
00420 /*-----------------------------------------------------------------------------
00421                             Functions prototypes
00422  -----------------------------------------------------------------------------*/
00425 static int
00426 extract_order_simple(const cpl_image *image, const cpl_image *image_noise,
00427                      const polynomial *order_locations,
00428                      int order, int minorder,
00429              int spectrum_row,
00430                      double offset,
00431                      double slit_length,
00432                      extract_method method,
00433                      const cpl_image *weights,
00434                      bool extract_partial,
00435                      cpl_image *spectrum,
00436                      cpl_image *spectrum_noise,
00437                      cpl_binary*spectrum_badmap,
00438              cpl_table **info_tbl,
00439              double *sn);
00440 
00441 static double area_above_line(int y, double left, double right);
00442 
00443 static cpl_table *opt_define_sky(const cpl_image *image, const cpl_image *weights,
00444                                  uves_iterate_position *pos);
00445 
00446 static cpl_image *opt_extract_sky(const cpl_image *image, const cpl_image *image_noise,
00447                                   const cpl_image *weights,
00448                                   uves_iterate_position *pos,
00449                                   cpl_image *sky_spectrum,
00450                                   cpl_image *sky_spectrum_noise);
00451 
00452 static cpl_image * opt_subtract_sky(
00453     const cpl_image *image, const cpl_image *image_noise,
00454     const cpl_image *weights,
00455     uves_iterate_position *pos,
00456     const cpl_table *sky_map,
00457     cpl_image *sky_spectrum,
00458     cpl_image *sky_spectrum_noise);
00459 
00460 static cpl_table **opt_sample_spatial_profile(
00461     const cpl_image *image, const cpl_image *weights,
00462     uves_iterate_position *pos, 
00463     int chunk,
00464     int sampling_factor,
00465     int *nbins);
00466 
00467 static uves_extract_profile *opt_measure_profile(
00468     const cpl_image *image, const cpl_image *image_noise,
00469     const cpl_image *weights,
00470     uves_iterate_position *pos, 
00471     int chunk, int sampling_factor,
00472     int (*f)   (const double x[], const double a[], double *result),
00473     int (*dfda)(const double x[], const double a[], double result[]),
00474     int M,
00475     const cpl_image *sky_spectrum,
00476     cpl_table *info_tbl,
00477     cpl_table **profile_global);
00478 
00479 static cpl_table *opt_measure_profile_order(
00480     const cpl_image *image, const cpl_image *image_noise,
00481     const cpl_binary *image_bpm,
00482     uves_iterate_position *pos,
00483     int chunk,
00484     int (*f)   (const double x[], const double a[], double *result),
00485     int (*dfda)(const double x[], const double a[], double result[]),
00486     int M,
00487     const cpl_image *sky_spectrum);
00488 
00489 static void
00490 revise_noise(cpl_image *image_noise,
00491          const cpl_binary *image_bpm,
00492          const uves_propertylist *image_header,
00493          uves_iterate_position *pos,
00494          const cpl_image *spectrum, 
00495          const cpl_image *sky_spectrum, 
00496          const uves_extract_profile *profile,
00497          enum uves_chip chip);
00498 
00499 static int
00500 opt_extract(cpl_image *image, const cpl_image *image_noise,
00501             uves_iterate_position *pos,
00502             const uves_extract_profile *profile,
00503         bool optimal_extract_sky,
00504             double kappa,
00505             cpl_table *cosmic_mask, int *cr_row,
00506             cpl_table *profile_table, int *prof_row,
00507             cpl_image *spectrum, cpl_image *spectrum_noise, 
00508             cpl_image *weights,
00509             cpl_image *sky_spectrum,
00510             cpl_image *sky_spectrum_noise,
00511             double *sn);
00512 
00513 static int opt_get_order_width(const uves_iterate_position *pos);
00514 static double
00515 estimate_sn(const cpl_image *image, const cpl_image *image_noise,
00516             uves_iterate_position *pos);
00517 
00518 inline static double opt_get_sky(const double *image_data,
00519                                  const double *noise_data,
00520                                  const double *weights_data,
00521                                  uves_iterate_position *pos,
00522                                  const cpl_table *sky_map,
00523                                  double buffer_flux[], double buffer_noise[],
00524                                  double *sky_background_noise);
00525 
00526 inline static double opt_get_noise_median(const double *noise_data, 
00527                       const cpl_binary *image_bpm,
00528                                           uves_iterate_position *pos,
00529                       double noise_buffer[]);
00530 
00531 inline static double opt_get_flux_sky_variance(const double *image_data, 
00532                            const double *noise_data, 
00533                            double *weights_data,
00534                            uves_iterate_position *pos,
00535                            const uves_extract_profile *profile,
00536                            bool optimal_extract_sky,
00537                            double median_noise,
00538                            double *variance,
00539                            double *sky_background,
00540                            double *sky_background_noise);
00541 
00542 inline static bool opt_reject_outlier(const double *image_data, 
00543                       const double *noise_data,
00544                                       cpl_binary *image_bpm,
00545                                       double *weights_data,
00546                                       uves_iterate_position *pos,
00547                                       const uves_extract_profile *profile,
00548                                       double kappa, 
00549                                       double flux,
00550                       double sky_background,
00551                       double red_chisq,
00552                                       cpl_table *cosmic_mask, int *cr_row,
00553                                       int *hot_pixels, int *cold_pixels);
00554 
00555 static double opt_get_redchisq(const uves_extract_profile *profile,
00556                                const uves_iterate_position *pos);
00557 
00558 static polynomial *repeat_orderdef(const cpl_image *image, const cpl_image *image_noise,
00559                                    const polynomial *guess_locations,
00560                                    int minorder, int maxorder, slit_geometry sg,
00561                    cpl_table *info_tbl);
00562 
00563 static double
00564 detect_ripples(const cpl_image *spectrum, const uves_iterate_position *pos,
00565                double sn);
00566 
00567 /*-----------------------------------------------------------------------------
00568                             Implementation
00569  -----------------------------------------------------------------------------*/
00570 
00571 /*----------------------------------------------------------------------------*/
00579 /*----------------------------------------------------------------------------*/
00580 
00581 cpl_parameterlist *
00582 uves_extract_define_parameters(void)
00583 {
00584     const char *name = "";
00585     char *full_name = NULL;
00586     cpl_parameter *p = NULL;
00587     cpl_parameterlist *parameters = NULL;
00588 
00589     parameters = cpl_parameterlist_new();
00590     
00591     {
00592         name = "method";
00593         full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
00594 
00595         uves_parameter_new_enum(p, full_name,
00596                                 CPL_TYPE_STRING,
00597                                 "Extraction method",
00598                                 UVES_EXTRACT_ID,
00599                                 "optimal",
00600                                 5,
00601                                 "average",
00602                                 "linear",
00603                                 "2d",
00604                                 "weighted",
00605                                 "optimal");
00606         
00607         cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
00608         cpl_parameterlist_append(parameters, p);
00609         cpl_free(full_name);
00610     }
00611 
00612     {
00613         name = "kappa";
00614         full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
00615         
00616         uves_parameter_new_value(p, full_name,
00617                                  CPL_TYPE_DOUBLE,
00618                                  "In optimal extraction mode, this is the "
00619                                  "threshold for bad (i.e. hot/cold) "
00620                                  "pixel rejection. If a pixel deviates more than "
00621                                  "kappa*sigma (where sigma is "
00622                                  "the uncertainty of the pixel flux) from "
00623                                  "the inferred spatial profile, its "
00624                                  "weight is set to zero. If this parameter "
00625                                  "is negative, no rejection is performed.",
00626                                  UVES_EXTRACT_ID,
00627                                  10.0);
00628         
00629         cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
00630         cpl_parameterlist_append(parameters, p);
00631         cpl_free(full_name);
00632     }
00633 
00634     {
00635         name = "chunk";
00636         full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
00637         
00638         uves_parameter_new_range(p, full_name,
00639                                  CPL_TYPE_INT,
00640                                  "In optimal extraction mode, the chunk size (in pixels) "
00641                                  "used for fitting the analytical profile (a fit of the "
00642                                  "analytical profile to single bins would suffer from "
00643                                  "low statistics).",
00644                                  UVES_EXTRACT_ID,
00645                                  32,
00646                                  1, INT_MAX);
00647         
00648         cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
00649         cpl_parameterlist_append(parameters, p);
00650         cpl_free(full_name);
00651     }
00652     
00653     {
00654         name = "profile";
00655         full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
00656         
00657         uves_parameter_new_enum(p, full_name,
00658                                 CPL_TYPE_STRING,
00659                                 "In optimal extraction mode, the kind of profile to use. "
00660                                 "'gauss' gives a Gaussian profile, 'moffat' gives "
00661                                 "a Moffat profile with beta=4 and a possible linear sky "
00662                                 "contribution. 'virtual' uses "
00663                                 "a virtual resampling algorithm (i.e. measures and "
00664                                 "uses the actual object profile). "
00665                                 "'constant' assumes a constant spatial profile and "
00666                                 "allows optimal extraction of wavelength "
00667                                 "calibration frames. 'auto' will automatically "
00668                                 "select the best method based on the estimated S/N of the "
00669                                 "object. For low S/N, 'moffat' or 'gauss' are "
00670                                 "recommended (for robustness). For high S/N, 'virtual' is "
00671                                 "recommended (for accuracy). In the case of virtual resampling, "
00672                                 "a precise determination of the order positions is required; "
00673                                 "therefore the order-definition is repeated "
00674                                 "using the (assumed non-low S/N) science frame",
00675                                 UVES_EXTRACT_ID,
00676                 "auto",
00677                                 5,
00678                                 "constant",
00679                                 "gauss",
00680                                 "moffat",
00681                                 "virtual",
00682                                 "auto");
00683         
00684         cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
00685         cpl_parameterlist_append(parameters, p);
00686         cpl_free(full_name);
00687     }
00688 
00689     {
00690         name = "skymethod";
00691         full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
00692         
00693         uves_parameter_new_enum(p, full_name,
00694                                 CPL_TYPE_STRING,
00695                                 "In optimal extraction mode, the sky subtraction method "
00696                 "to use. 'median' estimates the sky as the median of pixels "
00697                 "along the slit (ignoring pixels close to the object), whereas "
00698                 "'optimal' does a chi square minimization along the slit "
00699                 "to obtain the best combined object and sky levels. The optimal "
00700                 "method gives the most accurate sky determination but is also "
00701                 "a bit slower than the median method",
00702                                 UVES_EXTRACT_ID,
00703                 "optimal",
00704                                 2,
00705                                 "median",
00706                                 "optimal");
00707         
00708         cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
00709         cpl_parameterlist_append(parameters, p);
00710         cpl_free(full_name);
00711     }
00712 
00713     {
00714         name = "oversample";
00715         full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
00716         
00717         uves_parameter_new_range(p, full_name,
00718                                  CPL_TYPE_INT,
00719                                  "The oversampling factor used for the virtual "
00720                                  "resampling algorithm. If negative, the value 5 is "
00721                                  "used for S/N <=200, and the value 10 is used if the estimated "
00722                                  "S/N is > 200",
00723                                  UVES_EXTRACT_ID,
00724                                  -1,
00725                                  -2, INT_MAX);
00726         
00727         cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
00728         cpl_parameterlist_append(parameters, p);
00729         cpl_free(full_name);
00730     }
00731 
00732     {
00733         name = "best";
00734         full_name = uves_sprintf("%s.%s", UVES_EXTRACT_ID, name);
00735     
00736     uves_parameter_new_value(p, full_name,
00737                  CPL_TYPE_BOOL,
00738                  "(optimal extraction only) "
00739                  "If false (fastest), the spectrum is extracted only once. "
00740                  "If true (best), the spectrum is extracted twice, the "
00741                  "second time using improved variance estimates "
00742                  "based on the first iteration. Better variance "
00743                  "estimates slightly improve the obtained signal to "
00744                  "noise but at the cost of increased execution time",
00745                  UVES_EXTRACT_ID,
00746                  true);
00747     
00748     cpl_parameter_set_alias(p, CPL_PARAMETER_MODE_CLI, name);
00749     cpl_parameterlist_append(parameters, p);
00750     cpl_free(full_name);
00751     }
00752     
00753     if (cpl_error_get_code() != CPL_ERROR_NONE)
00754         {
00755             cpl_msg_error(__func__, "Creation of extraction parameters failed: '%s'", 
00756                           cpl_error_get_where());
00757             cpl_parameterlist_delete(parameters);
00758             return NULL;
00759         }
00760     else
00761         {
00762             return parameters;
00763         }
00764 }
00765 
00766 
00767 
00768 /*----------------------------------------------------------------------------*/
00778 /*----------------------------------------------------------------------------*/
00779 extract_method
00780 uves_get_extract_method(const cpl_parameterlist *parameters, 
00781                         const char *context, const char *subcontext)
00782 {
00783     const char *method = "";
00784     extract_method result = 0;
00785 
00786     check( uves_get_parameter(parameters, context, subcontext, "method", 
00787                               CPL_TYPE_STRING, &method),
00788            "Could not read parameter");
00789     
00790     if      (strcmp(method, "average" ) == 0) result = EXTRACT_AVERAGE;
00791     else if (strcmp(method, "linear"  ) == 0) result = EXTRACT_LINEAR;
00792     else if (strcmp(method, "2d"      ) == 0) result = EXTRACT_2D;
00793     else if (strcmp(method, "weighted") == 0) result = EXTRACT_WEIGHTED;
00794     else if (strcmp(method, "optimal" ) == 0) result = EXTRACT_OPTIMAL;
00795     else
00796         {
00797             assure(false, CPL_ERROR_ILLEGAL_INPUT, "No such extraction method: '%s'", method);
00798         }
00799     
00800   cleanup:
00801     return result;
00802 }
00803 
00804 /*----------------------------------------------------------------------------*/
00885 /*----------------------------------------------------------------------------*/
00886 cpl_image *
00887 uves_extract(cpl_image *image, 
00888              cpl_image *image_noise, 
00889              const uves_propertylist *image_header,
00890              const cpl_table *ordertable, 
00891              const polynomial *order_locations_raw,
00892              double slit_length, 
00893              double offset,
00894              const cpl_parameterlist *parameters, 
00895              const char *context,
00896              bool extract_partial,
00897              bool DEBUG,
00898              enum uves_chip chip,
00899              uves_propertylist **header, 
00900              cpl_image **spectrum_noise,
00901              cpl_image **sky_spectrum,
00902              cpl_image **sky_spectrum_noise,
00903              cpl_table **cosmic_mask,
00904              cpl_image **cosmic_image,
00905              cpl_table **profile_table,
00906              cpl_image **weights,
00907              cpl_table **info_tbl,
00908              cpl_table **order_trace)
00909 {
00910     cpl_image *spectrum = NULL;        /* Result */
00911     cpl_mask  *spectrum_bad = NULL;
00912     cpl_binary*spectrum_badmap = NULL;
00913     cpl_image *sky_subtracted = NULL;
00914     cpl_image *temp = NULL;
00915     cpl_image *reconstruct = NULL;
00916     slit_geometry sg;
00917 
00918     /* Recipe parameters */
00919     extract_method method;
00920     double kappa;
00921     int chunk;
00922     const char *p_method;
00923     int sampling_factor;
00924     bool best;
00925     bool optimal_extract_sky;
00926     int (*prof_func)   (const double x[], const double a[], double *result) = NULL;
00927     int (*prof_func_der)(const double x[], const double a[], double result[]) = NULL;
00928     int prof_pars = 0;
00929 
00930     polynomial *order_locations = NULL;/* Improved order positions (or duplicate
00931                                           of input polynomial) */
00932     int n_traces;                      /* The number of traces to extract
00933                                         * within each order, only relevant
00934                                         * for 2D extraction           */
00935     int iteration, trace;              /* Current iteration, order, trace */
00936     int n_iterations;
00937     int cr_row = 0;                    /* Points to first unused row in cr table */
00938     int prof_row = 0;                  /* Next unsused row of profile_table */
00939     uves_extract_profile *profile = NULL;
00940     uves_iterate_position *pos = NULL;              /* Iterator over input image */
00941 
00942     /* Check input */
00943     assure(image != NULL, CPL_ERROR_NULL_INPUT, "Missing input image");
00944     /* header may be NULL */
00945     assure( spectrum_noise == NULL || image_noise != NULL, CPL_ERROR_DATA_NOT_FOUND, 
00946             "Need image noise in order to calculate spectrum errors");
00947     assure( ordertable != NULL, CPL_ERROR_NULL_INPUT, "Missing order table");
00948     assure( order_locations_raw != NULL, CPL_ERROR_NULL_INPUT, "Missing order polynomial");
00949     assure( parameters != NULL, CPL_ERROR_NULL_INPUT, "Null parameter list");
00950     assure( context != NULL, CPL_ERROR_NULL_INPUT, "Missing context string!");
00951     assure( cpl_table_has_column(ordertable, "Order"), 
00952             CPL_ERROR_DATA_NOT_FOUND, "No 'Order' column in order table!");
00953     passure( uves_polynomial_get_dimension(order_locations_raw) == 2, "%d", 
00954              uves_polynomial_get_dimension(order_locations));
00955     assure( slit_length > 0, CPL_ERROR_ILLEGAL_INPUT, 
00956             "Slit length must a be positive number! It is %e", slit_length);
00957     /* sky_spectrum may be NULL */
00958     assure( (sky_spectrum == NULL) == (sky_spectrum_noise == NULL), CPL_ERROR_INCOMPATIBLE_INPUT,
00959             "Need 0 or 2 of sky spectrum + sky noise spectrum");
00960     /* info_tbl may be NULL */
00961 
00962     sg.length = slit_length;
00963     sg.offset = offset;
00964 
00965     /* Get recipe parameters */
00966     check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID, 
00967                   "kappa" , CPL_TYPE_DOUBLE, &kappa) , 
00968        "Could not read parameter");
00969     check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID,
00970                   "chunk" , CPL_TYPE_INT, &chunk) , 
00971        "Could not read parameter");
00972 
00973     check_nomsg( method = uves_get_extract_method(parameters, context, UVES_EXTRACT_ID) );
00974 
00975     {
00976     char *s_method;
00977     
00978         check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID,
00979                                   "skymethod", CPL_TYPE_STRING, &s_method),
00980                "Could not read parameter");
00981         if      (strcmp(s_method, "median" ) == 0) optimal_extract_sky = false;
00982         else if (strcmp(s_method, "optimal") == 0) optimal_extract_sky = true;
00983         else
00984             {
00985                 assure( false, CPL_ERROR_ILLEGAL_INPUT,
00986                         "Unrecognized sky extraction method: '%s'", s_method);
00987             }
00988 
00989     }
00990 
00991     {
00992         int minorder, maxorder;
00993         check(( minorder = cpl_table_get_column_min(ordertable, "Order"),
00994                 maxorder = cpl_table_get_column_max(ordertable, "Order")),
00995               "Error getting order range");
00996         
00997         pos = uves_iterate_new(cpl_image_get_size_x(image),
00998                                cpl_image_get_size_y(image), 
00999                                order_locations_raw,
01000                                minorder, maxorder, sg); 
01001         /* needed for estimate_sn */
01002     }
01003  
01004     if (method == EXTRACT_OPTIMAL)
01005         {
01006             assure( image_noise != NULL, CPL_ERROR_ILLEGAL_INPUT,
01007                     "Extraction method is optimal, but no noise image is provided");
01008 
01009             assure( weights != NULL, CPL_ERROR_ILLEGAL_INPUT,
01010                     "Extraction method is optimal, but no weight image is provided");
01011             
01012             assure( cosmic_mask != NULL, CPL_ERROR_ILLEGAL_INPUT,
01013                     "Extraction method is optimal, but no cosmic ray mask table is provided");
01014             
01015             assure( cosmic_image != NULL, CPL_ERROR_ILLEGAL_INPUT,
01016                     "Extraction method is optimal, but no cosmic ray mask image is provided");
01017             
01018             assure( order_trace != NULL, CPL_ERROR_ILLEGAL_INPUT,
01019                     "Extraction method is optimal, but no order trace table is provided");
01020 
01021             assure( *weights == NULL, CPL_ERROR_ILLEGAL_INPUT,
01022                     "Weight image already exists");
01023             
01024             check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID, "oversample",
01025                                       CPL_TYPE_INT, &sampling_factor), 
01026                    "Could not read parameter");
01027 
01028         check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID, "best",
01029                                       CPL_TYPE_BOOL, &best), 
01030                    "Could not read parameter");
01031 
01032             check( uves_get_parameter(parameters, context, UVES_EXTRACT_ID, "profile",
01033                                       CPL_TYPE_STRING, &p_method),
01034                    "Could not read parameter");
01035             
01036             assure( strcmp(p_method, "constant") == 0 || 
01037                     sky_spectrum != NULL, CPL_ERROR_ILLEGAL_INPUT, 
01038                     "Extraction method is optimal, but no sky spectrum is provided");
01039 
01040             if      (strcmp(p_method, "auto"   ) == 0)
01041                 {
01042                     /* Auto-select profile measuring method.
01043                        At low S/N a model with fewer free
01044                        parameters is needed */
01045 
01046                     double sn_estimate;
01047                     
01048                     check( sn_estimate = estimate_sn(image, image_noise,
01049                                                      pos),
01050                            "Could not estimate image S/N");
01051                     
01052                     if (sn_estimate < 10)
01053                         {
01054                             p_method = "gauss";
01055                         }
01056                     else
01057                         {
01058                             p_method = "virtual";
01059                         }
01060 
01061                     uves_msg("Estimated S/N is %.2f, "
01062                              "auto-selecting profile measuring method '%s'", sn_estimate,
01063                              p_method);
01064                 }
01065             
01066             if      (strcmp(p_method, "gauss"  ) == 0) 
01067                 {prof_func = uves_gauss ; prof_func_der = uves_gauss_derivative ; prof_pars = 4;}
01068             else if (strcmp(p_method, "moffat" ) == 0) 
01069                 {prof_func = uves_moffat; prof_func_der = uves_moffat_derivative; prof_pars = 5;}
01070             else if (strcmp(p_method, "virtual") == 0) 
01071                 {prof_func = NULL       ; prof_func_der = NULL                  ; prof_pars = 0;}
01072             else if (strcmp(p_method, "constant") != 0) 
01073                 {
01074                     assure( false, CPL_ERROR_ILLEGAL_INPUT,
01075                             "Unrecognized profile method: '%s'", p_method);
01076                 }
01077 
01078             assure( sampling_factor != 0, CPL_ERROR_ILLEGAL_INPUT,
01079                     "Illegal oversampling factor = %d", sampling_factor);
01080 
01081             if (strcmp(p_method, "virtual") == 0 && sampling_factor < 0)
01082                 /* Auto-select value */
01083                 {
01084                     double sn_estimate;
01085                     
01086                     check( sn_estimate = estimate_sn(image, image_noise,
01087                                                      pos),
01088                            "Could not estimate image S/N");
01089                     
01090                     if (sn_estimate <= 200)
01091                         {
01092                             sampling_factor = 5;
01093                         }
01094                     else
01095                         {
01096                             sampling_factor = 10;
01097                         }
01098 
01099                     uves_msg("Estimated S/N is %.2f, "
01100                              "auto-selecting oversampling factor = %d", sn_estimate,
01101                              sampling_factor);
01102                 }
01103         }
01104 
01105     assure( method != EXTRACT_WEIGHTED || weights != NULL, CPL_ERROR_ILLEGAL_INPUT,
01106             "Extraction method is weighted, but no weight image is provided");
01107     
01108     if (method == EXTRACT_2D)
01109         {
01110             /* 1 trace is just 1 pixel */
01111             n_traces = uves_round_double(slit_length);
01112             
01113             assure( n_traces % 2 == 0, CPL_ERROR_ILLEGAL_INPUT, 
01114                     "For 2d extraction slit length (%d) must be an even number", n_traces);
01115         }
01116     else
01117         {
01118             n_traces = 1;
01119         }
01120 
01121     if (method == EXTRACT_2D)
01122         {
01123             uves_msg_low("Slit length = %.1f pixels", slit_length);
01124         }
01125     else
01126         {
01127             uves_msg_low("Slit length = %.1f pixels; offset = %.1f pixel(s)", 
01128                          sg.length, sg.offset);
01129         }
01130 
01131     /* Initialize result images */
01132     check(( spectrum        = cpl_image_new(pos->nx,
01133                                             n_traces*(pos->maxorder - pos->minorder + 1), 
01134                                             CPL_TYPE_DOUBLE),
01135             spectrum_bad    = cpl_image_get_bpm(spectrum),
01136             spectrum_badmap = cpl_mask_get_data(spectrum_bad)),
01137           "Error creating spectrum image");
01138 
01139 
01140     if (spectrum_noise != NULL)
01141         {
01142             check( *spectrum_noise = cpl_image_new(cpl_image_get_size_x(spectrum),
01143                                                    cpl_image_get_size_y(spectrum),
01144                                                    CPL_TYPE_DOUBLE), 
01145                    "Could not create image");
01146         }
01147 
01148     if (info_tbl != NULL &&
01149     (method == EXTRACT_LINEAR  || method == EXTRACT_AVERAGE ||
01150          method == EXTRACT_OPTIMAL)
01151     )
01152     {
01153         *info_tbl = cpl_table_new(pos->maxorder-pos->minorder+1);
01154         cpl_table_new_column(*info_tbl, "Order", CPL_TYPE_INT);
01155         cpl_table_new_column(*info_tbl, "S/N", CPL_TYPE_DOUBLE);
01156         cpl_table_new_column(*info_tbl, "Ripple", CPL_TYPE_DOUBLE);
01157         /* Pos+FWHM columns are calculated differently,
01158            based on optimal extraction method,
01159            and simple extraction */
01160 
01161         cpl_table_new_column(*info_tbl, "Pos", CPL_TYPE_DOUBLE); /* From bottom of slit */
01162         cpl_table_new_column(*info_tbl, "FWHM", CPL_TYPE_DOUBLE);
01163     }
01164 
01165     /* Extra input validation + initialization for optimal extraction */
01166     if (method == EXTRACT_OPTIMAL)
01167         {
01168             /* Initialize weights to zero (good pixels) */
01169             check( *weights = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE),
01170                    "Could not allocate weight image");
01171             
01172             /* Initialize cr and profile tables */
01173             check(( *cosmic_mask = cpl_table_new(1),
01174                     cpl_table_new_column(*cosmic_mask, "Order", CPL_TYPE_INT),
01175                     cpl_table_new_column(*cosmic_mask, "X"    , CPL_TYPE_INT),
01176                     cpl_table_new_column(*cosmic_mask, "Y"    , CPL_TYPE_INT),
01177                     cpl_table_new_column(*cosmic_mask, "Flux" , CPL_TYPE_DOUBLE),
01178                     cr_row = 0),
01179                    "Error creating cosmic ray table");
01180             
01181             if (profile_table != NULL)
01182                 {
01183                     check( (*profile_table = cpl_table_new((pos->maxorder - pos->minorder + 1) *
01184                                                            pos->nx *
01185                                                            (3+uves_round_double(sg.length))),
01186                             cpl_table_new_column(*profile_table, "Order"      , CPL_TYPE_INT),
01187                             cpl_table_new_column(*profile_table, "X"          , CPL_TYPE_INT),
01188                             cpl_table_new_column(*profile_table, "DY"         , CPL_TYPE_DOUBLE),
01189                             cpl_table_new_column(*profile_table, "Profile_raw", CPL_TYPE_DOUBLE),
01190                             cpl_table_new_column(*profile_table, "Profile_int", CPL_TYPE_DOUBLE)),
01191                            "Error creating profile table");
01192                     prof_row = 0;
01193                 }
01194 
01195             if (strcmp(p_method, "constant") != 0) {
01196                 check( *sky_spectrum = cpl_image_new(
01197                            pos->nx, pos->maxorder - pos->minorder + 1, CPL_TYPE_DOUBLE),
01198                        "Could not allocate sky spectrum");
01199                 check( *sky_spectrum_noise = cpl_image_new(
01200                            pos->nx, pos->maxorder - pos->minorder + 1, CPL_TYPE_DOUBLE),
01201                        "Could not allocate sky spectrum noise");
01202             }
01203     }
01204   
01205     if (method == EXTRACT_OPTIMAL && 
01206         strcmp(p_method, "constant") != 0 && prof_func == NULL)
01207         {
01208             /* Virtual method needs accurate order definition.
01209              * Some calibration order tables are inaccurate because
01210              * the poly-degree used (2,3) is too low.
01211              *
01212              * Besides, the (science) spectrum might be shifted compared
01213              * to the order-flat-narrow frame.
01214              */
01215             
01216             uves_msg("Refining order definition using the object frame");
01217 
01218             check( order_locations = repeat_orderdef(image, image_noise, order_locations_raw, 
01219                                                      pos->minorder, pos->maxorder, 
01220                              pos->sg,
01221                              *info_tbl),
01222                    "Could not refine order definition");
01223         }
01224     else
01225         {
01226             order_locations = uves_polynomial_duplicate(order_locations_raw);
01227         }
01228 
01229     pos->order_locations = order_locations;
01230 
01231     /* Input checking + output initialization done. */
01232 
01233 
01234     /* Do the processing, pseudocode for optimal extraction:
01235 
01236        extract+subtract sky (median method)
01237        globally measure profile
01238 
01239        two times
01240          for each order
01241              extract object+sky, reject hot/cold pixels
01242          revise variances
01243     */
01244     if (method == EXTRACT_OPTIMAL)
01245     {
01246             if (strcmp(p_method, "constant") == 0) {
01247 
01248                 uves_msg("Assuming constant spatial profile");
01249                 
01250                 profile = uves_extract_profile_new_constant(sg.length);
01251 
01252                 /* Pretend that we subtracted the sky here */
01253                 sky_subtracted = cpl_image_duplicate(image);
01254                 optimal_extract_sky = false;
01255 
01256             }
01257             else {
01258                 check( sky_subtracted = opt_extract_sky(
01259                            image, image_noise, *weights,
01260                            pos,
01261                            *sky_spectrum,
01262                            *sky_spectrum_noise),
01263                        "Could not extract sky");
01264                 
01265                 if (prof_func != NULL)
01266                     {
01267                         uves_msg("Measuring spatial profile "
01268                                  "(method = %s, chunk = %d bins)",
01269                                  p_method, chunk);
01270                     }
01271                 else
01272                     {
01273                         uves_msg("Measuring spatial profile "
01274                                  "(method = %s, oversampling = %d)", 
01275                                  p_method, sampling_factor);
01276                     }
01277                 
01278                 uves_extract_profile_delete(&profile);
01279                 /* the new profile measuring method should use this one
01280                    check( profile = opt_measure_profile(image, image_noise, *weights, */
01281                 check( profile = opt_measure_profile(sky_subtracted, image_noise, *weights,
01282                                                      pos,
01283                                                      chunk, sampling_factor,
01284                                                      prof_func, prof_func_der, prof_pars,
01285                                                      *sky_spectrum,
01286                                                      *info_tbl,
01287                                                      order_trace),
01288                        "Could not measure profile");
01289                 
01290                 /* In previous versions, the sky was subtracted (again) at this point
01291                    using the knowledge of the analytical profile.
01292                    But this is not needed anymore, now that the sky is
01293                    extracted simultaneously with the flux (which is equivalent
01294                    but much faster).
01295                 */
01296             }
01297         }
01298     
01299     /* The loop over traces is trivial, unless method = 2d. */
01300     passure( method == EXTRACT_2D || n_traces == 1, "%d", n_traces);
01301  
01302     n_iterations = (method == EXTRACT_OPTIMAL && 
01303                     best && 
01304                     strcmp(p_method, "constant") != 0) ? 2 : 1;
01305 
01306     for (iteration = 1; 
01307      iteration <= n_iterations;
01308      iteration++)
01309     {
01310         uves_msg("Extracting object %s(method = %s)", 
01311              (method == EXTRACT_OPTIMAL && optimal_extract_sky)  
01312                                           ? "and sky " : "",
01313              (method == EXTRACT_OPTIMAL)  ? "optimal"  : 
01314              (method == EXTRACT_AVERAGE)  ? "average"  :
01315              (method == EXTRACT_LINEAR )  ? "linear"   :
01316              (method == EXTRACT_2D     )  ? "2d"       :
01317              (method == EXTRACT_WEIGHTED) ? "weighted" : "???");
01318         
01319         /* Clear cosmic ray + profile table + S/N table */
01320             cr_row = 0;
01321             prof_row = 0;
01322             for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++) {
01323                 for (trace = 1; trace <= n_traces; trace++) {
01324                     int spectrum_row; /* Spectrum image row to write to */
01325                     int bins_extracted;
01326                     
01327                     double sn = 0;
01328                     
01329                     spectrum_row = (pos->order - pos->minorder)*n_traces + trace;
01330                     /* Always count from order=1 in the extracted spectrum */
01331                     
01332                     if (method == EXTRACT_OPTIMAL)
01333                         {
01334                             /*
01335                              * We already know the spatial profile.
01336                              * Extract object+sky
01337                              */
01338                             
01339                             check( bins_extracted = opt_extract(
01340                                        optimal_extract_sky ?
01341                                        image : sky_subtracted,
01342                                        image_noise,
01343                                        pos,
01344                                        profile,
01345                                        optimal_extract_sky,
01346                                        kappa,
01347                                        *cosmic_mask, &cr_row,
01348                                        (profile_table  != NULL) ?
01349                                        *profile_table : NULL,
01350                                        &prof_row,
01351                                        spectrum, 
01352                                        (spectrum_noise != NULL) ?
01353                                        *spectrum_noise : NULL,
01354                                        *weights,
01355                                        optimal_extract_sky ? *sky_spectrum : NULL,
01356                                        optimal_extract_sky ? *sky_spectrum_noise : NULL,
01357                                        &sn),
01358                                    "Error extracting order #%d", pos->order);
01359                         }
01360                     else
01361                         {   
01362                             /* Average, linear, 2d, weighted */
01363                                     
01364                             /* A 2d extraction is implemented
01365                              * as a repeated linear extraction
01366                              * with slit_length = 1.        
01367                              *
01368                              * For 2d mode, map
01369                              *        trace =  1, 2, ..., n_traces
01370                              *  to something that is symmetric around 0
01371                              *  (notice that n_traces is an even number)
01372                              *        offset = -n_traces/2 + 1/2, ..., n_traces/2 - 1/2
01373                              */
01374                                     
01375                             double offset_2d = trace - (n_traces+1)/2.0;
01376                             double slit_2d = 1;
01377                                     
01378                             check( bins_extracted = extract_order_simple(
01379                                        image, image_noise,
01380                                        order_locations,
01381                                        pos->order, pos->minorder,
01382                                        spectrum_row,
01383                                        (method == EXTRACT_2D) ? offset_2d : sg.offset,
01384                                        (method == EXTRACT_2D) ? slit_2d : sg.length,
01385                                        (method == EXTRACT_2D) ? EXTRACT_LINEAR : method,
01386                                        (weights        != NULL) ? *weights        : NULL,
01387                                        extract_partial,
01388                                        spectrum,
01389                                        (spectrum_noise != NULL) ? *spectrum_noise : NULL,
01390                                        spectrum_badmap,
01391                                        info_tbl,
01392                                        &sn),
01393                                    "Could not extract order #%d ; trace #%d", 
01394                                    pos->order, trace);
01395                         }
01396 
01397 
01398                     if (info_tbl != NULL &&
01399                         (method == EXTRACT_LINEAR || method == EXTRACT_AVERAGE ||
01400                          method == EXTRACT_OPTIMAL)
01401                         )
01402                         {
01403                             /* Do post extraction measurements of any ripples */
01404                             double ripple_index = detect_ripples(spectrum, pos, sn);
01405                             uves_msg("Order #%d: S/N = %.2f",
01406                                      pos->order, sn);
01407                             uves_msg_debug("Ripple index = %.2f (should be less than 2)",
01408                                            ripple_index);
01409 
01410                             if (false && ripple_index > 3) {
01411                                 /* Disabled. This would also produce warnings about arc
01412                                    lamp frames which have short period ripples (a.k.a ThAr emmision
01413                                    lines), which is just silly.
01414                                 */
01415                                 uves_msg_warning("Short period ripples detected (index = %f). "
01416                                                  "It might help to use average or linear extraction "
01417                                                  "or optimal/virtual extraction with larger "
01418                                                  "oversampling factor", ripple_index);
01419                             }
01420 
01421                             cpl_table_set_int   (*info_tbl, "Order", 
01422                                                  pos->order - pos->minorder, pos->order);
01423                             cpl_table_set_double(*info_tbl, "S/N"  , 
01424                                                  pos->order - pos->minorder, sn);
01425                             cpl_table_set_double(*info_tbl, "Ripple", 
01426                                                  pos->order - pos->minorder, 
01427                                                  (ripple_index > -0.5) ? ripple_index : -1);
01428                         }
01429 
01430                     uves_msg_debug(
01431                         "Order #%d; trace #%d: %d of %d bins extracted", 
01432                         pos->order, trace, bins_extracted, pos->nx);
01433                             
01434                 }/* for trace ... */
01435                     
01436             }/* for order ... */
01437 
01438     
01439         if (method == EXTRACT_OPTIMAL)
01440         {
01441             if (spectrum_noise != NULL)
01442             {
01443                 uves_free_image(&temp);
01444                 temp = cpl_image_divide_create(spectrum, *spectrum_noise);
01445                 uves_msg("Average S/N = %.3f", cpl_image_get_median(temp));
01446             }
01447 
01448             if (iteration == 1 && n_iterations >= 2)
01449             {
01450                 /* If optimal extraction, repeat with more accurate error bars */
01451                 uves_msg_low("Recomputing pixel variances");
01452                 
01453                 check( revise_noise(image_noise,
01454                         cpl_mask_get_data(
01455                             cpl_image_get_bpm(sky_subtracted)),
01456                         image_header, pos,
01457                         spectrum, *sky_spectrum, profile,
01458                         chip),
01459                    "Error refining input image variances");
01460             }
01461         }
01462         
01463         }/* for iteration */
01464 
01465     /* Set cosmic mask + profile table size, and weights to non-negative */
01466     if (method == EXTRACT_OPTIMAL)
01467         {
01468             int i;
01469 
01470             check( cpl_table_set_size(*cosmic_mask, cr_row),
01471                    "Error setting cosmic ray table size to %d", cr_row);
01472 
01473             *cosmic_image = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
01474             assure_mem(*cosmic_image);
01475 
01476             for (i = 0; i < cpl_table_get_nrow(*cosmic_mask); i++)
01477                 {
01478                     cpl_image_set(*cosmic_image,
01479                                   cpl_table_get_int(*cosmic_mask, "X", i, NULL),
01480                                   cpl_table_get_int(*cosmic_mask, "Y", i, NULL),
01481                                   cpl_table_get_double(*cosmic_mask, "Flux", i, NULL));
01482                 }
01483 
01484             if (profile_table != NULL)
01485                 {
01486                     check( cpl_table_set_size(*profile_table, prof_row),
01487                            "Error setting profile table size to %d", prof_row);
01488                 }
01489 
01490             /* There are still pixels outside the extraction bins
01491                which have not been touched after creating
01492                the weights image. They are negative; set to zero. */
01493 
01494             check( cpl_image_threshold(*weights,
01495                                        0, DBL_MAX,
01496                                        0, DBL_MAX),
01497                    "Error thresholding weight image");
01498 
01499             /* Normalize weights (to 1) to get a
01500              * more informative weight image
01501              * This is not needed for the algorithm
01502              * but is computationally cheap
01503              */
01504             
01505             {
01506                 double *weights_data = cpl_image_get_data_double(*weights);
01507 
01508                 for (uves_iterate_set_first(pos,
01509                                             1, pos->nx,
01510                                             pos->minorder, pos->maxorder,
01511                                             NULL, false);
01512                      !uves_iterate_finished(pos);
01513                      uves_iterate_increment(pos))
01514                     {
01515                         double sum_weights = 0.0;
01516                         
01517                         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
01518                             {
01519                                 double weight = DATA(weights_data, pos);
01520                                 sum_weights += weight;
01521                             }
01522                         
01523                         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
01524                             {
01525                                 if (sum_weights > 0)
01526                                     {
01527                                         DATA(weights_data, pos) /= sum_weights;
01528                                     }
01529                             }
01530                     }
01531             }
01532     } /* if optimal */
01533 
01534     /* Copy bad pixel map from spectrum to error bar spectrum */
01535     uves_msg_debug("Rejecting %d bins", cpl_mask_count(spectrum_bad));
01536 
01537     if (spectrum_noise != NULL)
01538         {
01539             check( cpl_image_reject_from_mask(*spectrum_noise, spectrum_bad),
01540                    "Error setting bad pixels");
01541         }
01542     
01543     /* Create spectrum header */
01544     if (header != NULL)
01545         {
01546             /* (pixel, pixel) or (pixel, order) space */
01547             check( *header = uves_initialize_image_header(
01548                        "PIXEL", (method == EXTRACT_2D) ? "PIXEL" : "ORDER",
01549                        "FLUX",
01550                        1.0, pos->minorder,    /* CRVAL */
01551                        1.0, 1.0,         /* CRPIX */
01552                        1.0, 1.0),        /* CDELT (this should really be the x-binning) */
01553                    "Error initializing spectrum header");
01554         }
01555 
01556     if (DEBUG && header != NULL) {
01557         if (profile == NULL) {
01558             /* If profile was not measured (i.e. linear/average etc.),
01559                set to constant */
01560             profile = uves_extract_profile_new_constant(sg.length);
01561         }
01562 
01563         check_nomsg( reconstruct = 
01564                uves_create_image(pos, chip,
01565                                  spectrum,
01566                                  sky_spectrum != NULL ? *sky_spectrum : NULL,
01567                                  cosmic_image != NULL ? *cosmic_image : NULL,
01568                                  profile,
01569                                  NULL, NULL)); /* error bars, header */
01570 
01571     /*
01572       check(uves_propertylist_copy_property_regexp(*header, image_header, "^ESO  ", 0),
01573        "Error copying hieararch keys");
01574     */
01575         check( uves_save_image_local("Reconstructed image", "simulate",
01576                                      reconstruct, chip, -1, -1, *header, true),
01577                "Error saving image");
01578 
01579     }
01580     
01581     if (spectrum_noise != NULL)
01582         {
01583             int x, y;
01584             
01585             /* Assert that produced noise spectrum is
01586                always positive. 
01587                
01588                For efficiency, cpl_image_get_minpos
01589                is called only in case of error (using
01590                a comma expression) 
01591             */
01592 
01593             /* ... then this assertion should not fail */
01594             assure( cpl_image_get_min(*spectrum_noise) > 0, CPL_ERROR_ILLEGAL_OUTPUT,
01595                     "Non-positive noise: %e at (%d, %d)",
01596                     cpl_image_get_min(*spectrum_noise),
01597                     (cpl_image_get_minpos(*spectrum_noise, &x, &y), x),
01598                     (cpl_image_get_minpos(*spectrum_noise, &x, &y), y));
01599 
01600         /* For debugging: this code dumps S/N statistics (and leaks memory)
01601         cpl_stats_dump(cpl_stats_new_from_image(
01602                    cpl_image_divide_create(spectrum, *spectrum_noise), 
01603                    CPL_STATS_ALL), CPL_STATS_ALL, stdout);
01604         */
01605     }
01606     
01607   cleanup:
01608     uves_free_image(&reconstruct);
01609     uves_free_image(&sky_subtracted);
01610     uves_extract_profile_delete(&profile);
01611     uves_polynomial_delete(&order_locations);
01612     uves_iterate_delete(&pos);
01613     uves_free_image(&temp);
01614 
01615     if (cpl_error_get_code() != CPL_ERROR_NONE)
01616         {
01617             uves_free_image(&spectrum);
01618             uves_free_image(spectrum_noise);
01619             uves_free_table(profile_table);
01620         }
01621     
01622     return spectrum;
01623 }
01624 
01625 /*----------------------------------------------------------------------------*/
01635 /*----------------------------------------------------------------------------*/
01636 static double
01637 detect_ripples(const cpl_image *spectrum, const uves_iterate_position *pos,
01638                double sn)
01639 {
01640     double ratio = -1; /* result */
01641     int n_traces = 1; /* Not 2d extraction */
01642     int trace = 1;
01643     int nx = cpl_image_get_size_x(spectrum);
01644     cpl_image *spectrum_order = NULL;
01645     cpl_vector *tempx = NULL;
01646     cpl_vector *tempy = NULL;
01647     double *auto_corr = NULL;
01648 
01649     int spectrum_row = (pos->order - pos->minorder)*n_traces + trace;
01650     int n_rejected;
01651     
01652     uves_free_image(&spectrum_order);
01653     
01654     check( spectrum_order = cpl_image_extract(spectrum, 
01655                                               1, spectrum_row,
01656                                               nx, spectrum_row),
01657            "Error extracting order %d from spectrum", pos->order);
01658     
01659     n_rejected = cpl_image_count_rejected(spectrum_order);
01660     uves_msg_debug("Order %d: %d/%d invalid values", pos->order,
01661                    n_rejected,
01662                    nx);
01663     
01664     if (n_rejected == 0) /* Skip partial orders */
01665         /* Compute auto-correlation function */
01666         {
01667             double order_slope =     /* dy/dx at x = nx/2 */
01668                 uves_polynomial_derivative_2d(pos->order_locations, nx/2, pos->order, 1);
01669             
01670             int expected_period = uves_round_double(1.0/order_slope);
01671             int max_period = 2*expected_period;
01672             int shift; /* in pixels */
01673             
01674             uves_msg_debug("Estimated ripple period = %d pixels", expected_period);
01675             
01676             auto_corr = cpl_calloc(sizeof(double), 1+max_period);
01677             
01678             for (shift = 0; shift <= max_period; shift += 1) {
01679                 int N = 0;
01680                 int x;
01681                 
01682                 auto_corr[shift] = 0;
01683                 
01684                 for (x = 1; x <= nx - max_period; x++) {
01685                     int rejected1, rejected2;
01686                     double val1, val2;
01687                     
01688                     val1 = cpl_image_get(spectrum_order, x, 1, &rejected1);
01689                     val2 = cpl_image_get(spectrum_order, x+shift, 1, &rejected2);
01690                     
01691                     if (!rejected1 && !rejected2)
01692                         {
01693                             auto_corr[shift] += val1*val2;
01694                             N++;
01695                         }
01696                 }
01697                 
01698                 if (N != 0)
01699                     {
01700                         auto_corr[shift] /= N;
01701                     }
01702                 else
01703                     {
01704                         auto_corr[shift] = 0;
01705                     }
01706                 
01707                 if (shift > 0 && auto_corr[0] > 0)
01708                     {
01709                         auto_corr[shift] /= auto_corr[0];
01710                     }
01711                 
01712                 uves_msg_debug("Auto-correlation (%d pixels, %d samples) = %f",
01713                                shift, N, (shift == 0) ? 1 : auto_corr[shift]);
01714             }
01715             auto_corr[0] = 1;
01716             /* Done compute auto correlation function for this order */
01717             
01718             {
01719                 /* Get amplitude of normalized auto correlation function */
01720                 double auto_amplitude;
01721                 int imax = expected_period;
01722                 int imin1 = expected_period/2;
01723                 int imin2 = (expected_period*3)/2;
01724 
01725                 /* Measuring the ACF maxima + minima would be non-robust to
01726                    the case where there is no peak. Therefore use simply
01727                    the predicted positions: */
01728 
01729                 auto_amplitude = auto_corr[imax] - 
01730                     (auto_corr[imin1] + auto_corr[imin2])/2.0;
01731                 
01732                 /* The autocorrelation function is used to estimate the ripple amplitude.
01733                  * Not caring too much about numerical factors and the specific 
01734                  * analytical form of the oscillations, the following relation holds:
01735                  *
01736                  * autocorrelation function relative amplitude = 
01737                  * (ripple relative amplitude)^2 
01738                  *
01739                  * To convert from this amplitude to a stdev we can assume a
01740                  * sine curve i.e. divide the amplitude by 2 to get the stdev
01741                  * (or alternatively multiply the spectrum error bars by 2)
01742                  */
01743                 
01744                 if (auto_amplitude > 0 && sn > 0)
01745                     {
01746                         double rel_ripple = sqrt(auto_amplitude);
01747                         uves_msg_debug("Order %d: Relative ripple amplitude = %f, "
01748                                        "relative error bars = %f",
01749                                        pos->order, rel_ripple, 2.0*1/sn);
01750                         
01751                         ratio = rel_ripple * sn/2.0;
01752                     }
01753             }
01754         } /* Done measuring auto correlation function */       
01755 
01756   cleanup:
01757     uves_free_double(&auto_corr);
01758     uves_free_vector(&tempx);
01759     uves_unwrap_vector(&tempy);
01760     uves_free_image(&spectrum_order);
01761 
01762     
01763     return ratio;
01764 }
01765 
01766 /*----------------------------------------------------------------------------*/
01778 /*----------------------------------------------------------------------------*/
01779 static double
01780 estimate_sn(const cpl_image *image, const cpl_image *image_noise,
01781             uves_iterate_position *pos)
01782 {
01783     double sn = -1;
01784     int range = 5;          /* Use central (2*range+1) bins in each order */
01785     cpl_table *sn_temp = NULL;
01786     cpl_table *sky_temp = NULL;
01787     int sn_row, sky_row;
01788     int sky_size = 2 + 2*uves_round_double(pos->sg.length); /* allocate enough rows
01789                                                                to store all values
01790                                                                across the slit */
01791 
01792     passure( image_noise != NULL, " ");
01793 
01794     assure( pos->nx >= 2*(range+1), CPL_ERROR_ILLEGAL_INPUT,
01795             "Input image is too small. Width = %d", pos->nx);
01796 
01797     sn_temp = cpl_table_new((pos->maxorder - pos->minorder + 1) * (2*range + 1));
01798     cpl_table_new_column(sn_temp, "SN", CPL_TYPE_DOUBLE);
01799     sn_row = 0;
01800 
01801     sky_temp = cpl_table_new(sky_size);
01802     cpl_table_new_column(sky_temp, "Sky", CPL_TYPE_DOUBLE);
01803 
01804     for (uves_iterate_set_first(pos,
01805                                 pos->nx/2 - range, pos->nx/2 + range,
01806                                 pos->minorder, pos->maxorder,
01807                                 NULL, false);
01808          !uves_iterate_finished(pos);
01809          uves_iterate_increment(pos))
01810         {
01811             double flux = 0;
01812             double error = 0;
01813             int N = 0;
01814             
01815             sky_row = 0;
01816             
01817             for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
01818                 {
01819                     int pis_rejected1, pis_rejected2;
01820                     double pixel       = cpl_image_get(image,
01821                                                        pos->x, pos->y, &pis_rejected1);
01822                     double pixel_noise = cpl_image_get(image_noise, 
01823                                                        pos->x, pos->y, &pis_rejected2);
01824                     
01825                     if (!pis_rejected1 && !pis_rejected2)
01826                         {
01827                             flux += pixel;
01828                             error += pixel_noise*pixel_noise;
01829                             N++;
01830                             
01831                             cpl_table_set_double(sky_temp, "Sky",
01832                                                  sky_row, pixel);
01833                             sky_row++;
01834                         }
01835                 }
01836             
01837             if (N > 0)
01838                 {
01839                     double sky; /* Sky level of one pixel, not full slit */
01840                     
01841                     while(sky_row < sky_size)
01842                         /* Mark remaining values as bad before getting median */
01843                         {
01844                             cpl_table_set_invalid(sky_temp, "Sky",
01845                                                   sky_row);
01846                             
01847                             sky_row++;
01848                         }
01849                     
01850                     sky = cpl_table_get_column_median(sky_temp, "Sky");
01851                     
01852                     flux = flux - N*sky;
01853                     error = sqrt(error); /* Don't propagate the (small) error
01854                                             from the sky subtraction */
01855                     
01856                     if (error > 0)
01857                         {
01858                             uves_msg_debug("Order %d: S/N estimate = %f", 
01859                                            pos->order, flux/error);
01860                             
01861                             cpl_table_set_double(sn_temp, "SN",
01862                                                  sn_row, flux/error);
01863                             sn_row++;
01864                         }
01865                 }
01866         }
01867     
01868     assure(sn_row > 0, CPL_ERROR_DATA_NOT_FOUND,
01869            "Extraction of central bins failed!");
01870     
01871     cpl_table_set_size(sn_temp, sn_row);
01872     
01873     sn = cpl_table_get_column_median(sn_temp, "SN");
01874     
01875   cleanup:
01876     uves_free_table(&sn_temp);
01877     uves_free_table(&sky_temp);
01878     return sn;
01879 }
01880 
01881 /*----------------------------------------------------------------------------*/
01913 /*----------------------------------------------------------------------------*/
01914 
01915 static int
01916 extract_order_simple(const cpl_image *image, 
01917                      const cpl_image *image_noise,
01918                      const polynomial *order_locations,
01919                      int order, 
01920                      int minorder,
01921                      int spectrum_row,
01922                      double offset,
01923                      double slit_length,
01924                      extract_method method,
01925                      const cpl_image *weights,
01926                      bool extract_partial,
01927                      cpl_image *spectrum,
01928                      cpl_image *spectrum_noise,
01929                      cpl_binary*spectrum_badmap,
01930                      cpl_table **info_tbl,
01931                      double *sn)
01932 {
01933     int bins_extracted = 0;
01934     double *spectrum_data;
01935     int x, nx, ny;
01936     double flux_y, flux_yy, flux_tot;
01937     int sn_row = 0;          /* Number of rows in 'signal_to_noise' 
01938                 actually used */
01939     cpl_table *signal_to_noise = NULL;
01940 
01941     passure( method == EXTRACT_AVERAGE ||
01942              method == EXTRACT_LINEAR ||
01943              method == EXTRACT_WEIGHTED, "%d", method);
01944 
01945     /* It's probably a bug if there's a weight image and method = linear/average */
01946     passure( (method == EXTRACT_WEIGHTED) == (weights != NULL), "%d", method);
01947 
01948     nx = cpl_image_get_size_x(image);
01949     ny = cpl_image_get_size_y(image);
01950 
01951     check( (signal_to_noise = cpl_table_new(nx),
01952             cpl_table_new_column(signal_to_noise, "SN", CPL_TYPE_DOUBLE)),
01953            "Error allocating S/N table");
01954 
01955     spectrum_data = cpl_image_get_data_double(spectrum);
01956 
01957     flux_y = 0;
01958     flux_yy = 0;
01959     flux_tot = 0;
01960     /* Extract the entire image width */
01961     for (x = 1 ; x <= nx; x++) {
01962         double slope, ycenter;   /* Running slope, bin center */
01963         int ylo, yhi;            /* Lowest, highest pixel to look at */
01964         double flux = 0;
01965         double flux_variance = 0;
01966         double sum = 0;          /* (Fractional) number of pixels extracted so far */
01967         int y;
01968             
01969         /* Get local order slope */
01970         check(( slope = (uves_polynomial_evaluate_2d(order_locations, x+1, order) -
01971                          uves_polynomial_evaluate_2d(order_locations, x-1, order) ) / 2,
01972                 /* Center of order */
01973                 ycenter = uves_polynomial_evaluate_2d(order_locations, x, order) + offset),
01974               "Error evaluating polynomial");
01975             
01976         assure( 0 < slope && slope < 1, CPL_ERROR_ILLEGAL_INPUT,
01977                 "At (x, order)=(%d, %d) slope is %f. Must be positive", x, order, slope);
01978         
01979         /* Lowest and highest pixels partially inside the slit */
01980         ylo = uves_round_double(ycenter - slit_length/2 - 0.5*slope);
01981         yhi = uves_round_double(ycenter + slit_length/2 + 0.5*slope);
01982             
01983         /* If part of the bin is outside the image... */
01984         if (ylo < 1 || ny < yhi)
01985             {
01986                 if (extract_partial)
01987                     {
01988                         ylo = uves_max_int(ylo, 1);
01989                         yhi = uves_min_int(yhi, ny);
01990                     }
01991                 else
01992                     {
01993                         /* Don't extract the bin if 'extract_partial' is false */
01994                         ylo = yhi + 1;
01995                     }
01996             }
01997         
01998         /* Extract */
01999         for (y = ylo; y <= yhi; y++) {
02000             /* Calculate area of pixel inside order */
02001             int pis_rejected;
02002             double pixelval;
02003             double pixelvariance;
02004             double weight;
02005                     
02006             /* Read pixel flux */
02007             pixelval = cpl_image_get(image, x, y, &pis_rejected);
02008                     
02009             /* Uncomment to disallow negative fluxes 
02010                assure( MIDAS || pis_rejected || pixelval >= 0, CPL_ERROR_ILLEGAL_INPUT,
02011                "Negative flux: %e  at (x, y) = (%d, %d)", pixelval, x, y);
02012             */
02013                     
02014             /* Read pixel noise */
02015             if (spectrum_noise != NULL && !pis_rejected)
02016                 {
02017                     pixelvariance = cpl_image_get(image_noise, x, y, &pis_rejected);
02018                     pixelvariance *= pixelvariance;
02019                 }                               
02020             else
02021                 {
02022                     pixelvariance = 1;
02023                 }
02024                     
02025             if (!pis_rejected) {
02026                 /* Get weight */
02027                 if (method == EXTRACT_WEIGHTED)
02028                     {
02029                         /* Use already defined weight
02030                            (from previous optimal extraction) */
02031                                     
02032                         weight = cpl_image_get(weights, x, y, &pis_rejected);
02033                                     
02034                         assure( weight >= 0, CPL_ERROR_ILLEGAL_INPUT,
02035                                 "Illegal weight: %e at (x, y) = (%d, %d)",
02036                                 weight, x, y);
02037                                     
02038                         if (weight == 0)
02039                             {
02040                                 /* To avoid ~100 MB log file this is commented out:
02041                                    uves_msg_debug("Ignoring bad pixel at (order, x, y) "
02042                                    "= (%d, %d, %d)", order, x, y);
02043                                 */
02044                             }
02045                     }
02046                 else if (method == EXTRACT_ARCLAMP) {
02047                     weight = 1.0 / pixelvariance;
02048                 }
02049                 else {
02050                     /* Linear / average extraction */
02051                     double area_outside_order_top;
02052                     double area_outside_order_bottom;
02053                     double left  = ycenter + slit_length/2 - 0.5*slope;
02054                     double right = ycenter + slit_length/2 + 0.5*slope;
02055                                     
02056                     check( area_outside_order_top = 
02057                            area_above_line(y, left, right),
02058                            "Error calculating area");
02059                                     
02060                     left  = ycenter - slit_length/2 - 0.5*slope;
02061                     right = ycenter - slit_length/2 + 0.5*slope;
02062                                     
02063                     check( area_outside_order_bottom =
02064                            1 - area_above_line(y, left, right),
02065                            "Error calculationg area");
02066                                     
02067                     weight = 1 - (area_outside_order_top + area_outside_order_bottom);
02068                                     
02069                     if (1 < y && y < ny && weight < 1)
02070                         {
02071                             /* Interpolate the flux profile at edge of slit */
02072                                             
02073                             /* Use a piecewise linear profile like this
02074                              *   
02075                              *                   C
02076                              * intrp.profile => / \
02077                              *              ---/---\-- <= measured pixelval
02078                              *              | /     \|
02079                              *              |/       B
02080                              *              A        |________ <= measured (integrated) profile
02081                              *             /|          
02082                              *    __________|        
02083                              *
02084                              * The flux levels A and B are midway between the
02085                              * current pixel flux and its neighbours' levels.
02086                              * C is chosen so that the integrated over the 
02087                              * current pixel is consistent with the measured flux.
02088                              *
02089                              * This guess profile is continous as well as flux conserving
02090                              */
02091                                             
02092                             int pis_rejected_prev, pis_rejected_next;
02093                                             
02094                             /* Define flux at pixel borders (A and B) as 
02095                                mean value of this and neighbouring pixel */
02096                             double flux_minus = (pixelval + cpl_image_get(
02097                                                      image, x, y - 1, &pis_rejected_prev)) / 2.0;
02098                             double flux_plus  = (pixelval + cpl_image_get(
02099                                                      image, x, y + 1, &pis_rejected_next)) / 2.0;
02100                             if (!pis_rejected_prev && !pis_rejected_next)
02101                                 {
02102                                     /* Define flux at pixel center, fluxc, so that the average 
02103                                      * flux is equal to the measured value 'pixelval':
02104                                      *
02105                                      * ((flux- + fluxc)/2 + (flux+ + fluxc)/2) / 2 = pixelval
02106                                      * =>  flux- + flux+ + 2fluxc = 4pixelval
02107                                      * =>  fluxc = ...
02108                                      */
02109                                                     
02110                                     double flux_center = 
02111                                         2*pixelval - (flux_minus + flux_plus) / 2.0;
02112                                                     
02113                                     /* Line slopes */
02114                                     double slope_minus = 
02115                                         (flux_center - flux_minus )/ 0.5;
02116                                     double slope_plus  = 
02117                                         (flux_plus   - flux_center) / 0.5;
02118                                                     
02119                                     /*  Define interval in [-0.5 ; 0] . Pixel center is at 0.*/
02120                                     double lo1 = 
02121                                         uves_min_double(0, -0.5 + area_outside_order_bottom);
02122                                     double hi1 =
02123                                         uves_min_double(0,  0.5 - area_outside_order_top   );
02124                                     double dy1 = hi1-lo1;
02125                                                     
02126                                     /*  Define interval in [0 ; 0.5]                 */
02127                                     double lo2 = 
02128                                         uves_max_double(0, -0.5 + area_outside_order_bottom);
02129                                     double hi2 = 
02130                                         uves_max_double(0,  0.5 - area_outside_order_top   );
02131                                     double dy2 = hi2-lo2;
02132                                                     
02133                                     if (dy1 + dy2 > 0)
02134                                         {
02135                                             /* Get average flux over the two intervals */
02136                                             pixelval = (
02137                                                 (flux_center + slope_minus * (lo1+hi1)/2.0) * dy1
02138                                                 +
02139                                                 (flux_center + slope_plus  * (lo2+hi2)/2.0) * dy2
02140                                                 ) / (dy1 + dy2);
02141                                                             
02142                                             /* Don't update/interpolate 'pixelvariance'
02143                                              * correspondingly (for simplicity) .
02144                                              */
02145                                         }
02146                                     /* else { don't change pixelval } */
02147                                 }/* Neighbours are good */
02148                         }/* Profile interpolation */
02149                     else
02150                         {
02151                             /* Neighbours not available, don't change flux */
02152                         }
02153                 } /* Get weight */
02154                             
02155                 /*
02156                  * Accumulate weighted sum (linear/average):
02157                  *
02158                  * Flux     =  [ sum weight_i   * flux_i     ]
02159                  * Variance =  [ sum weight_i^2 * variance_i ]
02160                  *
02161                  * Arclamp:
02162                  *
02163                  * Flux     =  [ sum flux_i / variance_i ] /
02164                  *             [ sum      1 / variance_i ]
02165                  * Variance =  1 /
02166                  *          =  [ sum      1 / variance_i ]
02167                  *
02168                  * For the entire order, accumulate
02169                  *
02170                  * Flux_y   =  [ sum weight_i * flux_i * (y-ymin)   ]
02171                  * Flux_yy  =  [ sum weight_i * flux_i * (y-ymin)^2 ]
02172          * Flux_tot =  [ sum weight_i * flux_i              ]
02173                  */
02174                 
02175                 flux  += weight*pixelval;
02176                 flux_variance += weight*weight * pixelvariance;
02177                 sum  += weight;
02178 
02179         /* For measuring object position + FWHM */
02180 
02181                 if (method != EXTRACT_ARCLAMP) 
02182                     {
02183                         flux_y  += weight * pixelval * (y-ylo);
02184                         flux_yy += weight * pixelval * (y-ylo)*(y-ylo);
02185                         flux_tot+= weight * pixelval;
02186                     }
02187             }/* If pixel was good */
02188         }/* for y ... */
02189                     
02190         /* This debugging message significantly increases the execution time 
02191          *  uves_msg_debug("Order %d, x=%d: %d - %d   pixels = %f  flux = %f", 
02192          order, x, ylo, yhi, sum, flux);
02193          */
02194 
02195         /* If any pixels were extracted */
02196         if (sum > 0)
02197             {
02198                 bins_extracted += 1;
02199                 
02200                 if (method == EXTRACT_ARCLAMP && flux_variance > 0) {
02201                     flux *= 1.0 / sum;
02202                     flux_variance = 1.0 / sum;                    
02203                 }
02204                 else if (method == EXTRACT_AVERAGE || method == EXTRACT_WEIGHTED) 
02205                     {
02206                         /* Divide by sum of weights */
02207                         flux *= 1.0 / sum;
02208                         flux_variance *= 1.0 / (sum*sum);
02209                     }
02210                 else {
02211                     /* Linear extraction */
02212                     
02213                     /* Normalize to slit length in the case of bad pixels */
02214                     flux *= slit_length / sum;
02215                     flux_variance *= (slit_length*slit_length) / (sum*sum);
02216                 }
02217 
02218                 /* Write result */
02219 
02220                 /* This will make the spectrum bad map pointer invalid:
02221                    check( cpl_image_set(spectrum, x, spectrum_row, flux),
02222                    "Could not write extracted flux at (%d, %d)", x, spectrum_row);
02223                 */
02224                 spectrum_data  [(x-1) + (spectrum_row-1) * nx] = flux;
02225                 spectrum_badmap[(x-1) + (spectrum_row-1) * nx] = CPL_BINARY_0;
02226 
02227                 if (spectrum_noise != NULL)
02228                     {
02229                         check( cpl_image_set(
02230                                    spectrum_noise, x, spectrum_row, sqrt(flux_variance)),
02231                                "Could not write noise at (%d, %d)", x, spectrum_row);
02232                     }
02233                     
02234         check_nomsg( cpl_table_set_double(
02235                signal_to_noise, "SN", sn_row, flux / sqrt(flux_variance)) );
02236         sn_row++;
02237 
02238             }/* if sum... */
02239         else
02240             {
02241                 /* Nothing extracted, reject bin */
02242                     
02243                 /* This is slow: 
02244                    check( cpl_image_reject(spectrum, x, spectrum_row),
02245                    "Could not reject bin at (x, row) = (%d, %d)", x, spectrum_row);
02246                        
02247                    if (spectrum_noise != NULL)
02248                    {
02249                    check( cpl_image_reject(spectrum_noise, x, spectrum_row),
02250                    "Could not reject bin at (x, row) = (%d, %d)", x, spectrum_row);
02251                    }
02252                 */
02253 
02254                 spectrum_badmap[(x-1) + (spectrum_row-1) * nx] = CPL_BINARY_1;
02255             }
02256 
02257     }/* for x... */
02258     
02259     if (info_tbl != NULL && *info_tbl != NULL && method != EXTRACT_ARCLAMP)
02260     {
02261       double objpos = 0;
02262       double fwhm =0;
02263       if(flux_tot != 0) {
02264         objpos = flux_y / flux_tot;
02265       } else {
02266         objpos = -1;  //we set to a negative value, which won't affect 
02267                       //the median of positive values
02268       }
02269         if (flux_yy/flux_tot - objpos*objpos >= 0)
02270         {
02271             fwhm = sqrt(flux_yy/flux_tot - objpos*objpos) * TWOSQRT2LN2;
02272         }
02273         else
02274         {
02275             fwhm = 0;
02276         }
02277         cpl_table_set_double(*info_tbl, "Pos"  , order - minorder, objpos);
02278         cpl_table_set_double(*info_tbl, "FWHM" , order - minorder, fwhm);
02279     }
02280 
02281     /* Get S/N */
02282     check_nomsg( cpl_table_set_size(signal_to_noise, sn_row) );
02283 
02284     if (sn_row > 0)
02285         {
02286             check_nomsg( *sn = cpl_table_get_column_median(signal_to_noise, "SN"));
02287         }
02288     else
02289         {
02290             *sn = 0;
02291         }
02292   
02293   cleanup:
02294     uves_free_table(&signal_to_noise);
02295     return bins_extracted;
02296 }
02297 
02298 /*----------------------------------------------------------------------------*/
02312 /*----------------------------------------------------------------------------*/
02313 static double
02314 area_above_line(int y, double left, double right)
02315 {
02316     double area = -1;               /* Result */
02317     double pixeltop = y + .5;       /* Top and bottom edges of pixel */
02318     double pixelbot = y - .5;
02319     double slope    = right - left;
02320 
02321     assure( 0 <= slope && slope <= 1, CPL_ERROR_ILLEGAL_INPUT, "Slope is %f", slope);
02322 
02323 /*  There are 5 cases to consider
02324 
02325    Case 1:
02326      (line below pixel)
02327     ___
02328    |   |
02329    |   |
02330    |___|/
02331        /
02332       /
02333      /
02334 
02335    Case 2:
02336     ___ 
02337    |   | 
02338    |  _|/
02339    |_/_|
02340     /
02341    Case 3:
02342     ___
02343    |  _|/
02344    |_/ |
02345   /|___|
02346     
02347    Case 4:
02348     ___
02349    | / |
02350    |/  |
02351    |___|
02352     
02353    Case 5:
02354      (line above pixel)
02355    /
02356   / ___
02357    |   |
02358    |   |
02359    |___|
02360     
02361 */
02362 
02363     if      (pixelbot > right)
02364         {   /* 1 */
02365             area = 1;
02366         }
02367     else if (pixelbot > left)
02368         {    /* 2. Area of triangle is height^2/(2*line_slope) */
02369             area = 1 -
02370                 (right - pixelbot) *
02371                 (right - pixelbot) / (2*slope);
02372         }
02373     else if (pixeltop > right)
02374         {     /* 3 */
02375             area = pixeltop - (left + right)/2;
02376         }
02377     else if (pixeltop > left)
02378         {      /* 4. See 2 */
02379             area =
02380                 (pixeltop - left) *
02381                 (pixeltop - left) / (2*slope);
02382         }
02383     else 
02384         {
02385             /* 5 */
02386             area = 0;
02387         }
02388     
02389   cleanup:
02390     return area;
02391 }
02392 
02393 
02394 /*----------------------------------------------------------------------------*/
02410 /*----------------------------------------------------------------------------*/
02411 
02412 static void
02413 revise_noise(cpl_image *image_noise,
02414          const cpl_binary *image_bpm,
02415          const uves_propertylist *image_header,
02416          uves_iterate_position *pos,
02417          const cpl_image *spectrum, 
02418          const cpl_image *sky_spectrum, 
02419          const uves_extract_profile *profile,
02420          enum uves_chip chip)
02421 {
02422     cpl_image *revised = NULL;
02423     cpl_image *simulated = NULL;
02424     const cpl_binary *spectrum_bpm = 
02425         cpl_mask_get_data_const(cpl_image_get_bpm_const(spectrum));
02426     double *simul_data;
02427     const double *spectrum_data;
02428     const double *sky_data;
02429 
02430     simulated = cpl_image_new(pos->nx, pos->ny,
02431                   CPL_TYPE_DOUBLE);
02432     assure_mem( simulated );
02433 
02434     simul_data    = cpl_image_get_data_double(simulated);
02435     spectrum_data = cpl_image_get_data_double_const(spectrum);
02436     sky_data      = cpl_image_get_data_double_const(sky_spectrum);
02437 
02438     for (uves_iterate_set_first(pos,
02439                 1, pos->nx,
02440                 pos->minorder, pos->maxorder,
02441                 NULL, false);
02442      !uves_iterate_finished(pos);
02443      uves_iterate_increment(pos))
02444     {
02445         if (SPECTRUM_DATA(spectrum_bpm, pos) == CPL_BINARY_0)
02446         {
02447             /* Need this before calling uves_extract_profile_evaluate() */
02448             uves_extract_profile_set(profile, pos, NULL);
02449 
02450             for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
02451             if (ISGOOD(image_bpm, pos))
02452                 {
02453                 /* Set pixel(x,y) = sky(x) + profile(x,y)*flux(x) */
02454                 DATA(simul_data, pos) = 
02455                     SPECTRUM_DATA(sky_data, pos)/pos->sg.length +
02456                     SPECTRUM_DATA(spectrum_data, pos) *
02457                     uves_extract_profile_evaluate(profile, pos);
02458                 }
02459             }
02460     }
02461 
02462     /* For debugging: 
02463        cpl_image_save(simulated, "/tmp/simul.fits", CPL_BPP_IEEE_FLOAT, NULL, CPL_IO_DEFAULT);
02464     */
02465 
02466     {
02467     int ncom = 1; /* no median stacking is involved */
02468 
02469     /* Note! Assumes de-biased, non-flatfielded data */
02470     check( revised = uves_define_noise(simulated,
02471                        image_header,
02472                        ncom, chip),
02473            "Error computing noise image");
02474     }
02475 
02476     /* Copy relevant parts to the input noise image */
02477     {
02478     double *revised_data = cpl_image_get_data_double(revised);
02479     double *input_data = cpl_image_get_data_double(image_noise);
02480 
02481     for (uves_iterate_set_first(pos,
02482                     1, pos->nx,
02483                     pos->minorder, pos->maxorder,
02484                     image_bpm, true);
02485          !uves_iterate_finished(pos);
02486          uves_iterate_increment(pos))
02487         {
02488         DATA(input_data, pos) = DATA(revised_data, pos);
02489         }
02490     }
02491         
02492   cleanup:
02493     uves_free_image(&simulated);
02494     uves_free_image(&revised);
02495 
02496     return;
02497 }
02498 
02499 /*----------------------------------------------------------------------------*/
02516 /*----------------------------------------------------------------------------*/
02517 static cpl_image *
02518 opt_extract_sky(const cpl_image *image, const cpl_image *image_noise,
02519                 const cpl_image *weights,
02520                 uves_iterate_position *pos,
02521                 cpl_image *sky_spectrum,
02522                 cpl_image *sky_spectrum_noise)
02523 {
02524     cpl_image  *sky_subtracted = NULL;        /* Result */
02525     cpl_table  *sky_map        = NULL;        /* Bitmap of sky/object (true/false)
02526                                                  pixels      */
02527     uves_msg("Defining sky region");
02528 
02529     check( sky_map = opt_define_sky(image, weights,
02530                                     pos),
02531            "Error determining sky window");
02532     
02533     uves_msg_low("%d/%d sky pixels", 
02534                  cpl_table_count_selected(sky_map),
02535                  cpl_table_get_nrow(sky_map));
02536 
02537     /* Extract the sky */
02538     uves_msg("Subtracting sky (method = median of sky channels)");
02539 
02540     check( sky_subtracted = opt_subtract_sky(image, image_noise, weights,
02541                                              pos,
02542                                              sky_map,
02543                                              sky_spectrum,
02544                                              sky_spectrum_noise),
02545            "Could not subtract sky");
02546 
02547   cleanup:
02548     uves_free_table(&sky_map);
02549     
02550     return sky_subtracted;
02551 }
02552 
02553 /*----------------------------------------------------------------------------*/
02565 /*----------------------------------------------------------------------------*/
02566 static cpl_table *
02567 opt_define_sky(const cpl_image *image, const cpl_image *weights,
02568                uves_iterate_position *pos)
02569 
02570 {
02571     cpl_table *sky_map = NULL;           /* Result */
02572 
02573     cpl_table **resampled = NULL;
02574     int nbins = 0;
02575     int i;
02576 
02577     /* Measure at all orders, resolution = 1 pixel */
02578     check( resampled = opt_sample_spatial_profile(image, weights,
02579                                                   pos,
02580                                                   50,          /* stepx */
02581                                                   1,           /* sampling resolution */
02582                                                   &nbins),
02583            "Error measuring spatial profile");
02584     
02585     sky_map = cpl_table_new(nbins);
02586     cpl_table_new_column(sky_map, "DY"  , CPL_TYPE_INT);    /* Bin id */
02587     cpl_table_new_column(sky_map, "Prof", CPL_TYPE_DOUBLE); /* Average profile */
02588 
02589     for (i = 0; i < nbins; i++)
02590         {
02591             cpl_table_set_int(sky_map, "DY"  , i, i - nbins/2);
02592             if (cpl_table_has_valid(resampled[i], "Prof"))
02593                 {
02594                     /* Use 90 percentile. If the median is used, we
02595                        will miss the object when the order definition 
02596                        is not good.
02597 
02598                        (The average wouldn't work as we need to reject
02599                        cosmic rays.)
02600                     */
02601                     int row = (cpl_table_get_nrow(resampled[i]) * 9) / 10;
02602 
02603                     uves_sort_table_1(resampled[i], "Prof", false);
02604 
02605                     cpl_table_set_double(sky_map, "Prof", i, 
02606                                          cpl_table_get_double(resampled[i], "Prof", row, NULL));
02607                 }
02608             else
02609                 {
02610                     cpl_table_set_invalid(sky_map, "Prof", i);
02611                 }
02612         }
02613 
02614     /* Fail cleanly in the unlikely case that input image had
02615        too few good pixels */
02616     assure( cpl_table_has_valid(sky_map, "Prof"), CPL_ERROR_DATA_NOT_FOUND,
02617             "Too many (%d/%d) bad pixels. Could not measure sky profile",
02618             cpl_image_count_rejected(image),
02619             pos->nx * pos->ny);
02620     
02621 
02622     /* Select sky channels = bins where profile < min + 2*(median-min) 
02623      * but less than (min+max)/2
02624      */
02625     {
02626         double prof_min = cpl_table_get_column_min(sky_map, "Prof");
02627         double prof_max = cpl_table_get_column_max(sky_map, "Prof");
02628         double prof_med = cpl_table_get_column_median(sky_map, "Prof");
02629         double sky_threshold = prof_min + 2*(prof_med - prof_min);
02630 
02631         sky_threshold = uves_min_double(sky_threshold, (prof_min + prof_max)/2);
02632         
02633         check( uves_plot_table(sky_map, "DY", "Prof", 
02634                                "Globally averaged spatial profile (sky threshold = %.5f)", 
02635                                sky_threshold),
02636                "Plotting failed");
02637         
02638         uves_select_table_rows(sky_map, "Prof", CPL_NOT_GREATER_THAN, sky_threshold);
02639     }
02640 
02641   cleanup:
02642     if (resampled != NULL)
02643         {
02644             for (i = 0; i < nbins; i++)
02645                 {
02646                     uves_free_table(&(resampled[i]));
02647                 }
02648             cpl_free(resampled);
02649         }
02650 
02651     return sky_map;
02652 }
02653 
02654 /*----------------------------------------------------------------------------*/
02672 /*----------------------------------------------------------------------------*/
02673 static cpl_table **
02674 opt_sample_spatial_profile(const cpl_image *image, const cpl_image *weights,
02675                            uves_iterate_position *pos,
02676                            int stepx,
02677                            int sampling_factor,
02678                            int *nbins)
02679 
02680 {
02681     cpl_table **resampled = NULL;          /* Array of tables,
02682                                               one table per y-bin.
02683                                               Contains the spatial profile
02684                                               for each y */
02685     int *resampled_row = NULL;             /* First unused row of above */
02686 
02687     const double *image_data;
02688     const double *weights_data;
02689     
02690     assure( stepx >= 1, CPL_ERROR_ILLEGAL_INPUT, "Step size = %d", stepx);
02691     assure( sampling_factor >= 1, CPL_ERROR_ILLEGAL_INPUT,
02692             "Sampling factor = %d", sampling_factor);
02693     
02694     image_data   = cpl_image_get_data_double_const(image);
02695     weights_data = cpl_image_get_data_double_const(weights);
02696 
02697     *nbins = uves_extract_profile_get_nbins(pos->sg.length, sampling_factor);
02698 
02699     resampled     = cpl_calloc(*nbins, sizeof(cpl_table *));
02700     resampled_row = cpl_calloc(*nbins, sizeof(int));
02701 
02702     assure_mem(resampled    );
02703     assure_mem(resampled_row);
02704     
02705     {
02706         int i;
02707         for (i = 0; i < *nbins; i++)
02708             {
02709                 resampled[i] = cpl_table_new((pos->nx/stepx+1)*
02710                                              (pos->maxorder-pos->minorder+1));
02711 
02712                 resampled_row[i] = 0;
02713                 assure_mem( resampled[i] );
02714                 
02715                 cpl_table_new_column(resampled[i], "X"    , CPL_TYPE_INT);
02716                 cpl_table_new_column(resampled[i], "Order", CPL_TYPE_INT);
02717                 cpl_table_new_column(resampled[i], "Prof" , CPL_TYPE_DOUBLE);
02718                 /* Don't store order number */
02719             }
02720     }
02721     
02722     for (uves_iterate_set_first(pos,
02723                                 1, pos->nx,
02724                                 pos->minorder, pos->maxorder,
02725                                 NULL, false);
02726          !uves_iterate_finished(pos);
02727          uves_iterate_increment(pos)) {
02728         if ((pos->x - 1) % stepx == 0)
02729             /* Look only at bins divisible by stepx */
02730             {
02731                 /* Linear extract bin */
02732                 double flux = 0;
02733                     
02734                 for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
02735                     if (!ISBAD(weights_data, pos)) {
02736                         flux += DATA(image_data, pos);
02737                     }
02738                 }
02739                     
02740                 if (flux != 0) {
02741                     for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
02742                         if (!ISBAD(weights_data, pos)) {
02743                             double f = DATA(image_data, pos);
02744                                 
02745                             /* Nearest bin */
02746                             int bin = uves_round_double(
02747                                 uves_extract_profile_get_bin(pos, sampling_factor));
02748                                 
02749                             passure( bin < *nbins, "%d %d", bin, *nbins);
02750                                 
02751                             /* Here the 'virtual resampling' consists 
02752                                of simply rounding to the nearest bin
02753                                (nearest-neighbour interpolation)
02754                             */
02755                             cpl_table_set_int   (resampled[bin], "X"    , 
02756                                                  resampled_row[bin], pos->x);
02757                             cpl_table_set_int   (resampled[bin], "Order", 
02758                                                  resampled_row[bin], pos->order);
02759                             cpl_table_set_double(resampled[bin], "Prof" , 
02760                                                  resampled_row[bin], f/flux);
02761                                 
02762                             resampled_row[bin]++;
02763                         }
02764                     }
02765                 }
02766             }
02767     }
02768     
02769     {
02770         int i;
02771         for (i = 0; i < *nbins; i++)
02772             {
02773                 cpl_table_set_size(resampled[i], resampled_row[i]);
02774             }
02775     }
02776     
02777     /* This is what we return */
02778     passure( cpl_table_get_ncol(resampled[0]) == 3, "%d",
02779              cpl_table_get_ncol(resampled[0]));
02780     passure( cpl_table_has_column(resampled[0], "X"), " ");
02781     passure( cpl_table_has_column(resampled[0], "Order"), " ");
02782     passure( cpl_table_has_column(resampled[0], "Prof"), " ");
02783 
02784   cleanup:
02785     cpl_free(resampled_row);
02786 
02787     return resampled;
02788 }
02789     
02790 
02791 
02792 /*----------------------------------------------------------------------------*/
02814 /*----------------------------------------------------------------------------*/
02815 static cpl_image * 
02816 opt_subtract_sky(const cpl_image *image, const cpl_image *image_noise,
02817                  const cpl_image *weights,
02818                  uves_iterate_position *pos,
02819                  const cpl_table *sky_map,
02820                  cpl_image *sky_spectrum,
02821                  cpl_image *sky_spectrum_noise)
02822 {
02823     cpl_image *sky_subtracted = cpl_image_duplicate(image);  /* Result, bad pixels
02824                                                                 are inherited */
02825     double *sky_subtracted_data;
02826     const double *image_data;
02827     const double *noise_data;
02828     const double *weights_data;
02829     double *buffer_flux  = NULL;  /* These buffers exist for efficiency reasons, to */
02830     double *buffer_noise = NULL;  /* avoid malloc/free for every bin */
02831 
02832     /* Needed because cpl_image_set() is slow */
02833     double *sky_spectrum_data     = NULL;
02834     double *sky_noise_data        = NULL;
02835     cpl_binary *sky_spectrum_bpm  = NULL;
02836     cpl_binary *sky_noise_bpm     = NULL;
02837     cpl_mask *temp                = NULL;
02838 
02839     assure_mem( sky_subtracted );
02840     
02841     image_data   = cpl_image_get_data_double_const(image);
02842     noise_data   = cpl_image_get_data_double_const(image_noise);
02843     weights_data = cpl_image_get_data_double_const(weights);
02844     sky_subtracted_data = cpl_image_get_data(sky_subtracted);
02845     
02846     buffer_flux  = cpl_malloc(uves_round_double(pos->sg.length + 5)*sizeof(double));
02847     buffer_noise = cpl_malloc(uves_round_double(pos->sg.length + 5)*sizeof(double));
02848 
02849 
02850     if (sky_spectrum != NULL)
02851         {
02852             sky_spectrum_data = cpl_image_get_data_double(sky_spectrum);
02853             sky_noise_data    = cpl_image_get_data_double(sky_spectrum_noise);
02854 
02855             /* Reject all bins in the extracted sky spectrum,
02856                then mark pixels as good if/when they are calculated later */
02857 
02858             temp = cpl_mask_new(cpl_image_get_size_x(sky_spectrum),
02859                                 cpl_image_get_size_y(sky_spectrum));
02860             cpl_mask_not(temp); /* Set all pixels to CPL_BINARY_1 */
02861 
02862             cpl_image_reject_from_mask(sky_spectrum      , temp);
02863             cpl_image_reject_from_mask(sky_spectrum_noise, temp);
02864 
02865             sky_spectrum_bpm  = cpl_mask_get_data(cpl_image_get_bpm(sky_spectrum));
02866             sky_noise_bpm     = cpl_mask_get_data(cpl_image_get_bpm(sky_spectrum_noise));
02867         }
02868 
02869     UVES_TIME_START("Subtract sky");
02870     
02871     for (uves_iterate_set_first(pos,
02872                                 1, pos->nx,
02873                                 pos->minorder, pos->maxorder,
02874                                 NULL, false);
02875          !uves_iterate_finished(pos);
02876          uves_iterate_increment(pos))
02877         {
02878             double sky_background, sky_background_noise;
02879             
02880             /* Get sky */
02881             sky_background = opt_get_sky(image_data, noise_data,
02882                                          weights_data,
02883                                          pos,
02884                                          sky_map,
02885                                          buffer_flux, buffer_noise,
02886                                          &sky_background_noise);
02887             
02888             /* Save sky */
02889             if (sky_spectrum != NULL)
02890                 {
02891                     /* Change normalization of sky from 1 pixel to full slit,
02892                        (i.e. same normalization as the extracted object) 
02893                        
02894                        Error propagation is trivial (just multiply 
02895                        by same factor) because the
02896                        uncertainty of 'slit_length' is negligible. 
02897                     */
02898                     
02899                     /*
02900                       cpl_image_set(sky_spectrum      , x, spectrum_row, 
02901                       slit_length * sky_background);
02902                       cpl_image_set(sky_spectrum_noise, x, spectrum_row,
02903                       slit_length * sky_background_noise);
02904                     */
02905                     SPECTRUM_DATA(sky_spectrum_data, pos) = 
02906                         pos->sg.length * sky_background;
02907                     SPECTRUM_DATA(sky_noise_data, pos) = 
02908                         pos->sg.length * sky_background_noise;
02909 
02910                     SPECTRUM_DATA(sky_spectrum_bpm, pos) = CPL_BINARY_0;
02911                     SPECTRUM_DATA(sky_noise_bpm   , pos) = CPL_BINARY_0;
02912                 }
02913             
02914             /* Subtract sky */
02915             for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
02916                 {
02917                     DATA(sky_subtracted_data, pos) = 
02918                         DATA(image_data, pos) - sky_background;
02919                     /* Don't update noise image. Error 
02920                        on sky determination is small. */
02921                     
02922                     /* BPM is duplicate of input image */
02923                 }
02924         }
02925 
02926     UVES_TIME_END;
02927     
02928   cleanup:
02929     uves_free_mask(&temp);
02930     cpl_free(buffer_flux);
02931     cpl_free(buffer_noise);
02932 
02933     return sky_subtracted;
02934 }
02935 
02936 
02937 /*----------------------------------------------------------------------------*/
02972 /*----------------------------------------------------------------------------*/
02973 
02974 static uves_extract_profile *
02975 opt_measure_profile(const cpl_image *image, const cpl_image *image_noise,
02976                     const cpl_image *weights,
02977                     uves_iterate_position *pos,
02978                     int chunk, int sampling_factor,
02979                     int (*f)   (const double x[], const double a[], double *result),
02980                     int (*dfda)(const double x[], const double a[], double result[]),
02981                     int M,
02982                     const cpl_image *sky_spectrum,
02983             cpl_table *info_tbl,
02984                     cpl_table **profile_global)
02985 {
02986     uves_extract_profile *profile = NULL;   /* Result    */
02987     int *stepx = NULL;                 /* per order or per spatial bin */
02988     int *good_bins = NULL;             /* per order or per spatial bin */
02989     cpl_table **profile_data  = NULL;  /* per order or per spatial bin */
02990     bool cont;               /* continue? */
02991 
02992     cpl_mask  *image_bad = NULL;
02993     cpl_binary*image_bpm = NULL;
02994 
02995     cpl_vector *plot0x = NULL;
02996     cpl_vector *plot0y = NULL;
02997     cpl_vector *plot1x = NULL;
02998     cpl_vector *plot1y = NULL;
02999     cpl_bivector *plot[] = {NULL, NULL};
03000     char *plot_titles[] = {NULL, NULL};
03001 
03002     int sample_bins = 100;   /* Is this used?? */
03003 
03004     /* Needed for virtual method */
03005     int spatial_bins = uves_extract_profile_get_nbins(pos->sg.length, sampling_factor);
03006     
03007     /* Convert weights image to bpm needed for 1d_fit.
03008      * The virtual resampling measurement will use the weights image
03009      */
03010     if (f != NULL)
03011         {
03012             image_bad = cpl_mask_new(pos->nx, pos->ny);
03013             assure_mem(image_bad);
03014             image_bpm = cpl_mask_get_data(image_bad);
03015             {
03016                 const double *weights_data = cpl_image_get_data_double_const(weights);
03017                 
03018                 for (pos->y = 1; pos->y <= pos->ny; pos->y++)
03019                     {
03020                         for (pos->x = 1; pos->x <= pos->nx; pos->x++)
03021                             {
03022                                 if (ISBAD(weights_data, pos))
03023                                     {
03024                                         DATA(image_bpm, pos) = CPL_BINARY_1;
03025                                     }
03026                             }
03027                     }
03028             }
03029         }
03030 
03031     if (f != NULL)
03032         {
03033             stepx        = cpl_malloc((pos->maxorder-pos->minorder+1) * sizeof(int));
03034             good_bins    = cpl_malloc((pos->maxorder-pos->minorder+1) * sizeof(int));
03035             profile_data = cpl_calloc( pos->maxorder-pos->minorder+1, sizeof(cpl_table *));
03036 
03037             assure_mem(stepx);
03038             assure_mem(good_bins);
03039             assure_mem(profile_data);
03040 
03041             for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
03042                 {
03043                     /*
03044                      * Get width of order inside image,
03045                      * and set stepx according to the
03046                      * total number of sample bins
03047                      */
03048                     int order_width;
03049                     
03050                     check( order_width = opt_get_order_width(pos),
03051                            "Error estimating width of order #%d", pos->order);
03052                     
03053                     /* If no bins were rejected, the
03054                        step size to use would be 
03055                        order_width/sample_bins
03056                        Add 1 to make stepx always positive 
03057                     */
03058                     
03059                     stepx    [pos->order-pos->minorder] = order_width / sample_bins + 1;
03060                     good_bins[pos->order-pos->minorder] = (2*sample_bins)/3;
03061                 }
03062         }
03063     else
03064         {
03065             int i;
03066 
03067             passure( f == NULL, " ");
03068 
03069             stepx        = cpl_malloc(sizeof(int) * spatial_bins);
03070             good_bins    = cpl_malloc(sizeof(int) * spatial_bins);
03071             /* No, they are currently allocated by opt_sample_spatial_profile:
03072                profile_data = cpl_calloc(spatial_bins, sizeof(cpl_table *));
03073             */
03074             profile_data = NULL;
03075 
03076             assure_mem(stepx);
03077             assure_mem(good_bins);
03078 
03079             for (i = 0; i < spatial_bins; i++)
03080                 {
03081                     /* Across the full chip we have
03082                           nx * norders * sg.ength / stepx  
03083                        measure positions.
03084                        We want (only):
03085                           sample_bins * spatial_bins * norders
03086                        so stepx = ...
03087                     */
03088 /*                  stepx    [i] = uves_round_double(
03089                     (pos->nx)*(pos->maxorder-pos->minorder+1)*pos->sg.length)/
03090                     (sample_bins*spatial_bins)
03091                     ) + 1;
03092 */
03093                     stepx    [i] = uves_round_double(
03094                         (pos->nx*pos->sg.length)/(sample_bins*spatial_bins)
03095                         ) + 1;
03096                     
03097                     good_bins[i] = sample_bins - 1;
03098                 }
03099         }
03100 
03101     /* Initialization done */
03102 
03103     /* Measure the object profile.
03104      * Iterate until we have at least 'sample_bins' good
03105      * measure points in each order,
03106      * or until the step size has decreased to 1
03107      *
03108      * For gauss/moffat methods, the profile is measured
03109      * in chunks of fixed size (using all the information
03110      * inside each chunk), and there are no iterations.
03111      *
03112      * For virtual method, the iteration is currently
03113      * not implemented (i.e. also no iterations here)
03114      *
03115      *  do
03116      *      update stepx
03117      *      measure using stepx
03118      *  until (for every order (and every spatial bin): good_bins >= sample_bins)
03119      *
03120      *  fit global polynomials to profile parameters
03121      */
03122 
03123     do  {
03124         /* Update stepx */
03125         int i;
03126 
03127         for (i = 0; i < ((f == NULL) ? spatial_bins : pos->maxorder-pos->minorder+1); i++)
03128                 {
03129                     if (f == NULL || profile_data[i] == NULL)
03130                         /* If we need to measure this order/spatial-bin (again) */
03131                         /* fixme: currently no iterations for virtual resampling */
03132                         {
03133                             passure(good_bins[i] < sample_bins, 
03134                                     "%d %d", good_bins[i], sample_bins);
03135                             
03136                             stepx[i] = (int) (stepx[i]*(good_bins[i]*0.8/sample_bins));
03137                             if (stepx[i] == 0) 
03138                                 {
03139                                     stepx[i] = 1;
03140                                 }
03141                             /* Example of above formula:
03142                                If we need       sample_bins=200,
03143                                but have only    good_bins=150,
03144                                then decrease stepsize to 150/200 = 75%
03145                                and then by another factor 0.8 (so we are 
03146                                more likely to end up with a few more
03147                                bins than needed, rather than a few less
03148                                bins than needed).
03149                                
03150                                Also note that stepx always decreases, so
03151                                the loop terminates.
03152                             */
03153                         }
03154                 }
03155 
03156         cont = false;
03157 
03158         /* Measure */
03159         if (f != NULL) {
03160 #if NEW_METHOD
03161             for (pos->order = pos->minorder; pos->order <= pos->minorder; pos->order++) {
03162 #else
03163             for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++) {
03164 #endif
03165                 /* Zero resampling */
03166                 if (profile_data[pos->order-pos->minorder] == NULL) {
03167                     int bins;
03168                     
03169                     check( profile_data[pos->order-pos->minorder] = 
03170                            opt_measure_profile_order(image, image_noise, image_bpm,
03171                                                      pos,
03172                                                      chunk,
03173                                                      f, dfda, M,
03174                                                      sky_spectrum),
03175                            "Error measuring profile of order #%d using chunk size = %d",
03176                            pos->order, chunk);
03177                                 
03178                     bins = cpl_table_get_nrow(profile_data[pos->order-pos->minorder]);
03179 
03180             uves_msg("Order %-2d: Chi^2/N = %.2f; FWHM = %.2f pix; Offset = %.2f pix",
03181                              pos->order,
03182                              (bins > 0) ? cpl_table_get_column_median(
03183                                  profile_data[pos->order-pos->minorder], 
03184                                  "Reduced_chisq") : 0,
03185                              /* Gaussian: fwhm = 2.35 sigma */
03186                              (bins > 0) ? cpl_table_get_column_median(
03187                                  profile_data[pos->order-pos->minorder], 
03188                                  "Sigma") * TWOSQRT2LN2 : 0,
03189                              (bins > 0) ? cpl_table_get_column_median(
03190                                  profile_data[pos->order-pos->minorder],
03191                                  "Y0") : 0);
03192 
03193                     /* Old way of doing things:
03194                        good_bins[pos->order-minorder] = bins;
03195                                 
03196                        Continue if there are not enough good bins for this order
03197                        if (good_bins[pos->order-minorder] < sample_bins &&
03198                            stepx[pos->order-minorder] >= 2)
03199                        {
03200                        cont = true;
03201                        uves_free_table(&(profile_data[pos->order-minorder]));
03202                        }
03203                     */
03204 
03205                     /* New method */
03206                     cont = false;
03207 
03208                 } /* if we needed to measure this order again */
03209             }
03210         }
03211         else
03212             /* Virtual method */
03213             {
03214                 int nbins = 0;
03215 
03216                 int step = 0; /* average of stepx */
03217                 for (i = 0; i < spatial_bins; i++)
03218                     {
03219                         step += stepx[i];
03220                     }
03221                 step /= spatial_bins;
03222                 
03223                 *profile_global = cpl_table_new(0);
03224                 assure_mem( *profile_global );
03225                 cpl_table_new_column(*profile_global, "Dummy" , CPL_TYPE_DOUBLE);
03226     
03227                 check( profile_data = opt_sample_spatial_profile(image, weights,
03228                                                                  pos, 
03229                                                                  step,
03230                                                                  sampling_factor,
03231                                                                  &nbins),
03232                        "Error measuring profile (virtual method)");
03233 
03234                 passure( nbins == spatial_bins, "%d %d", nbins, spatial_bins);
03235 
03236                 for (i = 0; i < spatial_bins; i++)
03237                     {
03238                         good_bins[i] = cpl_table_get_nrow(profile_data[i]);
03239                         
03240                         uves_msg_debug("Bin %d (%-3d samples): Prof = %f %d",
03241                                        i,
03242                                        good_bins[i],
03243                                        (good_bins[i] > 0) ? 
03244                                        cpl_table_get_column_median(profile_data[i], "Prof") : 0,
03245                                        stepx[i]);
03246                         
03247                         /* Continue if there are not enough measure points for this spatial bin */
03248                         //fixme:  disabled for now, need to cleanup and only measure
03249                         //bins when necessary
03250                         //if (false && good_bins[i] < sample_bins && stepx[i] >= 2)
03251                         //    {
03252                         //      cont = true;
03253                         //      uves_free_table(&(profile_data[i]));
03254                         //   }
03255                     }
03256             }
03257         
03258     } while(cont);
03259     
03260 
03261     /* Fit a global polynomial to each profile parameter */
03262     if (f == NULL)
03263         {
03264             int max_degree = 8;
03265             double kappa = 3.0;
03266             int i;
03267 
03268             uves_msg_low("Fitting global polynomials to "
03269                          "resampled profile (%d spatial bins)",
03270                          spatial_bins);
03271 
03272             uves_extract_profile_delete(&profile);
03273             profile = uves_extract_profile_new(NULL,
03274                                                NULL,
03275                                                0,
03276                                                pos->sg.length,
03277                                                sampling_factor);
03278 
03279             for (i = 0; i < spatial_bins; i++)
03280                 {
03281                     /* Do not make the code simpler by: 
03282              *       int n = cpl_table_get_nrow(profile_data[i]);
03283                      * because the table size is generally non-constant 
03284              */
03285                     
03286                     bool enough_points = (
03287                         cpl_table_get_nrow(profile_data[i]) >= (max_degree + 1)*(max_degree + 1));
03288                     
03289                     if (enough_points)
03290                         {
03291                             uves_msg_debug("Fitting 2d polynomial to spatial bin %d", i);
03292                             
03293                             if (true) {
03294                                 /* Clever but slow: */
03295                                 
03296                                 double min_reject = -0.01; /* negative value means disabled.
03297                                                               This optimization made the 
03298                                                               unit test fail. That should be
03299                                                               investigated before enabling this
03300                                                               optimization (is the unit test too strict?
03301                                                               or does the quality actually decrease?).
03302                                                               A good value is probably ~0.01
03303                                                             */
03304                                 profile->dy_poly[i] = uves_polynomial_regression_2d_autodegree(
03305                                     profile_data[i],
03306                                     "X", "Order", "Prof", NULL, 
03307                                     "Proffit", NULL, NULL,  /* new columns */
03308                                     NULL, NULL, NULL, /* mse, red_chisq, variance */
03309                                     kappa,
03310                                     max_degree, max_degree, -1, min_reject,
03311                                     false,    /* verbose? */
03312                                     NULL, NULL, 0, NULL);
03313                             } else {
03314                                 /* For testing only. Don't do like this. */
03315                                 /* This is no good at high S/N where a 
03316                                    precise profile measurement is crucial */
03317 
03318                                 profile->dy_poly[i] =
03319                                     uves_polynomial_regression_2d(profile_data[i],
03320                                                                   "X", "Order", "Prof", NULL, 
03321                                                                   0, 0,
03322                                                                   "Proffit", NULL, NULL,  /* new columns */
03323                                                                   NULL, NULL, NULL, kappa, -1);
03324                                     }
03325                                                         
03326                             if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
03327                                 {
03328                                     uves_error_reset();
03329                                     uves_msg_debug("Fitting bin %d failed", i);
03330 
03331                                     uves_polynomial_delete(&(profile->dy_poly[i]));
03332                                     enough_points = false;
03333                                 }
03334                             
03335                             assure( cpl_error_get_code() == CPL_ERROR_NONE,
03336                                     cpl_error_get_code(),
03337                                     "Could not fit polynomial to bin %d", i);
03338 
03339                         }/* if enough points  */
03340                                 
03341                     if (!enough_points)
03342                         {
03343                             /* Not enough points for fit (usually at edges of slit) */
03344 
03345                             profile->dy_poly[i] = uves_polynomial_new_zero(2);
03346                 
03347                 cpl_table_new_column(profile_data[i], "Proffit", CPL_TYPE_DOUBLE);
03348                             if (cpl_table_get_nrow(profile_data[i]) > 0)
03349                                 {
03350                                     cpl_table_fill_column_window_double(
03351                                         profile_data[i], "Proffit", 
03352                                         0, cpl_table_get_nrow(profile_data[i]),
03353                                         0);
03354                                 }
03355                         }
03356 
03357                     /* Optimization:
03358                        If zero degree, do quick evaluations later
03359                     */
03360                     profile->is_zero_degree[i] = (uves_polynomial_get_degree(profile->dy_poly[i]) == 0);
03361                     if (profile->is_zero_degree[i])
03362                         {
03363                             profile->dy_double[i] = uves_polynomial_evaluate_2d(profile->dy_poly[i], 0, 0);
03364                         }
03365                 } /* for each spatial bin */
03366         }
03367     else
03368         /* Analytical profile */
03369         {
03370             int max_degree;
03371             double min_rms = 0.1;  /* pixels, stop if this precision is achieved */
03372             double kappa = 3.0;  /* The fits to individual chunks can be noisy (due
03373                                     to low statistics), so use a rather low kappa */
03374 
03375             bool enough_points;  /* True iff the data allows fitting a polynomial */
03376 
03377             /* Merge individual order tables to global table before fitting */
03378             uves_free_table(profile_global);
03379             
03380 #if NEW_METHOD
03381             for (pos->order = pos->minorder; order <= pos->minorder; pos->order++)
03382 #else
03383             for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
03384 #endif
03385                 {
03386                     if (pos->order == pos->minorder)
03387                         {
03388                             *profile_global = cpl_table_duplicate(profile_data[0]);
03389                         }
03390                     else
03391                         {
03392                             /* Insert at top */
03393                             cpl_table_insert(*profile_global, 
03394                                              profile_data[pos->order-pos->minorder], 0);
03395                         }
03396         }
03397             
03398             uves_extract_profile_delete(&profile);
03399             profile = uves_extract_profile_new(f, dfda, M, 0, 0);
03400             
03401             /*
03402                For robustness against
03403                too small (i.e. wrong) uncertainties (which would cause
03404                single points to have extremely high weight 1/sigma^2),
03405                raise uncertainties to median before fitting.
03406             */
03407 
03408             max_degree = 5;
03409 
03410 #if ORDER_PER_ORDER
03411         for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
03412         {
03413             int degree = 4;
03414 #else
03415 #endif
03416 
03417             enough_points = 
03418 #if ORDER_PER_ORDER
03419                 (cpl_table_get_nrow(profile_data[pos->order-pos->minorder])
03420          >= (degree + 1));
03421 #else
03422             (cpl_table_get_nrow(*profile_global) >= (max_degree + 1)*(max_degree + 1));
03423 #endif
03424             if (enough_points)
03425                 {
03426                     double mse;
03427                     /* Make sure the fit has sensible values at the following positions */
03428                     double min_val = -pos->sg.length/2;
03429                     double max_val = pos->sg.length/2;
03430                     double minmax_pos[4][2];
03431                     minmax_pos[0][0] = 1      ; minmax_pos[0][1] = pos->minorder;
03432                     minmax_pos[1][0] = 1      ; minmax_pos[1][1] = pos->maxorder;
03433                     minmax_pos[2][0] = pos->nx; minmax_pos[2][1] = pos->minorder;
03434                     minmax_pos[3][0] = pos->nx; minmax_pos[3][1] = pos->maxorder;
03435                     
03436                     uves_msg_low("Fitting profile centroid = polynomial(x, order)");
03437                     
03438 #if ORDER_PER_ORDER
03439                     check_nomsg( uves_raise_to_median_frac(
03440                      profile_data[pos->order-pos->minorder], "dY0", 1.0) );
03441 
03442             profile->y0[pos->order - pos->minorder] = 
03443             uves_polynomial_regression_1d(
03444                 profile_data[pos->order-pos->minorder],
03445                 "X", "Y0", "dY0", degree,
03446                 "Y0fit", NULL,
03447                             &mse, kappa);
03448 #else                    
03449                     check_nomsg( uves_raise_to_median_frac(*profile_global, "dY0", 1.0) );
03450 
03451                     profile->y0 = 
03452                         uves_polynomial_regression_2d_autodegree(
03453                             *profile_global,
03454                             "X", "Order", "Y0", "dY0", 
03455                             "Y0fit", NULL, NULL,
03456                             &mse, NULL, NULL,
03457                             kappa,
03458                             max_degree, max_degree, min_rms, -1,
03459                             true,
03460                             &min_val, &max_val, 4, minmax_pos);
03461 #endif
03462             if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
03463                         {
03464                             uves_error_reset();
03465 #if ORDER_PER_ORDER
03466                             uves_polynomial_delete(&(profile->y0[pos->order - pos->minorder]));
03467 #else
03468                             uves_polynomial_delete(&(profile->y0));
03469 #endif
03470                             
03471                             enough_points = false;
03472                         }
03473                     else
03474                         {
03475                             assure( cpl_error_get_code() == CPL_ERROR_NONE,
03476                                     cpl_error_get_code(),
03477                                     "Error fitting object position");
03478                             
03479                             /* Fit succeeded */
03480 #if ORDER_PER_ORDER
03481 #else
03482                             uves_msg_low("Object offset at chip center = %.2f pixels",
03483                                          uves_polynomial_evaluate_2d(
03484                                              profile->y0,
03485                                              pos->nx/2,
03486                                              (pos->minorder+pos->maxorder)/2));
03487 #endif
03488                             
03489                             if (sqrt(mse) > 0.5)  /* Pixels */
03490                                 {
03491                                     uves_msg_warning("Problem localizing object "
03492                                                      "(usually RMS ~= 0.1 pixels)");
03493                                 }
03494                         }
03495                 }
03496 
03497             if (!enough_points)
03498                 {
03499 #if ORDER_PER_ORDER
03500                     uves_msg_warning("Too few points (%d) to fit global polynomial to "
03501                                      "object centroid. Setting offset to zero",
03502                                      cpl_table_get_nrow(profile_data[pos->order - pos->minorder])); 
03503 #else
03504                     uves_msg_warning("Too few points (%d) to fit global polynomial to "
03505                                      "object centroid. Setting offset to zero",
03506                                      cpl_table_get_nrow(*profile_global)); 
03507 #endif
03508                     
03509                     /* Set y0(x, m) := 0 */
03510 #if ORDER_PER_ORDER
03511                     profile->y0[pos->order - pos->minorder] = uves_polynomial_new_zero(1);
03512 
03513                     cpl_table_new_column(profile_data[pos->order-pos->minorder], "Y0fit", CPL_TYPE_DOUBLE);
03514                     if (cpl_table_get_nrow(profile_data[pos->order-pos->minorder]) > 0)
03515                         {
03516                             cpl_table_fill_column_window_double(
03517                                 profile_data[pos->order-pos->minorder], "Y0fit", 
03518                                 0, cpl_table_get_nrow(profile_data[pos->order-pos->minorder]),
03519                                 0);
03520                         }
03521 #else
03522                     profile->y0 = uves_polynomial_new_zero(2);
03523 
03524                     cpl_table_new_column(*profile_global, "Y0fit", CPL_TYPE_DOUBLE);
03525                     if (cpl_table_get_nrow(*profile_global) > 0)
03526                         {
03527                             cpl_table_fill_column_window_double(
03528                                 *profile_global, "Y0fit", 
03529                                 0, cpl_table_get_nrow(*profile_global),
03530                                 0);
03531                         }
03532 #endif                    
03533                 }
03534 #if ORDER_PER_ORDER
03535         } /* for order */
03536 #else
03537 #endif            
03538             max_degree = 3;
03539 
03540 #if ORDER_PER_ORDER
03541         for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
03542         {
03543             int degree = 4;
03544 #else
03545 #endif
03546             enough_points = 
03547 #if ORDER_PER_ORDER
03548                 (cpl_table_get_nrow(profile_data[pos->order-pos->minorder]) 
03549          >= (degree + 1));
03550 #else
03551             (cpl_table_get_nrow(*profile_global) >= (max_degree + 1)*(max_degree + 1));
03552 #endif
03553             if (enough_points)
03554                 {
03555                     double min_val = 0.1;
03556                     double max_val = pos->sg.length;
03557                     double minmax_pos[4][2];
03558                     minmax_pos[0][0] =      1 ; minmax_pos[0][1] = pos->minorder;
03559                     minmax_pos[1][0] =      1 ; minmax_pos[1][1] = pos->maxorder;
03560                     minmax_pos[2][0] = pos->nx; minmax_pos[2][1] = pos->minorder;
03561                     minmax_pos[3][0] = pos->nx; minmax_pos[3][1] = pos->maxorder;
03562                     
03563                     uves_msg_low("Fitting profile width = polynomial(x, order)");
03564 
03565 #if ORDER_PER_ORDER
03566                     check_nomsg( uves_raise_to_median_frac(
03567                      profile_data[pos->order-pos->minorder], "dSigma", 1.0) );
03568                  
03569             
03570             profile->sigma[pos->order - pos->minorder] = 
03571                  uves_polynomial_regression_1d(
03572                      profile_data[pos->order-pos->minorder],
03573                      "X", "Sigma", "dSigma", degree,
03574                      "Sigmafit", NULL,
03575                      NULL, kappa);
03576 #else
03577                     check_nomsg( uves_raise_to_median_frac(*profile_global, "dSigma", 1.0) );
03578 
03579                     profile->sigma = 
03580                         uves_polynomial_regression_2d_autodegree(
03581                             *profile_global,
03582                             "X", "Order", "Sigma", "dSigma",
03583                             "Sigmafit", NULL, NULL,
03584                             NULL, NULL, NULL,
03585                             kappa,
03586                             max_degree, max_degree, min_rms, -1,
03587                             true,
03588                             &min_val, &max_val, 4, minmax_pos);
03589 #endif
03590 
03591                     if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
03592                         {
03593                             uves_error_reset();
03594 #if ORDER_PER_ORDER
03595                             uves_polynomial_delete(&(profile->sigma[pos->order - pos->minorder]));
03596 #else
03597                             uves_polynomial_delete(&(profile->sigma));
03598 #endif
03599                             
03600                             enough_points = false;
03601                         }
03602                     else
03603                         {
03604                             assure( cpl_error_get_code() == CPL_ERROR_NONE,
03605                                     cpl_error_get_code(),
03606                                     "Error fitting profile width");
03607 
03608 #if ORDER_PER_ORDER                            
03609 #else
03610                             uves_msg_low("Profile FWHM at chip center = %.2f pixels",
03611                                          TWOSQRT2LN2 * uves_polynomial_evaluate_2d(
03612                                              profile->sigma,
03613                                              pos->nx/2,
03614                                              (pos->minorder+pos->maxorder)/2));
03615 #endif
03616                         }
03617                 }
03618             
03619             if (!enough_points)
03620                 {
03621 #if ORDER_PER_ORDER
03622                     uves_msg_warning("Too few points (%d) to fit global polynomial to "
03623                                      "object width. Setting std.dev. to 1 pixel",
03624                                      cpl_table_get_nrow(profile_data[pos->order - pos->minorder])); 
03625 #else
03626                     uves_msg_warning("Too few points (%d) to fit global polynomial to "
03627                                      "object width. Setting std.dev. to 1 pixel",
03628                              cpl_table_get_nrow(*profile_global)); 
03629 #endif
03630                     
03631                     /* Set sigma(x, m) := 1 */
03632 #if ORDER_PER_ORDER
03633                     profile->sigma[pos->order - pos->minorder] = uves_polynomial_new_zero(1);
03634                     uves_polynomial_shift(profile->sigma[pos->order - pos->minorder], 0, 1.0);
03635 
03636                     cpl_table_new_column(profile_data[pos->order-pos->minorder], "Sigmafit", CPL_TYPE_DOUBLE);
03637                     if (cpl_table_get_nrow(profile_data[pos->order-pos->minorder]) > 0)
03638                         {
03639                             cpl_table_fill_column_window_double(
03640                                 profile_data[pos->order-pos->minorder], "Sigmafit", 
03641                                 0, cpl_table_get_nrow(profile_data[pos->order-pos->minorder]),
03642                                 1.0);
03643                         }
03644 #else
03645                     profile->sigma = uves_polynomial_new_zero(2);
03646                     uves_polynomial_shift(profile->sigma, 0, 1.0);
03647 
03648                     cpl_table_new_column(*profile_global, "Sigmafit", CPL_TYPE_DOUBLE);
03649                     if (cpl_table_get_nrow(*profile_global) > 0)
03650                         {
03651                             cpl_table_fill_column_window_double(
03652                                 *profile_global, "Sigmafit", 
03653                                 0, cpl_table_get_nrow(*profile_global),
03654                                 1.0);
03655                         }
03656 #endif                    
03657 
03658                 }
03659 
03660             /* Don't fit a 2d polynomial to chi^2/N. Just use a robust average 
03661                (i.e. a (0,0) degree polynomial) */
03662             
03663 #if ORDER_PER_ORDER
03664             profile->red_chisq[pos->order - pos->minorder] = uves_polynomial_new_zero(1);
03665             uves_polynomial_shift(profile->red_chisq[pos->order - pos->minorder], 0,
03666                                   cpl_table_get_nrow(profile_data[pos->order - pos->minorder]) > 0 ?
03667                                   cpl_table_get_column_median(profile_data[pos->order - pos->minorder],
03668                                                               "Reduced_chisq") : 1.0);
03669 #else
03670             profile->red_chisq = uves_polynomial_new_zero(2);
03671             uves_polynomial_shift(profile->red_chisq, 0,
03672                                   cpl_table_get_nrow(*profile_global) > 0 ?
03673                                   cpl_table_get_column_median(*profile_global,
03674                                                               "Reduced_chisq") : 1.0);
03675 #endif
03676             
03677             /*
03678             if (cpl_table_get_nrow(*profile_global) >= (max_degree + 1)*(max_degree + 1))
03679                 {
03680                     uves_msg_low("Fitting chi^2/N = polynomial(x, order)");
03681                     
03682                     check(      profile->red_chisq = 
03683                                 uves_polynomial_regression_2d_autodegree(
03684                                 *profile_global,
03685                                 "X", "Order", "Reduced_chisq", NULL,
03686                                 NULL, NULL, NULL,
03687                                 NULL, NULL, NULL,
03688                                 kappa,
03689                                 max_degree, max_degree, -1, true),
03690                                 "Error fitting chi^2/N");
03691                 }
03692             else
03693                 {
03694                     uves_msg_warning("Too few points (%d) to fit global polynomial to "
03695                                      "chi^2/N. Setting chi^2/N to 1",
03696                                      cpl_table_get_nrow(*profile_global)); 
03697                     
03698                     profile->red_chisq = uves_polynomial_new_zero(2);
03699                     uves_polynomial_shift(profile->red_chisq, 0, 1.0);
03700                 }
03701             */
03702 #if ORDER_PER_ORDER
03703     } /* for order */
03704 
03705     /* Make sure the global table is consistent */
03706     uves_free_table(profile_global);
03707     for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
03708     {
03709         if (pos->order == pos->minorder)
03710         {
03711             *profile_global = cpl_table_duplicate(profile_data[0]);
03712         }
03713         else
03714         {
03715             /* Insert at top */
03716             cpl_table_insert(*profile_global, 
03717                      profile_data[pos->order-pos->minorder], 0);
03718         }
03719     }
03720 #else
03721 #endif
03722 
03723     } /* if  f != NULL  */
03724 
03725     /* Done fitting */
03726 
03727     /* Plot inferred profile at center of chip */
03728     {
03729         int xmin = uves_max_int(1 , pos->nx/2-100);
03730         int xmax = uves_min_int(pos->nx, pos->nx/2+100);
03731         int order = (pos->minorder + pos->maxorder)/2;
03732         int indx;
03733 
03734         plot0x = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
03735         plot0y = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
03736         plot1x = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
03737         plot1y = cpl_vector_new(uves_round_double(pos->sg.length+5)*(xmax-xmin+1));
03738         indx = 0;
03739         assure_mem( plot0x );
03740         assure_mem( plot0y );
03741         assure_mem( plot1x );
03742         assure_mem( plot1y );
03743 
03744         for (uves_iterate_set_first(pos,
03745                                     xmin, xmax,
03746                                     order, order,
03747                                     NULL, false);
03748              !uves_iterate_finished(pos);
03749              uves_iterate_increment(pos))
03750             
03751             {
03752                 /* Linear extract (to enable plotting raw profile) */
03753                 double flux = 0;
03754                 for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
03755                     {
03756                         int pis_rejected;
03757                         double pixelval = cpl_image_get(image, pos->x, pos->y, &pis_rejected);
03758                         if (!pis_rejected)
03759                             {
03760                                 flux += pixelval;
03761                             }
03762                     }
03763                 
03764                 uves_extract_profile_set(profile, pos, NULL);
03765                 
03766                 /* Get empirical and model profile */
03767                 for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
03768                     {
03769                         double dy = pos->y - pos->ycenter;
03770                         int pis_rejected;
03771                         double pixelval = cpl_image_get(
03772                             image, pos->x, uves_round_double(pos->y), &pis_rejected);
03773                         
03774                         if (!pis_rejected && flux != 0)
03775                             {
03776                                 pixelval /= flux;
03777                             }
03778                         else
03779                             {
03780                                 pixelval = 0;  /* Plot something anyway, if pixel is bad */
03781                             }
03782 
03783                         cpl_vector_set(plot0x, indx, dy);
03784                         cpl_vector_set(plot0y, indx, uves_extract_profile_evaluate(profile, pos));
03785 
03786                         cpl_vector_set(plot1x, indx, dy);
03787                         cpl_vector_set(plot1y, indx, pixelval);
03788                         
03789                         indx++;
03790                     }
03791             }
03792 
03793     if (indx > 0)
03794         {
03795         cpl_vector_set_size(plot0x, indx);
03796         cpl_vector_set_size(plot0y, indx);
03797         cpl_vector_set_size(plot1x, indx);
03798         cpl_vector_set_size(plot1y, indx);
03799         
03800         plot[0] = cpl_bivector_wrap_vectors(plot0x, plot0y);
03801         plot[1] = cpl_bivector_wrap_vectors(plot1x, plot1y);
03802         
03803         plot_titles[0] = uves_sprintf(
03804             "Model spatial profile at (order, x) = (%d, %d)", order, pos->nx/2);
03805         plot_titles[1] = uves_sprintf(
03806             "Empirical spatial profile at (order, x) = (%d, %d)", order, pos->nx/2);
03807         
03808         check( uves_plot_bivectors(plot, plot_titles, 2, "DY", "Profile"), "Plotting failed");
03809         }
03810     else
03811         {
03812         uves_msg_warning("No points to plot. This may happen if the order "
03813                  "polynomial is ill-formed");
03814         }
03815     } /* end plotting */
03816     
03817     if (f != NULL)
03818         {
03819             /*
03820              * Create column 'y0fit_world' (fitted value in absolute coordinate),
03821              * add order location center to y0fit
03822              */
03823             int i;
03824 
03825             for (i = 0; i < cpl_table_get_nrow(*profile_global); i++)
03826                 {
03827                     double y0fit = cpl_table_get_double(*profile_global, "Y0fit", i, NULL);
03828                     int order    = cpl_table_get_int   (*profile_global, "Order", i, NULL);
03829                     int x        = cpl_table_get_int   (*profile_global, "X"    , i, NULL);
03830 
03831                     /* This will calculate ycenter */
03832                     uves_iterate_set_first(pos, 
03833                                            x, x,
03834                                            order, order,
03835                                            NULL,
03836                                            false);
03837                   
03838                     cpl_table_set_double(*profile_global, "Y0fit_world", i, y0fit + pos->ycenter);
03839                 }
03840 
03841             /* Warn about bad detection */
03842 #if NEW_METHOD
03843             for (pos->order = pos->minorder; pos->order <= pos->minorder; pos->order++)
03844 #else
03845             for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
03846 #endif
03847                 {
03848                     if (good_bins[pos->order-pos->minorder] == 0)
03849                         {
03850                             uves_msg_warning("Order %d: Failed to detect object!", pos->order);
03851                         }
03852                 }
03853 
03854         /* Store parameters for QC
03855            (in virtual mode these are calculated elsewhere) */
03856         for (pos->order = pos->minorder; pos->order <= pos->maxorder; pos->order++)
03857         {
03858 #if ORDER_PER_ORDER
03859             double objpos;
03860             check_nomsg(
03861                 objpos = 
03862                 uves_polynomial_evaluate_1d(profile->y0[pos->order-pos->minorder],
03863                             pos->nx/2)
03864                 - ( - pos->sg.length/2 ));
03865             double fwhm = 
03866             uves_polynomial_evaluate_1d(profile->sigma[pos->order-pos->minorder],
03867                             pos->nx/2) * TWOSQRT2LN2;
03868 
03869 
03870             cpl_table_set_double(info_tbl, "Pos"  , pos->order - pos->minorder, objpos);
03871             cpl_table_set_double(info_tbl, "FWHM" , pos->order - pos->minorder, fwhm);
03872 #else
03873             double objpos  = 
03874             uves_polynomial_evaluate_2d(profile->y0, pos->nx/2, pos->order)
03875             - ( - pos->sg.length/2 );
03876             double fwhm = 
03877             uves_polynomial_evaluate_2d(profile->sigma   , pos->nx/2, pos->order)*
03878             TWOSQRT2LN2;
03879 
03880             cpl_table_set_double(info_tbl, "Pos"  , pos->order - pos->minorder, objpos);
03881             cpl_table_set_double(info_tbl, "FWHM" , pos->order - pos->minorder, fwhm);
03882 #endif
03883         }
03884                 
03885             /* Quality check on assumed profile (good fit: red.chisq ~= 1) */
03886             if (cpl_table_get_nrow(*profile_global) > 0)
03887                 {
03888                     double med_chisq = cpl_table_get_column_median(
03889                         *profile_global, "Reduced_chisq");
03890                     double limit = 5.0;
03891                     
03892                     if (med_chisq > limit || med_chisq < 1/limit)
03893                         {
03894                             /* The factor 5 is somewhat arbitrary.
03895                              * As an empirical fact, red_chisq ~= 1 for
03896                              * virtually resampled profiles (high and low
03897                              * S/N). This indicates that 1) the noise
03898                              * model and 2) the inferred profile are
03899                              * both correct. (If one or both of them
03900                              * were wrong it would a strange coincidence
03901                              * that we get red_chisq ~= 1.)
03902                              */
03903                             uves_msg_warning("Assumed spatial profile might not be a "
03904                                              "good fit to the data: median(Chi^2/N) = %f",
03905                                              med_chisq);
03906                             
03907                             if (f != NULL && med_chisq > limit)
03908                                 {
03909                                     uves_msg_warning("Recommended profile "
03910                                                      "measuring method: virtual");
03911                                 }
03912                         }
03913                     else
03914                         {
03915                             uves_msg("Median(reduced Chi^2) is %f", med_chisq);
03916                         }
03917                 }
03918         }
03919     else
03920         {
03921             /* fixme: calculate and report chi^2 (requires passing noise image
03922                to the profile sampling function)    */      
03923         }
03924 
03925   cleanup:
03926     uves_free_mask(&image_bad);
03927     cpl_free(stepx);
03928     cpl_free(good_bins);
03929     if (profile_data != NULL)
03930         {
03931             int i;
03932             for (i = 0; i < ((f == NULL) ? spatial_bins : pos->maxorder-pos->minorder+1); i++)
03933                 {
03934                     if (profile_data[i] != NULL)
03935                         {
03936                             uves_free_table(&(profile_data[i]));
03937                         }
03938                 }
03939             cpl_free(profile_data);
03940         }
03941     cpl_bivector_unwrap_vectors(plot[0]);
03942     cpl_bivector_unwrap_vectors(plot[1]);
03943     cpl_free(plot_titles[0]);
03944     cpl_free(plot_titles[1]);
03945     uves_free_vector(&plot0x);
03946     uves_free_vector(&plot0y);
03947     uves_free_vector(&plot1x);
03948     uves_free_vector(&plot1y);
03949     
03950     return profile;
03951 }
03952 
03953 #if NEW_METHOD
03954 struct
03955 {
03956     double *flux; /* Array [0..nx][minorder..maxorder] x = 0 is not used */
03957     double *sky;  /* As above */
03958     int minorder, nx; /* Needed for indexing of arrays above */
03959 
03960     int (*f)   (const double x[], const double a[], double *result);
03961     int (*dfda)(const double x[], const double a[], double result[]);
03962 
03963     int deg_y0_x;
03964     int deg_y0_m;
03965     int deg_sigma_x;
03966     int deg_sigma_m;
03967 } profile_params;
03968 
03969 /*
03970   Evaluate 2d polynomial
03971   degrees must be zero or more
03972 */
03973 inline static double
03974 eval_pol(const double *coeffs, 
03975          int degree1, int degree2,
03976          double x1, double x2)
03977 {
03978     double result = 0;
03979     double x2j;    /* x2^j */
03980     int j;
03981 
03982     for (j = 0, x2j = 1;
03983          j <= degree2;
03984          j++, x2j *= x2)
03985         {
03986             /* Use Horner's scheme to sum the coefficients
03987                involving x2^j */
03988 
03989             int i = degree1;
03990             double r = coeffs[i + (degree1+1)*j];
03991             
03992             while(i > 0)
03993                 {
03994                     r *= x1;
03995                     i -= 1;
03996                     r += coeffs[i + (degree1+1)*j];
03997                 }
03998             
03999             /* Finished using Horner. Add to grand result */
04000             result += x2j*r;
04001         }
04002 
04003     return result;
04004 }
04005 
04006 /*
04007   @brief  evaluate 2d profile
04008   @param x      length 3 array of (xi, yi, mi)
04009   @param a      all polynomial coefficients
04010   @param result (output) result
04011   @return zero iff success
04012 
04013   This function evaluates
04014 
04015   P(xi, yi ; a) = S_xi + F_xi * (normalized profile)
04016 
04017   using the data in 'profile_params' which must have been
04018   already initialized
04019 */
04020 static int
04021 profile_f(const double x[], const double a[], double *result)
04022 {
04023     int xi = uves_round_double(x[0]);
04024     double yi = x[1];
04025     int mi = uves_round_double(x[2]);
04026     int idx;
04027 
04028     double y_0   = eval_pol(a,
04029                             profile_params.deg_y0_x,
04030                             profile_params.deg_y0_m,
04031                             xi, mi);
04032     double sigma = eval_pol(a + (1 + profile_params.deg_y0_x)*(1 + profile_params.deg_y0_m),
04033                             profile_params.deg_sigma_x,
04034                             profile_params.deg_sigma_m,
04035                             xi, mi);
04036 
04037     /* Now evaluate normalized profile */
04038     double norm_prof;
04039 
04040     double xf[1];  /* Point of evaluation */
04041 
04042     double af[5];  /* Parameters */
04043     af[0] = y_0;   /* centroid   */
04044     af[1] = sigma; /* stdev      */
04045     af[2] = 1;     /* norm       */
04046     af[3] = 0;     /* offset     */
04047     af[4] = 0;     /* non-linear sky */
04048 
04049     xf[0] = yi;
04050 
04051     if (profile_params.f(xf, af, &norm_prof) != 0)
04052         {
04053             return 1;
04054         }
04055 
04056     idx = xi + (mi - profile_params.minorder)*(profile_params.nx + 1);
04057 
04058     *result = profile_params.sky[idx] + profile_params.flux[idx] * norm_prof;
04059 
04060     return 0;
04061 }
04062 
04063 /*
04064   @brief  evaluate 2d profile partial derivatives
04065   @param x      length 3 array of (xk, yk, mk)
04066   @param a      all polynomial coefficients
04067   @param result (output) result
04068   @return zero iff success
04069 
04070   This function evaluates the partial derivatives
04071   (with respect to the polynomial coefficients) of the function above
04072 
04073   (1) dP/da_ij(xk, yk ; a) = F_xk * d(normalized profile)/dy0    * xk^i mk^j 
04074   (2) dP/da_ij(xk, yk ; a) = F_xk * d(normalized profile)/dsigma * xk^ii mk^jj
04075 
04076   (using the chain rule on the 1d profile function)
04077 
04078   Here (1) is used for the coefficients that y0 depend on, i.e.
04079   for (i + (deg_y0_x+1)*j) < (deg_y0_x+1)(deg_y0_m+1)
04080 
04081   and (2) is used for the remaining coefficients which sigma depend on
04082   (ii and jj are appropriate functions of i and j)
04083 
04084 */
04085 static int
04086 profile_dfda(const double x[], const double a[], double result[])
04087 {
04088     int xi = uves_round_double(x[0]);
04089     double yi = x[1];
04090     int mi = uves_round_double(x[2]);
04091 
04092     double y_0   = eval_pol(a,
04093                             profile_params.deg_y0_x,
04094                             profile_params.deg_y0_m,
04095                             xi, mi);
04096     double sigma = eval_pol(a + (1 + profile_params.deg_y0_x)*(1 + profile_params.deg_y0_m),
04097                             profile_params.deg_sigma_x,
04098                             profile_params.deg_sigma_m,
04099                             xi, mi);
04100 
04101     double norm_prof_derivatives[5];
04102 
04103     double xf[1];  /* Point of evaluation */
04104 
04105     double af[5];  /* Parameters */
04106     af[0] = y_0;   /* centroid   */
04107     af[1] = sigma; /* stdev      */
04108     af[2] = 1;     /* norm       */
04109     af[3] = 0;     /* offset     */
04110     af[4] = 0;     /* non-linear sky */
04111 
04112     xf[0] = yi;
04113 
04114     if (profile_params.dfda(xf, af, norm_prof_derivatives) != 0)
04115         {
04116             return 1;
04117         }
04118 
04119     {
04120         int idx = xi + (mi - profile_params.minorder)*(profile_params.nx + 1);
04121 
04122         /* Need only these two */
04123         double norm_prof_dy0    = norm_prof_derivatives[0];
04124         double norm_prof_dsigma = norm_prof_derivatives[1];
04125         int i, j;
04126         
04127         /* Compute all the derivatives 
04128               flux(xk)*df/dy0 * x^i m^j
04129 
04130            It is only the product (x^i m^j) that changes, so use
04131            recurrence to caluculate the coefficients, in
04132            this order (starting from (i,j) = (0,0))):
04133 
04134               (0,0) -> (1,0) -> (2,0) -> ...
04135                 V
04136               (0,1) -> (1,1) -> (2,1) -> ...
04137                 V
04138               (0,2) -> (1,2) -> (2,2) -> ...
04139                 V
04140                 :
04141         */
04142         i = 0;
04143         j = 0;
04144         result[i + (profile_params.deg_y0_x + 1) * j] = profile_params.flux[idx] * norm_prof_dy0;
04145         for (j = 0; j <= profile_params.deg_y0_m; j++) {
04146             if (j >= 1)
04147                 {
04148                     i = 0;
04149                     result[i + (profile_params.deg_y0_x + 1) * j] = 
04150                     result[i + (profile_params.deg_y0_x + 1) * (j-1)] * mi;
04151                 }
04152             for (i = 1; i <= profile_params.deg_y0_x; i++) {
04153                 result[i   + (profile_params.deg_y0_x + 1) * j] = 
04154                 result[i-1 + (profile_params.deg_y0_x + 1) * j] * xi;
04155             }
04156         }
04157 
04158 
04159         /* Calculate the derivatives flux(xk)*df/dsigma * x^i m^j,
04160            like above (but substituting y0->sigma where relevant).
04161            Insert the derivatives in the result
04162            array starting after the derivatives related to y0,
04163            i.e. at index (deg_y0_x+1)(deg_y0_m+1).
04164         */
04165 
04166         result += (profile_params.deg_y0_x + 1) * (profile_params.deg_y0_m + 1); 
04167         /* Pointer arithmetics which skips
04168            the first part of the array */
04169 
04170         i = 0;
04171         j = 0;
04172         result[i + (profile_params.deg_sigma_x + 1) * j] = 
04173             profile_params.flux[idx] * norm_prof_dsigma;
04174         for (j = 0; j <= profile_params.deg_sigma_m; j++) {
04175             if (j >= 1)
04176                 {
04177                     i = 0;
04178                     result[i + (profile_params.deg_sigma_x + 1) * j] =
04179                     result[i + (profile_params.deg_sigma_x + 1) * (j-1)] * mi;
04180                 }
04181             for (i = 1; i <= profile_params.deg_sigma_x; i++) {
04182                 result[i   + (profile_params.deg_sigma_x + 1) * j] = 
04183                 result[i-1 + (profile_params.deg_sigma_x + 1) * j] * xi;
04184             }
04185         }
04186     }
04187 
04188     return 0;
04189 }
04190 #endif /* NEW_METHOD */
04191 /*----------------------------------------------------------------------------*/
04211 /*----------------------------------------------------------------------------*/
04212 static cpl_table *
04213 opt_measure_profile_order(const cpl_image *image, const cpl_image *image_noise,
04214                           const cpl_binary *image_bpm,
04215                           uves_iterate_position *pos,
04216                           int chunk,
04217                           int (*f)   (const double x[], const double a[], double *result),
04218                           int (*dfda)(const double x[], const double a[], double result[]),
04219                           int M,
04220                           const cpl_image *sky_spectrum)
04221 {
04222     cpl_table *profile_data = NULL; /* Result */
04223     int profile_row;
04224     cpl_matrix *covariance  = NULL;
04225 
04226 #if NEW_METHOD
04227     cpl_matrix *eval_points = NULL;
04228     cpl_vector *eval_data   = NULL;
04229     cpl_vector *eval_err    = NULL;
04230     cpl_vector *coeffs      = NULL;
04231 #if CREATE_DEBUGGING_TABLE
04232     cpl_table *temp = NULL;
04233 #endif
04234     double *fluxes = NULL;
04235     double *skys   = NULL;
04236     int *ia = NULL;
04237     /* For initial estimates of y0,sigma: */
04238     cpl_table *estimate = NULL; 
04239     cpl_table *estimate_dup = NULL; 
04240     polynomial *y0_estim_pol    = NULL;
04241     polynomial *sigma_estim_pol = NULL;
04242 #endif
04243     
04244 
04245     cpl_vector *dy = NULL;         /* spatial position */
04246     cpl_vector *prof = NULL;       /* normalized profile */
04247     cpl_vector *prof2= NULL;       /* kill me */
04248     cpl_vector *dprof = NULL;      /* uncertainty of 'prof' */
04249     cpl_vector **data = NULL;      /* array of vectors */
04250     int *size = NULL;              /* array of vector sizes */
04251     double *hicut = NULL;          /* array of vector sizes */
04252     double *locut = NULL;          /* array of vector sizes */
04253     int nbins = 0;
04254 
04255     const double *image_data;
04256     const double *noise_data;
04257 
04258     int x;
04259     
04260 #if NEW_METHOD
04261     int norders = pos->maxorder-pos->minorder+1;
04262 #else
04263     /* eliminate warning */
04264      sky_spectrum = sky_spectrum;
04265 #endif
04266 
04267      passure( f != NULL, " ");
04268 
04269     image_data = cpl_image_get_data_double_const(image);
04270     noise_data = cpl_image_get_data_double_const(image_noise);
04271 
04272 #if NEW_METHOD
04273     profile_data = cpl_table_new((nx/chunk + 3) * norders);
04274 #else
04275     profile_data = cpl_table_new(pos->nx);
04276 #endif
04277     assure_mem( profile_data );
04278     
04279     check( (cpl_table_new_column(profile_data, "Order", CPL_TYPE_INT),
04280             cpl_table_new_column(profile_data, "X", CPL_TYPE_INT),
04281             cpl_table_new_column(profile_data, "Y0", CPL_TYPE_DOUBLE),
04282             cpl_table_new_column(profile_data, "Sigma", CPL_TYPE_DOUBLE),
04283             cpl_table_new_column(profile_data, "Norm", CPL_TYPE_DOUBLE),
04284             cpl_table_new_column(profile_data, "dY0", CPL_TYPE_DOUBLE),
04285             cpl_table_new_column(profile_data, "dSigma", CPL_TYPE_DOUBLE),
04286             cpl_table_new_column(profile_data, "dNorm", CPL_TYPE_DOUBLE),
04287             cpl_table_new_column(profile_data, "Y0_world", CPL_TYPE_DOUBLE),
04288             cpl_table_new_column(profile_data, "Y0fit_world", CPL_TYPE_DOUBLE),
04289             cpl_table_new_column(profile_data, "Reduced_chisq", CPL_TYPE_DOUBLE)),
04290            "Error initializing order trace table for order #%d", pos->order);
04291     
04292     /* For msg-output purposes, only */
04293     cpl_table_set_column_unit(profile_data, "X" ,     "pixels");
04294     cpl_table_set_column_unit(profile_data, "Y0",     "pixels");
04295     cpl_table_set_column_unit(profile_data, "Sigma",  "pixels");
04296     cpl_table_set_column_unit(profile_data, "dY0",    "pixels");
04297     cpl_table_set_column_unit(profile_data, "dSigma", "pixels");
04298 
04299     profile_row = 0;
04300 
04301     UVES_TIME_START("Measure loop");
04302 
04303     nbins = uves_round_double(pos->sg.length + 5); /* more than enough */
04304     data  = cpl_calloc(nbins, sizeof(cpl_vector *));
04305     size  = cpl_calloc(nbins, sizeof(int));
04306     locut = cpl_calloc(nbins, sizeof(double));
04307     hicut = cpl_calloc(nbins, sizeof(double));
04308     {
04309         int i;
04310         for (i = 0; i < nbins; i++)
04311             {
04312                 data[i] = cpl_vector_new(1);
04313             }
04314     }
04315 
04316 
04317 #if NEW_METHOD
04318     /* new method:
04319 
04320        for each order       
04321          for each chunk
04322            bin data in spatial bins parallel to order trace
04323            define hicut/locut for each bin
04324            get the data points within locut/hicut
04325 
04326        fit model to all orders
04327     */
04328     {
04329         /* 4 degrees are needed for the model
04330           y0 = pol(x, m) 
04331           sigma = pol(x, m) 
04332         */
04333         int deg_y0_x = 0;
04334         int deg_y0_m = 0;
04335         int deg_sigma_x = 0;
04336         int deg_sigma_m = 0;
04337 
04338         int ncoeffs = 
04339             (deg_y0_x   +1)*(deg_y0_m   +1) +
04340             (deg_sigma_x+1)*(deg_sigma_m+1);
04341 
04342         double red_chisq;
04343         int n = 0;        /* Number of points (matrix rows) */
04344         int nbad = 0;     /* Number of hot/cold pixels (full chip) */
04345 
04346 #if CREATE_DEBUGGING_TABLE
04347         temp = cpl_table_new(norders*nx*uves_round_double(pos->sg.length+3));
04348         cpl_table_new_column(temp, "x", CPL_TYPE_DOUBLE);
04349         cpl_table_new_column(temp, "y", CPL_TYPE_DOUBLE);
04350         cpl_table_new_column(temp, "order", CPL_TYPE_DOUBLE);
04351         cpl_table_new_column(temp, "dat", CPL_TYPE_DOUBLE);
04352         cpl_table_new_column(temp, "err", CPL_TYPE_DOUBLE);
04353 
04354 #endif
04355 
04356         /*
04357         uves_msg_error("Saving 'sky_subtracted.fits'");
04358         cpl_image_save(image, "sky_subtracted.fits", CPL_BPP_IEEE_FLOAT, NULL,
04359                        CPL_IO_DEFAULT);
04360         */
04361 
04362 
04363 
04364 
04365 
04366 
04367 
04368         /* Allocate max. number of storage needed (and resize/shorten later when we
04369            know how much was needed). 
04370 
04371            One might get the idea to allocate storage for (nx*ny) points, but this
04372            is only a maximum if the orders are non-overlapping (which cannot a priori
04373            be assumed)
04374         */
04375         eval_points = cpl_matrix_new(norders*nx*uves_round_double(pos->sg.length+3), 3);
04376         eval_data   = cpl_vector_new(norders*nx*uves_round_double(pos->sg.length+3));
04377         eval_err    = cpl_vector_new(norders*nx*uves_round_double(pos->sg.length+3));
04378         
04379         fluxes = cpl_calloc((nx+1)*norders, sizeof(double));
04380         skys   = cpl_calloc((nx+1)*norders, sizeof(double));
04381         /* orders (m) are index'ed starting from 0,
04382            columns (x) are index'ed starting from 1 (zero'th index is not used) */
04383 
04384         estimate = cpl_table_new(norders);
04385         cpl_table_new_column(estimate, "Order", CPL_TYPE_INT);
04386         cpl_table_new_column(estimate, "Y0"   , CPL_TYPE_DOUBLE);
04387         cpl_table_new_column(estimate, "Sigma", CPL_TYPE_DOUBLE);
04388 
04389         coeffs = cpl_vector_new(ncoeffs);  /* Polynomial coefficients */
04390         ia = cpl_calloc(ncoeffs, sizeof(int));
04391         {
04392             int i;
04393             for (i = 0; i < ncoeffs; i++)
04394                 {
04395                     cpl_vector_set(coeffs, i, 0); /* First guess */
04396                     
04397                     ia[i] = 1;  /* Yes, fit this parameter */
04398                 }
04399         }
04400 
04401 //        for (order = minorder; order <= maxorder; order++) {
04402         for (order = 17; order <= 17; order++) {
04403             /* For estimates of y0, sigma for
04404                this order (pixel data values are
04405                used as weights)
04406             */
04407             double sumw   = 0;  /* sum data     */
04408             double sumwy  = 0;  /* sum data*y   */
04409             double sumwyy = 0;  /* sum data*y*y */
04410             
04411             for (x = chunk/2; x <= nx - chunk/2; x += chunk) {
04412 //      for (x = 900; x <= 1100; x += chunk)
04413                 /* Find cosmic rays */
04414                 int i;
04415                 for (i = 0; i < nbins; i++)
04416                     {
04417                         /* Each wavel.bin contributes with one data point
04418                            to each spatial bin. Therefore each spatial
04419                            bin must be able to hold (chunk+1) points. But
04420                            to be *completely* safe against weird rounding
04421                            (depending on the architecture), make the vectors
04422                            a bit longer. */
04423                         cpl_vector_set_size(data[i], 2*(chunk + 1));
04424                         size[i] = 0;
04425                     }
04426                 
04427                 /* Bin data in this chunk */
04428                 for (uves_iterate_set_first(pos,
04429                                             x - chunk/2 + 1, x + chunk/2,
04430                                             order, order,
04431                                             image_bpm, true);
04432                      !uves_iterate_finished(pos);
04433                      uves_iterate_increment(pos))
04434                     {
04435                         int bin = pos->y - pos->ylow;
04436                         
04437                         check_nomsg(cpl_vector_set(data[bin], size[bin], 
04438                                                    DATA(image_data, pos)));
04439                         size[bin]++;
04440                     }
04441                 
04442                 /* Get threshold values for each spatial bin in this chunk */
04443                 for (i = 0; i < nbins; i++)
04444                     {
04445                         if (size[i] == 0)
04446                             {
04447                                 /* locut[i] hicut[i] are not used */
04448                             }
04449                         else if (size[i] <= chunk/2)
04450                             {
04451                                 /* Not enough statistics to verify that the
04452                                    points are not outliers. Mark them as bad.*/
04453                                 locut[i] = cpl_vector_get_max(data[i]) + 1;
04454                                 hicut[i] = cpl_vector_get_min(data[i]) - 1;
04455                             }
04456                         else
04457                             {
04458                                 /* Iteratively do kappa-sigma clipping to
04459                                    find the threshold for the current bin */
04460                                 double median, stdev;
04461                                 double kappa = 3.0;
04462                                 double *data_data;
04463                                 int k;
04464                                 
04465                                 k = size[i];
04466                             
04467                                 do {
04468                                     cpl_vector_set_size(data[i], k);
04469                                     size[i] = k;
04470                                     data_data = cpl_vector_get_data(data[i]);
04471                                     
04472 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(4, 0, 0)
04473                                     median = cpl_vector_get_median_const(data[i]);
04474 #else
04475                                     median = cpl_vector_get_median(data[i]);
04476 #endif
04477                                     stdev = cpl_vector_get_stdev(data[i]);
04478                                     locut[i] = median - kappa*stdev;
04479                                     hicut[i] = median + kappa*stdev;
04480                                     
04481                                     /* Copy good points to beginning of vector */
04482                                     k = 0;
04483                                     {
04484                                         int j;
04485                                         for (j = 0; j < size[i]; j++)
04486                                             {
04487                                                 if (locut[i] <= data_data[j] &&
04488                                                     data_data[j] <= hicut[i])
04489                                                     {
04490                                                         data_data[k] = data_data[j];
04491                                                         k++;
04492                                                     }
04493                                             }
04494                                     }
04495                                 }
04496                                 while (k < size[i] && k > 1);
04497                                 /* while more points rejected */
04498                             }
04499                     }
04500                 
04501                 /* Collect data points in this chunk.
04502                  * At the same time compute estimates of
04503                  * y0, sigma for this order
04504                  */
04505                 
04506                 for (uves_iterate_set_first(pos,
04507                                             x - chunk/2 + 1, x + chunk/2,
04508                                             order, order,
04509                                             NULL, false)
04510                          !uves_iterate_finished(pos);
04511                      uves_iterate_increment(pos))
04512                     {
04513                         int pis_rejected;
04514                         double flux = 0; /* Linear extract bin */
04515                         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
04516                             {
04517                                 int bin = pos->y - pos->ylow;
04518                                 
04519                                 if (ISGOOD(image_bpm, pos) &&
04520                                     (locut[bin] <= DATA(image_data, pos) &&
04521                                      DATA(image_data, pos) <= hicut[bin])
04522                                     )
04523                                     {
04524                                         double pix = DATA(image_data, pos);
04525                                         double dy = pos->y - pos->ycenter;
04526                                         flux += pix;
04527                                         
04528                                         cpl_matrix_set(eval_points, n, 0, pos->x);
04529                                         cpl_matrix_set(eval_points, n, 1, dy);
04530                                         cpl_matrix_set(eval_points, n, 2, order);
04531                                         cpl_vector_set(eval_data, n, pix);
04532                                         cpl_vector_set(eval_err , n, 
04533                                                        DATA(noise_data, pos));
04534                                         
04535                                         sumw   += pix;
04536                                         sumwy  += pix * dy;
04537                                         sumwyy += pix * dy * dy;
04538 #if CREATE_DEBUGGING_TABLE
04539                                         cpl_table_set_double(temp, "x", n, pos->x);
04540                                         cpl_table_set_double(temp, "y", n, dy);
04541                                         cpl_table_set_double(temp, "order", n, order);
04542                                         cpl_table_set_double(temp, "dat", n, pix);
04543                                         cpl_table_set_double(temp, "err", n, 
04544                                                              DATA(noise_data, pos));
04545                                         
04546 #endif                              
04547                                         n++;
04548                                     }
04549                                 else
04550                                     {
04551                                         nbad += 1;
04552                                         /* uves_msg_error("bad pixel at (%d, %d)", i, pos->y);*/
04553                                     }
04554                             }
04555                         fluxes[pos->x + (order-pos->minorder)*(pos->nx+1)] = flux;
04556                         skys  [pos->x + (order-pos->minorder)*(pos->nx+1)] = 
04557                             cpl_image_get(sky_spectrum, 
04558                                           pos->x, order-pos->minorder+1, &pis_rejected);
04559                         
04560                         /* Buffer widths are nx+1, not nx */
04561                         skys  [pos->x + (order-pos->minorder)*(pos->nx+1)] = 0;
04562                         /* need non-sky-subtracted as input image */
04563 
04564                     } /* collect data */
04565             } /* for each chunk */
04566             
04567             /* Estimate fit parameters */
04568             {
04569                 double y0_estim;
04570                 double sigma_estim;
04571                 bool y0_is_good;   /* Is the estimate valid, or should it be ignored? */
04572                 bool sigma_is_good;
04573                 
04574                 if (sumw != 0)
04575                     {
04576                         y0_is_good = true;
04577                         y0_estim    = sumwy/sumw;
04578                         
04579                         sigma_estim = sumwyy/sumw - (sumwy/sumw)*(sumwy/sumw);
04580                         if (sigma_estim > 0)
04581                             {
04582                                 sigma_estim = sqrt(sigma_estim);
04583                                 sigma_is_good = true;
04584                             }
04585                         else
04586                             {
04587                                 sigma_is_good = false;
04588                             }
04589                     }
04590                 else
04591                     {
04592                         
04593                         y0_is_good = false;
04594                         sigma_is_good = false;
04595                     }
04596                 
04597                 cpl_table_set_int   (estimate, "Order", order - pos->minorder, order);
04598                 
04599                 if (y0_is_good)
04600                     {
04601                         cpl_table_set_double(estimate, "Y0"   , order - pos->minorder, y0_estim);
04602                     }
04603                 else
04604                     {
04605                         cpl_table_set_invalid(estimate, "Y0", order - pos->minorder);
04606                     }
04607                 
04608                 if (sigma_is_good)
04609                     {
04610                         cpl_table_set_double(estimate, "Sigma", 
04611                                              order - pos->minorder, sigma_estim);
04612                     }
04613                 else
04614                     {
04615                         cpl_table_set_invalid(estimate, "Sigma", order - pos->minorder);
04616                     }
04617                 
04618                 
04619                 /* There's probably a nicer way of printing this... */
04620                 if      (y0_is_good && sigma_is_good) {
04621                     uves_msg_error("Order #%d: Offset = %.2f pix; FWHM = %.2f pix", 
04622                                    order, y0_estim, sigma_estim*TWOSQRT2LN2);
04623                 }
04624                 else if (y0_is_good && !sigma_is_good) {
04625                     uves_msg_error("Order #%d: Offset = %.2f pix; FWHM = -- pix", 
04626                                    order, y0_estim);
04627                 }
04628                 else if (!y0_is_good && sigma_is_good) {
04629                     uves_msg_error("Order #%d: Offset = -- pix; FWHM = %.2f pix", 
04630                                    order, sigma_estim);
04631                 }
04632                 else {
04633                     uves_msg_error("Order #%d: Offset = -- pix; FWHM = -- pix",
04634                                    order);
04635                 }
04636             } /* end estimating */
04637             
04638         } /* for each order */
04639         
04640         cpl_matrix_set_size(eval_points, n, 3);
04641         cpl_vector_set_size(eval_data, n);
04642         cpl_vector_set_size(eval_err , n);
04643     
04644 #if CREATE_DEBUGGING_TABLE
04645         cpl_table_set_size(temp, n);
04646 #endif
04647         
04648         /* Get estimates of constant + linear coefficients 
04649            (as function of order (m), not x) */
04650         {
04651             double kappa = 3.0;
04652             int degree;
04653 
04654             cpl_table_dump(estimate, 0, cpl_table_get_nrow(estimate), stdout);
04655 
04656             /* Remove rows with invalid y0, but keep rows with
04657                valid sigma (therefore we need a copy) */
04658             estimate_dup = cpl_table_duplicate(estimate);
04659             assure_mem( estimate_dup );
04660             uves_erase_invalid_table_rows(estimate_dup, "Y0");
04661 
04662             /* Linear fit, or zero'th if only one position to fit */
04663             degree = (cpl_table_get_nrow(estimate_dup) > 1) ? 1 : 0;
04664 
04665             y0_estim_pol = uves_polynomial_regression_1d(
04666                 estimate_dup, "Order", "Y0", NULL,
04667                 degree,
04668                 NULL, NULL,  /* New columns */
04669                 NULL,        /* mse */
04670                 kappa);
04671 
04672             uves_polynomial_dump(y0_estim_pol, stdout); fflush(stdout);
04673 
04674             if (cpl_error_get_code() != CPL_ERROR_NONE)
04675                 {
04676                     uves_msg_warning("Could not estimate object centroid (%s). "
04677                                      "Setting initial offset to zero",
04678                                      cpl_error_get_message());
04679 
04680                     uves_error_reset();
04681                     
04682                     /* Set y0(m) := 0 */
04683                     uves_polynomial_delete(&y0_estim_pol);
04684                     y0_estim_pol = uves_polynomial_new_zero(1); /* dimension = 1 */
04685                 }
04686             
04687             uves_free_table(&estimate_dup);
04688             estimate_dup = cpl_table_duplicate(estimate);
04689             assure_mem( estimate_dup );
04690             uves_erase_invalid_table_rows(estimate_dup, "Sigma");
04691 
04692             degree = (cpl_table_get_nrow(estimate_dup) > 1) ? 1 : 0;
04693 
04694             sigma_estim_pol = uves_polynomial_regression_1d(
04695                 estimate_dup, "Order", "Sigma", NULL,
04696                 degree,
04697                 NULL, NULL,  /* New columns */
04698                 NULL,        /* mse */
04699                 kappa);
04700 
04701             if (cpl_error_get_code() != CPL_ERROR_NONE)
04702                 {
04703                     uves_msg_warning("Could not estimate object width (%s). "
04704                                      "Setting initial sigma to 1 pixel",
04705                                      cpl_error_get_message());
04706                     
04707                     uves_error_reset();
04708 
04709                     /* Set sigma(m) := 1 */
04710                     uves_polynomial_delete(&sigma_estim_pol);
04711                     sigma_estim_pol = uves_polynomial_new_zero(1);
04712                     uves_polynomial_shift(sigma_estim_pol, 0, 1.0);
04713                 }
04714         } /* end estimating */
04715         
04716         /* Copy estimate to 'coeffs' vector */
04717 
04718         /* Centroid, constant term x^0 m^0 */
04719         cpl_vector_set(coeffs, 0, 
04720                        uves_polynomial_get_coeff_1d(y0_estim_pol, 0));
04721         /* Centroid, linear term  x^0 m^1 */
04722         if (deg_y0_m >= 1)
04723             {
04724                 cpl_vector_set(coeffs, 0 + (deg_y0_x+1)*1, 
04725                                uves_polynomial_get_coeff_1d(y0_estim_pol, 1));
04726 
04727                 uves_msg_error("Estimate: y0    ~= %g + %g * m",
04728                                cpl_vector_get(coeffs, 0),
04729                                cpl_vector_get(coeffs, 0 + (deg_y0_x+1)*1));
04730             }
04731         else
04732             {
04733                 uves_msg_error("Estimate: y0    ~= %g",
04734                                cpl_vector_get(coeffs, 0));
04735             }
04736         
04737 
04738         /* Sigma, constant term x^0 m^0 */
04739         cpl_vector_set(coeffs, (deg_y0_x+1)*(deg_y0_m+1), 
04740                        uves_polynomial_get_coeff_1d(sigma_estim_pol, 0)); 
04741         /* Sigma, linear term  x^0 m^1 */
04742         if (deg_sigma_m >= 1)
04743             {
04744                 cpl_vector_set(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
04745                                0 + (deg_sigma_x+1)*1,
04746                                uves_polynomial_get_coeff_1d(sigma_estim_pol, 1));
04747                 
04748                 uves_msg_error("Estimate: sigma ~= %g + %g * m",
04749                                cpl_vector_get(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
04750                                               0),
04751                                cpl_vector_get(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
04752                                               0 + (deg_y0_x+1)*1));
04753             }
04754         else
04755             {
04756                 uves_msg_error("Estimate: sigma ~= %g",
04757                                cpl_vector_get(coeffs, (deg_y0_x+1)*(deg_y0_m+1) +
04758                                               0));
04759                                
04760             }
04761         /* Remaining coeff.s were set to 0 */
04762         
04763         /* Fill struct used for fitting */
04764         profile_params.flux = fluxes;
04765         profile_params.sky  = skys;
04766         profile_params.minorder = pos->minorder;
04767         profile_params.nx = nx;
04768 
04769         profile_params.f = f;
04770         profile_params.dfda = dfda;
04771         
04772         profile_params.deg_y0_x = deg_y0_x;
04773         profile_params.deg_y0_m = deg_y0_m;
04774         profile_params.deg_sigma_x = deg_sigma_x;
04775         profile_params.deg_sigma_m = deg_sigma_m;
04776 
04777 //    cpl_msg_set_level(CPL_MSG_DEBUG);
04778 
04779         /* Unweighted fit: */ 
04780 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(4, 0, 0)
04781         cpl_vector_fill(eval_err,
04782                         cpl_vector_get_median_const(eval_err));
04783 #else
04784         cpl_vector_fill(eval_err,
04785                         cpl_vector_get_median(eval_err));
04786 #endif
04787 
04788         uves_msg_error("Fitting model to %d positions; %d bad pixels found",
04789                        n, nbad);
04790         
04791         uves_fit(eval_points, NULL,
04792                  eval_data, eval_err,
04793                  coeffs, ia,
04794                  profile_f,
04795                  profile_dfda,
04796                  NULL, /* mse, red_chisq, covariance */
04797                  &red_chisq,
04798                  &covariance);
04799 //    cpl_msg_set_level(CPL_MSG_INFO);
04800         
04801         if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX ||
04802             cpl_error_get_code() == CPL_ERROR_CONTINUE)
04803         {
04804             uves_msg_warning("Fitting global model failed (%s)", cpl_error_get_message());
04805             uves_error_reset();
04806 #if CREATE_DEBUGGING_TABLE
04807             cpl_table_save(temp, NULL, NULL, "tab.fits", CPL_IO_DEFAULT);
04808 #endif
04809         }
04810     else
04811         {
04812             assure( cpl_error_get_code() == CPL_ERROR_NONE,
04813                     cpl_error_get_code(), "Fitting global model failed");
04814 
04815             cpl_matrix_dump(covariance, stdout); fflush(stdout);
04816 
04817             uves_msg_error("Solution: y0    ~= %g", eval_pol(cpl_vector_get_data(coeffs),
04818                                                              deg_y0_x, deg_y0_m, 
04819                                                              pos->nx/2, 
04820                                                              (pos->minorder+pos->maxorder)/2));
04821             uves_msg_error("Solution: sigma ~= %g", eval_pol(cpl_vector_get_data(coeffs)+
04822                                                              (deg_y0_x+1)*(deg_y0_m+1),
04823                                                              deg_y0_x, deg_y0_m, 
04824                                                              pos->nx/2,
04825                                                              (pos->minorder+pos->maxorder)/2));
04826             
04827             /* Fill table with solution */
04828             for (order = pos->minorder; order <= pos->maxorder; order++) {
04829             for (x = chunk/2; x <= nx - chunk/2; x += chunk)
04830                 {
04831                     double y_0   =      eval_pol(cpl_vector_get_data(coeffs), 
04832                                                  deg_y0_x, deg_y0_m, x, order);
04833                     double sigma = fabs(eval_pol(cpl_vector_get_data(coeffs)+
04834                                                  (deg_y0_x+1)*(deg_y0_m+1),
04835                                                  deg_sigma_x, deg_sigma_m, x, order));
04836                     
04837                     /* Use error propagation formula to get variance of polynomials:
04838                        
04839                        We have p(x,m) = sum_ij a_ij x^i m^j,
04840 
04841                        and thus a quadruple sum for the variance,
04842 
04843                        V(x,m) = sum_i1j1i2j2 Cov(a_i1j1, a_i2j2), x^(i1+i2) m^(j1+j2)
04844 
04845                        (for both y0(x,m) and sigma(x,m))
04846                     */
04847                     double dy0 = 0;
04848                     double dsigma = 0;
04849                     int i1, i2, j_1, j2;  /* because POSIX 1003.1-2001 defines 'j1' */
04850 
04851                     for (i1 = 0; i1 < (deg_y0_x+1); i1++)
04852                     for (j_1 = 0; j_1 < (deg_y0_m+1); j_1++)
04853                     for (i2 = 0; i2 < (deg_y0_x+1); i2++)
04854                     for (j2 = 0; j2 < (deg_y0_m+1); j2++)
04855                         {
04856                             dy0 += cpl_matrix_get(covariance, 
04857                                                   i1+(deg_y0_x+1)*j_1,
04858                                                   i2+(deg_y0_x+1)*j2) * 
04859                                 uves_pow_int(x, i1+i2) *
04860                                 uves_pow_int(order, j_1+j2);
04861                         }
04862                     if (dy0 > 0)
04863                         {
04864                             dy0 = sqrt(dy0);
04865                         }
04866                     else
04867                         /* Should not happen */
04868                         {
04869                             dy0 = 1.0; 
04870                         }
04871 
04872                     for (i1 = 0; i1 < (deg_sigma_x+1); i1++)
04873                     for (j_1 = 0; j_1 < (deg_sigma_m+1); j_1++)
04874                     for (i2 = 0; i2 < (deg_sigma_x+1); i2++)
04875                     for (j2 = 0; j2 < (deg_sigma_m+1); j2++)
04876                         {
04877                             /* Ignore the upper left part of the covariance
04878                                matrix (the covariances related to y0)
04879                             */
04880                             dsigma += cpl_matrix_get(
04881                                 covariance,
04882                                 (deg_y0_x+1)*(deg_y0_m+1) + i1+(deg_sigma_x+1)*j_1,
04883                                 (deg_y0_x+1)*(deg_y0_m+1) + i2+(deg_sigma_x+1)*j2) * 
04884                                 uves_pow_int(x, i1+i1) *
04885                                 uves_pow_int(order, j_1+j2);
04886                         }
04887                     if (dsigma > 0)
04888                         {
04889                             dsigma = sqrt(dsigma);
04890                         }
04891                     else
04892                         /* Should not happen */
04893                         {
04894                             dsigma = 1.0; 
04895                         }
04896 
04897                     check((cpl_table_set_int   (profile_data, "Order", profile_row, order),
04898                            cpl_table_set_int   (profile_data, "X"    , profile_row, x),
04899                            cpl_table_set_double(profile_data, "Y0"   , profile_row, y_0),
04900                            cpl_table_set_double(profile_data, "Sigma", profile_row, sigma),
04901                            cpl_table_set_double(profile_data, "Norm" , profile_row, 1),
04902                            cpl_table_set_double(profile_data, "dY0"  , profile_row, dy0),
04903                            cpl_table_set_double(profile_data, "dSigma", profile_row, dsigma),
04904                            cpl_table_set_double(profile_data, "dNorm", profile_row, 1),
04905                            cpl_table_set_double(profile_data, "Y0_world", profile_row, -1),
04906                            cpl_table_set_double(profile_data, "Reduced_chisq", profile_row, 
04907                                                 red_chisq)),
04908                           "Error writing table row %d", profile_row+1);
04909                     profile_row += 1;
04910                 } /* For each chunk */
04911             } /* For each order */
04912 #if CREATE_DEBUGGING_TABLE
04913             cpl_table_new_column(temp, "pemp", CPL_TYPE_DOUBLE); /* empirical profile */
04914             cpl_table_new_column(temp, "fit", CPL_TYPE_DOUBLE); /* fitted profile */
04915             cpl_table_new_column(temp, "pfit", CPL_TYPE_DOUBLE); /* fitted profile, normalized */
04916             {int i;
04917             for (i = 0; i < cpl_table_get_nrow(temp); i++)
04918                 {
04919                     double y = cpl_table_get_double(temp, "y", i, NULL);
04920                     int xi = uves_round_double(cpl_table_get_double(temp, "x", i, NULL));
04921                     int mi = uves_round_double(cpl_table_get_double(temp, "order", i, NULL));
04922                     double dat = cpl_table_get_double(temp, "dat", i, NULL);
04923                     int idx = xi + (mi - profile_params.minorder)*(profile_params.nx + 1);
04924                     double flux_fit;
04925                     double xar[3];
04926                     xar[0] = xi;
04927                     xar[1] = y;
04928                     xar[2] = mi;
04929                     
04930                     profile_f(xar,
04931                               cpl_vector_get_data(coeffs), &flux_fit);
04932                     
04933                     cpl_table_set(temp, "pemp", i,
04934                                   (dat - profile_params.sky[idx])/profile_params.flux[idx]);
04935                     
04936                     cpl_table_set(temp, "fit", i, flux_fit);
04937 
04938                     cpl_table_set(temp, "pfit", i,
04939                                   (flux_fit - profile_params.sky[idx])/profile_params.flux[idx]);
04940                 }
04941             }
04942             check_nomsg(
04943                 cpl_table_save(temp, NULL, NULL, "tab.fits", CPL_IO_DEFAULT));
04944 #endif
04945         }
04946     }
04947 
04948 #else  /* if NEW_METHOD */
04949     dy    = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
04950     prof  = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
04951     prof2 = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
04952     dprof = cpl_vector_new((chunk+1) * ((int)(pos->sg.length + 3)));
04953 
04954     for (x = 1 + chunk/2; x + chunk/2 <= pos->nx; x += chunk) {
04955         /* Collapse chunk [x-chunk/2 ; x+chunk/2],
04956            then fit profile (this is to have better
04957            statistics than if fitting individual bins). */
04958         const int points_needed_for_fit = 6;
04959         int n = 0;
04960         int nbad = 0;
04961         int i;
04962         
04963         /* Use realloc rather than malloc (for each chunk) */
04964         cpl_vector_set_size(dy,    (chunk+1) * ((int)(pos->sg.length + 3)));
04965         cpl_vector_set_size(prof,  (chunk+1) * ((int)(pos->sg.length + 3)));
04966         cpl_vector_set_size(prof2, (chunk+1) * ((int)(pos->sg.length + 3)));
04967         cpl_vector_set_size(dprof, (chunk+1) * ((int)(pos->sg.length + 3)));
04968         n = 0; /* Number of points inserted in dy, prof, dprof */
04969 
04970         for (i = 0; i < nbins; i++)
04971             {
04972                 /* Each wavel.bin contributes with one data point
04973                    to each spatial bin. Therefore each spatial
04974                    bin must be able to hold (chunk+1) points. But
04975                    to be *completely* safe against weird rounding
04976                    (depending on the architecture), make the vectors
04977                    a bit longer. */
04978                 cpl_vector_set_size(data[i], 2*(chunk + 1));
04979                 size[i] = 0;
04980             }
04981         
04982 
04983         /* Bin data in this chunk */
04984         for (uves_iterate_set_first(pos,
04985                                     x - chunk/2 + 1,
04986                                     x + chunk/2,
04987                                     pos->order, pos->order,
04988                                     image_bpm, true);
04989              !uves_iterate_finished(pos);
04990              uves_iterate_increment(pos))
04991             {
04992                 int bin = pos->y - pos->ylow;
04993                 
04994                 /* Group into spatial bins */
04995                 check_nomsg(cpl_vector_set(data[bin], size[bin], 
04996                                            DATA(image_data, pos)));
04997                 size[bin]++;
04998             }
04999 
05000         /* Get threshold values for each spatial bin in this chunk */
05001         for (i = 0; i < nbins; i++)
05002             {
05003                 if (size[i] == 0)
05004                     {
05005                         /* locut[i] hicut[i] are not used */
05006                     }
05007                 else if (size[i] <= chunk/2)
05008                     {
05009                         /* Not enough statistics to verify that the
05010                            points are not outliers. Mark them as bad.*/
05011                         locut[i] = cpl_vector_get_max(data[i]) + 1;
05012                         hicut[i] = cpl_vector_get_min(data[i]) - 1;
05013                     }
05014                 else
05015                     {
05016                         /* Iteratively do kappa-sigma clipping to
05017                            find the threshold for the current bin */
05018                         double median, stdev;
05019                         double kappa = 3.0;
05020                         double *data_data;
05021                         int k;
05022                         
05023                         k = size[i];
05024                         
05025                         do {
05026                             cpl_vector_set_size(data[i], k);
05027                             size[i] = k;
05028                             data_data = cpl_vector_get_data(data[i]);
05029 
05030 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(4, 0, 0)
05031                             median = cpl_vector_get_median_const(data[i]);
05032 #else
05033                             median = cpl_vector_get_median(data[i]);
05034 #endif
05035                             stdev = cpl_vector_get_stdev(data[i]);
05036                             locut[i] = median - kappa*stdev;
05037                             hicut[i] = median + kappa*stdev;
05038                             
05039                             /* Copy good points to beginning of vector */
05040                             k = 0;
05041                             {
05042                                 int j;
05043                                 for (j = 0; j < size[i]; j++)
05044                                     {
05045                                         if (locut[i] <= data_data[j] &&
05046                                             data_data[j] <= hicut[i])
05047                                             {
05048                                                 data_data[k] = data_data[j];
05049                                                 k++;
05050                                             }
05051                                     }
05052                             }
05053                         }
05054                         while (k < size[i] && k > 1);
05055                         /* while still more points rejected */
05056                     }
05057             } /* for each bin */
05058 
05059         /* Collect good data in this chunk */
05060         for (uves_iterate_set_first(pos,
05061                                     x - chunk/2 + 1,
05062                                     x + chunk/2,
05063                                     pos->order, pos->order,
05064                                     NULL, false);
05065              !uves_iterate_finished(pos);
05066              uves_iterate_increment(pos))
05067             {
05068                 double flux = 0;
05069                 for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
05070                     {
05071                         int bin = pos->y - pos->ylow;
05072                         
05073                         if (ISGOOD(image_bpm, pos) &&
05074                             (locut[bin] <= DATA(image_data, pos) &&
05075                              DATA(image_data, pos) <= hicut[bin])
05076                             )
05077                             {
05078                                 flux += DATA(image_data, pos);
05079                             }
05080                     }
05081 
05082                 if (flux != 0)
05083                     {
05084                         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
05085                             {
05086                                 int bin = pos->y - pos->ylow;
05087                                 
05088                                 if (ISGOOD(image_bpm, pos) &&
05089                                     (locut[bin] <= DATA(image_data, pos) &&
05090                                      DATA(image_data, pos) <= hicut[bin])
05091                                     )
05092                                     {
05093                                         double pix = DATA(image_data, pos);
05094                                         
05095                                         cpl_vector_set(dy   , n, pos->y - pos->ycenter);
05096                                         cpl_vector_set(prof , n, pix/flux); 
05097                                         cpl_vector_set(dprof, n, (flux > 0) ?
05098                                                         DATA(noise_data, pos)/flux :
05099                                                        -DATA(noise_data, pos)/flux);
05100                                         n++;
05101                                     }
05102                                 else
05103                                     {
05104                                         nbad += 1;
05105                                         /* uves_msg_debug("Bad pixel at (%d, %d)", 
05106                        pos->x, pos->y); */
05107                                     }
05108                             }
05109                     }
05110             } /* collect data */
05111         
05112         if (n >= points_needed_for_fit) {
05113             double y_0, norm, background, slope, sigma, red_chisq;
05114           
05115             cpl_vector_set_size(dy,    n);
05116             cpl_vector_set_size(prof,  n);
05117             cpl_vector_set_size(prof2, n);
05118             cpl_vector_set_size(dprof, n);
05119 
05120             /* Fit */
05121             uves_msg_debug("Fitting chunk (%d, %d)", 
05122                            x-chunk/2, x+chunk/2);
05123                     
05124 //          cpl_vector_dump(dy, stdout);
05125 //          cpl_vector_dump(prof, stdout);
05126 
05127             uves_free_matrix(&covariance);
05128                     
05129             background = 0;  /* The sky was already subtracted */
05130             norm = 1.0;      /* We are fitting the normalized profile.
05131                                 Reducing the number of free parameters
05132                                 gives a better fit.
05133                              */
05134                                         
05135             /* Use constant uncertainty */
05136 if (0)      {
05137     /* This gives a better fit (narrower profile at low S/N)
05138        but overestimates chi^2 
05139     */
05140 #if defined CPL_VERSION_CODE && CPL_VERSION_CODE >= CPL_VERSION(4, 0, 0)
05141                 double median = cpl_vector_get_median_const(dprof);
05142 #else
05143                 double median = cpl_vector_get_median(dprof);
05144 #endif
05145                 cpl_vector_fill(dprof, median);
05146             }
05147             uves_fit_1d(dy, NULL,
05148 #if 1
05149                         prof, dprof,
05150 #else
05151                         prof, NULL,
05152 #endif
05153                         CPL_FIT_CENTROID |
05154                         CPL_FIT_STDEV,
05155                         false,
05156                         &y_0, &sigma, &norm, &background, &slope,
05157 #if 1
05158                         NULL, &red_chisq,      /* mse, red_chisq */
05159                         &covariance,
05160 #else
05161                         NULL, NULL,
05162                         NULL,
05163 #endif
05164                         f, dfda, M);
05165 #if 1
05166 #else
05167             covariance = cpl_matrix_new(4,4);
05168             cpl_matrix_set(covariance, 0, 0, 1);
05169             cpl_matrix_set(covariance, 1, 1, 1);
05170             cpl_matrix_set(covariance, 2, 2, 1);
05171             cpl_matrix_set(covariance, 3, 3, 1);
05172             red_chisq = 1;
05173 #endif
05174             if (false) /* && 800-chunk/2 <= x && x <= 800+chunk/2 && order == 17) */
05175                 {
05176 /*                  uves_msg_error("dumping chunk at x,order = %d, %d", x, order);
05177                     uves_msg_error("dy = ");
05178                     cpl_vector_dump(dy, stderr);
05179                     uves_msg_error("prof = ");
05180                     cpl_vector_dump(prof, stderr);
05181 */
05182 
05183 /*
05184                     cpl_bivector *b = cpl_bivector_wrap_vectors(dy, prof);
05185                     irplib_bivector_plot("set grid;set yrange[-1:1];set xlabel 'Wavelength [m]';",
05186                                          "t 'Spatial profile' w points",
05187                                          "",b);
05188                     cpl_bivector_unwrap_vectors(b);
05189 */
05190 
05191                     cpl_vector *pl[] = {NULL, NULL, NULL};
05192 
05193                     cpl_vector *fit = cpl_vector_new(cpl_vector_get_size(dy));
05194                     {
05195                     for (i = 0; i < cpl_vector_get_size(dy); i++)
05196                         {
05197                             double yy = cpl_vector_get(dy, i);
05198                             cpl_vector_set(fit, i,
05199                                            exp(-(yy-y_0)*(yy-y_0)/(2*sigma*sigma))
05200                                            /(sigma*sqrt(2*M_PI)));
05201                         }
05202                     }
05203 
05204                     /* uves_msg_error("result is %f, %f, %f, %f  %d   %f",
05205                        y_0, sigma, norm, background, cpl_error_get_code(), sigma*TWOSQRT2LN2);
05206                     */
05207 
05208                     pl[0] = prof2;
05209                     pl[1] = dprof;
05210                     pl[2] = dprof;
05211 //                  pl[0] = dy;
05212 //                  pl[1] = prof;
05213 //                  pl[2] = fit;
05214                     uves_error_reset();
05215                     irplib_vectors_plot("set grid;set yrange[0:0.5];set xlabel 'dy';",
05216                                         "t 'Spatial profile' w points",
05217                                         "",
05218                                         (const cpl_vector **)pl, 3);
05219                     
05220 
05221                     pl[0] = prof;
05222                     pl[1] = dprof;
05223                     pl[2] = dprof;
05224 
05225                     irplib_vectors_plot("set grid;set xrange[-2:2];"
05226                                         "set yrange[0:0.5];set xlabel 'dy';",
05227                                         "t 'Spatial profile' w points",
05228                                         "",
05229                                         (const cpl_vector **)pl, 3);
05230                     
05231                     uves_free_vector(&fit);
05232 
05233                 }
05234 
05235             /* Convert to global coordinate (at middle of chunk) */
05236             uves_iterate_set_first(pos, 
05237                                    x, x,
05238                                    pos->order, pos->order,
05239                                    NULL,
05240                                    false);
05241             y_0 += pos->ycenter;
05242                             
05243             /* Recover from a failed fit.
05244              *
05245              * The gaussian fitting routine itself guarantees 
05246              * that, on success, sigma < slit_length.
05247              * Tighten this constraint by requiring that also 4sigma < slit_length (see below).
05248              * This is to avoid detecting
05249              *    sky-on-top-of-interorder
05250              * rather than
05251              *    object-on-top-of-sky
05252              * (observed to happen in low-S/N cases when
05253              *  the sky flux dominates the object flux )
05254              *
05255              *               object
05256              *              /\
05257              *       |-sky-/  \--sky-|
05258              *       |               |
05259              *       |               |
05260              *  -----|  s  l  i  t   |---interorder--
05261              *
05262              *
05263              *  Also avoid fits with sigma < 0.2 which are probably CRs
05264              *
05265              */
05266             if (cpl_error_get_code() == CPL_ERROR_CONTINUE || 
05267                 cpl_error_get_code()== CPL_ERROR_SINGULAR_MATRIX ||
05268                 4.0*sigma >= pos->sg.length || sigma < 0.2) {
05269                 
05270                 uves_msg_debug("Profile fitting failed at (order, x) = (%d, %d) "
05271                                "(%s), ignoring chunk",
05272                                pos->order, x, cpl_error_get_message());
05273 
05274                 uves_error_reset();
05275             }
05276             else {
05277                 assure( cpl_error_get_code() == CPL_ERROR_NONE, cpl_error_get_code(),
05278                         "Gaussian fitting failed");
05279                             
05280                 check(
05281                     (cpl_table_set_int   (profile_data, "Order", profile_row, pos->order),
05282                      cpl_table_set_int   (profile_data, "X"    , profile_row, x),
05283                      cpl_table_set_double(profile_data, "Y0"   , profile_row, y_0 - pos->ycenter),
05284                      cpl_table_set_double(profile_data, "Sigma", profile_row, sigma),
05285                      cpl_table_set_double(profile_data, "Norm" , profile_row, norm),
05286                      cpl_table_set_double(profile_data, "dY0"  , profile_row,
05287                                           sqrt(cpl_matrix_get(covariance, 0, 0))),
05288                      cpl_table_set_double(profile_data, "dSigma", profile_row, 
05289                                           sqrt(cpl_matrix_get(covariance, 1, 1))),
05290                      cpl_table_set_double(profile_data, "dNorm", profile_row, 
05291                                           sqrt(cpl_matrix_get(covariance, 2, 2))),
05292                      cpl_table_set_double(profile_data, "Y0_world", profile_row, y_0),
05293                      cpl_table_set_double(profile_data, "Reduced_chisq", profile_row, 
05294                                           red_chisq)),
05295                     "Error writing table");
05296                 
05297                 profile_row += 1;
05298                 /* uves_msg_debug("y0 = %f  sigma = %f    norm = %f "
05299                    "background = %f", y_0, sigma, norm, background); */
05300             }
05301         }
05302         else
05303             {
05304                 uves_msg_debug("Order #%d: Too few (%d) points available in "
05305                                "at x = %d - %d, ignoring chunk", 
05306                                pos->order, n,
05307                                x - chunk/2, x + chunk/2);
05308             }
05309     } /* for each chunk */
05310 
05311 #endif /* old method */
05312 
05313     cpl_table_set_size(profile_data, profile_row);
05314     
05315     UVES_TIME_END;
05316 
05317     
05318 cleanup:
05319 #if NEW_METHOD
05320     uves_free_matrix(&eval_points);
05321     uves_free_vector(&eval_data);
05322     uves_free_vector(&eval_err);
05323     uves_free_vector(&coeffs);
05324     cpl_free(fluxes);
05325     cpl_free(skys);
05326     cpl_free(ia);
05327 #if CREATE_DEBUGGING_TABLE
05328     uves_free_table(&temp);
05329 #endif
05330     uves_free_table(&estimate);
05331     uves_free_table(&estimate_dup);
05332     uves_polynomial_delete(&y0_estim_pol);
05333     uves_polynomial_delete(&sigma_estim_pol);
05334 #endif
05335 
05336     uves_free_matrix(&covariance);
05337     uves_free_vector(&dy);
05338     uves_free_vector(&prof);
05339     uves_free_vector(&prof2);
05340     uves_free_vector(&dprof);
05341     {
05342         int i;
05343         for (i = 0; i < nbins; i++)
05344             {
05345                 uves_free_vector(&(data[i]));
05346             }
05347     }
05348     cpl_free(data);
05349     cpl_free(size);
05350     cpl_free(locut);
05351     cpl_free(hicut);
05352 
05353     if (cpl_error_get_code() != CPL_ERROR_NONE)
05354         {
05355             uves_free_table(&profile_data);
05356         }
05357     
05358     return profile_data;
05359 }
05360 
05361 
05362 /*----------------------------------------------------------------------------*/
05371 /*----------------------------------------------------------------------------*/
05372 static int
05373 opt_get_order_width(const uves_iterate_position *pos)
05374 {
05375     int result = -1;
05376 
05377     double x1 = 1;
05378     double x2 = pos->nx;
05379     double y_1 = uves_polynomial_evaluate_2d(pos->order_locations, x1, pos->order);
05380     double y2  = uves_polynomial_evaluate_2d(pos->order_locations, x2, pos->order);
05381     double slope = (y2 - y_1)/(x2 - x1);
05382     
05383     if (slope != 0)
05384         {
05385             /* Solve   
05386                       slope * x + y1 = 1    and
05387                       slope * x + y1 = ny
05388                for x
05389 
05390                ... then get exact solution
05391             */
05392             double x_yeq1  = (      1 - y_1)/slope;
05393             double x_yeqny = (pos->ny - y_1)/slope;
05394             
05395             if (1 <= x_yeq1 && x_yeq1 <= pos->nx)   /* If order is partially below image */
05396                 {
05397                     double guess = x_yeq1;
05398 
05399                     uves_msg_debug("Guess value (y = 1) x = %f", guess);
05400                     /* Get exact value of x_yeq1 */
05401                     x_yeq1 = uves_polynomial_solve_2d(pos->order_locations, 
05402                                                       1,        /* Solve p = 1 */
05403                                                       guess,    /* guess value */
05404                                                       1,        /* multiplicity */
05405                                                       2,        /* fix this 
05406                                                                    variable number */
05407                                                       pos->order);/* ... to this value */
05408                     
05409                     if (cpl_error_get_code() != CPL_ERROR_NONE)
05410                         {
05411                             uves_error_reset();
05412                             uves_msg_warning("Could not solve order polynomial = 1 at order #%d. "
05413                                              "Order polynomial may be ill-formed", pos->order);
05414                             x_yeq1 = guess;
05415                         }
05416                     else
05417                         {
05418                             uves_msg_debug("Exact value (y = 1) x = %f", x_yeq1);
05419                         }
05420                 }
05421             
05422             if (1 <= x_yeqny && x_yeqny <= pos->nx)   /* If order is partially above image */
05423                 {
05424                     double guess = x_yeqny;
05425 
05426                     uves_msg_debug("Guess value (y = %d) = %f", pos->ny, guess);
05427                     /* Get exact value of x_yeqny */
05428                     x_yeqny = uves_polynomial_solve_2d(pos->order_locations, 
05429                                                        pos->ny,  /* Solve p = ny */
05430                                                        guess,    /* guess value */
05431                                                        1,        /* multiplicity */
05432                                                        2,        /* fix this
05433                                                                     variable number */
05434                                                        pos->order);/* ... to this value */
05435 
05436                     if (cpl_error_get_code() != CPL_ERROR_NONE)
05437                         {
05438                             uves_error_reset();
05439                             uves_msg_warning("Could not solve order polynomial = %d at order #%d. "
05440                                              "Order polynomial may be ill-formed",
05441                                              pos->ny, pos->order);
05442                             x_yeqny = guess;
05443                         }
05444                     else
05445                         {
05446                             uves_msg_debug("Exact value (y = %d) x = %f", pos->ny, x_yeqny);
05447                         }
05448                 }
05449             
05450             if (slope > 0)
05451                 {
05452                     result = uves_round_double(
05453                         uves_max_double(1, 
05454                                         uves_min_double(pos->nx, x_yeqny) - 
05455                                         uves_max_double(1, x_yeq1) + 1));
05456                 }
05457             else
05458                 {
05459                     passure( slope < 0, "%f", slope);
05460                     result = uves_round_double(
05461                         uves_max_double(1, 
05462                                         uves_min_double(pos->nx, x_yeq1 ) - 
05463                                         uves_max_double(1, x_yeqny) + 1));
05464                 }
05465         }
05466     else
05467         {
05468             result = pos->nx;
05469         }
05470 
05471     uves_msg_debug("Order width = %d pixels", result);
05472     
05473   cleanup:
05474 
05475     return result;
05476 }
05477 
05478 
05479 /*----------------------------------------------------------------------------*/
05517 /*----------------------------------------------------------------------------*/
05518 static int
05519 opt_extract(cpl_image *image, const cpl_image *image_noise,
05520             uves_iterate_position *pos,
05521             const uves_extract_profile *profile,
05522         bool optimal_extract_sky,
05523             double kappa,
05524             cpl_table *cosmic_mask, int *cr_row,
05525             cpl_table *profile_table, int *prof_row,
05526             cpl_image *spectrum, cpl_image *spectrum_noise, 
05527             cpl_image *weights,
05528             cpl_image *sky_spectrum,
05529             cpl_image *sky_spectrum_noise,
05530             double *sn)
05531 {
05532     cpl_table *signal_to_noise = NULL;    /* S/N values of bins in this order
05533                                            * (table used as a variable length array)
05534                                            */
05535     int sn_row = 0;                       /* Number of rows in 'signal_to_noise' 
05536                                              actually used */
05537 
05538     int bins_extracted = 0;
05539     int cold_pixels = 0;                  /* Number of hot/cold pixels in this order  */
05540     int hot_pixels = 0;
05541     int warnings = 0;                     /* Warnings printed so far */
05542     
05543     const double *image_data;
05544     const double *noise_data;
05545     double *weights_data;
05546     cpl_mask  *image_bad = NULL;
05547     cpl_binary*image_bpm = NULL;
05548     double *noise_buffer = NULL; /* For efficiency. To avoid allocating/deallocating
05549                     space for each bin */
05550     int order_width;
05551     int spectrum_row = pos->order - pos->minorder + 1;
05552 
05553     /* For efficiency, use direct pointer to pixel buffer,
05554        assume type double, support bad pixels */
05555 
05556     assure( cpl_image_get_type(image)       == CPL_TYPE_DOUBLE &&
05557             cpl_image_get_type(image_noise) == CPL_TYPE_DOUBLE, CPL_ERROR_UNSUPPORTED_MODE,
05558             "Input image+noise must have type double. Types are %s + %s",
05559             uves_tostring_cpl_type(cpl_image_get_type(image)),
05560             uves_tostring_cpl_type(cpl_image_get_type(image_noise)));
05561 
05562     image_data    = cpl_image_get_data_double_const(image);
05563     noise_data    = cpl_image_get_data_double_const(image_noise);
05564     weights_data  = cpl_image_get_data_double(weights);
05565 
05566     image_bad = cpl_image_get_bpm(image);
05567     image_bpm = cpl_mask_get_data(image_bad);
05568 
05569     noise_buffer = cpl_malloc(uves_round_double(pos->sg.length + 5)*sizeof(double));
05570 
05571     check( (signal_to_noise = cpl_table_new(pos->nx),
05572             cpl_table_new_column(signal_to_noise, "SN", CPL_TYPE_DOUBLE)),
05573            "Error allocating S/N table");
05574 
05575     check( order_width = opt_get_order_width(pos),
05576            "Error estimating width of order #%d", pos->order);
05577 
05578 
05579     /* First set all pixels in the extracted spectrum as bad,
05580        then mark them as good if/when the flux is calculated */
05581     {
05582         int x;
05583         for (x = 1; x <= pos->nx; x++)
05584             {
05585                 cpl_image_reject(spectrum, x, spectrum_row);
05586                 /* cpl_image_reject preserves the internal bad pixel map */
05587 
05588                 if (spectrum_noise != NULL)
05589                     {
05590                         cpl_image_reject(spectrum_noise, x, spectrum_row);
05591                     }
05592                 if (optimal_extract_sky && sky_spectrum != NULL)
05593                     {
05594                         cpl_image_reject(sky_spectrum      , x, spectrum_row);
05595                         cpl_image_reject(sky_spectrum_noise, x, spectrum_row);
05596                     }
05597             }
05598     }
05599 
05600     for (uves_iterate_set_first(pos,
05601                                 1, pos->nx,
05602                                 pos->order, pos->order,
05603                                 NULL, false);
05604          !uves_iterate_finished(pos);
05605          uves_iterate_increment(pos)) 
05606         {
05607             double flux = 0, variance = 0; /* Flux and variance of this bin */
05608             double sky_background = 0, sky_background_noise = 0;
05609             
05610             /* 
05611              * Determine 'flux' and 'variance' of this bin.
05612              */
05613             int iteration;
05614             
05615             bool found_bad_pixel;
05616             double median_noise;
05617             
05618             double redchisq = 0;
05619             
05620             /* If rejection is asked for, get correction factor for this bin */
05621             if (kappa > 0)
05622                 {
05623                     redchisq = opt_get_redchisq(profile, pos);
05624                 }
05625             
05626             /* Prepare for calls of uves_extract_profile_evaluate() */
05627             uves_extract_profile_set(profile, pos, &warnings);
05628             
05629             /*  Pseudocode for optimal extraction of this bin:
05630              *
05631              *  reset weights
05632              *
05633              *  do
05634              *      flux,variance := extract optimal 
05635              *                       (only good pixels w. weight > 0)
05636              *      (in first iteration, noise = max(noise, median(noise_i))
05637              *
05638              *      reject the worst outlier by setting its weight to -1
05639              *
05640              *  until there were no more outliers
05641              *
05642              *
05643              *  Note that the first iteration increases the noise level
05644              *  of each pixel to the median noise level. Otherwise, outlier
05645              *  cold pixels would
05646              *  would destroy the first flux estimate because of their very low
05647              *  'photonic' noise (i.e. they would have very large weight when their
05648              *  uncertainties are taken into account). With the scheme above,
05649              *  such a dead pixel will be rejected in the first iteration, and it is
05650              *  safe to continue with optimal extractions until convergence.
05651              *
05652              */
05653             
05654             /*
05655              *  Clear previously detected cosmic rays.
05656              */
05657             for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
05658                 {
05659                     if (DATA(image_bpm, pos) == CPL_BINARY_1)
05660                         {
05661                             DATA(weights_data, pos) = -1.0;
05662                         }
05663                     else
05664                         {
05665                             DATA(weights_data, pos) = 0.0;
05666                         }
05667                 }
05668             
05669             /* Get median noise level (of all object + sky bins) */
05670             median_noise = opt_get_noise_median(noise_data, image_bpm,
05671                                                 pos, noise_buffer);
05672             
05673             /* Extract optimally,
05674                reject outliers ... while found_bad_pixel (but at least twice) */
05675             found_bad_pixel = false;
05676 
05677             for (iteration = 0; iteration < 2 || found_bad_pixel; iteration++)
05678                 {
05679                     /* Get (flux,variance). In first iteration
05680                        raise every noise value to median.
05681                     */
05682                     flux = opt_get_flux_sky_variance(image_data, noise_data,
05683                              weights_data,
05684                              pos,
05685                              profile,
05686                              optimal_extract_sky,
05687                              (iteration == 0) ? 
05688                              median_noise : -1,
05689                              &variance,
05690                              &sky_background,
05691                              &sky_background_noise);
05692                     
05693                     /* If requested, find max outlier among remaining good pixels */
05694                     if (kappa > 0)
05695                         {
05696                             check( found_bad_pixel = opt_reject_outlier(
05697                                        image_data, noise_data,
05698                                        image_bpm,
05699                                        weights_data,
05700                                        pos,
05701                                        profile,
05702                                        kappa,
05703                                        flux, 
05704                        optimal_extract_sky ? sky_background : 0,
05705                        redchisq,
05706                                        cosmic_mask, cr_row,
05707                                        &hot_pixels, &cold_pixels),
05708                                    "Error rejecting outlier pixel");
05709                             
05710                         } 
05711                     else
05712                         {
05713                                 found_bad_pixel = false;
05714                         }
05715                     
05716                 } /* while there was an outlier or iteration < 2 */
05717             
05718             /* Update profile table */
05719             if (profile_table != NULL) {
05720                 double lin_flux = 0; /* Linearly extracted flux */
05721                 for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
05722                     /* If pixel is not rejected */
05723                     if (DATA(weights_data, pos) > 0)
05724                         {
05725                             double pixelval = DATA(image_data, pos);
05726                             lin_flux += pixelval;
05727                         }
05728                 }
05729 
05730                 for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
05731                     /* If pixel is not rejected */
05732                     if (DATA(weights_data, pos) > 0)
05733                         {
05734                             double dy = pos->y - pos->ycenter;
05735                             double pixelval = DATA(image_data, pos);
05736                             
05737                             check_nomsg(
05738                                     (cpl_table_set_int   (profile_table, "Order"      , 
05739                                                           *prof_row, pos->order),
05740                                      cpl_table_set_int   (profile_table, "X"          , 
05741                                                           *prof_row, pos->x),
05742                                      cpl_table_set_double(profile_table, "DY"         , 
05743                                                           *prof_row, dy),
05744                                      cpl_table_set_double(profile_table, "Profile_raw", 
05745                                                           *prof_row, pixelval/lin_flux),
05746                                      cpl_table_set_double(profile_table, "Profile_int",
05747                                                           *prof_row, 
05748                                                           uves_extract_profile_evaluate(profile, pos))));
05749                                 (*prof_row)++;
05750                             }
05751                     }
05752             }
05753             
05754             bins_extracted += 1;
05755             
05756             /* Don't do the following!! It changes the internal bpm with a low probability.
05757                That's bad because we already got a pointer to that so next time
05758                we follow that pointer the object might not exist. This is true
05759                for CPL3.0, it should be really be fixed in later versions.
05760                
05761                cpl_image_set(spectrum, pos->x, spectrum_row, flux);
05762                
05763                We don't have a pointer 'spectrum_noise', so calling cpl_image_set
05764                on that one is safe.
05765             */
05766             SPECTRUM_DATA(cpl_image_get_data_double(spectrum), pos) = flux;
05767             SPECTRUM_DATA(cpl_mask_get_data(cpl_image_get_bpm(spectrum)), pos) 
05768                 = CPL_BINARY_0;
05769             /* The overhead of these function calls is negligible */
05770             
05771             if (spectrum_noise != NULL)
05772                 {
05773                     cpl_image_set(spectrum_noise, pos->x, spectrum_row, sqrt(variance));
05774                 }
05775             
05776             
05777             /* Save sky (if extracted again) */
05778             if (optimal_extract_sky)
05779                 {
05780                     /* Change normalization of sky from 1 pixel to full slit,
05781                        (i.e. same normalization as the extracted object) 
05782                        
05783                        Error propagation is trivial (just multiply 
05784                        by same factor) because the
05785                        uncertainty of 'slit_length' is negligible. 
05786                     */
05787                     
05788                     cpl_image_set(sky_spectrum      , pos->x, spectrum_row, 
05789                                   pos->sg.length * sky_background);
05790                     cpl_image_set(sky_spectrum_noise, pos->x, spectrum_row,
05791                                   pos->sg.length * sky_background_noise);
05792                 }
05793             
05794             /* Update S/N. Use only central 10% (max of blaze function)
05795              * to calculate S/N.
05796              * If order is partially without image, use all bins in order.
05797              */
05798             if (order_width < pos->nx ||
05799                 (0.45*pos->nx <= pos->x && pos->x <= 0.55*pos->nx)
05800                 )
05801                 {
05802                     cpl_table_set_double(
05803                         signal_to_noise, "SN", sn_row, flux / sqrt(variance));
05804                     sn_row++;
05805                 }
05806             
05807         } /* for each x... */
05808     uves_msg_debug("%d/%d hot/cold pixels rejected", hot_pixels, cold_pixels);
05809     
05810     /* Return S/N */
05811     check_nomsg( cpl_table_set_size(signal_to_noise, sn_row) );
05812     if (sn_row > 0)
05813         {
05814             check_nomsg( *sn = cpl_table_get_column_median(signal_to_noise, "SN"));
05815         }
05816     else
05817         {
05818             *sn = 0;
05819         }
05820     
05821   cleanup:
05822     uves_free_table(&signal_to_noise);
05823     cpl_free(noise_buffer);
05824 
05825     return bins_extracted;
05826 }
05827 
05828 /*----------------------------------------------------------------------------*/
05851 /*----------------------------------------------------------------------------*/
05852 inline static double
05853 opt_get_sky(const double *image_data,
05854             const double *noise_data,
05855             const double *weights_data,
05856             uves_iterate_position *pos,
05857             const cpl_table *sky_map,
05858             double buffer_flux[], double buffer_noise[],
05859             double *sky_background_noise)
05860 {
05861     double sky_background;
05862     bool found_good = false;     /* Any good pixels in current bin? */
05863     double flux_max = 0;         /* Of all pixels in current bin */
05864     double flux_min = 0;
05865     int ngood = 0;  /* Number of elements in arrays (good sky pixels) */
05866 
05867     /* Get image data (sky pixels that are also good pixels) */
05868     for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
05869         {
05870             int row = pos->y - pos->ylow;
05871                     
05872             if (!ISBAD(weights_data, pos))
05873                 {
05874                     double fflux = DATA(image_data, pos);
05875                     double noise = DATA(noise_data, pos);
05876                     
05877                     if (!found_good)
05878                         {
05879                             found_good = true;
05880                             flux_max = fflux;
05881                             flux_min = fflux;
05882                         }
05883                     else
05884                         {
05885                             flux_max = uves_max_double(flux_max, fflux);
05886                             flux_min = uves_min_double(flux_min, fflux);
05887                         }
05888 
05889             /*if (pos->order == 1 && pos->x == 2825)
05890             {
05891                 uves_msg_error("%d: %f +- %f%s", pos->y, fflux, noise,
05892                        cpl_table_is_selected(sky_map, row) ? " *" : "");
05893             }
05894             */
05895 
05896                     if (cpl_table_is_selected(sky_map, row))
05897                         {
05898                             buffer_flux [ngood] = fflux;
05899                             buffer_noise[ngood] = noise;
05900                             ngood++;
05901                         }
05902                 }
05903         }
05904     
05905     /* Get median of valid rows */
05906     if (ngood > 0)
05907         {
05908             /* Get noise of one sky pixel (assumed constant for all sky pixels) */
05909             double avg_noise = uves_tools_get_median(buffer_noise, ngood);
05910                     
05911             sky_background   = uves_tools_get_median(buffer_flux, ngood);
05912                     
05913             /* If only 1 valid sky pixel */
05914             if (ngood == 1)
05915                 {
05916                     *sky_background_noise = avg_noise;
05917                 }
05918             else
05919                 {
05920                     /* 2 or more sky pixels.
05921                      *
05922                      * Uncertainty of median is (approximately)
05923                      *
05924                      *  sigma_median = sigma / sqrt(N * 2/pi)  ;  N >= 2
05925                      *
05926                      *  where sigma is the (constant) noise of each pixel
05927                      */
05928                     *sky_background_noise = avg_noise / sqrt(ngood * 2 / M_PI);
05929                 }
05930         }
05931     else
05932         /* No sky pixels, set noise as max - min */
05933         {
05934             if (found_good)
05935                 {
05936                     sky_background = flux_min;
05937                     *sky_background_noise = flux_max - flux_min;
05938                             
05939                     /* In the rare case where max==min, set noise to
05940                        something that's not zero */
05941                     if (*sky_background_noise <= 0) *sky_background_noise = 1;
05942                 }
05943             else
05944                 /* No good pixels in bin */
05945                 {
05946                     sky_background = 0;
05947                     *sky_background_noise = 1;
05948                 }
05949         }
05950          
05951     /* if (pos->order == 1 && pos->x == 2825) uves_msg_error("sky = %f", sky_background); */
05952     return sky_background;
05953 
05954 }
05955 
05956 
05957 /*----------------------------------------------------------------------------*/
05967 /*----------------------------------------------------------------------------*/
05968 inline static double
05969 opt_get_noise_median(const double *noise_data, const cpl_binary *image_bpm,
05970                      uves_iterate_position *pos, double noise_buffer[])
05971 {
05972     double median_noise;     /* Result */
05973     int ngood;               /* Number of good pixels */
05974     
05975     ngood = 0;
05976     for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
05977         {
05978             if (ISGOOD(image_bpm, pos))
05979                 {
05980                     noise_buffer[ngood] = DATA(noise_data, pos);
05981             ngood++;
05982                 }
05983         }
05984     
05985     if (ngood >= 1)
05986     {
05987             median_noise = uves_tools_get_median(noise_buffer, ngood);
05988         }
05989     else
05990         {
05991             median_noise = 1;
05992         }
05993     
05994     return median_noise;
05995 }
05996 
05997 /*----------------------------------------------------------------------------*/
06070 /*----------------------------------------------------------------------------*/
06071 
06072 inline static double
06073 opt_get_flux_sky_variance(const double *image_data, const double *noise_data, 
06074               double *weights_data,
06075               uves_iterate_position *pos,
06076               const uves_extract_profile *profile,
06077               bool optimal_extract_sky,
06078               double median_noise,
06079               double *variance,
06080               double *sky_background,
06081               double *sky_background_noise)
06082 {
06083     double flux;                 /* Result */
06084     double sumpfv = 0;           /* Sum of  profile*flux / variance */
06085     double sumppv = 0;           /* Sum of  profile^2/variance      */
06086     double sum1v = 0;            /* Sum of  1 / variance            */
06087     double sumpv = 0;            /* Sum of  profile / variance      */
06088     double sumfv = 0;            /* Sum of  flux / variance         */
06089 
06090     for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
06091         {
06092             /* If pixel is not rejected, set weight and accumulate */
06093             if (!ISBAD(weights_data, pos))
06094                 {
06095                     double pixel_variance, pixelval, weight;
06096                     double prof = uves_extract_profile_evaluate(profile, pos); /* is positive */
06097                     
06098                     pixelval       = DATA(image_data, pos);
06099                     pixel_variance = DATA(noise_data, pos);
06100                     pixel_variance *= pixel_variance;
06101                     
06102                     if (median_noise >= 0 && pixel_variance < median_noise*median_noise)
06103                         {
06104                             /* Increase noise to median (otherwise, 'dead' pixels
06105                                that aren't yet rejected will get too much weight) */
06106                             pixel_variance = median_noise*median_noise;
06107                         }
06108                     
06109                     weight = prof / pixel_variance;
06110                     DATA(weights_data, pos) = weight; 
06111                     /* Assuming Horne's traditional formula
06112                        which is a good approximation
06113                     */
06114 
06115                     sumpfv += pixelval * weight;
06116                     sumppv += prof * weight;
06117             if (optimal_extract_sky) 
06118             /* Optimization. Don't calculate if not needed. */
06119             {
06120                 sumpv  += weight;
06121                 sum1v  += 1 / pixel_variance;
06122                 sumfv  += pixelval / pixel_variance;
06123             }
06124                 }
06125 
06126         /*
06127         if (pos->order == 1 && pos->x == 2825){
06128         if (ISBAD(weights_data, pos))
06129         uves_msg_error("%d: *", pos->y);
06130             else
06131         uves_msg_error("%d: %f +- %f", pos->y, DATA(image_data, pos), DATA(noise_data, pos));
06132             }
06133         */
06134             
06135         }
06136     
06137     if (!optimal_extract_sky)
06138     {
06139         /* Horne's traditional formulas */
06140         if (sumppv > 0)
06141         {
06142             flux      = sumpfv / sumppv;
06143             *variance =      1 / sumppv;
06144         }
06145         else
06146         {
06147             flux = 0;
06148             *variance = 1;
06149         }
06150     }
06151     else
06152     {
06153         /* Generalization of Horne explained above */
06154         double denominator = sum1v*sumppv - sumpv*sumpv;
06155         if (denominator != 0)
06156         {
06157             flux      = (sum1v * sumpfv - sumpv * sumfv) / denominator;
06158 
06159                     /* Traditional formula, underestimates the error bars
06160                        and results in a (false) higher S/N
06161                        *variance = 1 / sumppv; 
06162                     */
06163             
06164             /* Formula which takes into account the uncertainty
06165                of the sky subtraction: */
06166                     *variance = sum1v / denominator;
06167             
06168             *sky_background = (sumppv*sumfv - sumpv*sumpfv) / denominator;
06169             *sky_background_noise = sqrt(sumppv / denominator);
06170         }
06171         else
06172         {
06173             flux = 0;
06174             *variance = 1;
06175 
06176             *sky_background = 0;
06177             *sky_background_noise = 1;
06178         }
06179     }
06180 
06181     /*
06182     if (pos->order == 1 && pos->x == 2825)
06183     {if (sky_background)
06184         uves_msg_error("sky = %f", *sky_background);
06185     }
06186     */
06187 
06188     return flux;
06189 }  
06190 
06191 
06192 /*----------------------------------------------------------------------------*/
06217 /*----------------------------------------------------------------------------*/
06218 inline static bool
06219 opt_reject_outlier(const double *image_data, const double *noise_data,
06220                    cpl_binary *image_bpm,
06221                    double *weights_data,
06222                    uves_iterate_position *pos,
06223                    const uves_extract_profile *profile,
06224                    double kappa, 
06225                    double flux, 
06226            double sky_background,
06227            double red_chisq,
06228                    cpl_table *cosmic_mask, int *cr_row,
06229                    int *hot_pixels, int *cold_pixels)
06230 {
06231     bool found_outlier = false;       /* Result                          */
06232 
06233     int y_outlier = -1;               /* Position of worst outlier       */
06234     double max_residual_sq = 0;       /* Residual^2/sigma^2 of
06235                                          worst outlier                   */
06236     bool outlier_is_hot = false;      /* true iff residual is positive   */
06237     
06238     /* Find worst outlier */
06239     for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++)
06240         {
06241             double prof = uves_extract_profile_evaluate(profile, pos);
06242             double pixel_variance, pixelval;
06243         double best_fit;
06244  
06245             pixel_variance = DATA(noise_data, pos);
06246             pixel_variance *= pixel_variance;
06247             
06248             pixelval = DATA(image_data, pos);
06249 
06250         best_fit = flux * prof + sky_background;   /* This part used to be a stupid bug:
06251                               the sky contribution was forgotten
06252                               -> most pixels were outliers
06253                               This bug was in the MIDAS version
06254                               and independently reimplemented in 
06255                               first CPL versions(!)
06256                                */
06257 
06258             if (!ISBAD(weights_data, pos) && 
06259                 /* for efficiency, don't:
06260                    fabs(pixelval - flux * prof) / sigma >= sqrt(max_residual_sq)
06261                 */
06262                 (pixelval - best_fit)*(pixelval - best_fit) / pixel_variance
06263                 >= max_residual_sq)
06264                 {
06265                     max_residual_sq =
06266                         (pixelval - best_fit) *
06267                         (pixelval - best_fit) / pixel_variance;
06268                     
06269                     y_outlier = pos->y;
06270                     
06271                     outlier_is_hot = (pixelval > best_fit);
06272                 }
06273         }
06274     
06275     /* Reject outlier if residual is larger than kappa sigma sqrt(red_chisq), i.e. if
06276        res^2/sigma^2  >  kappa^2  * chi^2/N 
06277     */
06278     if (max_residual_sq > kappa*kappa * red_chisq)
06279         {
06280             uves_msg_debug("Order #%d: Bad pixel at (x, y) = (%d, %d) residual^2 = %.2f sigma^2",
06281                            pos->order, pos->x, y_outlier, max_residual_sq);
06282             
06283             pos->y = y_outlier;
06284             SETBAD(weights_data, image_bpm, pos);
06285 
06286             found_outlier = true;
06287             if (outlier_is_hot)
06288                 {
06289                     *hot_pixels += 1;
06290                     
06291                     /* Update cosmic ray table. If it is too short, double the size */
06292             while (*cr_row >= cpl_table_get_nrow(cosmic_mask))
06293             {
06294                 cpl_table_set_size(cosmic_mask, 2*cpl_table_get_nrow(cosmic_mask));
06295                 uves_msg_debug("Setting CR table size to %d", 
06296                        cpl_table_get_nrow(cosmic_mask));
06297             }
06298             
06299                     check(( cpl_table_set_int   (cosmic_mask, "Order", *cr_row, pos->order),
06300                             cpl_table_set_int   (cosmic_mask, "X"    , *cr_row, pos->x),
06301                             cpl_table_set_int   (cosmic_mask, "Y"    , *cr_row, y_outlier),
06302                             cpl_table_set_double(cosmic_mask, "Flux" , *cr_row,
06303                                                  DATA(image_data, pos)),
06304                             (*cr_row)++),
06305                           "Error updating cosmic ray table");
06306                 }
06307             else
06308                 {
06309                     *cold_pixels += 1;
06310                 }
06311         }
06312     
06313   cleanup:
06314     return found_outlier;   
06315 }
06316 
06317 /*----------------------------------------------------------------------------*/
06327 /*----------------------------------------------------------------------------*/
06328 static double
06329 opt_get_redchisq(const uves_extract_profile *profile,
06330                  const uves_iterate_position *pos)
06331 {
06332     if (profile->constant) {
06333         return 1.0;
06334     }
06335     if (profile->f != NULL)
06336         {
06337             return uves_max_double(1,
06338 #if ORDER_PER_ORDER
06339                    uves_polynomial_evaluate_1d(
06340                        profile->red_chisq[pos->order-pos->minorder], pos->x));
06341 #else
06342                    uves_polynomial_evaluate_2d(
06343                        profile->red_chisq, pos->x, pos->order));
06344 #endif
06345         }
06346     else
06347         {
06348             /* Virtual resampling, don't adjust kappa */
06349             return 1.0;
06350         }
06351 }
06352 
06353 /*----------------------------------------------------------------------------*/
06373 /*----------------------------------------------------------------------------*/
06374 static polynomial *
06375 repeat_orderdef(const cpl_image *image, const cpl_image *image_noise,
06376                 const polynomial *guess_locations,
06377                 int minorder, int maxorder, slit_geometry sg,
06378         cpl_table *info_tbl)
06379 {
06380     polynomial *order_locations = NULL;
06381     int nx = cpl_image_get_size_x(image);
06382     int ny = cpl_image_get_size_y(image);
06383     double max_shift = sg.length/2; /* pixels in y-direction */
06384     int stepx = 10;
06385     int x, order;
06386     int ordertab_row;   /* First unused row of ordertab */
06387     cpl_table *ordertab = NULL;
06388     cpl_table *temp = NULL;
06389 
06390     ordertab = cpl_table_new((maxorder - minorder + 1)*nx);
06391     ordertab_row = 0;
06392     cpl_table_new_column(ordertab, "X"    , CPL_TYPE_INT);
06393     cpl_table_new_column(ordertab, "Order", CPL_TYPE_INT);
06394     cpl_table_new_column(ordertab, "Y"    , CPL_TYPE_DOUBLE);
06395     cpl_table_new_column(ordertab, "Yold" , CPL_TYPE_DOUBLE);
06396     cpl_table_new_column(ordertab, "Sigma", CPL_TYPE_DOUBLE);
06397     cpl_table_set_column_unit(ordertab, "Y", "pixels");
06398 
06399     /* Measure */
06400     for (order = minorder; order <= maxorder; order++) {
06401         for (x = 1 + stepx/2; x <= nx; x += stepx) {
06402             double ycenter;
06403             int yhigh, ylow;
06404                     
06405             double y_0, sigma, norm, background;
06406             check( ycenter = uves_polynomial_evaluate_2d(guess_locations, x, order),
06407                    "Error evaluating polynomial");
06408                     
06409             ylow  = uves_round_double(ycenter - max_shift);
06410             yhigh = uves_round_double(ycenter + max_shift);
06411                     
06412             if (1 <= ylow && yhigh <= ny) {
06413                 uves_fit_1d_image(image, image_noise, NULL,
06414                                   false,            /* Horizontal?              */
06415                                   false, false,     /* Fix/fit background?      */
06416                                   ylow, yhigh, x,   /* yrange, x                */
06417                                   &y_0, &sigma, &norm, &background, NULL,
06418                                   NULL, NULL, NULL, /* mse, chi^2/N, covariance */
06419                                   uves_gauss, uves_gauss_derivative, 4);
06420                             
06421                 if (cpl_error_get_code() == CPL_ERROR_CONTINUE) {
06422                     uves_error_reset();
06423                     uves_msg_debug("Profile fitting failed "
06424                                    "at (x,y) = (%d, %e), ignoring bin",
06425                                    x, ycenter);
06426                 }
06427                 else {
06428                     assure(cpl_error_get_code() == CPL_ERROR_NONE,
06429                            cpl_error_get_code(), "Gaussian fitting failed");
06430                                     
06431                     cpl_table_set_int   (ordertab, "X"     , ordertab_row, x);
06432                     cpl_table_set_int   (ordertab, "Order" , ordertab_row, order);
06433                     cpl_table_set_double(ordertab, "Y"     , ordertab_row, y_0);
06434                     cpl_table_set_double(ordertab, "Yold"  , ordertab_row, ycenter);
06435                     cpl_table_set_double(ordertab, "Sigma" , ordertab_row, sigma);
06436                     ordertab_row += 1;
06437                 }
06438             }
06439         }
06440     }
06441     
06442     cpl_table_set_size(ordertab, ordertab_row);
06443 
06444     /* Fit */
06445     if (ordertab_row < 300)
06446     {
06447         uves_msg_warning("Too few points (%d) to reliably fit order polynomial. "
06448                  "Using calibration solution", ordertab_row);
06449         
06450         uves_polynomial_delete(&order_locations);
06451         order_locations = uves_polynomial_duplicate(guess_locations);
06452         
06453         cpl_table_duplicate_column(ordertab, "Yfit", ordertab, "Yold");
06454     }
06455     else
06456     {
06457         int max_degree = 10;
06458         double kappa = 4.0;
06459         double min_rms = 0.05;   /* Pixels (stop at this point, for efficiency) */
06460         
06461         order_locations = 
06462         uves_polynomial_regression_2d_autodegree(ordertab,
06463                              "X", "Order", "Y", NULL,
06464                              "Yfit", NULL, NULL,
06465                              NULL, NULL, NULL,
06466                              kappa,
06467                              max_degree, max_degree, min_rms, -1,
06468                                                          true,
06469                              NULL, NULL, -1, NULL);
06470     
06471         if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
06472         {
06473             uves_error_reset();
06474             uves_msg_warning("Could not fit new order polynomial. "
06475                      "Using calibration solution");
06476             
06477             uves_polynomial_delete(&order_locations);
06478             order_locations = uves_polynomial_duplicate(guess_locations);
06479             
06480             cpl_table_duplicate_column(ordertab, "Yfit", ordertab, "Yold");
06481             
06482             /* Compute shift, also in this case */
06483         }
06484         else
06485         {
06486             assure( cpl_error_get_code() == CPL_ERROR_NONE,
06487                 cpl_error_get_code(),
06488                 "Error fitting orders polynomial");
06489         }
06490     }
06491     
06492     /* Yshift := Yfit - Yold */
06493     cpl_table_duplicate_column(ordertab, "Yshift", ordertab, "Yfit"); /* Yshift := Yfit */
06494     cpl_table_subtract_columns(ordertab, "Yshift", "Yold");  /* Yshift := Yshift - Yold */
06495     
06496     {
06497     double mean  = cpl_table_get_column_mean(ordertab, "Yshift");
06498     double stdev = cpl_table_get_column_mean(ordertab, "Yshift");
06499     double rms = sqrt(mean*mean + stdev*stdev);
06500     
06501     uves_msg("Average shift with respect to calibration solution is %.2f pixels", rms);
06502     }
06503     
06504     /* Compute object postion+FWHM wrt old solution (for QC) */
06505     for (order = minorder; order <= maxorder; order++)
06506     {
06507         double pos = 
06508         uves_polynomial_evaluate_2d(order_locations, nx/2, order)-
06509         uves_polynomial_evaluate_2d(guess_locations, nx/2, order);
06510         
06511         double fwhm;
06512         
06513         
06514         /* Extract rows with "Order" equal to current order,
06515            but avoid == comparison of floating point values */
06516         uves_free_table(&temp);
06517         temp = uves_extract_table_rows(ordertab, "Order",
06518                        CPL_EQUAL_TO, 
06519                        order); /* Last argument is double, will
06520                               be rounded to nearest integer */
06521         
06522         if (cpl_table_get_nrow(temp) < 1)
06523         {
06524             uves_msg_warning("Problem tracing object in order %d. "
06525                      "Setting QC FHWM parameter to zero",
06526                      order);
06527             fwhm = 0;
06528         }
06529         else
06530         {
06531             fwhm = cpl_table_get_column_median(temp, "Sigma") * TWOSQRT2LN2;
06532         }
06533         
06534 
06535         cpl_table_set_int   (info_tbl, "Order", order - minorder, order);
06536         cpl_table_set_double(info_tbl, "Pos"  , order - minorder, 
06537                  pos - (-sg.length/2 + sg.offset));
06538         cpl_table_set_double(info_tbl, "FWHM" , order - minorder, fwhm);
06539     }
06540     
06541   cleanup:
06542     uves_free_table(&ordertab);
06543     uves_free_table(&temp);
06544 
06545     return order_locations;
06546 }
06547 

Generated on Fri Apr 18 14:11:42 2008 for UVES Pipeline Reference Manual by  doxygen 1.5.1