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

Generated on 9 Mar 2012 for UVES Pipeline Reference Manual by  doxygen 1.6.1