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

Generated on Tue Jun 19 14:39:16 2007 for UVES Pipeline Reference Manual by  doxygen 1.4.6