uves_utils.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: jmlarsen $
00022  * $Date: 2007/06/06 14:57:24 $
00023  * $Revision: 1.140 $
00024  * $Name: uves-3_3_1 $
00025  * $Log: uves_utils.c,v $
00026  * Revision 1.140  2007/06/06 14:57:24  jmlarsen
00027  * Disabled FLAMES for public release
00028  *
00029  * Revision 1.139  2007/06/06 08:17:33  amodigli
00030  * replace tab with 4 spaces
00031  *
00032  * Revision 1.138  2007/05/25 07:06:00  jmlarsen
00033  * Don't print output frameset
00034  *
00035  * Revision 1.137  2007/05/22 11:30:57  jmlarsen
00036  * Removed MIDAS flag for good
00037  *
00038  * Revision 1.136  2007/05/04 08:51:01  jmlarsen
00039  * Update
00040  *
00041  * Revision 1.135  2007/05/02 13:18:50  jmlarsen
00042  * Added function to simulate reconstruct raw image
00043  *
00044  * Revision 1.134  2007/04/24 12:50:29  jmlarsen
00045  * Replaced cpl_propertylist -> uves_propertylist which is much faster
00046  *
00047  * Revision 1.133  2007/04/12 14:07:28  jmlarsen
00048  * Removed debugging code
00049  *
00050  * Revision 1.132  2007/04/12 14:02:47  jmlarsen
00051  * Fixed memory error in uves_regression_2d()
00052  *
00053  * Revision 1.131  2007/04/12 11:58:08  jmlarsen
00054  * Check compile time CPL version number
00055  *
00056  * Revision 1.130  2007/04/10 07:10:37  jmlarsen
00057  * uves_spline_hermite(): maintain current array position (for efficiency)
00058  *
00059  * Revision 1.129  2007/03/28 11:39:40  jmlarsen
00060  * Removed MIDAS flag from uves_define_noise
00061  *
00062  * Revision 1.128  2007/03/19 15:11:21  jmlarsen
00063  * Optimization in 2d fitting
00064  *
00065  * Revision 1.127  2007/03/13 15:34:42  jmlarsen
00066  * Time optimizations of 2d poly fit functions
00067  *
00068  * Revision 1.126  2007/03/05 10:17:44  jmlarsen
00069  * Disabled strange msginfolevel parameter
00070  *
00071  * Revision 1.125  2007/02/23 07:36:33  jmlarsen
00072  * Changed definition of non-linear background term in uves_gauss_linear()
00073  *
00074  * Revision 1.124  2007/02/22 15:34:46  jmlarsen
00075  * Implement gaussian function with linear background
00076  *
00077  * Revision 1.123  2007/02/14 14:07:13  jmlarsen
00078  * Removed dead code
00079  *
00080  * Revision 1.122  2007/02/09 08:14:16  jmlarsen
00081  * Do not use CPL_PIXEL_MAXVAL which works only for integer images
00082  *
00083  * Revision 1.121  2007/01/15 08:47:47  jmlarsen
00084  * More robust polynomial fitting
00085  *
00086  * Revision 1.120  2006/12/12 12:09:35  jmlarsen
00087  * Print more CPL version info
00088  *
00089  * Revision 1.119  2006/11/15 15:02:15  jmlarsen
00090  * Implemented const safe workarounds for CPL functions
00091  *
00092  * Revision 1.117  2006/11/15 14:04:08  jmlarsen
00093  * Removed non-const version of parameterlist_get_first/last/next which is
00094  * already in CPL, added const-safe wrapper, unwrapper and deallocator functions
00095  *
00096  * Revision 1.116  2006/11/06 15:19:42  jmlarsen
00097  * Removed unused include directives
00098  *
00099  * Revision 1.115  2006/11/03 15:01:21  jmlarsen
00100  * Killed UVES 3d table module and use CPL 3d tables
00101  *
00102  * Revision 1.114  2006/10/09 13:03:09  jmlarsen
00103  * Removed explicit uves_msg_softer/louder calls
00104  *
00105  * Revision 1.113  2006/09/20 12:53:57  jmlarsen
00106  * Replaced stringcat functions with uves_sprintf()
00107  *
00108  * Revision 1.112  2006/09/19 07:17:08  jmlarsen
00109  * Reformatted line
00110  *
00111  * Revision 1.111  2006/09/08 14:05:36  jmlarsen
00112  * Added max/min allowed values in autodegree fitting
00113  *
00114  * Revision 1.110  2006/09/06 14:45:24  jmlarsen
00115  * Minor documentation update
00116  *
00117  * Revision 1.109  2006/09/01 13:58:32  jmlarsen
00118  * Minor doc bug fix
00119  *
00120  * Revision 1.108  2006/08/24 11:43:47  jmlarsen
00121  * Write recipe start/stop time to header
00122  *
00123  * Revision 1.107  2006/08/23 09:31:47  jmlarsen
00124  * Fixed buffer overrun
00125  *
00126  * Revision 1.106  2006/08/18 07:07:43  jmlarsen
00127  * Switched order of cpl_calloc arguments
00128  *
00129  * Revision 1.105  2006/08/17 14:11:25  jmlarsen
00130  * Use assure_mem macro to check for memory allocation failure
00131  *
00132  * Revision 1.104  2006/08/17 13:56:53  jmlarsen
00133  * Reduced max line length
00134  *
00135  * Revision 1.103  2006/08/16 14:25:47  jmlarsen
00136  * On recipe exit, print only products frames
00137  *
00138  * Revision 1.102  2006/08/11 14:56:06  amodigli
00139  * removed Doxygen warnings
00140  *
00141  * Revision 1.101  2006/08/11 11:29:09  jmlarsen
00142  * uves_get_version_binary
00143  *
00144  * Revision 1.100  2006/08/10 10:53:27  jmlarsen
00145  * Changed requirements on CPL, QFITS versions
00146  *
00147  * Revision 1.99  2006/07/14 12:42:42  jmlarsen
00148  * Added function uves_strincat_4
00149  *
00150  * Revision 1.98  2006/07/03 13:20:25  jmlarsen
00151  * Fixed indexing problem in autodegree fitting function
00152  *
00153  * Revision 1.97  2006/06/22 09:44:02  jmlarsen
00154  * Added function to remove string prefix
00155  *
00156  * Revision 1.96  2006/06/16 08:26:15  jmlarsen
00157  * Removed deprecated comment
00158  *
00159  * Revision 1.95  2006/06/06 08:40:10  jmlarsen
00160  * Shortened max line length
00161  *
00162  * Revision 1.94  2006/06/01 14:43:17  jmlarsen
00163  * Added missing documentation
00164  *
00165  * Revision 1.93  2006/05/12 15:40:08  jmlarsen
00166  * Fixed mixed code declarations
00167  *
00168  * Revision 1.92  2006/05/12 15:12:11  jmlarsen
00169  * Support minimum RMS in auto-degree fitting
00170  *
00171  * Revision 1.91  2006/05/05 13:58:09  jmlarsen
00172  * Added uves_polynomial_regression_2d_autodegree
00173  *
00174  * Revision 1.90  2006/04/24 09:26:37  jmlarsen
00175  * Added code to compute Moffat profile
00176  *
00177  * Revision 1.89  2006/03/24 13:48:47  jmlarsen
00178  * Renamed shadowing variables
00179  *
00180  * Revision 1.88  2006/03/09 10:52:52  jmlarsen
00181  * Changed order of for loops
00182  *
00183  * Revision 1.87  2006/03/03 13:54:11  jmlarsen
00184  * Changed syntax of check macro
00185  *
00186  * Revision 1.86  2006/02/28 09:15:23  jmlarsen
00187  * Minor update
00188  *
00189  * Revision 1.85  2006/02/15 13:19:15  jmlarsen
00190  * Reduced source code max. line length
00191  *
00192  * Revision 1.84  2006/02/08 07:52:16  jmlarsen
00193  * Added function returning library version
00194  *
00195  * Revision 1.83  2006/02/03 07:46:30  jmlarsen
00196  * Moved recipe implementations to ./uves directory
00197  *
00198  * Revision 1.82  2006/01/12 15:41:14  jmlarsen
00199  * Moved gauss. fitting to irplib
00200  *
00201  * Revision 1.81  2006/01/05 14:23:30  jmlarsen
00202  * Fixed hard-coded qfits version bug
00203  *
00204  * Revision 1.80  2006/01/03 15:50:54  amodigli
00205  * :q!
00206  *
00207  * Revision 1.79  2005/12/19 16:17:56  jmlarsen
00208  * Replaced bool -> int
00209  *
00210  * Revision 1.78  2005/12/19 12:29:36  jmlarsen
00211  * Added subtract_bias, subtract_dark functions
00212  *
00213  * Revision 1.77  2005/12/16 14:22:23  jmlarsen
00214  * Removed midas test data; Added sof files
00215  *
00216  * Revision 1.76  2005/12/12 10:34:57  jmlarsen
00217  * Minor doc. update
00218  *
00219  * Revision 1.75  2005/12/02 10:41:49  jmlarsen
00220  * Minor update
00221  *
00222  * Revision 1.74  2005/11/24 11:54:46  jmlarsen
00223  * Added support for CPL 3 interface
00224  *
00225  * Revision 1.73  2005/11/14 13:18:44  jmlarsen
00226  * Minor update
00227  *
00228  * Revision 1.72  2005/11/11 14:52:08  jmlarsen
00229  * Inserted median filter before estimating photonic noise
00230  *
00231  * Revision 1.71  2005/11/11 13:18:54  jmlarsen
00232  * Reorganized code, renamed source files
00233  *
00234  * Revision 1.70  2005/11/10 16:33:41  jmlarsen
00235  * Added weighted extraction, test of gauss. fit
00236  *
00237  * Revision 1.69  2005/11/07 12:18:21  jmlarsen
00238  * Support for sigma in 1d pol.fit
00239  *
00240  * Revision 1.68  2005/11/03 15:14:17  jmlarsen
00241  * Fixed a few doc. bugs
00242  *
00243  * Revision 1.67  2005/10/27 10:44:05  jmlarsen
00244  * Optimized opt.extraction + efficiency calc.
00245  *
00246  * Revision 1.66  2005/10/25 11:59:19  jmlarsen
00247  * scired flux calibration
00248  *
00249  * Revision 1.65  2005/10/20 11:36:59  jmlarsen
00250  * Removed variable declaration after code
00251  *
00252  * Revision 1.64  2005/10/19 13:18:45  jmlarsen
00253  * General update
00254  *
00255  */
00256 
00257 #ifdef HAVE_CONFIG_H
00258 #  include <config.h>
00259 #endif
00260 
00261 /*----------------------------------------------------------------------------*/
00267 /*----------------------------------------------------------------------------*/
00268 
00269 /*-----------------------------------------------------------------------------
00270                             Includes
00271  -----------------------------------------------------------------------------*/
00272 
00273 #include <uves_utils.h>
00274 
00275 #include <uves_extract_profile.h>
00276 #include <uves_plot.h>
00277 #include <uves_dfs.h>
00278 #include <uves_pfits.h>
00279 #include <uves_utils_wrappers.h>
00280 #include <uves_msg.h>
00281 #include <uves_dump.h>
00282 #include <uves_error.h>
00283 
00284 #include <irplib_utils.h>
00285 #include <irplib_access.h>
00286 
00287 #include <cpl.h>
00288 #include <qfits.h> /* iso time */
00289 
00290 #include <ctype.h>  /* tolower */
00291 #include <stdbool.h>
00292 #include <float.h>
00293 
00294 /*-----------------------------------------------------------------------------
00295                             Defines
00296  -----------------------------------------------------------------------------*/
00297 // The following macros are used to provide a fast
00298 // and readable way to convert C-indexes to FORTRAN-indexes.
00299 #define C_TO_FORTRAN_INDEXING(a) &a[-1]
00300 #define FORTRAN_TO_C_INDEXING(a) &a[1]
00301 
00303 /*-----------------------------------------------------------------------------
00304                             Functions prototypes
00305  -----------------------------------------------------------------------------*/
00306 /*-----------------------------------------------------------------------------
00307                             Implementation
00308  -----------------------------------------------------------------------------*/
00309 /*----------------------------------------------------------------------------*/
00319 /*----------------------------------------------------------------------------*/
00320 inline double
00321 uves_pow_int(double x, int y)
00322 {
00323     double result = 1.0;
00324 
00325     /* Invariant is:   result * x ^ y   */
00326     
00327 
00328     while(y != 0)
00329     {
00330         if (y % 2 == 0)
00331         {
00332             x *= x;
00333             y /= 2;
00334         }
00335         else
00336         {
00337             if (y > 0)
00338             {
00339                 result *= x;
00340                 y -= 1;            
00341             }
00342             else
00343             {
00344                 result /= x;
00345                 y += 1;            
00346             }
00347         }
00348     }
00349     
00350     return result;
00351 }
00352 
00353 
00354 
00355 
00356 /*----------------------------------------------------------------------------*/
00365 /*----------------------------------------------------------------------------*/
00366 inline long
00367 uves_round_double(double x)
00368 {
00369     return (x >=0) ? (long)(x+0.5) : (long)(x-0.5);
00370 }
00371 
00372 /*----------------------------------------------------------------------------*/
00381 /*----------------------------------------------------------------------------*/
00382 inline double
00383 uves_max_double(double x, double y)
00384 {
00385     return (x >=y) ? x : y;
00386 }
00387 /*----------------------------------------------------------------------------*/
00396 /*----------------------------------------------------------------------------*/
00397 inline int
00398 uves_max_int(int x, int y)
00399 {
00400     return (x >=y) ? x : y;
00401 }
00402 
00403 /*----------------------------------------------------------------------------*/
00412 /*----------------------------------------------------------------------------*/
00413 inline double
00414 uves_min_double(double x, double y)
00415 {
00416     return (x <=y) ? x : y;
00417 }
00418 /*----------------------------------------------------------------------------*/
00427 /*----------------------------------------------------------------------------*/
00428 inline int
00429 uves_min_int(int x, int y)
00430 {
00431     return (x <=y) ? x : y;
00432 }
00433 
00434 /*----------------------------------------------------------------------------*/
00445 /*----------------------------------------------------------------------------*/
00446 inline double
00447 uves_error_fraction(double x, double y, double dx, double dy)
00448 {
00449     /* Error propagation:
00450      * sigma(x/y)^2 = (1/y sigma(x))^2 + (-x/y^2 sigma(y))^2 
00451      */
00452     return sqrt( dx*dx/(y*y) + x*x*dy*dy/(y*y*y*y) );
00453 }
00454 
00455 
00456 
00457 /*----------------------------------------------------------------------------*/
00466 /*----------------------------------------------------------------------------*/
00467 cpl_error_code
00468 uves_get_version(int *major, int *minor, int *micro)
00469 {
00470     /* Macros are defined in config.h */
00471     if (major != NULL) *major = UVES_MAJOR_VERSION;
00472     if (minor != NULL) *minor = UVES_MINOR_VERSION;
00473     if (micro != NULL) *micro = UVES_MICRO_VERSION;
00474 
00475     return cpl_error_get_code();
00476 }
00477 
00478 
00479 /*----------------------------------------------------------------------------*/
00485 /*----------------------------------------------------------------------------*/
00486 int
00487 uves_get_version_binary(void)
00488 {
00489     return UVES_BINARY_VERSION;
00490 }
00491 
00492 
00493 /*----------------------------------------------------------------------------*/
00501 /*----------------------------------------------------------------------------*/
00502 const char *
00503 uves_get_license(void)
00504 {
00505     return
00506     "This file is part of the ESO UVES Instrument Pipeline\n"
00507     "Copyright (C) 2004,2005,2006 European Southern Observatory\n"
00508     "\n"
00509     "This program is free software; you can redistribute it and/or modify\n"
00510     "it under the terms of the GNU General Public License as published by\n"
00511     "the Free Software Foundation; either version 2 of the License, or\n"
00512     "(at your option) any later version.\n"
00513     "\n"
00514     "This program is distributed in the hope that it will be useful,\n"
00515     "but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
00516     "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n"
00517         "GNU General Public License for more details.\n"
00518         "\n"
00519         "You should have received a copy of the GNU General Public License\n"
00520         "along with this program; if not, write to the Free Software\n"
00521         "Foundation, 51 Franklin St, Fifth Floor, Boston, \n"
00522         "MA  02111-1307  USA" ;
00523 
00524     /* Note that long strings are unsupported in C89 */
00525 }
00526 
00527 /*----------------------------------------------------------------------------*/
00537 /*----------------------------------------------------------------------------*/
00538 /* To change requirements, just edit these numbers */
00539 #define REQ_CPL_MAJOR 3
00540 #define REQ_CPL_MINOR 1
00541 #define REQ_CPL_MICRO 0
00542 
00543 #define REQ_QF_MAJOR 6
00544 #define REQ_QF_MINOR 2
00545 #define REQ_QF_MICRO 0
00546 
00547 void
00548 uves_check_version(void)
00549 {
00550 #ifdef CPL_VERSION_CODE
00551 #if CPL_VERSION_CODE >= CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO)
00552     uves_msg_debug("Compile time CPL version code was %d "
00553                    "(version %d-%d-%d, code %d required)",
00554                    CPL_VERSION_CODE, REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO,
00555                    CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO));
00556 #else
00557 #error CPL version too old
00558 #endif
00559 #else  /* ifdef CPL_VERSION_CODE */
00560 #error CPL_VERSION_CODE not defined. CPL version too old
00561 #endif
00562 
00563     if (cpl_version_get_major() < REQ_CPL_MAJOR ||
00564     (cpl_version_get_major() == REQ_CPL_MAJOR && 
00565      (int) cpl_version_get_minor() < REQ_CPL_MINOR) || /* cast suppresses warning
00566                                                               about comparing unsigned < 0 */
00567     (cpl_version_get_major() == REQ_CPL_MAJOR &&
00568      cpl_version_get_minor() == REQ_CPL_MINOR && 
00569      (int) cpl_version_get_micro() < REQ_CPL_MICRO)
00570     )
00571     {
00572         uves_msg_warning("CPL version %s (%d.%d.%d) (detected) is not supported. "
00573                  "Please update to CPL version %d.%d.%d or later", 
00574                  cpl_version_get_version(),
00575                  cpl_version_get_major(),
00576                  cpl_version_get_minor(),
00577                  cpl_version_get_micro(),
00578                  REQ_CPL_MAJOR,
00579                  REQ_CPL_MINOR,
00580                  REQ_CPL_MICRO);
00581     }
00582     else
00583     {
00584         uves_msg_debug("CPL version %s (%d.%d.%d) detected (%d.%d.%d or later required)",
00585                cpl_version_get_version(),
00586                cpl_version_get_major(),
00587                cpl_version_get_minor(),
00588                cpl_version_get_micro(),
00589                REQ_CPL_MAJOR,
00590                REQ_CPL_MINOR,
00591                REQ_CPL_MICRO);
00592     }
00593 
00594     {
00595     const char *qfts_v = " ";
00596     char *suffix;
00597     
00598     long qfts_major;
00599     long qfts_minor;
00600     long qfts_micro;
00601 
00602     qfts_v = qfits_version();
00603 
00604     assure( qfts_v != NULL, CPL_ERROR_ILLEGAL_INPUT,
00605         "Error reading qfits version");
00606 
00607     /* Parse    "X.[...]" */
00608     qfts_major = strtol(qfts_v, &suffix, 10);
00609     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
00610         CPL_ERROR_ILLEGAL_INPUT, 
00611         "Error parsing version string '%s'. "
00612         "Format 'X.Y.Z' expected", qfts_v);
00613 
00614     /* Parse    "Y.[...]" */
00615     qfts_minor = strtol(suffix+1, &suffix, 10);
00616     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
00617         CPL_ERROR_ILLEGAL_INPUT,
00618         "Error parsing version string '%s'. "
00619         "Format 'X.Y.Z' expected", qfts_v);
00620 
00621     /* Parse    "Z" */
00622     qfts_micro = strtol(suffix+1, &suffix, 10);
00623 
00624     /* If qfits version is earlier than required ... */
00625     if (qfts_major < REQ_QF_MAJOR ||
00626         (qfts_major == REQ_QF_MAJOR && qfts_minor  < REQ_QF_MINOR) ||
00627         (qfts_major == REQ_QF_MAJOR && qfts_minor == REQ_QF_MINOR && 
00628          qfts_micro < REQ_QF_MICRO)
00629         )
00630         {
00631         uves_msg_warning("qfits version %s (detected) is not supported. "
00632                  "Please update to qfits version %d.%d.%d or later", 
00633                  qfts_v,
00634                  REQ_QF_MAJOR,
00635                  REQ_QF_MINOR,
00636                  REQ_QF_MICRO);
00637         }
00638     else
00639         {
00640         uves_msg_debug("qfits version %ld.%ld.%ld detected "
00641                    "(%d.%d.%d or later required)", 
00642                    qfts_major, qfts_minor, qfts_micro,
00643                    REQ_QF_MAJOR,
00644                    REQ_QF_MINOR,
00645                    REQ_QF_MICRO);
00646         }
00647     }
00648     
00649   cleanup:
00650     return;
00651 }
00652 
00653 /*----------------------------------------------------------------------------*/
00665 /*----------------------------------------------------------------------------*/
00666 cpl_error_code
00667 uves_end(const char *recipe_id, const cpl_frameset *frames)
00668 {
00669     cpl_frameset *products = NULL;
00670     const cpl_frame *f;
00671     int warnings = uves_msg_get_warnings();
00672 
00673     recipe_id = recipe_id; /* Suppress warning about unused variable,
00674                   perhaps we the recipe_id later, so
00675                   keep it in the interface. */
00676 
00677 
00678     /* Print (only) output frames */
00679 
00680     products = cpl_frameset_new();
00681     assure_mem( products );
00682 
00683     for (f = irplib_frameset_get_first_const(frames);
00684      f != NULL;
00685      f = irplib_frameset_get_next_const(frames))
00686     {
00687         if (cpl_frame_get_group(f) == CPL_FRAME_GROUP_PRODUCT)
00688         {
00689             check_nomsg(
00690             cpl_frameset_insert(products, cpl_frame_duplicate(f)));
00691         }
00692     }
00693 
00694 /* Don't do this. EsoRex should.
00695    uves_msg_low("Output frames");
00696    check( uves_print_cpl_frameset(products),
00697    "Could not print output frames");
00698 */
00699 
00700     /* Summarize warnings, if any */
00701     if( warnings > 0)
00702     {
00703         uves_msg_warning("Recipe produced %d warning%s (excluding this one)",
00704                  uves_msg_get_warnings(),
00705                  /* Plural? */ (warnings > 1) ? "s" : "");
00706     }
00707 
00708   cleanup:
00709     uves_free_frameset(&products);
00710     return cpl_error_get_code();    
00711 }
00712 
00713 /*----------------------------------------------------------------------------*/
00734 /*----------------------------------------------------------------------------*/
00735 char *
00736 uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist, 
00737         const char *recipe_id, const char *short_descr)
00738 {
00739     char *recipe_string = NULL;
00740     char *stars = NULL;     /* A string of stars */
00741     char *spaces1 = NULL;
00742     char *spaces2 = NULL;
00743     char *spaces3 = NULL;
00744     char *spaces4 = NULL;
00745     char *start_time = NULL;
00746 
00747 //    const char *version_cpl;
00748 
00749     start_time = uves_sprintf("%s", qfits_get_datetime_iso8601());
00750 
00751     /* Now read parameters and set specified message level */
00752     {
00753     const char *plotter_command;
00754     int msglevel;
00755     
00756     /* Read parameters using context = recipe_id */
00757 
00758         if (0) /* disabled */
00759             check( uves_get_parameter(parlist, NULL, "uves", "msginfolevel", 
00760                                       CPL_TYPE_INT, &msglevel),
00761                    "Could not read parameter");
00762         else
00763             {
00764                 msglevel = -1; /* max verbosity */
00765             }
00766     uves_msg_set_level(msglevel);
00767     check( uves_get_parameter(parlist, NULL, "uves", "plotter",
00768                   CPL_TYPE_STRING, &plotter_command), "Could not read parameter");
00769     
00770     /* Initialize plotting */
00771     check( uves_plot_initialize(plotter_command), 
00772            "Could not initialize plotting");
00773     }    
00774 
00775 //    check( version_cpl = cpl_get_version(), "Error reading CPL version");
00776 
00777     /* Print 
00778      *************************
00779      ***   PACAGE_STRING   ***
00780      *** Recipe: recipe_id ***
00781      *************************
00782      */
00783     recipe_string = uves_sprintf("Recipe: %s", recipe_id);
00784     {
00785     int field = uves_max_int(strlen(PACKAGE_STRING), strlen(recipe_string));
00786     int nstars = 3+1 + field + 1+3;
00787     int nspaces1, nspaces2, nspaces3, nspaces4;
00788     int i;
00789     
00790     /* ' ' padding */
00791     nspaces1 = (field - strlen(PACKAGE_STRING)) / 2; 
00792     nspaces2 = field - strlen(PACKAGE_STRING) - nspaces1;
00793 
00794     nspaces3 = (field - strlen(recipe_string)) / 2;
00795     nspaces4 = field - strlen(recipe_string) - nspaces3;
00796 
00797     spaces1 = cpl_calloc(nspaces1 + 1, sizeof(char)); 
00798     spaces2 = cpl_calloc(nspaces2 + 1, sizeof(char));
00799     spaces3 = cpl_calloc(nspaces3 + 1, sizeof(char)); 
00800     spaces4 = cpl_calloc(nspaces4 + 1, sizeof(char));
00801     for (i = 0; i < nspaces1; i++) spaces1[i] = ' ';
00802     for (i = 0; i < nspaces2; i++) spaces2[i] = ' ';
00803     for (i = 0; i < nspaces3; i++) spaces3[i] = ' ';
00804     for (i = 0; i < nspaces4; i++) spaces4[i] = ' ';
00805 
00806     stars = cpl_calloc(nstars + 1, sizeof(char));
00807     for (i = 0; i < nstars; i++) stars[i] = '*';
00808     
00809     uves_msg("%s", stars);
00810     uves_msg("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
00811     uves_msg("*** %s%s%s ***", spaces3, recipe_string, spaces4);
00812     uves_msg("%s", stars);
00813     }
00814 
00815     check( uves_check_version(), "Library validation failed");
00816 
00817     uves_msg("This recipe %c%s", tolower(short_descr[0]), short_descr+1);
00818 
00819     if (cpl_frameset_is_empty(frames)) {
00820         uves_msg_debug("Guvf cvcryvar unf ernpurq vgf uvtu dhnyvgl qhr na npgvir "
00821                        "hfre pbzzhavgl naq gur erfcbafvoyr naq vqrnyvfgvp jbex bs "
00822                        "vaqvivqhny cvcryvar qrirybcref, naq qrfcvgr orvat 'onfrq ba' "
00823                        "PCY juvpu vf n cvrpr bs cbyvgvpny penc");
00824     }
00825 
00826     /* Set group (RAW/CALIB) of input frames */
00827     /* This is mandatory for the later call of 
00828        cpl_dfs_setup_product_header */
00829     check( uves_dfs_set_groups(frames), "Could not classify input frames");
00830 
00831     /* Print input frames */
00832     uves_msg_low("Input frames");
00833     check( uves_print_cpl_frameset(frames), "Could not print input frames" );
00834 
00835   cleanup:
00836     cpl_free(recipe_string);
00837     cpl_free(stars);
00838     cpl_free(spaces1);
00839     cpl_free(spaces2);
00840     cpl_free(spaces3);
00841     cpl_free(spaces4);
00842     return start_time;
00843 }
00844 
00845 
00846 /*----------------------------------------------------------------------------*/
00874 /*----------------------------------------------------------------------------*/
00875 cpl_image *
00876 uves_average_images(const cpl_image *image1, const cpl_image *noise1,
00877             const cpl_image *image2, const cpl_image *noise2,
00878             cpl_image **noise)
00879 {
00880     cpl_image *result = NULL;
00881     int nx, ny, x, y;
00882 
00883     /* Check input */
00884     assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00885     assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00886     assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00887     assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00888     assure( noise  != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00889 
00890     assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
00891         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
00892     assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
00893         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
00894     
00895     nx = cpl_image_get_size_x(image1);
00896     ny = cpl_image_get_size_y(image1);
00897 
00898     assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT, 
00899         "Size mismatch %d != %d",
00900         nx,   cpl_image_get_size_x(image2));
00901     assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT, 
00902         "Size mismatch %d != %d", 
00903         nx,   cpl_image_get_size_x(noise1));
00904     assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
00905         "Size mismatch %d != %d", 
00906         nx,   cpl_image_get_size_x(noise2));
00907     assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
00908         "Size mismatch %d != %d", 
00909         ny,   cpl_image_get_size_y(image2));
00910     assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
00911         "Size mismatch %d != %d", 
00912         ny,   cpl_image_get_size_y(noise1));
00913     assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
00914         "Size mismatch %d != %d", 
00915         ny,   cpl_image_get_size_y(noise2));
00916     
00917     result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
00918     *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
00919 
00920     /* Do the calculation */
00921     for (y = 1; y <= ny; y++)
00922     {
00923         for (x = 1; x <= nx; x++)
00924         {
00925             double flux1, flux2;
00926             double sigma1, sigma2;
00927             int pis_rejected1, noise_rejected1;
00928             int pis_rejected2, noise_rejected2;
00929 
00930             flux1  = cpl_image_get(image1, x, y, &pis_rejected1);
00931             flux2  = cpl_image_get(image2, x, y, &pis_rejected2);
00932             sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
00933             sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);
00934 
00935             pis_rejected1 = pis_rejected1 || noise_rejected1;
00936             pis_rejected2 = pis_rejected2 || noise_rejected2;
00937             
00938             if (pis_rejected1 && pis_rejected2)
00939             {
00940                 cpl_image_reject(result, x, y);
00941                 cpl_image_reject(*noise, x, y);
00942             }
00943             else
00944             {
00945                 /* At least one good pixel */
00946 
00947                 double flux, sigma;
00948                 
00949                 if (pis_rejected1 && !pis_rejected2)
00950                 {
00951                     flux = flux2;
00952                     sigma = sigma2;
00953                 }
00954                 else if (!pis_rejected1 && pis_rejected2)
00955                 {
00956                     flux = flux1;
00957                     sigma = sigma1;
00958                 }
00959                 else
00960                 {
00961                     /* Both pixels are good */
00962                     sigma =
00963                     1 / (sigma1*sigma1) +
00964                     1 / (sigma2*sigma2);
00965                     
00966                     flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
00967                     flux /= sigma;
00968                     
00969                     sigma = sqrt(sigma);
00970                 }
00971                 
00972                 cpl_image_set(result, x, y, flux);
00973                 cpl_image_set(*noise, x, y, sigma);
00974             }
00975         }
00976     }
00977     
00978   cleanup:
00979     if (cpl_error_get_code() != CPL_ERROR_NONE) 
00980     {
00981         uves_free_image(&result);
00982     }
00983     return result;
00984 }
00985 
00986 /*----------------------------------------------------------------------------*/
01001 /*----------------------------------------------------------------------------*/
01002 uves_propertylist *
01003 uves_initialize_image_header(const char *ctype1, const char *ctype2, const char *bunit,
01004                  double crval1, double crval2,
01005                  double crpix1, double crpix2,
01006                  double cdelt1, double cdelt2)
01007 {
01008     uves_propertylist *header = NULL;  /* Result */
01009 
01010     header = uves_propertylist_new();
01011 
01012     check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
01013     check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
01014     check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
01015     check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
01016     check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
01017     check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
01018     check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
01019     check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
01020     check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
01021     
01022   cleanup:
01023     return header;
01024 }
01025 
01026 /*----------------------------------------------------------------------------*/
01044 /*----------------------------------------------------------------------------*/
01045 cpl_image *
01046 uves_define_noise(const cpl_image *image, const uves_propertylist *image_header, 
01047           int ncom, enum uves_chip chip)
01048 {
01049     /*
01050           \/  __
01051            \_(__)_...
01052     */
01053 
01054     cpl_image *noise = NULL;      /* Result */
01055 
01056     /* cpl_image *in_med = NULL;     Median filtered input image */
01057 
01058     double ron;                   /* Read-out noise in ADU */
01059     double gain;
01060     int nx, ny, i;
01061     double *noise_data;
01062     const double *image_data;
01063     
01064     /* Read, check input parameters */
01065     assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
01066     
01067     check( ron = uves_pfits_get_ron_adu(image_header, chip),
01068        "Could not read read-out noise");
01069     
01070     check( gain = uves_pfits_get_gain(image_header, chip),
01071        "Could not read gain factor");
01072     assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);
01073 
01074     nx = cpl_image_get_size_x(image);
01075     ny = cpl_image_get_size_y(image);
01076 
01077     /* For efficiency reasons, use pointers to image data buffers */
01078     assure(cpl_image_count_rejected(image) == 0, 
01079        CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
01080     assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
01081        CPL_ERROR_UNSUPPORTED_MODE, 
01082        "Input image is of type %s. double expected", 
01083        uves_tostring_cpl_type(cpl_image_get_type(image)));
01084 
01085     noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
01086     assure_mem( noise );
01087 
01088     noise_data = irplib_image_get_data_double(noise);
01089 
01090     image_data = irplib_image_get_data_double_const(image);
01091 
01092 
01093     /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */
01094 
01095     /* This filter is disabled, as there is often structure on the scale
01096        of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
01097        structure *does* result in worse fits to the data.
01098 
01099        in_med = cpl_image_duplicate(image);
01100        assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
01101        
01102        uves_msg_low("Applying 3x3 median filter");
01103        
01104        check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
01105        image_data = cpl_image_get_data_double(in_med);
01106        
01107        uves_msg_low("Setting pixel flux uncertainty");
01108     */
01109 
01110     for (i = 0; i < nx*ny; i++)
01111     {
01112         double flux;
01113         
01114         /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
01115         /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
01116         flux = image_data[i];
01117         {
01118         double flux_e    = uves_max_double(0, flux) / gain;  /* Flux  (e-)          */
01119         double sigma_e   = sqrt(flux_e);                     /* Photonic noise (e-) */
01120         double sigma_adu = sigma_e * gain;                   /* Photonic noise (ADU)*/
01121         double quant_var = uves_max_double(0, (gain*gain - 1)/12.0);/* Quant. error =
01122                                          * sqrt((g^2-1)/12)
01123                                          */
01124         /* For a number, N, of averaged or median stacked "identical" frames
01125          * (gaussian distribution assumed), the combined noise is
01126          *
01127          *  sigma_N = sigma / sqrt(N*f)
01128          *
01129          *  where (to a good approximation)
01130          *        f ~= { 1    , N = 1
01131          *             { 2/pi , N > 1
01132          *
01133          *  (i.e. the resulting uncertainty is
01134          *   larger than for average stacked inputs where f = 1)
01135          */
01136         
01137         /* We assume median stacked input (master flat, master dark, ...) */
01138         double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
01139         
01140         /* Slow: cpl_image_set(noise, x, y, ... ); */
01141         /* Slow: noise_data[(x-1) + (y-1)*nx] = 
01142                  sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
01143               ((MIDAS) ? 1 : ncom * median_factor)); */
01144         noise_data[i] = sqrt((ron*ron + quant_var + sigma_adu*sigma_adu)
01145                      / (ncom * median_factor));
01146         }
01147     }
01148 
01149   cleanup:
01150     /* uves_free_image(&in_med); */
01151     if (cpl_error_get_code() != CPL_ERROR_NONE)
01152     {
01153         uves_free_image(&noise);
01154     }
01155 
01156     return noise;
01157 }
01158 
01159 
01160 /*----------------------------------------------------------------------------*/
01170 /*----------------------------------------------------------------------------*/
01171 cpl_error_code
01172 uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
01173 {
01174     passure ( image != NULL, " ");
01175     passure ( master_bias != NULL, " ");
01176 
01177     check( cpl_image_subtract(image, master_bias),
01178        "Error subtracting bias");
01179 
01180     /* Due to different bad column correction in image/master_bias,
01181        it might happen that the image has become negative after 
01182        subtracting the bias. Disallow that. */
01183 
01184 #if 0
01185     /* No, for backwards compatibility, allow negative values.
01186      * MIDAS has an inconsistent logic on this matter.
01187      * For master dark frames, the thresholding *is* applied,
01188      * but not for science frames. Therefore we have to
01189      * apply thresholding on a case-by-case base (i.e. from
01190      * the caller).
01191      */
01192     check( cpl_image_threshold(image, 
01193                    0, DBL_MAX,     /* Interval */
01194                    0, DBL_MAX),    /* New values */
01195        "Error thresholding image");
01196 #endif
01197 
01198   cleanup:
01199     return cpl_error_get_code();
01200 }
01201 /*----------------------------------------------------------------------------*/
01214 /*----------------------------------------------------------------------------*/
01215 cpl_error_code
01216 uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
01217            const cpl_image *master_dark,
01218            const uves_propertylist *mdark_header)
01219 {
01220     cpl_image *normalized_mdark = NULL;
01221     double image_exptime = 0.0;
01222     double mdark_exptime = 0.0;
01223 
01224     passure ( image != NULL, " ");
01225     passure ( image_header != NULL, " ");
01226     passure ( master_dark != NULL, " ");
01227     passure ( mdark_header != NULL, " ");
01228 
01229     /* Normalize mdark to same exposure time as input image, then subtract*/
01230     check( image_exptime = uves_pfits_get_exptime(image_header), 
01231        "Error reading input image exposure time");
01232     check( mdark_exptime = uves_pfits_get_exptime(mdark_header), 
01233        "Error reading master dark exposure time");
01234     
01235     uves_msg("Rescaling master dark from %f s to %f s exposure time", 
01236          mdark_exptime, image_exptime);
01237     
01238     check( normalized_mdark = 
01239        cpl_image_multiply_scalar_create(master_dark,
01240                         image_exptime / mdark_exptime),
01241        "Error normalizing master dark");
01242     
01243     check( cpl_image_subtract(image, normalized_mdark), 
01244        "Error subtracting master dark");
01245 
01246   cleanup:
01247     uves_free_image(&normalized_mdark);
01248     return cpl_error_get_code();
01249 }
01250 
01251 /*----------------------------------------------------------------------------*/
01265 /*----------------------------------------------------------------------------*/
01266 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
01267 {
01268     return (first_abs_order +
01269         (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
01270 }
01271 
01272 /*----------------------------------------------------------------------------*/
01286 /*----------------------------------------------------------------------------*/
01287 double
01288 uves_average_reject(cpl_table *t,
01289                     const char *column,
01290                     const char *residual2,
01291                     double kappa)
01292 {
01293     double mean = 0, median, sigma2;
01294     int rejected;
01295     
01296     do {
01297         /* Robust estimation */
01298         median = cpl_table_get_column_median(t, column);
01299 
01300         /* Create column
01301            residual2 = (column - median)^2   */
01302         cpl_table_duplicate_column(t, residual2, t, column);
01303         cpl_table_subtract_scalar(t, residual2, median);
01304         cpl_table_multiply_columns(t, residual2, residual2);
01305 
01306         /* For a Gaussian distribution:
01307          * sigma    ~= median(|residual|) / 0.6744
01308          * sigma^2  ~= median(residual^2) / 0.6744^2  
01309          */
01310 
01311         sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744);
01312 
01313         /* Reject values where
01314            residual^2 > (kappa*sigma)^2
01315         */
01316     check_nomsg( rejected = uves_erase_table_rows(t, residual2,
01317                                                       CPL_GREATER_THAN,
01318                                                       kappa*kappa*sigma2));
01319         
01320         cpl_table_erase_column(t, residual2);
01321 
01322     } while (rejected > 0);
01323 
01324     mean  = cpl_table_get_column_mean(t, column);
01325     
01326   cleanup:
01327     return mean;
01328 }
01329 
01330 /*----------------------------------------------------------------------------*/
01363 /*----------------------------------------------------------------------------*/
01364 polynomial *
01365 uves_polynomial_regression_1d(cpl_table *t,
01366                   const char *X, const char *Y, const char *sigmaY, 
01367                   int degree, 
01368                   const char *polynomial_fit, const char *residual_square,
01369                   double *mean_squared_error, double kappa)
01370 {
01371     int N;
01372     int total_rejected = 0;  /* Rejected in kappa sigma clipping */
01373     int rejected = 0;
01374     double mse;                  /* local mean squared error */
01375     double *x;
01376     double *y;
01377     double *sy;
01378     polynomial *result = NULL;
01379     cpl_vector *vx = NULL;
01380     cpl_vector *vy = NULL;
01381     cpl_vector *vsy = NULL;
01382     cpl_type type;
01383 
01384     /* Check input */
01385     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
01386     assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
01387     assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
01388     assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
01389     assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
01390     assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
01391         "No such column: %s", sigmaY);
01392 
01393     assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
01394         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
01395 
01396     assure( residual_square == NULL || !cpl_table_has_column(t, residual_square), 
01397         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
01398     
01399     /* Check column types */
01400     type = cpl_table_get_column_type(t, Y);
01401     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE, 
01402         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
01403     type = cpl_table_get_column_type(t, X);
01404     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
01405         "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
01406     if (sigmaY != NULL)
01407     {
01408         type = cpl_table_get_column_type(t, sigmaY);
01409         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
01410             CPL_ERROR_INVALID_TYPE, 
01411             "Input column '%s' has wrong type (%s)", 
01412             sigmaY, uves_tostring_cpl_type(type));
01413     }
01414 
01415     check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
01416        "Could not cast table column '%s' to double", X);
01417     check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
01418        "Could not cast table column '%s' to double", Y);
01419     if (sigmaY != NULL)
01420     {
01421         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
01422            "Could not cast table column '%s' to double", sigmaY);
01423     } 
01424     
01425     total_rejected = 0;
01426     rejected = 0;
01427     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
01428        "Could not create column");
01429     do{
01430     check( (N = cpl_table_get_nrow(t),
01431         x = irplib_table_get_data_double(t, "_X_double"),
01432         y = irplib_table_get_data_double(t, "_Y_double")),
01433            "Could not read table data");
01434     
01435     if (sigmaY != NULL) 
01436         {
01437         check( sy = irplib_table_get_data_double(t,  "_sY_double"),
01438                "Could not read table data");
01439         } 
01440     else 
01441         {
01442         sy = NULL;
01443         }
01444     
01445     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
01446 
01447     /* Wrap vectors */
01448     uves_unwrap_vector(&vx);
01449     uves_unwrap_vector(&vy);
01450     
01451     vx = cpl_vector_wrap(N, x);
01452     vy = cpl_vector_wrap(N, y);
01453        
01454     if (sy != NULL)
01455         {
01456         uves_unwrap_vector(&vsy);
01457         vsy = cpl_vector_wrap(N, sy);
01458         }
01459     else
01460         {
01461         vsy = NULL;
01462         }
01463      
01464     /* Fit! */
01465     uves_polynomial_delete(&result);
01466     check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse), 
01467            "Could not fit polynomial");
01468     
01469     /* If requested, calculate residuals and perform kappa-sigma clipping */
01470     if (kappa > 0)
01471         {
01472         double sigma2;   /* sigma squared */
01473         int i;
01474         
01475         for (i = 0; i < N; i++)
01476             {
01477             double xval, yval, yfit;
01478             
01479             check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
01480                 yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
01481                 yfit = uves_polynomial_evaluate_1d(result, xval),
01482     
01483                 cpl_table_set_double(t, "_residual_square", i, 
01484                              (yfit-yval)*(yfit-yval))),
01485                 "Could not evaluate polynomial");
01486             }
01487         
01488         /* For robustness, estimate sigma as (third quartile) / 0.6744
01489          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
01490          * The third quartile is estimated as the median of the absolute residuals,
01491          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
01492          *     sigma^2  ~= median(residual^2) / 0.6744^2  
01493          */
01494         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
01495 
01496         /* Remove points with residual^2 > kappa^2 * sigma^2 */
01497         check( rejected = uves_erase_table_rows(t, "_residual_square", 
01498                             CPL_GREATER_THAN, kappa*kappa*sigma2),
01499                "Could not remove outlier points");
01500         
01501         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
01502                    rejected, N, sqrt(mse));
01503         
01504         /* Update */
01505         total_rejected += rejected;
01506         N = cpl_table_get_nrow(t);
01507         }
01508     
01509 } while (rejected > 0);
01510     
01511     cpl_table_erase_column(t,  "_residual_square");    
01512     
01513     if (kappa > 0)
01514     {    
01515         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
01516               total_rejected,
01517               N + total_rejected,
01518               (100.0*total_rejected)/(N + total_rejected)
01519         );
01520     }
01521     
01522     if (mean_squared_error != NULL) *mean_squared_error = mse;
01523     
01524     /* Add the fitted values to table if requested */
01525     if (polynomial_fit != NULL || residual_square != NULL)
01526     {
01527         int i;
01528         
01529         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
01530            "Could not create column");
01531         for (i = 0; i < N; i++){
01532         double xval;
01533         double yfit;
01534         
01535         check((
01536               xval = cpl_table_get_double(t, "_X_double", i, NULL),
01537               yfit = uves_polynomial_evaluate_1d(result, xval),
01538               cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
01539               "Could not evaluate polynomial");
01540         }
01541         
01542         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
01543         if (residual_square != NULL)
01544         {
01545             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
01546                                t, "_polynomial_fit"),
01547                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
01548                 cpl_table_multiply_columns(t, residual_square, residual_square)),
01549                                                                                /* RS := RS^2 */
01550                 "Could not calculate Residual of fit");
01551         }
01552         
01553         /* Keep the polynomial_fit column if requested */
01554         if (polynomial_fit != NULL)
01555         {
01556             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
01557         }
01558         else
01559         {
01560             cpl_table_erase_column(t, "_polynomial_fit");
01561         }
01562     }
01563     
01564     check(( cpl_table_erase_column(t, "_X_double"),
01565         cpl_table_erase_column(t, "_Y_double")),
01566       "Could not delete temporary columns");
01567     
01568     if (sigmaY != NULL) 
01569     {
01570         check( cpl_table_erase_column(t, "_sY_double"), 
01571            "Could not delete temporary column");
01572     } 
01573     
01574   cleanup:
01575     uves_unwrap_vector(&vx);
01576     uves_unwrap_vector(&vy);
01577     uves_unwrap_vector(&vsy);
01578     if (cpl_error_get_code() != CPL_ERROR_NONE)
01579     {
01580         uves_polynomial_delete(&result);
01581     }
01582     
01583     return result;
01584 }
01585 
01586 
01587 /*----------------------------------------------------------------------------*/
01635 /*----------------------------------------------------------------------------*/
01636 
01637 polynomial *
01638 uves_polynomial_regression_2d(cpl_table *t,
01639                   const char *X1, const char *X2, const char *Y, 
01640                   const char *sigmaY,
01641                   int degree1, int degree2,
01642                   const char *polynomial_fit, const char *residual_square, 
01643                   const char *variance_fit,
01644                   double *mse, double *red_chisq,
01645                   polynomial **variance, double kappa,
01646                               double min_reject)
01647 {
01648     int N;
01649     int rejected;
01650     int total_rejected;
01651     double *x1;
01652     double *x2;
01653     double *y;
01654     double *res;
01655     double *sy;
01656     polynomial *p = NULL;               /* Result */
01657     polynomial *variance_local = NULL;
01658     cpl_vector *vx1 = NULL;
01659     cpl_vector *vx2 = NULL;
01660     cpl_bivector *vx = NULL;
01661     cpl_vector *vy = NULL;
01662     cpl_vector *vsy= NULL;
01663     cpl_type type;
01664 
01665     /* Check input */
01666     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
01667     assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
01668     assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
01669     assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
01670     assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
01671         CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
01672     if (sigmaY != NULL)
01673     {
01674         assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT, 
01675             "No such column: %s", sigmaY);
01676     }
01677     if (polynomial_fit != NULL)
01678     {
01679         assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
01680             "Table already has '%s' column", polynomial_fit);
01681     }
01682     if (residual_square != NULL)
01683     {
01684         assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT, 
01685             "Table already has '%s' column", residual_square);
01686     }
01687     if (variance_fit != NULL)
01688     {
01689         assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
01690             "Table already has '%s' column", variance_fit);
01691     }
01692 
01693     /* Check column types */
01694     type = cpl_table_get_column_type(t, X1);
01695     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01696         "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
01697     type = cpl_table_get_column_type(t, X2);
01698     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01699         "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
01700     type = cpl_table_get_column_type(t, Y);
01701     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01702         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
01703     if (sigmaY != NULL)
01704     {
01705         type = cpl_table_get_column_type(t, sigmaY);
01706         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01707             "Input column '%s' has wrong type (%s)", 
01708             sigmaY, uves_tostring_cpl_type(type));
01709     }
01710 
01711     /* In the case that these temporary columns already exist, a run-time error will occur */
01712     check( cpl_table_cast_column(t, X1    , "_X1_double", CPL_TYPE_DOUBLE), 
01713        "Could not cast table column to double");
01714     check( cpl_table_cast_column(t, X2    , "_X2_double", CPL_TYPE_DOUBLE),
01715        "Could not cast table column to double");
01716     check( cpl_table_cast_column(t,  Y    ,  "_Y_double", CPL_TYPE_DOUBLE), 
01717        "Could not cast table column to double");
01718     if (sigmaY != NULL)
01719     {
01720         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
01721            "Could not cast table column to double");
01722     }
01723     
01724     total_rejected = 0;
01725     rejected = 0;
01726     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
01727        "Could not create column");
01728 
01729     do {
01730         /* WARNING!!! Code duplication (see below). Be careful
01731            when updating */
01732     check(( N  = cpl_table_get_nrow(t),
01733         x1 = irplib_table_get_data_double(t, "_X1_double"),
01734         x2 = irplib_table_get_data_double(t, "_X2_double"),
01735         y  = irplib_table_get_data_double(t, "_Y_double"),
01736                 res= irplib_table_get_data_double(t, "_residual_square")),
01737           "Could not read table data");
01738     
01739     if (sigmaY != NULL) 
01740         {
01741         check (sy = irplib_table_get_data_double(t,  "_sY_double"),
01742                "Could not read table data");
01743         }
01744     else 
01745         {
01746         sy = NULL;
01747         }
01748 
01749     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
01750     
01751     /* Wrap vectors */
01752     uves_unwrap_vector(&vx1);
01753     uves_unwrap_vector(&vx2);
01754     uves_unwrap_vector(&vy);
01755 
01756     vx1 = cpl_vector_wrap(N, x1);
01757     vx2 = cpl_vector_wrap(N, x2);
01758     vy  = cpl_vector_wrap(N, y);
01759     if (sy != NULL)
01760         {
01761         uves_unwrap_vector(&vsy);
01762         vsy = cpl_vector_wrap(N, sy);
01763         }
01764     else
01765         {
01766         vsy = NULL;
01767         }
01768     
01769     /* Wrap up the bi-vector */
01770     uves_unwrap_bivector_vectors(&vx);
01771     vx = cpl_bivector_wrap_vectors(vx1, vx2);
01772     
01773     /* Fit! */
01774     uves_polynomial_delete(&p);
01775         check( p =  uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
01776                                            NULL, NULL, NULL),
01777                "Could not fit polynomial");
01778 
01779     /* If requested, calculate residuals and perform kappa-sigma clipping */
01780     if (kappa > 0)
01781         {
01782         double sigma2;   /* sigma squared */
01783         int i;
01784 
01785                 cpl_table_fill_column_window_double(t, "_residual_square", 0, 
01786                                                     cpl_table_get_nrow(t), 0.0);
01787 
01788         for (i = 0; i < N; i++)
01789             {
01790                         double yval, yfit;
01791 
01792                         yval  = y[i];
01793                         yfit  = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
01794                         res[i] = (yfit-y[i])*(yfit-y[i]);
01795             }
01796         
01797         /* For robustness, estimate sigma as (third quartile) / 0.6744
01798          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
01799          * The third quartile is estimated as the median of the absolute residuals,
01800          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
01801          *     sigma^2  ~= median(residual^2) / 0.6744^2  
01802          */
01803         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
01804                              
01805 
01806         /* Remove points with residual^2 > kappa^2 * sigma^2 */
01807         check( rejected = uves_erase_table_rows(t, "_residual_square", 
01808                             CPL_GREATER_THAN, kappa*kappa*sigma2),
01809                "Could not remove outlier points");
01810         /* Note! All pointers to table data are now invalid! */
01811 
01812 
01813         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f", 
01814                    rejected, N, sqrt(sigma2));
01815         
01816         /* Update */
01817         total_rejected += rejected;
01818         N = cpl_table_get_nrow(t);
01819         }
01820         
01821     /* Stop also if there are too few points left to make the fit.
01822      * Needed number of points = (degree1+1)(degree2+1) coefficients
01823      *      plus one extra point for chi^2 computation.   */
01824     } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
01825              N >= (degree1 + 1)*(degree2 + 1) + 1);
01826     
01827     if (kappa > 0)
01828     {    
01829         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
01830                 total_rejected,
01831                 N + total_rejected,
01832                 (100.0*total_rejected)/(N + total_rejected)
01833         );
01834     }
01835        
01836     /* Final fit */
01837     {
01838         /* Need to convert to vector again. */
01839 
01840         /* WARNING!!! Code duplication (see above). Be careful
01841            when updating */
01842     check(( N  = cpl_table_get_nrow(t),
01843         x1 = irplib_table_get_data_double(t, "_X1_double"),
01844         x2 = irplib_table_get_data_double(t, "_X2_double"),
01845         y  = irplib_table_get_data_double(t, "_Y_double"),
01846                 res= irplib_table_get_data_double(t, "_residual_square")),
01847           "Could not read table data");
01848     
01849     if (sigmaY != NULL) 
01850         {
01851         check (sy = irplib_table_get_data_double(t,  "_sY_double"),
01852                "Could not read table data");
01853         }
01854     else 
01855         {
01856         sy = NULL;
01857         }
01858 
01859     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
01860     
01861     /* Wrap vectors */
01862     uves_unwrap_vector(&vx1);
01863     uves_unwrap_vector(&vx2);
01864     uves_unwrap_vector(&vy);
01865 
01866     vx1 = cpl_vector_wrap(N, x1);
01867     vx2 = cpl_vector_wrap(N, x2);
01868     vy  = cpl_vector_wrap(N, y);
01869     if (sy != NULL)
01870         {
01871         uves_unwrap_vector(&vsy);
01872         vsy = cpl_vector_wrap(N, sy);
01873         }
01874     else
01875         {
01876         vsy = NULL;
01877         }
01878     
01879     /* Wrap up the bi-vector */
01880     uves_unwrap_bivector_vectors(&vx);
01881     vx = cpl_bivector_wrap_vectors(vx1, vx2);
01882     }
01883 
01884     uves_polynomial_delete(&p);
01885     if (variance_fit != NULL || variance != NULL)
01886         {
01887             /* If requested, also compute variance */
01888             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
01889                                               mse, red_chisq, &variance_local),
01890                    "Could not fit polynomial");
01891         }
01892     else
01893         {
01894             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
01895                                               mse, red_chisq, NULL),
01896                    "Could not fit polynomial");
01897         }
01898 
01899     cpl_table_erase_column(t,  "_residual_square");
01900     
01901     /* Add the fitted values to table as requested */
01902     if (polynomial_fit != NULL || residual_square != NULL)
01903     {
01904         int i;
01905             double *pf;
01906         
01907         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
01908            "Could not create column");
01909 
01910             cpl_table_fill_column_window_double(t, "_polynomial_fit", 0, 
01911                                                 cpl_table_get_nrow(t), 0.0);
01912 
01913             x1 = irplib_table_get_data_double(t, "_X1_double");
01914             x2 = irplib_table_get_data_double(t, "_X2_double");
01915             pf = irplib_table_get_data_double(t, "_polynomial_fit");
01916 
01917         for (i = 0; i < N; i++){
01918 #if 0        
01919         double x1val, x2val, yfit;
01920 
01921         check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
01922             x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
01923             yfit  = uves_polynomial_evaluate_2d(p, x1val, x2val),
01924             
01925             cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
01926             "Could not evaluate polynomial");
01927 
01928 #else
01929                 pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
01930 #endif
01931         }
01932         
01933         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
01934         if (residual_square != NULL)
01935         {
01936             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
01937                                t, "_polynomial_fit"),
01938                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
01939                 cpl_table_multiply_columns(t, residual_square, residual_square)),
01940                                                                    /* RS := RS^2 */
01941                "Could not calculate Residual of fit");
01942         }
01943         
01944         /* Keep the polynomial_fit column if requested */
01945         if (polynomial_fit != NULL)
01946         {
01947             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
01948         }
01949         else
01950         {
01951             cpl_table_erase_column(t, "_polynomial_fit");
01952         }
01953     }
01954     
01955     /* Add variance of poly_fit if requested */
01956     if (variance_fit != NULL)
01957     {
01958         int i;
01959             double *vf;
01960 
01961         check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE), 
01962            "Could not create column");
01963             
01964             cpl_table_fill_column_window_double(t, variance_fit, 0,
01965                                                 cpl_table_get_nrow(t), 0.0);
01966 
01967             x1 = irplib_table_get_data_double(t, "_X1_double");
01968             x2 = irplib_table_get_data_double(t, "_X2_double");
01969             vf = irplib_table_get_data_double(t, variance_fit);
01970 
01971         for (i = 0; i < N; i++)
01972         {
01973 #if 0
01974             double x1val, x2val, yfit_variance;
01975             check(( x1val         = cpl_table_get_double(t, "_X1_double", i, NULL),
01976                 x2val         = cpl_table_get_double(t, "_X2_double", i, NULL),
01977                 yfit_variance = uves_polynomial_evaluate_2d(variance_local, 
01978                                     x1val, x2val),
01979                 
01980                 cpl_table_set_double(t, variance_fit, i, yfit_variance)),
01981                "Could not evaluate polynomial");
01982 #else
01983                     vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
01984 #endif
01985 
01986         }
01987     }
01988     
01989     
01990     check(( cpl_table_erase_column(t, "_X1_double"),
01991         cpl_table_erase_column(t, "_X2_double"),
01992         cpl_table_erase_column(t,  "_Y_double")),
01993       "Could not delete temporary columns");
01994       
01995     if (sigmaY != NULL) 
01996     {
01997         check( cpl_table_erase_column(t, "_sY_double"),
01998            "Could not delete temporary column");
01999     }
02000     
02001   cleanup:
02002     uves_unwrap_bivector_vectors(&vx);
02003     uves_unwrap_vector(&vx1);
02004     uves_unwrap_vector(&vx2);
02005     uves_unwrap_vector(&vy);
02006     uves_unwrap_vector(&vsy);
02007     /* Delete 'variance_local', or return through 'variance' parameter */
02008     if (variance != NULL)
02009     {
02010         *variance = variance_local;
02011     }
02012     else
02013     {
02014         uves_polynomial_delete(&variance_local);
02015     }
02016     if (cpl_error_get_code() != CPL_ERROR_NONE)
02017     {
02018         uves_polynomial_delete(&p);
02019     }
02020 
02021     return p;
02022 }
02023 
02024 /*----------------------------------------------------------------------------*/
02067 /*----------------------------------------------------------------------------*/
02068 
02069 polynomial *
02070 uves_polynomial_regression_2d_autodegree(cpl_table *t,
02071                      const char *X1, const char *X2, const char *Y,
02072                      const char *sigmaY,
02073                      const char *polynomial_fit,
02074                      const char *residual_square, 
02075                      const char *variance_fit,
02076                      double *mean_squared_error, double *red_chisq,
02077                      polynomial **variance, double kappa,
02078                      int maxdeg1, int maxdeg2, double min_rms,
02079                                          double min_reject,
02080                                          bool verbose,
02081                      const double *min_val,
02082                      const double *max_val,
02083                      int npos, double positions[][2])
02084 {
02085     int deg1 = 0;               /* Current degrees                                  */
02086     int deg2 = 0;               /* Current degrees                                  */
02087     int i;
02088 
02089     double **mse = NULL;
02090     bool adjust1 = true;      /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
02091     bool adjust2 = true;      /*   (or held constant)            */
02092     bool finished = false;
02093 
02094     const char *y_unit;
02095     cpl_table *temp = NULL;
02096     polynomial *bivariate_fit = NULL;   /* Result */
02097 
02098     assure( (min_val == NULL && max_val == NULL) || positions != NULL,
02099         CPL_ERROR_NULL_INPUT,
02100         "Missing positions array");    
02101 
02102     check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
02103     if (y_unit == NULL)
02104     {
02105         y_unit = "";
02106     }
02107 
02108     assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT, 
02109        "Illegal max. degrees: (%d, %d)",
02110        maxdeg1, maxdeg2);
02111 
02112     mse = cpl_calloc(maxdeg1+1, sizeof(double *));
02113     assure_mem(mse);
02114     for (i = 0; i < maxdeg1+1; i++)
02115     {
02116         int j;
02117         mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
02118         assure_mem(mse);
02119 
02120         for (j = 0; j < maxdeg2+1; j++)
02121         {
02122             mse[i][j] = -1;
02123         }
02124     }
02125 
02126     temp = cpl_table_duplicate(t);
02127     assure_mem(temp);
02128 
02129     uves_polynomial_delete(&bivariate_fit);
02130     check( bivariate_fit = uves_polynomial_regression_2d(temp,
02131                              X1, X2, Y, sigmaY,
02132                              deg1,
02133                              deg2,
02134                              NULL, NULL, NULL,  /* new columns  */
02135                              &mse[deg1][deg2], NULL, /* chi^2/N */
02136                              NULL,              /* variance pol.*/
02137                              kappa, min_reject),
02138        "Error fitting polynomial");
02139     if (verbose)
02140         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)", 
02141                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
02142                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
02143                      cpl_table_get_nrow(t));
02144     else
02145         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)", 
02146                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
02147                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
02148                      cpl_table_get_nrow(t));
02149     /* Find best values of deg1, deg2 less than or equal to 8,8
02150        (the fitting algorithm is unstable after this point, anyway) */
02151     do
02152     {
02153         int new_deg1, new_deg2;
02154         double m;
02155 
02156         finished = true;
02157 
02158         adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
02159         adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
02160         
02161         /* Try the new degrees
02162 
02163                               (d1+1, d2  ) (d1+2, d2)
02164                        (d1, d2+1) (d1+1, d2+1)
02165                        (d1, d2+2)
02166 
02167            in the following order:
02168 
02169                                      1            3
02170                           1          2
02171                           3
02172 
02173                (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
02174         */
02175         for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
02176         for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
02177             if ( (
02178                  (new_deg1 == deg1+1 && new_deg2 == deg2   && adjust1) ||
02179                  (new_deg1 == deg1+2 && new_deg2 == deg2   && adjust1) ||
02180                  (new_deg1 == deg1   && new_deg2 == deg2+1 && adjust2) ||
02181                  (new_deg1 == deg1   && new_deg2 == deg2+2 && adjust2) ||
02182                  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
02183                  )
02184              && mse[new_deg1][new_deg2] < 0)
02185             {
02186                 int rejected = 0;
02187 
02188                 uves_free_table(&temp);
02189                 temp = cpl_table_duplicate(t);
02190                 assure_mem(temp);
02191 
02192                 uves_polynomial_delete(&bivariate_fit);
02193                 bivariate_fit = uves_polynomial_regression_2d(temp,
02194                                       X1, X2, Y, sigmaY,
02195                                       new_deg1,
02196                                       new_deg2,
02197                                       NULL, NULL, NULL,
02198                                       &(mse[new_deg1]
02199                                         [new_deg2]),
02200                                       NULL,
02201                                       NULL,
02202                                       kappa, min_reject);
02203 
02204                 if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
02205                 {
02206                     uves_error_reset();
02207 
02208                                     if (verbose)
02209                                         uves_msg_low("(%d, %d)-degree: Singular matrix", 
02210                          new_deg1, new_deg2);
02211                                     else
02212                                         uves_msg_debug("(%d, %d)-degree: Singular matrix", 
02213                          new_deg1, new_deg2);
02214                     
02215                     mse[new_deg1][new_deg2] = DBL_MAX/2; 
02216                 }
02217                 else
02218                 {
02219                     assure( cpl_error_get_code() == CPL_ERROR_NONE,
02220                         cpl_error_get_code(),
02221                         "Error fitting (%d, %d)-degree polynomial", 
02222                         new_deg1, new_deg2 );
02223                     
02224                     rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
02225                 
02226                                     if (verbose)
02227                                         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)",
02228                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
02229                                                      rejected, cpl_table_get_nrow(t));
02230                                     else
02231                                         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)",
02232                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
02233                                                      rejected, cpl_table_get_nrow(t));
02234 
02235                     /* Reject if fit produced bad values */
02236                     if (min_val != NULL || max_val != NULL)
02237                     {
02238                         for (i = 0; i < npos; i++)
02239                         {
02240                             double val = uves_polynomial_evaluate_2d(
02241                             bivariate_fit,
02242                             positions[i][0], positions[i][1]);
02243                             if (min_val != NULL && val < *min_val)
02244                             {
02245                                 uves_msg_debug("Bad fit: %f < %f", 
02246                                        val,
02247                                        *min_val);
02248                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
02249                                 /* A large number, even if we add a bit */
02250                             }
02251                             if (max_val != NULL && val > *max_val)
02252                             {
02253                                 uves_msg_debug("Bad fit: %f > %f", 
02254                                        val,
02255                                        *max_val);
02256                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
02257                             }
02258                         }
02259                     }
02260                 
02261                     /* For robustness, make sure that we don't accept a solution that
02262                        rejected too many points (say, 80%)
02263                     */
02264                     if (rejected >= (4*cpl_table_get_nrow(t))/5)
02265                     {
02266                         mse[new_deg1][new_deg2] = DBL_MAX/2; 
02267                     }
02268                     
02269                 }/* if fit succeeded */
02270             }
02271         
02272         /* If fit is significantly better (say, 10% improvement in MSE) in either direction, 
02273          * (in (degree,degree)-space) then move in that direction.
02274          *
02275          * First try to move one step horizontal/vertical, 
02276          * otherwise try to move diagonally (i.e. increase both degrees),
02277          * otherwise move two steps horizontal/vertical
02278          *
02279          */
02280         m = mse[deg1][deg2];
02281 
02282         if      (adjust1                              
02283              && (m - mse[deg1+1][deg2])/m > 0.1
02284              && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
02285              /* The condition is read like this:
02286             if 
02287             - we are trying to move right, and
02288             - this is this is a better place than the current, and
02289                 - this is better than moving down */
02290         )
02291         {
02292             deg1++;
02293             finished = false;
02294         }
02295         else if (adjust2 &&
02296              (m - mse[deg1][deg2+1])/m > 0.1
02297              && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
02298         )
02299         {
02300             deg2++;
02301             finished = false;
02302         }
02303         else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
02304         {
02305             deg1++;
02306             deg2++;
02307             finished = false;
02308         }
02309         else if (adjust1
02310              && (m - mse[deg1+2][deg2])/m > 0.1
02311              && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
02312         )
02313         {
02314             deg1 += 2;
02315             finished = false;
02316         }
02317         else if (adjust2 
02318              && (m - mse[deg1][deg2+2])/m > 0.1
02319              && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
02320         {
02321             deg2 += 2;
02322             finished = false;
02323         }
02324 
02325         /* For efficiency, stop if rms reached min_rms */   
02326         finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
02327 
02328     } while (!finished);
02329 
02330     uves_polynomial_delete(&bivariate_fit);
02331     check( bivariate_fit = uves_polynomial_regression_2d(t,
02332                              X1, X2, Y, sigmaY,
02333                              deg1,
02334                              deg2,
02335                              polynomial_fit, residual_square, 
02336                              variance_fit,
02337                              mean_squared_error, red_chisq,
02338                              variance, kappa, min_reject),
02339        "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
02340 
02341     if (verbose)
02342         uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
02343                      sqrt(mse[deg1][deg2]), y_unit);
02344     else
02345         uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
02346                      sqrt(mse[deg1][deg2]), y_unit);
02347     
02348   cleanup:
02349     if (mse != NULL)
02350     {
02351         for (i = 0; i < maxdeg1+1; i++)
02352         {
02353             if (mse[i] != NULL)
02354             {
02355                 cpl_free(mse[i]);
02356             }
02357         }
02358         cpl_free(mse);
02359     }
02360     uves_free_table(&temp);
02361     
02362     return bivariate_fit;    
02363 }
02364 
02365 /*----------------------------------------------------------------------------*/
02375 /*----------------------------------------------------------------------------*/
02376 const char *
02377 uves_remove_string_prefix(const char *s, const char *prefix)
02378 {
02379     const char *result = NULL;
02380     unsigned int prefix_length;
02381 
02382     assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
02383     assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
02384 
02385     prefix_length = strlen(prefix);
02386 
02387     assure( strlen(s) >= prefix_length &&
02388         strncmp(s, prefix, prefix_length) == 0,
02389         CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
02390         prefix, s);
02391     
02392     result = s + prefix_length;
02393     
02394   cleanup:
02395     return result;
02396 }
02397 
02398 
02399 /*----------------------------------------------------------------------------*/
02408 /*----------------------------------------------------------------------------*/
02409 
02410 double uves_gaussrand(void)
02411 {
02412     static double V1, V2, S;
02413     static int phase = 0;
02414     double X;
02415     
02416     if(phase == 0) {
02417     do {
02418         double U1 = (double)rand() / RAND_MAX;
02419         double U2 = (double)rand() / RAND_MAX;
02420         
02421         V1 = 2 * U1 - 1;
02422         V2 = 2 * U2 - 1;
02423         S = V1 * V1 + V2 * V2;
02424     } while(S >= 1 || S == 0);
02425     
02426     X = V1 * sqrt(-2 * log(S) / S);
02427     } else
02428     X = V2 * sqrt(-2 * log(S) / S);
02429     
02430     phase = 1 - phase;
02431     
02432     return X;
02433 }
02434 
02435 /*----------------------------------------------------------------------------*/
02446 /*----------------------------------------------------------------------------*/
02447 
02448 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x, 
02449                 const char *column_y, int *istart )
02450 {
02451     double result = 0;
02452     int n;
02453 
02454     const double *x, *y;
02455     
02456     check( x = irplib_table_get_data_double_const(t, column_x),
02457        "Error reading column '%s'", column_x);
02458     check( y = irplib_table_get_data_double_const(t, column_y),
02459        "Error reading column '%s'", column_y);
02460 
02461     n = cpl_table_get_nrow(t);
02462 
02463     result = uves_spline_hermite(xp, x, y, n, istart);
02464 
02465   cleanup:
02466     return result;
02467 }
02468 
02469 /*----------------------------------------------------------------------------*/
02485 /*----------------------------------------------------------------------------*/
02486 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
02487 {
02488     double yp1, yp2, yp = 0;
02489     double xpi, xpi1, l1, l2, lp1, lp2;
02490     int i;
02491 
02492     if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) )    return 0.0;
02493     if ( x[0] >  x[n-1] && (xp > x[0] || xp < x[n-1]) )    return 0.0;
02494 
02495     if ( x[0] <= x[n-1] )
02496     {
02497         for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
02498         ;
02499     }
02500     else
02501     {
02502         for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
02503         ;
02504     }
02505 
02506     *istart = i;
02507     i--;
02508     
02509     lp1 = 1.0 / (x[i-1] - x[i]);
02510     lp2 = -lp1;
02511 
02512     if ( i == 1 )
02513     {
02514         yp1 = (y[1] - y[0]) / (x[1] - x[0]);
02515     }
02516     else
02517     {
02518         yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
02519     }
02520 
02521     if ( i >= n - 1 )
02522     {
02523         yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
02524     }
02525     else
02526     {
02527         yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
02528     }
02529 
02530     xpi1 = xp - x[i];
02531     xpi  = xp - x[i-1];
02532     l1   = xpi1*lp1;
02533     l2   = xpi*lp2;
02534 
02535     yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 + 
02536          y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 + 
02537          yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
02538 
02539     return yp;
02540 }
02541 
02542 /*----------------------------------------------------------------------------*/
02556 /*----------------------------------------------------------------------------*/
02557 
02558 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
02559 {
02560     int klo, khi, k;
02561     double a, b, h, yp = 0;
02562 
02563     assure_nomsg( x  != NULL, CPL_ERROR_NULL_INPUT);
02564     assure_nomsg( y  != NULL, CPL_ERROR_NULL_INPUT);
02565     assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
02566     assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
02567 
02568     klo = *kstart;
02569     khi = n;
02570 
02571     if ( xp < x[1] || xp > x[n] )
02572     {
02573         return 0.0;
02574     }
02575     else if ( xp == x[1] )
02576     {
02577         return(y[1]);
02578     }
02579     
02580     for ( k = klo; k < n && xp > x[k]; k++ )
02581     ;
02582 
02583     klo = *kstart = k-1;
02584     khi = k;
02585 
02586     h = x[khi] - x[klo];
02587     assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
02588         "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
02589 
02590     a = (x[khi] - xp) / h;
02591     b = (xp - x[klo]) / h;
02592 
02593     yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
02594      (h*h) / 6.0;
02595 
02596   cleanup:
02597     return yp;
02598 }
02599 
02600 /*----------------------------------------------------------------------------*/
02610 /*----------------------------------------------------------------------------*/
02611 bool
02612 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
02613 {
02614     bool is_sorted = true;       /* ... until proven false */
02615     int i;
02616     int N;
02617     double previous, current;    /* column values */
02618 
02619     passure(t != NULL, " ");
02620     passure(cpl_table_has_column(t, column), "No column '%s'", column);
02621     passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
02622     
02623     N = cpl_table_get_nrow(t);
02624 
02625     if (N > 1) 
02626     {
02627         previous = cpl_table_get_double(t, column, 0, NULL);
02628         
02629         for(i = 1; i < N && is_sorted; i++)
02630         {
02631             current = cpl_table_get_double(t, column, i, NULL);
02632             if (!reverse)
02633             {
02634                 /* Check for ascending */
02635                 is_sorted = is_sorted && ( current >= previous );
02636             }
02637             else
02638             {
02639                 /* Check for descending */
02640                 is_sorted = is_sorted && ( current <= previous );
02641             }
02642             
02643             previous = current;
02644         }
02645     }
02646     else
02647     {
02648         /* 0 or 1 rows. Table is sorted */        
02649     }
02650     
02651   cleanup:
02652     return is_sorted;
02653 }
02654 
02655 /*----------------------------------------------------------------------------*/
02661 /*----------------------------------------------------------------------------*/
02662 cpl_table *
02663 uves_ordertable_traces_new(void)
02664 {
02665     cpl_table *result = NULL;
02666     
02667     check((
02668           result = cpl_table_new(0),
02669           cpl_table_new_column(result, "TraceID"  , CPL_TYPE_INT),
02670           cpl_table_new_column(result, "Offset"   , CPL_TYPE_DOUBLE),
02671           cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
02672     "Error creating table");
02673     
02674   cleanup:
02675     return result;
02676 }
02677 
02678 /*----------------------------------------------------------------------------*/
02688 /*----------------------------------------------------------------------------*/
02689 cpl_error_code
02690 uves_ordertable_traces_add(cpl_table *traces, 
02691                int fibre_ID, double fibre_offset, int fibre_mask)
02692 {
02693     int size;
02694 
02695     assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
02696     
02697     /* Write to new table row */
02698     check((
02699           size = cpl_table_get_nrow(traces),
02700           cpl_table_set_size  (traces, size+1),
02701           cpl_table_set_int   (traces, "TraceID"  , size, fibre_ID),
02702           cpl_table_set_double(traces, "Offset"   , size, fibre_offset),
02703           cpl_table_set_int   (traces, "Tracemask", size, fibre_mask)),
02704       "Error updating table");
02705 
02706   cleanup:
02707     return cpl_error_get_code();
02708 }
02709 
02710 
02711 /*
02712  * modified on 2006/04/19
02713  *  jmlarsen:  float[5] -> const double[]
02714  *             changed mapping of indices to parameters
02715  *             Normalized the profile to 1 and changed meaning
02716  *             of (a[3], a[2]) to (integrated flux, stdev)
02717  *             Disabled debugging messages
02718  *
02719  * modified on 2005/07/29 to make dydapar a FORTRAN array
02720  * (indiced from 1 to N instead of 0 to N-1).
02721  * This allows the array to be passed to C functions expecting
02722  * FORTRAN-like arrays.
02723  *
02724  * modified on 2005/08/02 to make the function prototype ANSI
02725  * compliant (so it can be used with the levmar library).
02726  *
02727  * modified on 2005/08/16. The function now expects C-indexed
02728  * arrays as parameters (to allow proper integration). However, the
02729  * arrays are still converted to FORTRAN-indexed arrays internally.
02730  */
02731 
02742 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
02743 
02744  
02745      /*     int na;*/
02746 {
02747   double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
02748   double a2i=0, m = 0, p = 0, dif =0;
02749   double sqrt5 = 2.23606797749979;
02750 
02751   *y=0.0;
02752 //  a2i = 1.0/a[2];
02753   a2i = 1.0/(a[2]*sqrt5);
02754 
02755   dif=x-a[1];
02756   arg=dif*a2i;
02757   arg2=arg*arg;
02758 
02759   fac=1.0+arg2;
02760   fac2=fac*fac;
02761   fac4=fac2*fac2;
02762   fac4i = 1.0/fac4;
02763   
02764 //  m = a[1]*fac4i;
02765   m = a[3]*fac4i * a2i*16/(5.0*M_PI);
02766   *y = m + a[4]*(1.0+dif*a[5]);  
02767   p = 8.0*m/fac*arg*a2i;
02768 
02769   dyda[3] = m/a[3];
02770   dyda[2] = p*dif/a[2] - m/a[2];
02771 
02772 //  dyda[3]=fac4i;
02773   dyda[1]=p-a[4]*a[5];
02774 //  dyda[2]=p*dif*a2i;
02775   dyda[4]=1.0+dif*a[5];
02776   dyda[5]=a[4]*dif;
02777 
02778 
02779 #if 0
02780   {
02781      int i = 0, npar=5 ;
02782      printf("fmoffat_i \n");
02783      for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
02784      
02785      printf("fmoffat_i ");
02786      for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
02787      printf("\n");
02788   }
02789 #endif
02790   
02791 }
02792 
02811 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
02812 //void fmoffa_c(x,a,y, dyda)
02813 
02814 
02815 //     float x,*a,*y,*dyda;
02816 /*int na;*/
02817 {
02818   int npoint = 3;
02819   double const xgl[3] = {-0.387298334621,0.,0.387298334621};
02820   double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
02821   int i=0;
02822   int j=0;
02823   int npar = 5;
02824   double xmod = 0;
02825   double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
02826   double ypar;
02827 
02828 
02829   // Convert C-indexed arrays to FORTRAN-indexed arrays
02830   a    = C_TO_FORTRAN_INDEXING(a);
02831   dyda = C_TO_FORTRAN_INDEXING(dyda);
02832 
02833   *y = 0.0;
02834   for (i = 1;i<=npar;i++) dyda[i] = 0.;
02835   /*  printf("fmoffat_c ");
02836   for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
02837   /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
02838   /*  printf("\n");*/
02839   for (j=0; j < npoint; j++) 
02840       {
02841       xmod = x+xgl[j];
02842 
02843       fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
02844       
02845       *y = *y + ypar*wgl[j];
02846       
02847       for (i = 1; i <= npar; i++)
02848           {
02849           dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
02850           }
02851 
02852      /*      if (j == 2) 
02853     for (i = 1;i<=npar;i++) 
02854       {
02855         dyda[i] = dydapar[i];
02856       };
02857      */
02858     }
02859 
02860 #if 0
02861       printf("fmoffat_c ");
02862       for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
02863       printf("\n");
02864 #endif
02865 }
02866 
02867 /*----------------------------------------------------------------------------*/
02875 /*----------------------------------------------------------------------------*/
02876 int
02877 uves_moffat(const double x[], const double a[], double *result)
02878 {
02879     double dyda[5];
02880 
02881     fmoffa_c(x[0], a, result, dyda);
02882 
02883     return 0;
02884 }
02885 
02886 /*----------------------------------------------------------------------------*/
02894 /*----------------------------------------------------------------------------*/
02895 int
02896 uves_moffat_derivative(const double x[], const double a[], double result[])
02897 {
02898     double y;
02899 
02900     fmoffa_c(x[0], a, &y, result);
02901 
02902     return 0;
02903 }
02904 
02905 /*----------------------------------------------------------------------------*/
02925 /*----------------------------------------------------------------------------*/
02926 
02927 int
02928 uves_gauss(const double x[], const double a[], double *result)
02929 {
02930     double my    = a[0];
02931     double sigma = a[1];
02932 
02933     if (sigma == 0)
02934     {
02935         /* Dirac's delta function */
02936         if (x[0] == my)
02937         {
02938             *result = DBL_MAX;
02939         }
02940         else
02941         {
02942             *result = 0;
02943         }
02944         return 0;
02945     }
02946     else
02947     {
02948         double A     = a[2];
02949         double B     = a[3];
02950         
02951         *result = B    +
02952         A/(sqrt(2*M_PI*sigma*sigma)) *
02953         exp(- (x[0] - my)*(x[0] - my)
02954             / (2*sigma*sigma));
02955     }
02956     
02957     return 0;
02958 }
02959 
02960 /*----------------------------------------------------------------------------*/
02980 /*----------------------------------------------------------------------------*/
02981 
02982 int
02983 uves_gauss_derivative(const double x[], const double a[], double result[])
02984 {
02985     double my    = a[0];
02986     double sigma = a[1];
02987     double A     = a[2];
02988     /* a[3] not used */
02989 
02990     double factor;
02991    
02992     /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
02993      *
02994      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
02995      *          = A * fac. * (x-my)  / s^2
02996      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
02997      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
02998      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
02999      *          = fac.
03000      * df/dB    = 1
03001      */
03002     
03003     if (sigma == 0)
03004     {
03005         /* Derivative of Dirac's delta function */
03006         result[0] = 0;
03007         result[1] = 0;
03008         result[2] = 0;
03009         result[3] = 0;
03010         return 0;
03011     }
03012 
03013     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
03014     / (sqrt(2*M_PI*sigma*sigma));
03015 
03016     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
03017     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
03018     result[2] = factor;
03019     result[3] = 1;
03020 
03021     return 0;
03022 }
03023 
03024 /*----------------------------------------------------------------------------*/
03045 /*----------------------------------------------------------------------------*/
03046 
03047 int
03048 uves_gauss_linear(const double x[], const double a[], double *result)
03049 {
03050     double my    = a[0];
03051     double sigma = a[1];
03052 
03053     if (sigma == 0)
03054     {
03055         /* Dirac's delta function */
03056         if (x[0] == my)
03057         {
03058             *result = DBL_MAX;
03059         }
03060         else
03061         {
03062             *result = 0;
03063         }
03064         return 0;
03065     }
03066     else
03067     {
03068         double A     = a[2];
03069         double B     = a[3];
03070         double C     = a[4];
03071         
03072         *result = B    + C*(x[0] - my) +
03073         A/(sqrt(2*M_PI*sigma*sigma)) *
03074         exp(- (x[0] - my)*(x[0] - my)
03075             / (2*sigma*sigma));
03076     }
03077     
03078     return 0;
03079 }
03080 
03081 /*----------------------------------------------------------------------------*/
03104 /*----------------------------------------------------------------------------*/
03105 
03106 int
03107 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
03108 {
03109     double my    = a[0];
03110     double sigma = a[1];
03111     double A     = a[2];
03112     /* a[3] not used */
03113     double C     = a[4];
03114 
03115     double factor;
03116    
03117     /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03118      *
03119      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
03120      *          = A * fac. * (x-my)  / s^2   - C
03121      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
03122      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
03123      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03124      *          = fac.
03125      * df/dB    = 1
03126      *
03127      * df/dC    = x-my
03128      */
03129     
03130     if (sigma == 0)
03131     {
03132         /* Derivative of Dirac's delta function */
03133         result[0] = -C;
03134         result[1] = 0;
03135         result[2] = 0;
03136         result[3] = 0;
03137         result[4] = x[0];
03138         return 0;
03139     }
03140 
03141     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
03142     / (sqrt(2*M_PI*sigma*sigma));
03143 
03144     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
03145     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
03146     result[2] = factor;
03147     result[3] = 1;
03148     result[4] = x[0] - my;
03149 
03150     return 0;
03151 }
03152 
03153 
03154 
03155 
03156 /*----------------------------------------------------------------------------*/
03169 /*----------------------------------------------------------------------------*/
03170 cpl_image *
03171 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
03172                   const cpl_image *spectrum, const cpl_image *sky,
03173                   const cpl_image *cosmic_image,
03174                   const uves_extract_profile *profile,
03175                   cpl_image **image_noise, uves_propertylist **image_header)
03176 {
03177     cpl_image *image = NULL;
03178 
03179     cpl_binary *bpm = NULL;
03180     bool loop_y = false;
03181 
03182     double ron = 3;
03183     double gain = 1.0; //fixme
03184     bool new_format = true;
03185 
03186     image        = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
03187     assure_mem( image );
03188     if (image_noise != NULL) {
03189         *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
03190         assure_mem( *image_noise );
03191         cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
03192     }
03193 
03194     if (image_header != NULL) {
03195         *image_header = uves_propertylist_new();
03196       
03197         uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
03198         uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
03199         uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
03200     }
03201 
03202     for (uves_iterate_set_first(pos,
03203                                 1, pos->nx,
03204                                 pos->minorder, pos->maxorder,
03205                                 bpm,
03206                                 loop_y);
03207          !uves_iterate_finished(pos); 
03208          uves_iterate_increment(pos)) {
03209       
03210         /* Manual loop over y */
03211         uves_extract_profile_set(profile, pos, NULL);
03212         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
03213 
03214             /* Get empirical and model profile */
03215             double flux, sky_flux;
03216             int bad;
03217             int spectrum_row = pos->order - pos->minorder + 1;
03218             double noise;
03219             double prof = uves_extract_profile_evaluate(profile, pos);
03220           
03221             if (sky != NULL)
03222                 {
03223                     sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
03224                 }
03225             else
03226                 {
03227                     sky_flux = 0;
03228                 }
03229 
03230             flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
03231           
03232             //fixme: check this formula
03233             noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
03234 //          uves_msg_error("%f", prof);
03235             cpl_image_set(image, pos->x, pos->y, 
03236                           flux);
03237             if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
03238           
03239         }
03240     }
03241 
03242     if (cosmic_image != NULL) {
03243         double cr_val = 2*cpl_image_get_max(image);
03244         /* assign high pixel value to CR pixels */
03245         
03246         loop_y = true;
03247         
03248         for (uves_iterate_set_first(pos,
03249                                     1, pos->nx,
03250                                     pos->minorder, pos->maxorder,
03251                                     bpm,
03252                                     loop_y);
03253              !uves_iterate_finished(pos); 
03254              uves_iterate_increment(pos)) {
03255             
03256             int is_rejected;
03257             if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
03258                 cpl_image_set(image, pos->x, pos->y, cr_val);
03259             }
03260         }
03261     }
03262     
03263   cleanup:
03264     return image;
03265 }
03266 

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