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

Generated on 8 Mar 2011 for UVES Pipeline Reference Manual by  doxygen 1.6.1