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

Generated on Thu Nov 15 14:32:28 2007 for UVES Pipeline Reference Manual by  doxygen 1.5.1