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: amodigli $
00022  * $Date: 2007/09/11 12:11:49 $
00023  * $Revision: 1.144 $
00024  * $Name: uves-3_4_5 $
00025  * $Log: uves_utils.c,v $
00026  * Revision 1.144  2007/09/11 12:11:49  amodigli
00027  * added uves_frameset_extract
00028  *
00029  * Revision 1.143  2007/08/21 13:08:26  jmlarsen
00030  * Removed irplib_access module, largely deprecated by CPL-4
00031  *
00032  * Revision 1.142  2007/08/02 15:18:44  amodigli
00033  * added uves_frameset_dump
00034  *
00035  * Revision 1.141  2007/06/28 09:24:11  jmlarsen
00036  * Changed message
00037  *
00038  * Revision 1.140  2007/06/06 14:57:24  jmlarsen
00039  * Disabled FLAMES for public release
00040  *
00041  * Revision 1.139  2007/06/06 08:17:33  amodigli
00042  * replace tab with 4 spaces
00043  *
00044  * Revision 1.138  2007/05/25 07:06:00  jmlarsen
00045  * Don't print output frameset
00046  *
00047  * Revision 1.137  2007/05/22 11:30:57  jmlarsen
00048  * Removed MIDAS flag for good
00049  *
00050  * Revision 1.136  2007/05/04 08:51:01  jmlarsen
00051  * Update
00052  *
00053  * Revision 1.135  2007/05/02 13:18:50  jmlarsen
00054  * Added function to simulate reconstruct raw image
00055  *
00056  * Revision 1.134  2007/04/24 12:50:29  jmlarsen
00057  * Replaced cpl_propertylist -> uves_propertylist which is much faster
00058  *
00059  * Revision 1.133  2007/04/12 14:07:28  jmlarsen
00060  * Removed debugging code
00061  *
00062  * Revision 1.132  2007/04/12 14:02:47  jmlarsen
00063  * Fixed memory error in uves_regression_2d()
00064  *
00065  * Revision 1.131  2007/04/12 11:58:08  jmlarsen
00066  * Check compile time CPL version number
00067  *
00068  * Revision 1.130  2007/04/10 07:10:37  jmlarsen
00069  * uves_spline_hermite(): maintain current array position (for efficiency)
00070  *
00071  * Revision 1.129  2007/03/28 11:39:40  jmlarsen
00072  * Removed MIDAS flag from uves_define_noise
00073  *
00074  * Revision 1.128  2007/03/19 15:11:21  jmlarsen
00075  * Optimization in 2d fitting
00076  *
00077  * Revision 1.127  2007/03/13 15:34:42  jmlarsen
00078  * Time optimizations of 2d poly fit functions
00079  *
00080  * Revision 1.126  2007/03/05 10:17:44  jmlarsen
00081  * Disabled strange msginfolevel parameter
00082  *
00083  * Revision 1.125  2007/02/23 07:36:33  jmlarsen
00084  * Changed definition of non-linear background term in uves_gauss_linear()
00085  *
00086  * Revision 1.124  2007/02/22 15:34:46  jmlarsen
00087  * Implement gaussian function with linear background
00088  *
00089  * Revision 1.123  2007/02/14 14:07:13  jmlarsen
00090  * Removed dead code
00091  *
00092  * Revision 1.122  2007/02/09 08:14:16  jmlarsen
00093  * Do not use CPL_PIXEL_MAXVAL which works only for integer images
00094  *
00095  * Revision 1.121  2007/01/15 08:47:47  jmlarsen
00096  * More robust polynomial fitting
00097  *
00098  * Revision 1.120  2006/12/12 12:09:35  jmlarsen
00099  * Print more CPL version info
00100  *
00101  * Revision 1.119  2006/11/15 15:02:15  jmlarsen
00102  * Implemented const safe workarounds for CPL functions
00103  *
00104  * Revision 1.117  2006/11/15 14:04:08  jmlarsen
00105  * Removed non-const version of parameterlist_get_first/last/next which is
00106  * already in CPL, added const-safe wrapper, unwrapper and deallocator functions
00107  *
00108  * Revision 1.116  2006/11/06 15:19:42  jmlarsen
00109  * Removed unused include directives
00110  *
00111  * Revision 1.115  2006/11/03 15:01:21  jmlarsen
00112  * Killed UVES 3d table module and use CPL 3d tables
00113  *
00114  * Revision 1.114  2006/10/09 13:03:09  jmlarsen
00115  * Removed explicit uves_msg_softer/louder calls
00116  *
00117  * Revision 1.113  2006/09/20 12:53:57  jmlarsen
00118  * Replaced stringcat functions with uves_sprintf()
00119  *
00120  * Revision 1.112  2006/09/19 07:17:08  jmlarsen
00121  * Reformatted line
00122  *
00123  * Revision 1.111  2006/09/08 14:05:36  jmlarsen
00124  * Added max/min allowed values in autodegree fitting
00125  *
00126  * Revision 1.110  2006/09/06 14:45:24  jmlarsen
00127  * Minor documentation update
00128  *
00129  * Revision 1.109  2006/09/01 13:58:32  jmlarsen
00130  * Minor doc bug fix
00131  *
00132  * Revision 1.108  2006/08/24 11:43:47  jmlarsen
00133  * Write recipe start/stop time to header
00134  *
00135  * Revision 1.107  2006/08/23 09:31:47  jmlarsen
00136  * Fixed buffer overrun
00137  *
00138  * Revision 1.106  2006/08/18 07:07:43  jmlarsen
00139  * Switched order of cpl_calloc arguments
00140  *
00141  * Revision 1.105  2006/08/17 14:11:25  jmlarsen
00142  * Use assure_mem macro to check for memory allocation failure
00143  *
00144  * Revision 1.104  2006/08/17 13:56:53  jmlarsen
00145  * Reduced max line length
00146  *
00147  * Revision 1.103  2006/08/16 14:25:47  jmlarsen
00148  * On recipe exit, print only products frames
00149  *
00150  * Revision 1.102  2006/08/11 14:56:06  amodigli
00151  * removed Doxygen warnings
00152  *
00153  * Revision 1.101  2006/08/11 11:29:09  jmlarsen
00154  * uves_get_version_binary
00155  *
00156  * Revision 1.100  2006/08/10 10:53:27  jmlarsen
00157  * Changed requirements on CPL, QFITS versions
00158  *
00159  * Revision 1.99  2006/07/14 12:42:42  jmlarsen
00160  * Added function uves_strincat_4
00161  *
00162  * Revision 1.98  2006/07/03 13:20:25  jmlarsen
00163  * Fixed indexing problem in autodegree fitting function
00164  *
00165  * Revision 1.97  2006/06/22 09:44:02  jmlarsen
00166  * Added function to remove string prefix
00167  *
00168  * Revision 1.96  2006/06/16 08:26:15  jmlarsen
00169  * Removed deprecated comment
00170  *
00171  * Revision 1.95  2006/06/06 08:40:10  jmlarsen
00172  * Shortened max line length
00173  *
00174  * Revision 1.94  2006/06/01 14:43:17  jmlarsen
00175  * Added missing documentation
00176  *
00177  * Revision 1.93  2006/05/12 15:40:08  jmlarsen
00178  * Fixed mixed code declarations
00179  *
00180  * Revision 1.92  2006/05/12 15:12:11  jmlarsen
00181  * Support minimum RMS in auto-degree fitting
00182  *
00183  * Revision 1.91  2006/05/05 13:58:09  jmlarsen
00184  * Added uves_polynomial_regression_2d_autodegree
00185  *
00186  * Revision 1.90  2006/04/24 09:26:37  jmlarsen
00187  * Added code to compute Moffat profile
00188  *
00189  * Revision 1.89  2006/03/24 13:48:47  jmlarsen
00190  * Renamed shadowing variables
00191  *
00192  * Revision 1.88  2006/03/09 10:52:52  jmlarsen
00193  * Changed order of for loops
00194  *
00195  * Revision 1.87  2006/03/03 13:54:11  jmlarsen
00196  * Changed syntax of check macro
00197  *
00198  * Revision 1.86  2006/02/28 09:15:23  jmlarsen
00199  * Minor update
00200  *
00201  * Revision 1.85  2006/02/15 13:19:15  jmlarsen
00202  * Reduced source code max. line length
00203  *
00204  * Revision 1.84  2006/02/08 07:52:16  jmlarsen
00205  * Added function returning library version
00206  *
00207  * Revision 1.83  2006/02/03 07:46:30  jmlarsen
00208  * Moved recipe implementations to ./uves directory
00209  *
00210  * Revision 1.82  2006/01/12 15:41:14  jmlarsen
00211  * Moved gauss. fitting to irplib
00212  *
00213  * Revision 1.81  2006/01/05 14:23:30  jmlarsen
00214  * Fixed hard-coded qfits version bug
00215  *
00216  * Revision 1.80  2006/01/03 15:50:54  amodigli
00217  * :q!
00218  *
00219  * Revision 1.79  2005/12/19 16:17:56  jmlarsen
00220  * Replaced bool -> int
00221  *
00222  * Revision 1.78  2005/12/19 12:29:36  jmlarsen
00223  * Added subtract_bias, subtract_dark functions
00224  *
00225  * Revision 1.77  2005/12/16 14:22:23  jmlarsen
00226  * Removed midas test data; Added sof files
00227  *
00228  * Revision 1.76  2005/12/12 10:34:57  jmlarsen
00229  * Minor doc. update
00230  *
00231  * Revision 1.75  2005/12/02 10:41:49  jmlarsen
00232  * Minor update
00233  *
00234  * Revision 1.74  2005/11/24 11:54:46  jmlarsen
00235  * Added support for CPL 3 interface
00236  *
00237  * Revision 1.73  2005/11/14 13:18:44  jmlarsen
00238  * Minor update
00239  *
00240  * Revision 1.72  2005/11/11 14:52:08  jmlarsen
00241  * Inserted median filter before estimating photonic noise
00242  *
00243  * Revision 1.71  2005/11/11 13:18:54  jmlarsen
00244  * Reorganized code, renamed source files
00245  *
00246  * Revision 1.70  2005/11/10 16:33:41  jmlarsen
00247  * Added weighted extraction, test of gauss. fit
00248  *
00249  * Revision 1.69  2005/11/07 12:18:21  jmlarsen
00250  * Support for sigma in 1d pol.fit
00251  *
00252  * Revision 1.68  2005/11/03 15:14:17  jmlarsen
00253  * Fixed a few doc. bugs
00254  *
00255  * Revision 1.67  2005/10/27 10:44:05  jmlarsen
00256  * Optimized opt.extraction + efficiency calc.
00257  *
00258  * Revision 1.66  2005/10/25 11:59:19  jmlarsen
00259  * scired flux calibration
00260  *
00261  * Revision 1.65  2005/10/20 11:36:59  jmlarsen
00262  * Removed variable declaration after code
00263  *
00264  * Revision 1.64  2005/10/19 13:18:45  jmlarsen
00265  * General update
00266  *
00267  */
00268 
00269 #ifdef HAVE_CONFIG_H
00270 #  include <config.h>
00271 #endif
00272 
00273 /*----------------------------------------------------------------------------*/
00279 /*----------------------------------------------------------------------------*/
00280 
00281 /*-----------------------------------------------------------------------------
00282                             Includes
00283  -----------------------------------------------------------------------------*/
00284 
00285 #include <uves_utils.h>
00286 
00287 #include <uves_extract_profile.h>
00288 #include <uves_plot.h>
00289 #include <uves_dfs.h>
00290 #include <uves_pfits.h>
00291 #include <uves_utils_wrappers.h>
00292 #include <uves_msg.h>
00293 #include <uves_dump.h>
00294 #include <uves_error.h>
00295 
00296 #include <irplib_utils.h>
00297 
00298 #include <cpl.h>
00299 #include <qfits.h> /* iso time */
00300 
00301 #include <ctype.h>  /* tolower */
00302 #include <stdbool.h>
00303 #include <float.h>
00304 
00305 /*-----------------------------------------------------------------------------
00306                             Defines
00307  -----------------------------------------------------------------------------*/
00308 // The following macros are used to provide a fast
00309 // and readable way to convert C-indexes to FORTRAN-indexes.
00310 #define C_TO_FORTRAN_INDEXING(a) &a[-1]
00311 #define FORTRAN_TO_C_INDEXING(a) &a[1]
00312 
00314 /*-----------------------------------------------------------------------------
00315                             Functions prototypes
00316  -----------------------------------------------------------------------------*/
00317 /*-----------------------------------------------------------------------------
00318                             Implementation
00319  -----------------------------------------------------------------------------*/
00320 
00321 
00322 /*----------------------------------------------------------------------------*/
00329 /*----------------------------------------------------------------------------*/
00330 cpl_frameset *
00331 uves_frameset_extract(const cpl_frameset *frames,
00332                       const char *tag)
00333 {
00334     cpl_frameset *subset = NULL;
00335     const cpl_frame *f;
00336 
00337 
00338 
00339     assure( frames != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null frameset" );
00340     assure( tag    != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null tag" );
00341     
00342     subset = cpl_frameset_new();
00343 
00344     for (f = cpl_frameset_find_const(frames, tag);
00345          f != NULL;
00346          f = cpl_frameset_find_const(frames, NULL)) {
00347 
00348         cpl_frameset_insert(subset, cpl_frame_duplicate(f));
00349     }
00350  cleanup:
00351     return subset;
00352 }
00353 
00354 /*----------------------------------------------------------------------------*/
00364 /*----------------------------------------------------------------------------*/
00365 inline double
00366 uves_pow_int(double x, int y)
00367 {
00368     double result = 1.0;
00369 
00370     /* Invariant is:   result * x ^ y   */
00371     
00372 
00373     while(y != 0)
00374     {
00375         if (y % 2 == 0)
00376         {
00377             x *= x;
00378             y /= 2;
00379         }
00380         else
00381         {
00382             if (y > 0)
00383             {
00384                 result *= x;
00385                 y -= 1;            
00386             }
00387             else
00388             {
00389                 result /= x;
00390                 y += 1;            
00391             }
00392         }
00393     }
00394     
00395     return result;
00396 }
00397 
00398 
00399 
00400 
00401 /*----------------------------------------------------------------------------*/
00410 /*----------------------------------------------------------------------------*/
00411 inline long
00412 uves_round_double(double x)
00413 {
00414     return (x >=0) ? (long)(x+0.5) : (long)(x-0.5);
00415 }
00416 
00417 /*----------------------------------------------------------------------------*/
00426 /*----------------------------------------------------------------------------*/
00427 inline double
00428 uves_max_double(double x, double y)
00429 {
00430     return (x >=y) ? x : y;
00431 }
00432 /*----------------------------------------------------------------------------*/
00441 /*----------------------------------------------------------------------------*/
00442 inline int
00443 uves_max_int(int x, int y)
00444 {
00445     return (x >=y) ? x : y;
00446 }
00447 
00448 /*----------------------------------------------------------------------------*/
00457 /*----------------------------------------------------------------------------*/
00458 inline double
00459 uves_min_double(double x, double y)
00460 {
00461     return (x <=y) ? x : y;
00462 }
00463 /*----------------------------------------------------------------------------*/
00472 /*----------------------------------------------------------------------------*/
00473 inline int
00474 uves_min_int(int x, int y)
00475 {
00476     return (x <=y) ? x : y;
00477 }
00478 
00479 /*----------------------------------------------------------------------------*/
00490 /*----------------------------------------------------------------------------*/
00491 inline double
00492 uves_error_fraction(double x, double y, double dx, double dy)
00493 {
00494     /* Error propagation:
00495      * sigma(x/y)^2 = (1/y sigma(x))^2 + (-x/y^2 sigma(y))^2 
00496      */
00497     return sqrt( dx*dx/(y*y) + x*x*dy*dy/(y*y*y*y) );
00498 }
00499 
00500 
00501 
00502 /*----------------------------------------------------------------------------*/
00511 /*----------------------------------------------------------------------------*/
00512 cpl_error_code
00513 uves_get_version(int *major, int *minor, int *micro)
00514 {
00515     /* Macros are defined in config.h */
00516     if (major != NULL) *major = UVES_MAJOR_VERSION;
00517     if (minor != NULL) *minor = UVES_MINOR_VERSION;
00518     if (micro != NULL) *micro = UVES_MICRO_VERSION;
00519 
00520     return cpl_error_get_code();
00521 }
00522 
00523 
00524 /*----------------------------------------------------------------------------*/
00530 /*----------------------------------------------------------------------------*/
00531 int
00532 uves_get_version_binary(void)
00533 {
00534     return UVES_BINARY_VERSION;
00535 }
00536 
00537 
00538 /*----------------------------------------------------------------------------*/
00546 /*----------------------------------------------------------------------------*/
00547 const char *
00548 uves_get_license(void)
00549 {
00550     return
00551     "This file is part of the ESO UVES Instrument Pipeline\n"
00552     "Copyright (C) 2004,2005,2006 European Southern Observatory\n"
00553     "\n"
00554     "This program is free software; you can redistribute it and/or modify\n"
00555     "it under the terms of the GNU General Public License as published by\n"
00556     "the Free Software Foundation; either version 2 of the License, or\n"
00557     "(at your option) any later version.\n"
00558     "\n"
00559     "This program is distributed in the hope that it will be useful,\n"
00560     "but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
00561     "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n"
00562         "GNU General Public License for more details.\n"
00563         "\n"
00564         "You should have received a copy of the GNU General Public License\n"
00565         "along with this program; if not, write to the Free Software\n"
00566         "Foundation, 51 Franklin St, Fifth Floor, Boston, \n"
00567         "MA  02111-1307  USA" ;
00568 
00569     /* Note that long strings are unsupported in C89 */
00570 }
00571 
00572 /*----------------------------------------------------------------------------*/
00582 /*----------------------------------------------------------------------------*/
00583 /* To change requirements, just edit these numbers */
00584 #define REQ_CPL_MAJOR 3
00585 #define REQ_CPL_MINOR 1
00586 #define REQ_CPL_MICRO 0
00587 
00588 #define REQ_QF_MAJOR 6
00589 #define REQ_QF_MINOR 2
00590 #define REQ_QF_MICRO 0
00591 
00592 void
00593 uves_check_version(void)
00594 {
00595 #ifdef CPL_VERSION_CODE
00596 #if CPL_VERSION_CODE >= CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO)
00597     uves_msg_debug("Compile time CPL version code was %d "
00598                    "(version %d-%d-%d, code %d required)",
00599                    CPL_VERSION_CODE, REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO,
00600                    CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO));
00601 #else
00602 #error CPL version too old
00603 #endif
00604 #else  /* ifdef CPL_VERSION_CODE */
00605 #error CPL_VERSION_CODE not defined. CPL version too old
00606 #endif
00607 
00608     if (cpl_version_get_major() < REQ_CPL_MAJOR ||
00609     (cpl_version_get_major() == REQ_CPL_MAJOR && 
00610      (int) cpl_version_get_minor() < REQ_CPL_MINOR) || /* cast suppresses warning
00611                                                               about comparing unsigned < 0 */
00612     (cpl_version_get_major() == REQ_CPL_MAJOR &&
00613      cpl_version_get_minor() == REQ_CPL_MINOR && 
00614      (int) cpl_version_get_micro() < REQ_CPL_MICRO)
00615     )
00616     {
00617         uves_msg_warning("CPL version %s (%d.%d.%d) (detected) is not supported. "
00618                  "Please update to CPL version %d.%d.%d or later", 
00619                  cpl_version_get_version(),
00620                  cpl_version_get_major(),
00621                  cpl_version_get_minor(),
00622                  cpl_version_get_micro(),
00623                  REQ_CPL_MAJOR,
00624                  REQ_CPL_MINOR,
00625                  REQ_CPL_MICRO);
00626     }
00627     else
00628     {
00629         uves_msg_debug("Runtime CPL version %s (%d.%d.%d) detected (%d.%d.%d or later required)",
00630                cpl_version_get_version(),
00631                cpl_version_get_major(),
00632                cpl_version_get_minor(),
00633                cpl_version_get_micro(),
00634                REQ_CPL_MAJOR,
00635                REQ_CPL_MINOR,
00636                REQ_CPL_MICRO);
00637     }
00638 
00639     {
00640     const char *qfts_v = " ";
00641     char *suffix;
00642     
00643     long qfts_major;
00644     long qfts_minor;
00645     long qfts_micro;
00646 
00647     qfts_v = qfits_version();
00648 
00649     assure( qfts_v != NULL, CPL_ERROR_ILLEGAL_INPUT,
00650         "Error reading qfits version");
00651 
00652     /* Parse    "X.[...]" */
00653     qfts_major = strtol(qfts_v, &suffix, 10);
00654     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
00655         CPL_ERROR_ILLEGAL_INPUT, 
00656         "Error parsing version string '%s'. "
00657         "Format 'X.Y.Z' expected", qfts_v);
00658 
00659     /* Parse    "Y.[...]" */
00660     qfts_minor = strtol(suffix+1, &suffix, 10);
00661     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
00662         CPL_ERROR_ILLEGAL_INPUT,
00663         "Error parsing version string '%s'. "
00664         "Format 'X.Y.Z' expected", qfts_v);
00665 
00666     /* Parse    "Z" */
00667     qfts_micro = strtol(suffix+1, &suffix, 10);
00668 
00669     /* If qfits version is earlier than required ... */
00670     if (qfts_major < REQ_QF_MAJOR ||
00671         (qfts_major == REQ_QF_MAJOR && qfts_minor  < REQ_QF_MINOR) ||
00672         (qfts_major == REQ_QF_MAJOR && qfts_minor == REQ_QF_MINOR && 
00673          qfts_micro < REQ_QF_MICRO)
00674         )
00675         {
00676         uves_msg_warning("qfits version %s (detected) is not supported. "
00677                  "Please update to qfits version %d.%d.%d or later", 
00678                  qfts_v,
00679                  REQ_QF_MAJOR,
00680                  REQ_QF_MINOR,
00681                  REQ_QF_MICRO);
00682         }
00683     else
00684         {
00685         uves_msg_debug("qfits version %ld.%ld.%ld detected "
00686                    "(%d.%d.%d or later required)", 
00687                    qfts_major, qfts_minor, qfts_micro,
00688                    REQ_QF_MAJOR,
00689                    REQ_QF_MINOR,
00690                    REQ_QF_MICRO);
00691         }
00692     }
00693     
00694   cleanup:
00695     return;
00696 }
00697 
00698 /*----------------------------------------------------------------------------*/
00710 /*----------------------------------------------------------------------------*/
00711 cpl_error_code
00712 uves_end(const char *recipe_id, const cpl_frameset *frames)
00713 {
00714     cpl_frameset *products = NULL;
00715     const cpl_frame *f;
00716     int warnings = uves_msg_get_warnings();
00717 
00718     recipe_id = recipe_id; /* Suppress warning about unused variable,
00719                   perhaps we the recipe_id later, so
00720                   keep it in the interface. */
00721 
00722 
00723     /* Print (only) output frames */
00724 
00725     products = cpl_frameset_new();
00726     assure_mem( products );
00727 
00728     for (f = cpl_frameset_get_first_const(frames);
00729      f != NULL;
00730      f = cpl_frameset_get_next_const(frames))
00731     {
00732         if (cpl_frame_get_group(f) == CPL_FRAME_GROUP_PRODUCT)
00733         {
00734             check_nomsg(
00735             cpl_frameset_insert(products, cpl_frame_duplicate(f)));
00736         }
00737     }
00738 
00739 /* Don't do this. EsoRex should.
00740    uves_msg_low("Output frames");
00741    check( uves_print_cpl_frameset(products),
00742    "Could not print output frames");
00743 */
00744 
00745     /* Summarize warnings, if any */
00746     if( warnings > 0)
00747     {
00748         uves_msg_warning("Recipe produced %d warning%s (excluding this one)",
00749                  uves_msg_get_warnings(),
00750                  /* Plural? */ (warnings > 1) ? "s" : "");
00751     }
00752 
00753   cleanup:
00754     uves_free_frameset(&products);
00755     return cpl_error_get_code();    
00756 }
00757 
00758 /*----------------------------------------------------------------------------*/
00779 /*----------------------------------------------------------------------------*/
00780 char *
00781 uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist, 
00782         const char *recipe_id, const char *short_descr)
00783 {
00784     char *recipe_string = NULL;
00785     char *stars = NULL;     /* A string of stars */
00786     char *spaces1 = NULL;
00787     char *spaces2 = NULL;
00788     char *spaces3 = NULL;
00789     char *spaces4 = NULL;
00790     char *start_time = NULL;
00791 
00792     start_time = uves_sprintf("%s", qfits_get_datetime_iso8601());
00793 
00794     check( uves_check_version(), "Library validation failed");
00795 
00796     /* Now read parameters and set specified message level */
00797     {
00798     const char *plotter_command;
00799     int msglevel;
00800     
00801     /* Read parameters using context = recipe_id */
00802 
00803         if (0) /* disabled */
00804             check( uves_get_parameter(parlist, NULL, "uves", "msginfolevel", 
00805                                       CPL_TYPE_INT, &msglevel),
00806                    "Could not read parameter");
00807         else
00808             {
00809                 msglevel = -1; /* max verbosity */
00810             }
00811     uves_msg_set_level(msglevel);
00812     check( uves_get_parameter(parlist, NULL, "uves", "plotter",
00813                   CPL_TYPE_STRING, &plotter_command), "Could not read parameter");
00814     
00815     /* Initialize plotting */
00816     check( uves_plot_initialize(plotter_command), 
00817            "Could not initialize plotting");
00818     }    
00819 
00820     /* Print 
00821      *************************
00822      ***   PACAGE_STRING   ***
00823      *** Recipe: recipe_id ***
00824      *************************
00825      */
00826     recipe_string = uves_sprintf("Recipe: %s", recipe_id);
00827     {
00828     int field = uves_max_int(strlen(PACKAGE_STRING), strlen(recipe_string));
00829     int nstars = 3+1 + field + 1+3;
00830     int nspaces1, nspaces2, nspaces3, nspaces4;
00831     int i;
00832     
00833     /* ' ' padding */
00834     nspaces1 = (field - strlen(PACKAGE_STRING)) / 2; 
00835     nspaces2 = field - strlen(PACKAGE_STRING) - nspaces1;
00836 
00837     nspaces3 = (field - strlen(recipe_string)) / 2;
00838     nspaces4 = field - strlen(recipe_string) - nspaces3;
00839 
00840     spaces1 = cpl_calloc(nspaces1 + 1, sizeof(char)); 
00841     spaces2 = cpl_calloc(nspaces2 + 1, sizeof(char));
00842     spaces3 = cpl_calloc(nspaces3 + 1, sizeof(char)); 
00843     spaces4 = cpl_calloc(nspaces4 + 1, sizeof(char));
00844     for (i = 0; i < nspaces1; i++) spaces1[i] = ' ';
00845     for (i = 0; i < nspaces2; i++) spaces2[i] = ' ';
00846     for (i = 0; i < nspaces3; i++) spaces3[i] = ' ';
00847     for (i = 0; i < nspaces4; i++) spaces4[i] = ' ';
00848 
00849     stars = cpl_calloc(nstars + 1, sizeof(char));
00850     for (i = 0; i < nstars; i++) stars[i] = '*';
00851     
00852     uves_msg("%s", stars);
00853     uves_msg("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
00854     uves_msg("*** %s%s%s ***", spaces3, recipe_string, spaces4);
00855     uves_msg("%s", stars);
00856     }
00857 
00858     uves_msg("This recipe %c%s", tolower(short_descr[0]), short_descr+1);
00859 
00860     if (cpl_frameset_is_empty(frames)) {
00861         uves_msg_debug("Guvf cvcryvar unf ernpurq vgf uvtu dhnyvgl qhr na npgvir "
00862                        "hfre pbzzhavgl naq gur erfcbafvoyr naq vqrnyvfgvp jbex bs "
00863                        "vaqvivqhny cvcryvar qrirybcref, naq qrfcvgr orvat 'onfrq ba' "
00864                        "PCY juvpu vf n cvrpr bs cbyvgvpny penc");
00865     }
00866 
00867     /* Set group (RAW/CALIB) of input frames */
00868     /* This is mandatory for the later call of 
00869        cpl_dfs_setup_product_header */
00870     check( uves_dfs_set_groups(frames), "Could not classify input frames");
00871 
00872     /* Print input frames */
00873     uves_msg_low("Input frames");
00874     check( uves_print_cpl_frameset(frames), "Could not print input frames" );
00875 
00876   cleanup:
00877     cpl_free(recipe_string);
00878     cpl_free(stars);
00879     cpl_free(spaces1);
00880     cpl_free(spaces2);
00881     cpl_free(spaces3);
00882     cpl_free(spaces4);
00883     return start_time;
00884 }
00885 
00886 
00887 /*----------------------------------------------------------------------------*/
00915 /*----------------------------------------------------------------------------*/
00916 cpl_image *
00917 uves_average_images(const cpl_image *image1, const cpl_image *noise1,
00918             const cpl_image *image2, const cpl_image *noise2,
00919             cpl_image **noise)
00920 {
00921     cpl_image *result = NULL;
00922     int nx, ny, x, y;
00923 
00924     /* Check input */
00925     assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00926     assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00927     assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00928     assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00929     assure( noise  != NULL, CPL_ERROR_NULL_INPUT, "Null image");
00930 
00931     assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
00932         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
00933     assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
00934         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
00935     
00936     nx = cpl_image_get_size_x(image1);
00937     ny = cpl_image_get_size_y(image1);
00938 
00939     assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT, 
00940         "Size mismatch %d != %d",
00941         nx,   cpl_image_get_size_x(image2));
00942     assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT, 
00943         "Size mismatch %d != %d", 
00944         nx,   cpl_image_get_size_x(noise1));
00945     assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
00946         "Size mismatch %d != %d", 
00947         nx,   cpl_image_get_size_x(noise2));
00948     assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
00949         "Size mismatch %d != %d", 
00950         ny,   cpl_image_get_size_y(image2));
00951     assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
00952         "Size mismatch %d != %d", 
00953         ny,   cpl_image_get_size_y(noise1));
00954     assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
00955         "Size mismatch %d != %d", 
00956         ny,   cpl_image_get_size_y(noise2));
00957     
00958     result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
00959     *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
00960 
00961     /* Do the calculation */
00962     for (y = 1; y <= ny; y++)
00963     {
00964         for (x = 1; x <= nx; x++)
00965         {
00966             double flux1, flux2;
00967             double sigma1, sigma2;
00968             int pis_rejected1, noise_rejected1;
00969             int pis_rejected2, noise_rejected2;
00970 
00971             flux1  = cpl_image_get(image1, x, y, &pis_rejected1);
00972             flux2  = cpl_image_get(image2, x, y, &pis_rejected2);
00973             sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
00974             sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);
00975 
00976             pis_rejected1 = pis_rejected1 || noise_rejected1;
00977             pis_rejected2 = pis_rejected2 || noise_rejected2;
00978             
00979             if (pis_rejected1 && pis_rejected2)
00980             {
00981                 cpl_image_reject(result, x, y);
00982                 cpl_image_reject(*noise, x, y);
00983             }
00984             else
00985             {
00986                 /* At least one good pixel */
00987 
00988                 double flux, sigma;
00989                 
00990                 if (pis_rejected1 && !pis_rejected2)
00991                 {
00992                     flux = flux2;
00993                     sigma = sigma2;
00994                 }
00995                 else if (!pis_rejected1 && pis_rejected2)
00996                 {
00997                     flux = flux1;
00998                     sigma = sigma1;
00999                 }
01000                 else
01001                 {
01002                     /* Both pixels are good */
01003                     sigma =
01004                     1 / (sigma1*sigma1) +
01005                     1 / (sigma2*sigma2);
01006                     
01007                     flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
01008                     flux /= sigma;
01009                     
01010                     sigma = sqrt(sigma);
01011                 }
01012                 
01013                 cpl_image_set(result, x, y, flux);
01014                 cpl_image_set(*noise, x, y, sigma);
01015             }
01016         }
01017     }
01018     
01019   cleanup:
01020     if (cpl_error_get_code() != CPL_ERROR_NONE) 
01021     {
01022         uves_free_image(&result);
01023     }
01024     return result;
01025 }
01026 
01027 /*----------------------------------------------------------------------------*/
01042 /*----------------------------------------------------------------------------*/
01043 uves_propertylist *
01044 uves_initialize_image_header(const char *ctype1, const char *ctype2, const char *bunit,
01045                  double crval1, double crval2,
01046                  double crpix1, double crpix2,
01047                  double cdelt1, double cdelt2)
01048 {
01049     uves_propertylist *header = NULL;  /* Result */
01050 
01051     header = uves_propertylist_new();
01052 
01053     check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
01054     check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
01055     check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
01056     check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
01057     check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
01058     check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
01059     check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
01060     check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
01061     check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
01062     
01063   cleanup:
01064     return header;
01065 }
01066 
01067 /*----------------------------------------------------------------------------*/
01085 /*----------------------------------------------------------------------------*/
01086 cpl_image *
01087 uves_define_noise(const cpl_image *image, const uves_propertylist *image_header, 
01088           int ncom, enum uves_chip chip)
01089 {
01090     /*
01091           \/  __
01092            \_(__)_...
01093     */
01094 
01095     cpl_image *noise = NULL;      /* Result */
01096 
01097     /* cpl_image *in_med = NULL;     Median filtered input image */
01098 
01099     double ron;                   /* Read-out noise in ADU */
01100     double gain;
01101     int nx, ny, i;
01102     double *noise_data;
01103     const double *image_data;
01104     
01105     /* Read, check input parameters */
01106     assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
01107     
01108     check( ron = uves_pfits_get_ron_adu(image_header, chip),
01109        "Could not read read-out noise");
01110     
01111     check( gain = uves_pfits_get_gain(image_header, chip),
01112        "Could not read gain factor");
01113     assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);
01114 
01115     nx = cpl_image_get_size_x(image);
01116     ny = cpl_image_get_size_y(image);
01117 
01118     /* For efficiency reasons, use pointers to image data buffers */
01119     assure(cpl_image_count_rejected(image) == 0, 
01120        CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
01121     assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
01122        CPL_ERROR_UNSUPPORTED_MODE, 
01123        "Input image is of type %s. double expected", 
01124        uves_tostring_cpl_type(cpl_image_get_type(image)));
01125 
01126     noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
01127     assure_mem( noise );
01128 
01129     noise_data = cpl_image_get_data_double(noise);
01130 
01131     image_data = cpl_image_get_data_double_const(image);
01132 
01133 
01134     /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */
01135 
01136     /* This filter is disabled, as there is often structure on the scale
01137        of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
01138        structure *does* result in worse fits to the data.
01139 
01140        in_med = cpl_image_duplicate(image);
01141        assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
01142        
01143        uves_msg_low("Applying 3x3 median filter");
01144        
01145        check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
01146        image_data = cpl_image_get_data_double(in_med);
01147        
01148        uves_msg_low("Setting pixel flux uncertainty");
01149     */
01150 
01151     for (i = 0; i < nx*ny; i++)
01152     {
01153         double flux;
01154         
01155         /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
01156         /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
01157         flux = image_data[i];
01158         {
01159         double flux_e    = uves_max_double(0, flux) / gain;  /* Flux  (e-)          */
01160         double sigma_e   = sqrt(flux_e);                     /* Photonic noise (e-) */
01161         double sigma_adu = sigma_e * gain;                   /* Photonic noise (ADU)*/
01162         double quant_var = uves_max_double(0, (gain*gain - 1)/12.0);/* Quant. error =
01163                                          * sqrt((g^2-1)/12)
01164                                          */
01165         /* For a number, N, of averaged or median stacked "identical" frames
01166          * (gaussian distribution assumed), the combined noise is
01167          *
01168          *  sigma_N = sigma / sqrt(N*f)
01169          *
01170          *  where (to a good approximation)
01171          *        f ~= { 1    , N = 1
01172          *             { 2/pi , N > 1
01173          *
01174          *  (i.e. the resulting uncertainty is
01175          *   larger than for average stacked inputs where f = 1)
01176          */
01177         
01178         /* We assume median stacked input (master flat, master dark, ...) */
01179         double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
01180         
01181         /* Slow: cpl_image_set(noise, x, y, ... ); */
01182         /* Slow: noise_data[(x-1) + (y-1)*nx] = 
01183                  sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
01184               ((MIDAS) ? 1 : ncom * median_factor)); */
01185         noise_data[i] = sqrt((ron*ron + quant_var + sigma_adu*sigma_adu)
01186                      / (ncom * median_factor));
01187         }
01188     }
01189 
01190   cleanup:
01191     /* uves_free_image(&in_med); */
01192     if (cpl_error_get_code() != CPL_ERROR_NONE)
01193     {
01194         uves_free_image(&noise);
01195     }
01196 
01197     return noise;
01198 }
01199 
01200 
01201 /*----------------------------------------------------------------------------*/
01211 /*----------------------------------------------------------------------------*/
01212 cpl_error_code
01213 uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
01214 {
01215     passure ( image != NULL, " ");
01216     passure ( master_bias != NULL, " ");
01217 
01218     check( cpl_image_subtract(image, master_bias),
01219        "Error subtracting bias");
01220 
01221     /* Due to different bad column correction in image/master_bias,
01222        it might happen that the image has become negative after 
01223        subtracting the bias. Disallow that. */
01224 
01225 #if 0
01226     /* No, for backwards compatibility, allow negative values.
01227      * MIDAS has an inconsistent logic on this matter.
01228      * For master dark frames, the thresholding *is* applied,
01229      * but not for science frames. Therefore we have to
01230      * apply thresholding on a case-by-case base (i.e. from
01231      * the caller).
01232      */
01233     check( cpl_image_threshold(image, 
01234                    0, DBL_MAX,     /* Interval */
01235                    0, DBL_MAX),    /* New values */
01236        "Error thresholding image");
01237 #endif
01238 
01239   cleanup:
01240     return cpl_error_get_code();
01241 }
01242 /*----------------------------------------------------------------------------*/
01255 /*----------------------------------------------------------------------------*/
01256 cpl_error_code
01257 uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
01258            const cpl_image *master_dark,
01259            const uves_propertylist *mdark_header)
01260 {
01261     cpl_image *normalized_mdark = NULL;
01262     double image_exptime = 0.0;
01263     double mdark_exptime = 0.0;
01264 
01265     passure ( image != NULL, " ");
01266     passure ( image_header != NULL, " ");
01267     passure ( master_dark != NULL, " ");
01268     passure ( mdark_header != NULL, " ");
01269 
01270     /* Normalize mdark to same exposure time as input image, then subtract*/
01271     check( image_exptime = uves_pfits_get_exptime(image_header), 
01272        "Error reading input image exposure time");
01273     check( mdark_exptime = uves_pfits_get_exptime(mdark_header), 
01274        "Error reading master dark exposure time");
01275     
01276     uves_msg("Rescaling master dark from %f s to %f s exposure time", 
01277          mdark_exptime, image_exptime);
01278     
01279     check( normalized_mdark = 
01280        cpl_image_multiply_scalar_create(master_dark,
01281                         image_exptime / mdark_exptime),
01282        "Error normalizing master dark");
01283     
01284     check( cpl_image_subtract(image, normalized_mdark), 
01285        "Error subtracting master dark");
01286 
01287   cleanup:
01288     uves_free_image(&normalized_mdark);
01289     return cpl_error_get_code();
01290 }
01291 
01292 /*----------------------------------------------------------------------------*/
01306 /*----------------------------------------------------------------------------*/
01307 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
01308 {
01309     return (first_abs_order +
01310         (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
01311 }
01312 
01313 /*----------------------------------------------------------------------------*/
01327 /*----------------------------------------------------------------------------*/
01328 double
01329 uves_average_reject(cpl_table *t,
01330                     const char *column,
01331                     const char *residual2,
01332                     double kappa)
01333 {
01334     double mean = 0, median, sigma2;
01335     int rejected;
01336     
01337     do {
01338         /* Robust estimation */
01339         median = cpl_table_get_column_median(t, column);
01340 
01341         /* Create column
01342            residual2 = (column - median)^2   */
01343         cpl_table_duplicate_column(t, residual2, t, column);
01344         cpl_table_subtract_scalar(t, residual2, median);
01345         cpl_table_multiply_columns(t, residual2, residual2);
01346 
01347         /* For a Gaussian distribution:
01348          * sigma    ~= median(|residual|) / 0.6744
01349          * sigma^2  ~= median(residual^2) / 0.6744^2  
01350          */
01351 
01352         sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744);
01353 
01354         /* Reject values where
01355            residual^2 > (kappa*sigma)^2
01356         */
01357     check_nomsg( rejected = uves_erase_table_rows(t, residual2,
01358                                                       CPL_GREATER_THAN,
01359                                                       kappa*kappa*sigma2));
01360         
01361         cpl_table_erase_column(t, residual2);
01362 
01363     } while (rejected > 0);
01364 
01365     mean  = cpl_table_get_column_mean(t, column);
01366     
01367   cleanup:
01368     return mean;
01369 }
01370 
01371 /*----------------------------------------------------------------------------*/
01404 /*----------------------------------------------------------------------------*/
01405 polynomial *
01406 uves_polynomial_regression_1d(cpl_table *t,
01407                   const char *X, const char *Y, const char *sigmaY, 
01408                   int degree, 
01409                   const char *polynomial_fit, const char *residual_square,
01410                   double *mean_squared_error, double kappa)
01411 {
01412     int N;
01413     int total_rejected = 0;  /* Rejected in kappa sigma clipping */
01414     int rejected = 0;
01415     double mse;                  /* local mean squared error */
01416     double *x;
01417     double *y;
01418     double *sy;
01419     polynomial *result = NULL;
01420     cpl_vector *vx = NULL;
01421     cpl_vector *vy = NULL;
01422     cpl_vector *vsy = NULL;
01423     cpl_type type;
01424 
01425     /* Check input */
01426     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
01427     assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
01428     assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
01429     assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
01430     assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
01431     assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
01432         "No such column: %s", sigmaY);
01433 
01434     assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
01435         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
01436 
01437     assure( residual_square == NULL || !cpl_table_has_column(t, residual_square), 
01438         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
01439     
01440     /* Check column types */
01441     type = cpl_table_get_column_type(t, Y);
01442     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE, 
01443         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
01444     type = cpl_table_get_column_type(t, X);
01445     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
01446         "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
01447     if (sigmaY != NULL)
01448     {
01449         type = cpl_table_get_column_type(t, sigmaY);
01450         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
01451             CPL_ERROR_INVALID_TYPE, 
01452             "Input column '%s' has wrong type (%s)", 
01453             sigmaY, uves_tostring_cpl_type(type));
01454     }
01455 
01456     check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
01457        "Could not cast table column '%s' to double", X);
01458     check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
01459        "Could not cast table column '%s' to double", Y);
01460     if (sigmaY != NULL)
01461     {
01462         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
01463            "Could not cast table column '%s' to double", sigmaY);
01464     } 
01465     
01466     total_rejected = 0;
01467     rejected = 0;
01468     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
01469        "Could not create column");
01470     do{
01471     check( (N = cpl_table_get_nrow(t),
01472         x = cpl_table_get_data_double(t, "_X_double"),
01473         y = cpl_table_get_data_double(t, "_Y_double")),
01474            "Could not read table data");
01475     
01476     if (sigmaY != NULL) 
01477         {
01478         check( sy = cpl_table_get_data_double(t,  "_sY_double"),
01479                "Could not read table data");
01480         } 
01481     else 
01482         {
01483         sy = NULL;
01484         }
01485     
01486     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
01487 
01488     /* Wrap vectors */
01489     uves_unwrap_vector(&vx);
01490     uves_unwrap_vector(&vy);
01491     
01492     vx = cpl_vector_wrap(N, x);
01493     vy = cpl_vector_wrap(N, y);
01494        
01495     if (sy != NULL)
01496         {
01497         uves_unwrap_vector(&vsy);
01498         vsy = cpl_vector_wrap(N, sy);
01499         }
01500     else
01501         {
01502         vsy = NULL;
01503         }
01504      
01505     /* Fit! */
01506     uves_polynomial_delete(&result);
01507     check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse), 
01508            "Could not fit polynomial");
01509     
01510     /* If requested, calculate residuals and perform kappa-sigma clipping */
01511     if (kappa > 0)
01512         {
01513         double sigma2;   /* sigma squared */
01514         int i;
01515         
01516         for (i = 0; i < N; i++)
01517             {
01518             double xval, yval, yfit;
01519             
01520             check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
01521                 yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
01522                 yfit = uves_polynomial_evaluate_1d(result, xval),
01523     
01524                 cpl_table_set_double(t, "_residual_square", i, 
01525                              (yfit-yval)*(yfit-yval))),
01526                 "Could not evaluate polynomial");
01527             }
01528         
01529         /* For robustness, estimate sigma as (third quartile) / 0.6744
01530          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
01531          * The third quartile is estimated as the median of the absolute residuals,
01532          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
01533          *     sigma^2  ~= median(residual^2) / 0.6744^2  
01534          */
01535         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
01536 
01537         /* Remove points with residual^2 > kappa^2 * sigma^2 */
01538         check( rejected = uves_erase_table_rows(t, "_residual_square", 
01539                             CPL_GREATER_THAN, kappa*kappa*sigma2),
01540                "Could not remove outlier points");
01541         
01542         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
01543                    rejected, N, sqrt(mse));
01544         
01545         /* Update */
01546         total_rejected += rejected;
01547         N = cpl_table_get_nrow(t);
01548         }
01549     
01550 } while (rejected > 0);
01551     
01552     cpl_table_erase_column(t,  "_residual_square");    
01553     
01554     if (kappa > 0)
01555     {    
01556         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
01557               total_rejected,
01558               N + total_rejected,
01559               (100.0*total_rejected)/(N + total_rejected)
01560         );
01561     }
01562     
01563     if (mean_squared_error != NULL) *mean_squared_error = mse;
01564     
01565     /* Add the fitted values to table if requested */
01566     if (polynomial_fit != NULL || residual_square != NULL)
01567     {
01568         int i;
01569         
01570         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
01571            "Could not create column");
01572         for (i = 0; i < N; i++){
01573         double xval;
01574         double yfit;
01575         
01576         check((
01577               xval = cpl_table_get_double(t, "_X_double", i, NULL),
01578               yfit = uves_polynomial_evaluate_1d(result, xval),
01579               cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
01580               "Could not evaluate polynomial");
01581         }
01582         
01583         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
01584         if (residual_square != NULL)
01585         {
01586             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
01587                                t, "_polynomial_fit"),
01588                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
01589                 cpl_table_multiply_columns(t, residual_square, residual_square)),
01590                                                                                /* RS := RS^2 */
01591                 "Could not calculate Residual of fit");
01592         }
01593         
01594         /* Keep the polynomial_fit column if requested */
01595         if (polynomial_fit != NULL)
01596         {
01597             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
01598         }
01599         else
01600         {
01601             cpl_table_erase_column(t, "_polynomial_fit");
01602         }
01603     }
01604     
01605     check(( cpl_table_erase_column(t, "_X_double"),
01606         cpl_table_erase_column(t, "_Y_double")),
01607       "Could not delete temporary columns");
01608     
01609     if (sigmaY != NULL) 
01610     {
01611         check( cpl_table_erase_column(t, "_sY_double"), 
01612            "Could not delete temporary column");
01613     } 
01614     
01615   cleanup:
01616     uves_unwrap_vector(&vx);
01617     uves_unwrap_vector(&vy);
01618     uves_unwrap_vector(&vsy);
01619     if (cpl_error_get_code() != CPL_ERROR_NONE)
01620     {
01621         uves_polynomial_delete(&result);
01622     }
01623     
01624     return result;
01625 }
01626 
01627 
01628 /*----------------------------------------------------------------------------*/
01676 /*----------------------------------------------------------------------------*/
01677 
01678 polynomial *
01679 uves_polynomial_regression_2d(cpl_table *t,
01680                   const char *X1, const char *X2, const char *Y, 
01681                   const char *sigmaY,
01682                   int degree1, int degree2,
01683                   const char *polynomial_fit, const char *residual_square, 
01684                   const char *variance_fit,
01685                   double *mse, double *red_chisq,
01686                   polynomial **variance, double kappa,
01687                               double min_reject)
01688 {
01689     int N;
01690     int rejected;
01691     int total_rejected;
01692     double *x1;
01693     double *x2;
01694     double *y;
01695     double *res;
01696     double *sy;
01697     polynomial *p = NULL;               /* Result */
01698     polynomial *variance_local = NULL;
01699     cpl_vector *vx1 = NULL;
01700     cpl_vector *vx2 = NULL;
01701     cpl_bivector *vx = NULL;
01702     cpl_vector *vy = NULL;
01703     cpl_vector *vsy= NULL;
01704     cpl_type type;
01705 
01706     /* Check input */
01707     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
01708     assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
01709     assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
01710     assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
01711     assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
01712         CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
01713     if (sigmaY != NULL)
01714     {
01715         assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT, 
01716             "No such column: %s", sigmaY);
01717     }
01718     if (polynomial_fit != NULL)
01719     {
01720         assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
01721             "Table already has '%s' column", polynomial_fit);
01722     }
01723     if (residual_square != NULL)
01724     {
01725         assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT, 
01726             "Table already has '%s' column", residual_square);
01727     }
01728     if (variance_fit != NULL)
01729     {
01730         assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
01731             "Table already has '%s' column", variance_fit);
01732     }
01733 
01734     /* Check column types */
01735     type = cpl_table_get_column_type(t, X1);
01736     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01737         "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
01738     type = cpl_table_get_column_type(t, X2);
01739     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01740         "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
01741     type = cpl_table_get_column_type(t, Y);
01742     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01743         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
01744     if (sigmaY != NULL)
01745     {
01746         type = cpl_table_get_column_type(t, sigmaY);
01747         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
01748             "Input column '%s' has wrong type (%s)", 
01749             sigmaY, uves_tostring_cpl_type(type));
01750     }
01751 
01752     /* In the case that these temporary columns already exist, a run-time error will occur */
01753     check( cpl_table_cast_column(t, X1    , "_X1_double", CPL_TYPE_DOUBLE), 
01754        "Could not cast table column to double");
01755     check( cpl_table_cast_column(t, X2    , "_X2_double", CPL_TYPE_DOUBLE),
01756        "Could not cast table column to double");
01757     check( cpl_table_cast_column(t,  Y    ,  "_Y_double", CPL_TYPE_DOUBLE), 
01758        "Could not cast table column to double");
01759     if (sigmaY != NULL)
01760     {
01761         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
01762            "Could not cast table column to double");
01763     }
01764     
01765     total_rejected = 0;
01766     rejected = 0;
01767     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
01768        "Could not create column");
01769 
01770     do {
01771         /* WARNING!!! Code duplication (see below). Be careful
01772            when updating */
01773     check(( N  = cpl_table_get_nrow(t),
01774         x1 = cpl_table_get_data_double(t, "_X1_double"),
01775         x2 = cpl_table_get_data_double(t, "_X2_double"),
01776         y  = cpl_table_get_data_double(t, "_Y_double"),
01777                 res= cpl_table_get_data_double(t, "_residual_square")),
01778           "Could not read table data");
01779     
01780     if (sigmaY != NULL) 
01781         {
01782         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
01783                "Could not read table data");
01784         }
01785     else 
01786         {
01787         sy = NULL;
01788         }
01789 
01790     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
01791     
01792     /* Wrap vectors */
01793     uves_unwrap_vector(&vx1);
01794     uves_unwrap_vector(&vx2);
01795     uves_unwrap_vector(&vy);
01796 
01797     vx1 = cpl_vector_wrap(N, x1);
01798     vx2 = cpl_vector_wrap(N, x2);
01799     vy  = cpl_vector_wrap(N, y);
01800     if (sy != NULL)
01801         {
01802         uves_unwrap_vector(&vsy);
01803         vsy = cpl_vector_wrap(N, sy);
01804         }
01805     else
01806         {
01807         vsy = NULL;
01808         }
01809     
01810     /* Wrap up the bi-vector */
01811     uves_unwrap_bivector_vectors(&vx);
01812     vx = cpl_bivector_wrap_vectors(vx1, vx2);
01813     
01814     /* Fit! */
01815     uves_polynomial_delete(&p);
01816         check( p =  uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
01817                                            NULL, NULL, NULL),
01818                "Could not fit polynomial");
01819 
01820     /* If requested, calculate residuals and perform kappa-sigma clipping */
01821     if (kappa > 0)
01822         {
01823         double sigma2;   /* sigma squared */
01824         int i;
01825 
01826                 cpl_table_fill_column_window_double(t, "_residual_square", 0, 
01827                                                     cpl_table_get_nrow(t), 0.0);
01828 
01829         for (i = 0; i < N; i++)
01830             {
01831                         double yval, yfit;
01832 
01833                         yval  = y[i];
01834                         yfit  = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
01835                         res[i] = (yfit-y[i])*(yfit-y[i]);
01836             }
01837         
01838         /* For robustness, estimate sigma as (third quartile) / 0.6744
01839          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
01840          * The third quartile is estimated as the median of the absolute residuals,
01841          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
01842          *     sigma^2  ~= median(residual^2) / 0.6744^2  
01843          */
01844         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
01845                              
01846 
01847         /* Remove points with residual^2 > kappa^2 * sigma^2 */
01848         check( rejected = uves_erase_table_rows(t, "_residual_square", 
01849                             CPL_GREATER_THAN, kappa*kappa*sigma2),
01850                "Could not remove outlier points");
01851         /* Note! All pointers to table data are now invalid! */
01852 
01853 
01854         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f", 
01855                    rejected, N, sqrt(sigma2));
01856         
01857         /* Update */
01858         total_rejected += rejected;
01859         N = cpl_table_get_nrow(t);
01860         }
01861         
01862     /* Stop also if there are too few points left to make the fit.
01863      * Needed number of points = (degree1+1)(degree2+1) coefficients
01864      *      plus one extra point for chi^2 computation.   */
01865     } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
01866              N >= (degree1 + 1)*(degree2 + 1) + 1);
01867     
01868     if (kappa > 0)
01869     {    
01870         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
01871                 total_rejected,
01872                 N + total_rejected,
01873                 (100.0*total_rejected)/(N + total_rejected)
01874         );
01875     }
01876        
01877     /* Final fit */
01878     {
01879         /* Need to convert to vector again. */
01880 
01881         /* WARNING!!! Code duplication (see above). Be careful
01882            when updating */
01883     check(( N  = cpl_table_get_nrow(t),
01884         x1 = cpl_table_get_data_double(t, "_X1_double"),
01885         x2 = cpl_table_get_data_double(t, "_X2_double"),
01886         y  = cpl_table_get_data_double(t, "_Y_double"),
01887                 res= cpl_table_get_data_double(t, "_residual_square")),
01888           "Could not read table data");
01889     
01890     if (sigmaY != NULL) 
01891         {
01892         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
01893                "Could not read table data");
01894         }
01895     else 
01896         {
01897         sy = NULL;
01898         }
01899 
01900     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
01901     
01902     /* Wrap vectors */
01903     uves_unwrap_vector(&vx1);
01904     uves_unwrap_vector(&vx2);
01905     uves_unwrap_vector(&vy);
01906 
01907     vx1 = cpl_vector_wrap(N, x1);
01908     vx2 = cpl_vector_wrap(N, x2);
01909     vy  = cpl_vector_wrap(N, y);
01910     if (sy != NULL)
01911         {
01912         uves_unwrap_vector(&vsy);
01913         vsy = cpl_vector_wrap(N, sy);
01914         }
01915     else
01916         {
01917         vsy = NULL;
01918         }
01919     
01920     /* Wrap up the bi-vector */
01921     uves_unwrap_bivector_vectors(&vx);
01922     vx = cpl_bivector_wrap_vectors(vx1, vx2);
01923     }
01924 
01925     uves_polynomial_delete(&p);
01926     if (variance_fit != NULL || variance != NULL)
01927         {
01928             /* If requested, also compute variance */
01929             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
01930                                               mse, red_chisq, &variance_local),
01931                    "Could not fit polynomial");
01932         }
01933     else
01934         {
01935             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
01936                                               mse, red_chisq, NULL),
01937                    "Could not fit polynomial");
01938         }
01939 
01940     cpl_table_erase_column(t,  "_residual_square");
01941     
01942     /* Add the fitted values to table as requested */
01943     if (polynomial_fit != NULL || residual_square != NULL)
01944     {
01945         int i;
01946             double *pf;
01947         
01948         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
01949            "Could not create column");
01950 
01951             cpl_table_fill_column_window_double(t, "_polynomial_fit", 0, 
01952                                                 cpl_table_get_nrow(t), 0.0);
01953 
01954             x1 = cpl_table_get_data_double(t, "_X1_double");
01955             x2 = cpl_table_get_data_double(t, "_X2_double");
01956             pf = cpl_table_get_data_double(t, "_polynomial_fit");
01957 
01958         for (i = 0; i < N; i++){
01959 #if 0        
01960         double x1val, x2val, yfit;
01961 
01962         check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
01963             x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
01964             yfit  = uves_polynomial_evaluate_2d(p, x1val, x2val),
01965             
01966             cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
01967             "Could not evaluate polynomial");
01968 
01969 #else
01970                 pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
01971 #endif
01972         }
01973         
01974         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
01975         if (residual_square != NULL)
01976         {
01977             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
01978                                t, "_polynomial_fit"),
01979                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
01980                 cpl_table_multiply_columns(t, residual_square, residual_square)),
01981                                                                    /* RS := RS^2 */
01982                "Could not calculate Residual of fit");
01983         }
01984         
01985         /* Keep the polynomial_fit column if requested */
01986         if (polynomial_fit != NULL)
01987         {
01988             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
01989         }
01990         else
01991         {
01992             cpl_table_erase_column(t, "_polynomial_fit");
01993         }
01994     }
01995     
01996     /* Add variance of poly_fit if requested */
01997     if (variance_fit != NULL)
01998     {
01999         int i;
02000             double *vf;
02001 
02002         check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE), 
02003            "Could not create column");
02004             
02005             cpl_table_fill_column_window_double(t, variance_fit, 0,
02006                                                 cpl_table_get_nrow(t), 0.0);
02007 
02008             x1 = cpl_table_get_data_double(t, "_X1_double");
02009             x2 = cpl_table_get_data_double(t, "_X2_double");
02010             vf = cpl_table_get_data_double(t, variance_fit);
02011 
02012         for (i = 0; i < N; i++)
02013         {
02014 #if 0
02015             double x1val, x2val, yfit_variance;
02016             check(( x1val         = cpl_table_get_double(t, "_X1_double", i, NULL),
02017                 x2val         = cpl_table_get_double(t, "_X2_double", i, NULL),
02018                 yfit_variance = uves_polynomial_evaluate_2d(variance_local, 
02019                                     x1val, x2val),
02020                 
02021                 cpl_table_set_double(t, variance_fit, i, yfit_variance)),
02022                "Could not evaluate polynomial");
02023 #else
02024                     vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
02025 #endif
02026 
02027         }
02028     }
02029     
02030     
02031     check(( cpl_table_erase_column(t, "_X1_double"),
02032         cpl_table_erase_column(t, "_X2_double"),
02033         cpl_table_erase_column(t,  "_Y_double")),
02034       "Could not delete temporary columns");
02035       
02036     if (sigmaY != NULL) 
02037     {
02038         check( cpl_table_erase_column(t, "_sY_double"),
02039            "Could not delete temporary column");
02040     }
02041     
02042   cleanup:
02043     uves_unwrap_bivector_vectors(&vx);
02044     uves_unwrap_vector(&vx1);
02045     uves_unwrap_vector(&vx2);
02046     uves_unwrap_vector(&vy);
02047     uves_unwrap_vector(&vsy);
02048     /* Delete 'variance_local', or return through 'variance' parameter */
02049     if (variance != NULL)
02050     {
02051         *variance = variance_local;
02052     }
02053     else
02054     {
02055         uves_polynomial_delete(&variance_local);
02056     }
02057     if (cpl_error_get_code() != CPL_ERROR_NONE)
02058     {
02059         uves_polynomial_delete(&p);
02060     }
02061 
02062     return p;
02063 }
02064 
02065 /*----------------------------------------------------------------------------*/
02108 /*----------------------------------------------------------------------------*/
02109 
02110 polynomial *
02111 uves_polynomial_regression_2d_autodegree(cpl_table *t,
02112                      const char *X1, const char *X2, const char *Y,
02113                      const char *sigmaY,
02114                      const char *polynomial_fit,
02115                      const char *residual_square, 
02116                      const char *variance_fit,
02117                      double *mean_squared_error, double *red_chisq,
02118                      polynomial **variance, double kappa,
02119                      int maxdeg1, int maxdeg2, double min_rms,
02120                                          double min_reject,
02121                                          bool verbose,
02122                      const double *min_val,
02123                      const double *max_val,
02124                      int npos, double positions[][2])
02125 {
02126     int deg1 = 0;               /* Current degrees                                  */
02127     int deg2 = 0;               /* Current degrees                                  */
02128     int i;
02129 
02130     double **mse = NULL;
02131     bool adjust1 = true;      /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
02132     bool adjust2 = true;      /*   (or held constant)            */
02133     bool finished = false;
02134 
02135     const char *y_unit;
02136     cpl_table *temp = NULL;
02137     polynomial *bivariate_fit = NULL;   /* Result */
02138 
02139     assure( (min_val == NULL && max_val == NULL) || positions != NULL,
02140         CPL_ERROR_NULL_INPUT,
02141         "Missing positions array");    
02142 
02143     check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
02144     if (y_unit == NULL)
02145     {
02146         y_unit = "";
02147     }
02148 
02149     assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT, 
02150        "Illegal max. degrees: (%d, %d)",
02151        maxdeg1, maxdeg2);
02152 
02153     mse = cpl_calloc(maxdeg1+1, sizeof(double *));
02154     assure_mem(mse);
02155     for (i = 0; i < maxdeg1+1; i++)
02156     {
02157         int j;
02158         mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
02159         assure_mem(mse);
02160 
02161         for (j = 0; j < maxdeg2+1; j++)
02162         {
02163             mse[i][j] = -1;
02164         }
02165     }
02166 
02167     temp = cpl_table_duplicate(t);
02168     assure_mem(temp);
02169 
02170     uves_polynomial_delete(&bivariate_fit);
02171     check( bivariate_fit = uves_polynomial_regression_2d(temp,
02172                              X1, X2, Y, sigmaY,
02173                              deg1,
02174                              deg2,
02175                              NULL, NULL, NULL,  /* new columns  */
02176                              &mse[deg1][deg2], NULL, /* chi^2/N */
02177                              NULL,              /* variance pol.*/
02178                              kappa, min_reject),
02179        "Error fitting polynomial");
02180     if (verbose)
02181         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)", 
02182                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
02183                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
02184                      cpl_table_get_nrow(t));
02185     else
02186         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)", 
02187                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
02188                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
02189                      cpl_table_get_nrow(t));
02190     /* Find best values of deg1, deg2 less than or equal to 8,8
02191        (the fitting algorithm is unstable after this point, anyway) */
02192     do
02193     {
02194         int new_deg1, new_deg2;
02195         double m;
02196 
02197         finished = true;
02198 
02199         adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
02200         adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
02201         
02202         /* Try the new degrees
02203 
02204                               (d1+1, d2  ) (d1+2, d2)
02205                        (d1, d2+1) (d1+1, d2+1)
02206                        (d1, d2+2)
02207 
02208            in the following order:
02209 
02210                                      1            3
02211                           1          2
02212                           3
02213 
02214                (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
02215         */
02216         for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
02217         for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
02218             if ( (
02219                  (new_deg1 == deg1+1 && new_deg2 == deg2   && adjust1) ||
02220                  (new_deg1 == deg1+2 && new_deg2 == deg2   && adjust1) ||
02221                  (new_deg1 == deg1   && new_deg2 == deg2+1 && adjust2) ||
02222                  (new_deg1 == deg1   && new_deg2 == deg2+2 && adjust2) ||
02223                  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
02224                  )
02225              && mse[new_deg1][new_deg2] < 0)
02226             {
02227                 int rejected = 0;
02228 
02229                 uves_free_table(&temp);
02230                 temp = cpl_table_duplicate(t);
02231                 assure_mem(temp);
02232 
02233                 uves_polynomial_delete(&bivariate_fit);
02234                 bivariate_fit = uves_polynomial_regression_2d(temp,
02235                                       X1, X2, Y, sigmaY,
02236                                       new_deg1,
02237                                       new_deg2,
02238                                       NULL, NULL, NULL,
02239                                       &(mse[new_deg1]
02240                                         [new_deg2]),
02241                                       NULL,
02242                                       NULL,
02243                                       kappa, min_reject);
02244 
02245                 if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
02246                 {
02247                     uves_error_reset();
02248 
02249                                     if (verbose)
02250                                         uves_msg_low("(%d, %d)-degree: Singular matrix", 
02251                          new_deg1, new_deg2);
02252                                     else
02253                                         uves_msg_debug("(%d, %d)-degree: Singular matrix", 
02254                          new_deg1, new_deg2);
02255                     
02256                     mse[new_deg1][new_deg2] = DBL_MAX/2; 
02257                 }
02258                 else
02259                 {
02260                     assure( cpl_error_get_code() == CPL_ERROR_NONE,
02261                         cpl_error_get_code(),
02262                         "Error fitting (%d, %d)-degree polynomial", 
02263                         new_deg1, new_deg2 );
02264                     
02265                     rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
02266                 
02267                                     if (verbose)
02268                                         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)",
02269                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
02270                                                      rejected, cpl_table_get_nrow(t));
02271                                     else
02272                                         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)",
02273                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
02274                                                      rejected, cpl_table_get_nrow(t));
02275 
02276                     /* Reject if fit produced bad values */
02277                     if (min_val != NULL || max_val != NULL)
02278                     {
02279                         for (i = 0; i < npos; i++)
02280                         {
02281                             double val = uves_polynomial_evaluate_2d(
02282                             bivariate_fit,
02283                             positions[i][0], positions[i][1]);
02284                             if (min_val != NULL && val < *min_val)
02285                             {
02286                                 uves_msg_debug("Bad fit: %f < %f", 
02287                                        val,
02288                                        *min_val);
02289                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
02290                                 /* A large number, even if we add a bit */
02291                             }
02292                             if (max_val != NULL && val > *max_val)
02293                             {
02294                                 uves_msg_debug("Bad fit: %f > %f", 
02295                                        val,
02296                                        *max_val);
02297                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
02298                             }
02299                         }
02300                     }
02301                 
02302                     /* For robustness, make sure that we don't accept a solution that
02303                        rejected too many points (say, 80%)
02304                     */
02305                     if (rejected >= (4*cpl_table_get_nrow(t))/5)
02306                     {
02307                         mse[new_deg1][new_deg2] = DBL_MAX/2; 
02308                     }
02309                     
02310                 }/* if fit succeeded */
02311             }
02312         
02313         /* If fit is significantly better (say, 10% improvement in MSE) in either direction, 
02314          * (in (degree,degree)-space) then move in that direction.
02315          *
02316          * First try to move one step horizontal/vertical, 
02317          * otherwise try to move diagonally (i.e. increase both degrees),
02318          * otherwise move two steps horizontal/vertical
02319          *
02320          */
02321         m = mse[deg1][deg2];
02322 
02323         if      (adjust1                              
02324              && (m - mse[deg1+1][deg2])/m > 0.1
02325              && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
02326              /* The condition is read like this:
02327             if 
02328             - we are trying to move right, and
02329             - this is this is a better place than the current, and
02330                 - this is better than moving down */
02331         )
02332         {
02333             deg1++;
02334             finished = false;
02335         }
02336         else if (adjust2 &&
02337              (m - mse[deg1][deg2+1])/m > 0.1
02338              && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
02339         )
02340         {
02341             deg2++;
02342             finished = false;
02343         }
02344         else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
02345         {
02346             deg1++;
02347             deg2++;
02348             finished = false;
02349         }
02350         else if (adjust1
02351              && (m - mse[deg1+2][deg2])/m > 0.1
02352              && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
02353         )
02354         {
02355             deg1 += 2;
02356             finished = false;
02357         }
02358         else if (adjust2 
02359              && (m - mse[deg1][deg2+2])/m > 0.1
02360              && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
02361         {
02362             deg2 += 2;
02363             finished = false;
02364         }
02365 
02366         /* For efficiency, stop if rms reached min_rms */   
02367         finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
02368 
02369     } while (!finished);
02370 
02371     uves_polynomial_delete(&bivariate_fit);
02372     check( bivariate_fit = uves_polynomial_regression_2d(t,
02373                              X1, X2, Y, sigmaY,
02374                              deg1,
02375                              deg2,
02376                              polynomial_fit, residual_square, 
02377                              variance_fit,
02378                              mean_squared_error, red_chisq,
02379                              variance, kappa, min_reject),
02380        "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
02381 
02382     if (verbose)
02383         uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
02384                      sqrt(mse[deg1][deg2]), y_unit);
02385     else
02386         uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
02387                      sqrt(mse[deg1][deg2]), y_unit);
02388     
02389   cleanup:
02390     if (mse != NULL)
02391     {
02392         for (i = 0; i < maxdeg1+1; i++)
02393         {
02394             if (mse[i] != NULL)
02395             {
02396                 cpl_free(mse[i]);
02397             }
02398         }
02399         cpl_free(mse);
02400     }
02401     uves_free_table(&temp);
02402     
02403     return bivariate_fit;    
02404 }
02405 
02406 /*----------------------------------------------------------------------------*/
02416 /*----------------------------------------------------------------------------*/
02417 const char *
02418 uves_remove_string_prefix(const char *s, const char *prefix)
02419 {
02420     const char *result = NULL;
02421     unsigned int prefix_length;
02422 
02423     assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
02424     assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
02425 
02426     prefix_length = strlen(prefix);
02427 
02428     assure( strlen(s) >= prefix_length &&
02429         strncmp(s, prefix, prefix_length) == 0,
02430         CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
02431         prefix, s);
02432     
02433     result = s + prefix_length;
02434     
02435   cleanup:
02436     return result;
02437 }
02438 
02439 
02440 /*----------------------------------------------------------------------------*/
02449 /*----------------------------------------------------------------------------*/
02450 
02451 double uves_gaussrand(void)
02452 {
02453     static double V1, V2, S;
02454     static int phase = 0;
02455     double X;
02456     
02457     if(phase == 0) {
02458     do {
02459         double U1 = (double)rand() / RAND_MAX;
02460         double U2 = (double)rand() / RAND_MAX;
02461         
02462         V1 = 2 * U1 - 1;
02463         V2 = 2 * U2 - 1;
02464         S = V1 * V1 + V2 * V2;
02465     } while(S >= 1 || S == 0);
02466     
02467     X = V1 * sqrt(-2 * log(S) / S);
02468     } else
02469     X = V2 * sqrt(-2 * log(S) / S);
02470     
02471     phase = 1 - phase;
02472     
02473     return X;
02474 }
02475 
02476 /*----------------------------------------------------------------------------*/
02487 /*----------------------------------------------------------------------------*/
02488 
02489 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x, 
02490                 const char *column_y, int *istart )
02491 {
02492     double result = 0;
02493     int n;
02494 
02495     const double *x, *y;
02496     
02497     check( x = cpl_table_get_data_double_const(t, column_x),
02498        "Error reading column '%s'", column_x);
02499     check( y = cpl_table_get_data_double_const(t, column_y),
02500        "Error reading column '%s'", column_y);
02501 
02502     n = cpl_table_get_nrow(t);
02503 
02504     result = uves_spline_hermite(xp, x, y, n, istart);
02505 
02506   cleanup:
02507     return result;
02508 }
02509 
02510 /*----------------------------------------------------------------------------*/
02526 /*----------------------------------------------------------------------------*/
02527 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
02528 {
02529     double yp1, yp2, yp = 0;
02530     double xpi, xpi1, l1, l2, lp1, lp2;
02531     int i;
02532 
02533     if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) )    return 0.0;
02534     if ( x[0] >  x[n-1] && (xp > x[0] || xp < x[n-1]) )    return 0.0;
02535 
02536     if ( x[0] <= x[n-1] )
02537     {
02538         for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
02539         ;
02540     }
02541     else
02542     {
02543         for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
02544         ;
02545     }
02546 
02547     *istart = i;
02548     i--;
02549     
02550     lp1 = 1.0 / (x[i-1] - x[i]);
02551     lp2 = -lp1;
02552 
02553     if ( i == 1 )
02554     {
02555         yp1 = (y[1] - y[0]) / (x[1] - x[0]);
02556     }
02557     else
02558     {
02559         yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
02560     }
02561 
02562     if ( i >= n - 1 )
02563     {
02564         yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
02565     }
02566     else
02567     {
02568         yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
02569     }
02570 
02571     xpi1 = xp - x[i];
02572     xpi  = xp - x[i-1];
02573     l1   = xpi1*lp1;
02574     l2   = xpi*lp2;
02575 
02576     yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 + 
02577          y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 + 
02578          yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
02579 
02580     return yp;
02581 }
02582 
02583 /*----------------------------------------------------------------------------*/
02597 /*----------------------------------------------------------------------------*/
02598 
02599 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
02600 {
02601     int klo, khi, k;
02602     double a, b, h, yp = 0;
02603 
02604     assure_nomsg( x  != NULL, CPL_ERROR_NULL_INPUT);
02605     assure_nomsg( y  != NULL, CPL_ERROR_NULL_INPUT);
02606     assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
02607     assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
02608 
02609     klo = *kstart;
02610     khi = n;
02611 
02612     if ( xp < x[1] || xp > x[n] )
02613     {
02614         return 0.0;
02615     }
02616     else if ( xp == x[1] )
02617     {
02618         return(y[1]);
02619     }
02620     
02621     for ( k = klo; k < n && xp > x[k]; k++ )
02622     ;
02623 
02624     klo = *kstart = k-1;
02625     khi = k;
02626 
02627     h = x[khi] - x[klo];
02628     assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
02629         "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
02630 
02631     a = (x[khi] - xp) / h;
02632     b = (xp - x[klo]) / h;
02633 
02634     yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
02635      (h*h) / 6.0;
02636 
02637   cleanup:
02638     return yp;
02639 }
02640 
02641 /*----------------------------------------------------------------------------*/
02651 /*----------------------------------------------------------------------------*/
02652 bool
02653 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
02654 {
02655     bool is_sorted = true;       /* ... until proven false */
02656     int i;
02657     int N;
02658     double previous, current;    /* column values */
02659 
02660     passure(t != NULL, " ");
02661     passure(cpl_table_has_column(t, column), "No column '%s'", column);
02662     passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
02663     
02664     N = cpl_table_get_nrow(t);
02665 
02666     if (N > 1) 
02667     {
02668         previous = cpl_table_get_double(t, column, 0, NULL);
02669         
02670         for(i = 1; i < N && is_sorted; i++)
02671         {
02672             current = cpl_table_get_double(t, column, i, NULL);
02673             if (!reverse)
02674             {
02675                 /* Check for ascending */
02676                 is_sorted = is_sorted && ( current >= previous );
02677             }
02678             else
02679             {
02680                 /* Check for descending */
02681                 is_sorted = is_sorted && ( current <= previous );
02682             }
02683             
02684             previous = current;
02685         }
02686     }
02687     else
02688     {
02689         /* 0 or 1 rows. Table is sorted */        
02690     }
02691     
02692   cleanup:
02693     return is_sorted;
02694 }
02695 
02696 /*----------------------------------------------------------------------------*/
02702 /*----------------------------------------------------------------------------*/
02703 cpl_table *
02704 uves_ordertable_traces_new(void)
02705 {
02706     cpl_table *result = NULL;
02707     
02708     check((
02709           result = cpl_table_new(0),
02710           cpl_table_new_column(result, "TraceID"  , CPL_TYPE_INT),
02711           cpl_table_new_column(result, "Offset"   , CPL_TYPE_DOUBLE),
02712           cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
02713     "Error creating table");
02714     
02715   cleanup:
02716     return result;
02717 }
02718 
02719 /*----------------------------------------------------------------------------*/
02729 /*----------------------------------------------------------------------------*/
02730 cpl_error_code
02731 uves_ordertable_traces_add(cpl_table *traces, 
02732                int fibre_ID, double fibre_offset, int fibre_mask)
02733 {
02734     int size;
02735 
02736     assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
02737     
02738     /* Write to new table row */
02739     check((
02740           size = cpl_table_get_nrow(traces),
02741           cpl_table_set_size  (traces, size+1),
02742           cpl_table_set_int   (traces, "TraceID"  , size, fibre_ID),
02743           cpl_table_set_double(traces, "Offset"   , size, fibre_offset),
02744           cpl_table_set_int   (traces, "Tracemask", size, fibre_mask)),
02745       "Error updating table");
02746 
02747   cleanup:
02748     return cpl_error_get_code();
02749 }
02750 
02751 
02752 /*
02753  * modified on 2006/04/19
02754  *  jmlarsen:  float[5] -> const double[]
02755  *             changed mapping of indices to parameters
02756  *             Normalized the profile to 1 and changed meaning
02757  *             of (a[3], a[2]) to (integrated flux, stdev)
02758  *             Disabled debugging messages
02759  *
02760  * modified on 2005/07/29 to make dydapar a FORTRAN array
02761  * (indiced from 1 to N instead of 0 to N-1).
02762  * This allows the array to be passed to C functions expecting
02763  * FORTRAN-like arrays.
02764  *
02765  * modified on 2005/08/02 to make the function prototype ANSI
02766  * compliant (so it can be used with the levmar library).
02767  *
02768  * modified on 2005/08/16. The function now expects C-indexed
02769  * arrays as parameters (to allow proper integration). However, the
02770  * arrays are still converted to FORTRAN-indexed arrays internally.
02771  */
02772 
02783 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
02784 
02785  
02786      /*     int na;*/
02787 {
02788   double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
02789   double a2i=0, m = 0, p = 0, dif =0;
02790   double sqrt5 = 2.23606797749979;
02791 
02792   *y=0.0;
02793 //  a2i = 1.0/a[2];
02794   a2i = 1.0/(a[2]*sqrt5);
02795 
02796   dif=x-a[1];
02797   arg=dif*a2i;
02798   arg2=arg*arg;
02799 
02800   fac=1.0+arg2;
02801   fac2=fac*fac;
02802   fac4=fac2*fac2;
02803   fac4i = 1.0/fac4;
02804   
02805 //  m = a[1]*fac4i;
02806   m = a[3]*fac4i * a2i*16/(5.0*M_PI);
02807   *y = m + a[4]*(1.0+dif*a[5]);  
02808   p = 8.0*m/fac*arg*a2i;
02809 
02810   dyda[3] = m/a[3];
02811   dyda[2] = p*dif/a[2] - m/a[2];
02812 
02813 //  dyda[3]=fac4i;
02814   dyda[1]=p-a[4]*a[5];
02815 //  dyda[2]=p*dif*a2i;
02816   dyda[4]=1.0+dif*a[5];
02817   dyda[5]=a[4]*dif;
02818 
02819 
02820 #if 0
02821   {
02822      int i = 0, npar=5 ;
02823      printf("fmoffat_i \n");
02824      for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
02825      
02826      printf("fmoffat_i ");
02827      for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
02828      printf("\n");
02829   }
02830 #endif
02831   
02832 }
02833 
02852 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
02853 //void fmoffa_c(x,a,y, dyda)
02854 
02855 
02856 //     float x,*a,*y,*dyda;
02857 /*int na;*/
02858 {
02859   int npoint = 3;
02860   double const xgl[3] = {-0.387298334621,0.,0.387298334621};
02861   double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
02862   int i=0;
02863   int j=0;
02864   int npar = 5;
02865   double xmod = 0;
02866   double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
02867   double ypar;
02868 
02869 
02870   // Convert C-indexed arrays to FORTRAN-indexed arrays
02871   a    = C_TO_FORTRAN_INDEXING(a);
02872   dyda = C_TO_FORTRAN_INDEXING(dyda);
02873 
02874   *y = 0.0;
02875   for (i = 1;i<=npar;i++) dyda[i] = 0.;
02876   /*  printf("fmoffat_c ");
02877   for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
02878   /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
02879   /*  printf("\n");*/
02880   for (j=0; j < npoint; j++) 
02881       {
02882       xmod = x+xgl[j];
02883 
02884       fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
02885       
02886       *y = *y + ypar*wgl[j];
02887       
02888       for (i = 1; i <= npar; i++)
02889           {
02890           dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
02891           }
02892 
02893      /*      if (j == 2) 
02894     for (i = 1;i<=npar;i++) 
02895       {
02896         dyda[i] = dydapar[i];
02897       };
02898      */
02899     }
02900 
02901 #if 0
02902       printf("fmoffat_c ");
02903       for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
02904       printf("\n");
02905 #endif
02906 }
02907 
02908 /*----------------------------------------------------------------------------*/
02916 /*----------------------------------------------------------------------------*/
02917 int
02918 uves_moffat(const double x[], const double a[], double *result)
02919 {
02920     double dyda[5];
02921 
02922     fmoffa_c(x[0], a, result, dyda);
02923 
02924     return 0;
02925 }
02926 
02927 /*----------------------------------------------------------------------------*/
02935 /*----------------------------------------------------------------------------*/
02936 int
02937 uves_moffat_derivative(const double x[], const double a[], double result[])
02938 {
02939     double y;
02940 
02941     fmoffa_c(x[0], a, &y, result);
02942 
02943     return 0;
02944 }
02945 
02946 /*----------------------------------------------------------------------------*/
02966 /*----------------------------------------------------------------------------*/
02967 
02968 int
02969 uves_gauss(const double x[], const double a[], double *result)
02970 {
02971     double my    = a[0];
02972     double sigma = a[1];
02973 
02974     if (sigma == 0)
02975     {
02976         /* Dirac's delta function */
02977         if (x[0] == my)
02978         {
02979             *result = DBL_MAX;
02980         }
02981         else
02982         {
02983             *result = 0;
02984         }
02985         return 0;
02986     }
02987     else
02988     {
02989         double A     = a[2];
02990         double B     = a[3];
02991         
02992         *result = B    +
02993         A/(sqrt(2*M_PI*sigma*sigma)) *
02994         exp(- (x[0] - my)*(x[0] - my)
02995             / (2*sigma*sigma));
02996     }
02997     
02998     return 0;
02999 }
03000 
03001 /*----------------------------------------------------------------------------*/
03021 /*----------------------------------------------------------------------------*/
03022 
03023 int
03024 uves_gauss_derivative(const double x[], const double a[], double result[])
03025 {
03026     double my    = a[0];
03027     double sigma = a[1];
03028     double A     = a[2];
03029     /* a[3] not used */
03030 
03031     double factor;
03032    
03033     /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03034      *
03035      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
03036      *          = A * fac. * (x-my)  / s^2
03037      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
03038      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
03039      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03040      *          = fac.
03041      * df/dB    = 1
03042      */
03043     
03044     if (sigma == 0)
03045     {
03046         /* Derivative of Dirac's delta function */
03047         result[0] = 0;
03048         result[1] = 0;
03049         result[2] = 0;
03050         result[3] = 0;
03051         return 0;
03052     }
03053 
03054     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
03055     / (sqrt(2*M_PI*sigma*sigma));
03056 
03057     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
03058     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
03059     result[2] = factor;
03060     result[3] = 1;
03061 
03062     return 0;
03063 }
03064 
03065 /*----------------------------------------------------------------------------*/
03086 /*----------------------------------------------------------------------------*/
03087 
03088 int
03089 uves_gauss_linear(const double x[], const double a[], double *result)
03090 {
03091     double my    = a[0];
03092     double sigma = a[1];
03093 
03094     if (sigma == 0)
03095     {
03096         /* Dirac's delta function */
03097         if (x[0] == my)
03098         {
03099             *result = DBL_MAX;
03100         }
03101         else
03102         {
03103             *result = 0;
03104         }
03105         return 0;
03106     }
03107     else
03108     {
03109         double A     = a[2];
03110         double B     = a[3];
03111         double C     = a[4];
03112         
03113         *result = B    + C*(x[0] - my) +
03114         A/(sqrt(2*M_PI*sigma*sigma)) *
03115         exp(- (x[0] - my)*(x[0] - my)
03116             / (2*sigma*sigma));
03117     }
03118     
03119     return 0;
03120 }
03121 
03122 /*----------------------------------------------------------------------------*/
03145 /*----------------------------------------------------------------------------*/
03146 
03147 int
03148 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
03149 {
03150     double my    = a[0];
03151     double sigma = a[1];
03152     double A     = a[2];
03153     /* a[3] not used */
03154     double C     = a[4];
03155 
03156     double factor;
03157    
03158     /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03159      *
03160      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
03161      *          = A * fac. * (x-my)  / s^2   - C
03162      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
03163      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
03164      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03165      *          = fac.
03166      * df/dB    = 1
03167      *
03168      * df/dC    = x-my
03169      */
03170     
03171     if (sigma == 0)
03172     {
03173         /* Derivative of Dirac's delta function */
03174         result[0] = -C;
03175         result[1] = 0;
03176         result[2] = 0;
03177         result[3] = 0;
03178         result[4] = x[0];
03179         return 0;
03180     }
03181 
03182     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
03183     / (sqrt(2*M_PI*sigma*sigma));
03184 
03185     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
03186     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
03187     result[2] = factor;
03188     result[3] = 1;
03189     result[4] = x[0] - my;
03190 
03191     return 0;
03192 }
03193 
03194 
03195 
03196 
03197 /*----------------------------------------------------------------------------*/
03210 /*----------------------------------------------------------------------------*/
03211 cpl_image *
03212 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
03213                   const cpl_image *spectrum, const cpl_image *sky,
03214                   const cpl_image *cosmic_image,
03215                   const uves_extract_profile *profile,
03216                   cpl_image **image_noise, uves_propertylist **image_header)
03217 {
03218     cpl_image *image = NULL;
03219 
03220     cpl_binary *bpm = NULL;
03221     bool loop_y = false;
03222 
03223     double ron = 3;
03224     double gain = 1.0; //fixme
03225     bool new_format = true;
03226 
03227     image        = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
03228     assure_mem( image );
03229     if (image_noise != NULL) {
03230         *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
03231         assure_mem( *image_noise );
03232         cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
03233     }
03234 
03235     if (image_header != NULL) {
03236         *image_header = uves_propertylist_new();
03237       
03238         uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
03239         uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
03240         uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
03241     }
03242 
03243     for (uves_iterate_set_first(pos,
03244                                 1, pos->nx,
03245                                 pos->minorder, pos->maxorder,
03246                                 bpm,
03247                                 loop_y);
03248          !uves_iterate_finished(pos); 
03249          uves_iterate_increment(pos)) {
03250       
03251         /* Manual loop over y */
03252         uves_extract_profile_set(profile, pos, NULL);
03253         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
03254 
03255             /* Get empirical and model profile */
03256             double flux, sky_flux;
03257             int bad;
03258             int spectrum_row = pos->order - pos->minorder + 1;
03259             double noise;
03260             double prof = uves_extract_profile_evaluate(profile, pos);
03261           
03262             if (sky != NULL)
03263                 {
03264                     sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
03265                 }
03266             else
03267                 {
03268                     sky_flux = 0;
03269                 }
03270 
03271             flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
03272           
03273             //fixme: check this formula
03274             noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
03275 //          uves_msg_error("%f", prof);
03276             cpl_image_set(image, pos->x, pos->y, 
03277                           flux);
03278             if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
03279           
03280         }
03281     }
03282 
03283     if (cosmic_image != NULL) {
03284         double cr_val = 2*cpl_image_get_max(image);
03285         /* assign high pixel value to CR pixels */
03286         
03287         loop_y = true;
03288         
03289         for (uves_iterate_set_first(pos,
03290                                     1, pos->nx,
03291                                     pos->minorder, pos->maxorder,
03292                                     bpm,
03293                                     loop_y);
03294              !uves_iterate_finished(pos); 
03295              uves_iterate_increment(pos)) {
03296             
03297             int is_rejected;
03298             if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
03299                 cpl_image_set(image, pos->x, pos->y, cr_val);
03300             }
03301         }
03302     }
03303     
03304   cleanup:
03305     return image;
03306 }
03307 
03308 void 
03309 uves_frameset_dump(cpl_frameset* set)
03310 {
03311 
03312   cpl_frame* frm=NULL;
03313   int sz=0;
03314   int i=0;
03315 
03316   cknull(set,"Null input frameset");
03317   check_nomsg(sz=cpl_frameset_get_size(set));
03318   check_nomsg(frm=cpl_frameset_get_first(set));
03319   do{
03320     uves_msg("frame %d tag %s filename %s group %d",
03321          i,
03322              cpl_frame_get_tag(frm),
03323              cpl_frame_get_filename(frm),
03324              cpl_frame_get_group(frm));
03325     i++;
03326   } while ((frm=cpl_frameset_get_next(set)) != NULL);
03327 
03328   cleanup:
03329 
03330   return ;
03331 }
03332 

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