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: 2008/03/03 10:36:17 $
00023  * $Revision: 1.150 $
00024  * $Name: uves-3_9_0 $
00025  * $Log: uves_utils.c,v $
00026  * Revision 1.150  2008/03/03 10:36:17  amodigli
00027  * uves_msg_warning->uves_msg_debug and fixed some typos on starting indexes for cosmic ray rejection
00028  *
00029  * Revision 1.149  2008/02/29 15:34:33  amodigli
00030  * fixed typos on uves_sort
00031  *
00032  * Revision 1.148  2008/02/29 10:26:24  amodigli
00033  * added uves_rcosmic
00034  *
00035  * Revision 1.147  2008/02/21 07:51:33  amodigli
00036  * added draft for cormic ray rejiection
00037  *
00038  * Revision 1.146  2008/02/15 12:43:21  amodigli
00039  * added uves_string_tolower uves_string_toupper
00040  *
00041  * Revision 1.145  2008/02/04 14:08:58  amodigli
00042  * added uves_parameterlist_duplicate
00043  *
00044  * Revision 1.144  2007/09/11 12:11:49  amodigli
00045  * added uves_frameset_extract
00046  *
00047  * Revision 1.143  2007/08/21 13:08:26  jmlarsen
00048  * Removed irplib_access module, largely deprecated by CPL-4
00049  *
00050  * Revision 1.142  2007/08/02 15:18:44  amodigli
00051  * added uves_frameset_dump
00052  *
00053  * Revision 1.141  2007/06/28 09:24:11  jmlarsen
00054  * Changed message
00055  *
00056  * Revision 1.140  2007/06/06 14:57:24  jmlarsen
00057  * Disabled FLAMES for public release
00058  *
00059  * Revision 1.139  2007/06/06 08:17:33  amodigli
00060  * replace tab with 4 spaces
00061  *
00062  * Revision 1.138  2007/05/25 07:06:00  jmlarsen
00063  * Don't print output frameset
00064  *
00065  * Revision 1.137  2007/05/22 11:30:57  jmlarsen
00066  * Removed MIDAS flag for good
00067  *
00068  * Revision 1.136  2007/05/04 08:51:01  jmlarsen
00069  * Update
00070  *
00071  * Revision 1.135  2007/05/02 13:18:50  jmlarsen
00072  * Added function to simulate reconstruct raw image
00073  *
00074  * Revision 1.134  2007/04/24 12:50:29  jmlarsen
00075  * Replaced cpl_propertylist -> uves_propertylist which is much faster
00076  *
00077  * Revision 1.133  2007/04/12 14:07:28  jmlarsen
00078  * Removed debugging code
00079  *
00080  * Revision 1.132  2007/04/12 14:02:47  jmlarsen
00081  * Fixed memory error in uves_regression_2d()
00082  *
00083  * Revision 1.131  2007/04/12 11:58:08  jmlarsen
00084  * Check compile time CPL version number
00085  *
00086  * Revision 1.130  2007/04/10 07:10:37  jmlarsen
00087  * uves_spline_hermite(): maintain current array position (for efficiency)
00088  *
00089  * Revision 1.129  2007/03/28 11:39:40  jmlarsen
00090  * Removed MIDAS flag from uves_define_noise
00091  *
00092  * Revision 1.128  2007/03/19 15:11:21  jmlarsen
00093  * Optimization in 2d fitting
00094  *
00095  * Revision 1.127  2007/03/13 15:34:42  jmlarsen
00096  * Time optimizations of 2d poly fit functions
00097  *
00098  * Revision 1.126  2007/03/05 10:17:44  jmlarsen
00099  * Disabled strange msginfolevel parameter
00100  *
00101  * Revision 1.125  2007/02/23 07:36:33  jmlarsen
00102  * Changed definition of non-linear background term in uves_gauss_linear()
00103  *
00104  * Revision 1.124  2007/02/22 15:34:46  jmlarsen
00105  * Implement gaussian function with linear background
00106  *
00107  * Revision 1.123  2007/02/14 14:07:13  jmlarsen
00108  * Removed dead code
00109  *
00110  * Revision 1.122  2007/02/09 08:14:16  jmlarsen
00111  * Do not use CPL_PIXEL_MAXVAL which works only for integer images
00112  *
00113  * Revision 1.121  2007/01/15 08:47:47  jmlarsen
00114  * More robust polynomial fitting
00115  *
00116  * Revision 1.120  2006/12/12 12:09:35  jmlarsen
00117  * Print more CPL version info
00118  *
00119  * Revision 1.119  2006/11/15 15:02:15  jmlarsen
00120  * Implemented const safe workarounds for CPL functions
00121  *
00122  * Revision 1.117  2006/11/15 14:04:08  jmlarsen
00123  * Removed non-const version of parameterlist_get_first/last/next which is
00124  * already in CPL, added const-safe wrapper, unwrapper and deallocator functions
00125  *
00126  * Revision 1.116  2006/11/06 15:19:42  jmlarsen
00127  * Removed unused include directives
00128  *
00129  * Revision 1.115  2006/11/03 15:01:21  jmlarsen
00130  * Killed UVES 3d table module and use CPL 3d tables
00131  *
00132  * Revision 1.114  2006/10/09 13:03:09  jmlarsen
00133  * Removed explicit uves_msg_softer/louder calls
00134  *
00135  * Revision 1.113  2006/09/20 12:53:57  jmlarsen
00136  * Replaced stringcat functions with uves_sprintf()
00137  *
00138  * Revision 1.112  2006/09/19 07:17:08  jmlarsen
00139  * Reformatted line
00140  *
00141  * Revision 1.111  2006/09/08 14:05:36  jmlarsen
00142  * Added max/min allowed values in autodegree fitting
00143  *
00144  * Revision 1.110  2006/09/06 14:45:24  jmlarsen
00145  * Minor documentation update
00146  *
00147  * Revision 1.109  2006/09/01 13:58:32  jmlarsen
00148  * Minor doc bug fix
00149  *
00150  * Revision 1.108  2006/08/24 11:43:47  jmlarsen
00151  * Write recipe start/stop time to header
00152  *
00153  * Revision 1.107  2006/08/23 09:31:47  jmlarsen
00154  * Fixed buffer overrun
00155  *
00156  * Revision 1.106  2006/08/18 07:07:43  jmlarsen
00157  * Switched order of cpl_calloc arguments
00158  *
00159  * Revision 1.105  2006/08/17 14:11:25  jmlarsen
00160  * Use assure_mem macro to check for memory allocation failure
00161  *
00162  * Revision 1.104  2006/08/17 13:56:53  jmlarsen
00163  * Reduced max line length
00164  *
00165  * Revision 1.103  2006/08/16 14:25:47  jmlarsen
00166  * On recipe exit, print only products frames
00167  *
00168  * Revision 1.102  2006/08/11 14:56:06  amodigli
00169  * removed Doxygen warnings
00170  *
00171  * Revision 1.101  2006/08/11 11:29:09  jmlarsen
00172  * uves_get_version_binary
00173  *
00174  * Revision 1.100  2006/08/10 10:53:27  jmlarsen
00175  * Changed requirements on CPL, QFITS versions
00176  *
00177  * Revision 1.99  2006/07/14 12:42:42  jmlarsen
00178  * Added function uves_strincat_4
00179  *
00180  * Revision 1.98  2006/07/03 13:20:25  jmlarsen
00181  * Fixed indexing problem in autodegree fitting function
00182  *
00183  * Revision 1.97  2006/06/22 09:44:02  jmlarsen
00184  * Added function to remove string prefix
00185  *
00186  * Revision 1.96  2006/06/16 08:26:15  jmlarsen
00187  * Removed deprecated comment
00188  *
00189  * Revision 1.95  2006/06/06 08:40:10  jmlarsen
00190  * Shortened max line length
00191  *
00192  * Revision 1.94  2006/06/01 14:43:17  jmlarsen
00193  * Added missing documentation
00194  *
00195  * Revision 1.93  2006/05/12 15:40:08  jmlarsen
00196  * Fixed mixed code declarations
00197  *
00198  * Revision 1.92  2006/05/12 15:12:11  jmlarsen
00199  * Support minimum RMS in auto-degree fitting
00200  *
00201  * Revision 1.91  2006/05/05 13:58:09  jmlarsen
00202  * Added uves_polynomial_regression_2d_autodegree
00203  *
00204  * Revision 1.90  2006/04/24 09:26:37  jmlarsen
00205  * Added code to compute Moffat profile
00206  *
00207  * Revision 1.89  2006/03/24 13:48:47  jmlarsen
00208  * Renamed shadowing variables
00209  *
00210  * Revision 1.88  2006/03/09 10:52:52  jmlarsen
00211  * Changed order of for loops
00212  *
00213  * Revision 1.87  2006/03/03 13:54:11  jmlarsen
00214  * Changed syntax of check macro
00215  *
00216  * Revision 1.86  2006/02/28 09:15:23  jmlarsen
00217  * Minor update
00218  *
00219  * Revision 1.85  2006/02/15 13:19:15  jmlarsen
00220  * Reduced source code max. line length
00221  *
00222  * Revision 1.84  2006/02/08 07:52:16  jmlarsen
00223  * Added function returning library version
00224  *
00225  * Revision 1.83  2006/02/03 07:46:30  jmlarsen
00226  * Moved recipe implementations to ./uves directory
00227  *
00228  * Revision 1.82  2006/01/12 15:41:14  jmlarsen
00229  * Moved gauss. fitting to irplib
00230  *
00231  * Revision 1.81  2006/01/05 14:23:30  jmlarsen
00232  * Fixed hard-coded qfits version bug
00233  *
00234  * Revision 1.80  2006/01/03 15:50:54  amodigli
00235  * :q!
00236  *
00237  * Revision 1.79  2005/12/19 16:17:56  jmlarsen
00238  * Replaced bool -> int
00239  *
00240  * Revision 1.78  2005/12/19 12:29:36  jmlarsen
00241  * Added subtract_bias, subtract_dark functions
00242  *
00243  * Revision 1.77  2005/12/16 14:22:23  jmlarsen
00244  * Removed midas test data; Added sof files
00245  *
00246  * Revision 1.76  2005/12/12 10:34:57  jmlarsen
00247  * Minor doc. update
00248  *
00249  * Revision 1.75  2005/12/02 10:41:49  jmlarsen
00250  * Minor update
00251  *
00252  * Revision 1.74  2005/11/24 11:54:46  jmlarsen
00253  * Added support for CPL 3 interface
00254  *
00255  * Revision 1.73  2005/11/14 13:18:44  jmlarsen
00256  * Minor update
00257  *
00258  * Revision 1.72  2005/11/11 14:52:08  jmlarsen
00259  * Inserted median filter before estimating photonic noise
00260  *
00261  * Revision 1.71  2005/11/11 13:18:54  jmlarsen
00262  * Reorganized code, renamed source files
00263  *
00264  * Revision 1.70  2005/11/10 16:33:41  jmlarsen
00265  * Added weighted extraction, test of gauss. fit
00266  *
00267  * Revision 1.69  2005/11/07 12:18:21  jmlarsen
00268  * Support for sigma in 1d pol.fit
00269  *
00270  * Revision 1.68  2005/11/03 15:14:17  jmlarsen
00271  * Fixed a few doc. bugs
00272  *
00273  * Revision 1.67  2005/10/27 10:44:05  jmlarsen
00274  * Optimized opt.extraction + efficiency calc.
00275  *
00276  * Revision 1.66  2005/10/25 11:59:19  jmlarsen
00277  * scired flux calibration
00278  *
00279  * Revision 1.65  2005/10/20 11:36:59  jmlarsen
00280  * Removed variable declaration after code
00281  *
00282  * Revision 1.64  2005/10/19 13:18:45  jmlarsen
00283  * General update
00284  *
00285  */
00286 
00287 #ifdef HAVE_CONFIG_H
00288 #  include <config.h>
00289 #endif
00290 
00291 /*---------------------------------------------------------------------------*/
00297 /*---------------------------------------------------------------------------*/
00298 
00299 /*-----------------------------------------------------------------------------
00300                             Includes
00301  ----------------------------------------------------------------------------*/
00302 #include <assert.h>
00303 #include <uves_utils.h>
00304 #include <uves_utils_cpl.h>
00305 
00306 #include <uves_extract_profile.h>
00307 #include <uves_plot.h>
00308 #include <uves_dfs.h>
00309 #include <uves_pfits.h>
00310 #include <uves_utils_wrappers.h>
00311 #include <uves_msg.h>
00312 #include <uves_dump.h>
00313 #include <uves_error.h>
00314 
00315 #include <irplib_utils.h>
00316 
00317 #include <cpl.h>
00318 #include <qfits.h> /* iso time */
00319 
00320 #include <ctype.h>  /* tolower */
00321 #include <stdbool.h>
00322 #include <float.h>
00323 
00324 /*-----------------------------------------------------------------------------
00325                             Defines
00326  ----------------------------------------------------------------------------*/
00327 // The following macros are used to provide a fast
00328 // and readable way to convert C-indexes to FORTRAN-indexes.
00329 #define C_TO_FORTRAN_INDEXING(a) &a[-1]
00330 #define FORTRAN_TO_C_INDEXING(a) &a[1]
00331 
00333 /*-----------------------------------------------------------------------------
00334                             Functions prototypes
00335  ----------------------------------------------------------------------------*/
00336 
00337 
00338 static cpl_error_code 
00339 uves_cosrout(cpl_image* ima,
00340              cpl_image** msk,
00341              const double ron, 
00342              const double gain,
00343              const int ns,
00344              const double sky,
00345              const double rc,
00346              cpl_image** flt,
00347              cpl_image** out);
00348 
00349 
00350 static cpl_error_code 
00351 uves_find_next(cpl_image** msk,
00352                const int first_y,
00353                int* next_x,
00354            int* next_y);
00355 
00356 static cpl_error_code
00357 uves_sort(const int kmax,float* inp, int* ord);
00358 
00359 /*-----------------------------------------------------------------------------
00360                             Implementation
00361  ----------------------------------------------------------------------------*/
00362 
00363 
00364 /*---------------------------------------------------------------------------*/
00409 /*---------------------------------------------------------------------------*/
00410 
00411 cpl_error_code
00412 uves_rcosmic(cpl_image* ima,
00413              cpl_image** flt,
00414              cpl_image** out,
00415              cpl_image** msk,
00416              const double sky,
00417              const double ron,
00418              const double gain,
00419              const int ns,
00420              const double rc)
00421 
00422 {
00423 
00424 
00425 /*
00426 
00427 
00428       PROGRAM RCOSMIC
00429       INTEGER*4 IAV,I
00430       INTEGER*4 STATUS,MADRID,SIZEX,IOMODE
00431       INTEGER*4 NAXIS,NPIX(2),IMNI,IMNO,IMNF,IMNC
00432       INTEGER*8 PNTRI,PNTRF,PNTRO,PNTRC
00433       INTEGER*4 KUN,KNUL
00434       CHARACTER*60 IMAGE,OBJET,COSMIC
00435       CHARACTER*72 IDENT1,IDENT2,IDENT3
00436       CHARACTER*48 CUNIT
00437       DOUBLE PRECISION START(2),STEP(2)
00438       REAL*4 SKY,GAIN,RON,NS,RC,PARAM(5),CUTS(2)
00439       INCLUDE 'MID_INCLUDE:ST_DEF.INC'
00440       COMMON/VMR/MADRID(1)
00441       INCLUDE 'MID_INCLUDE:ST_DAT.INC'
00442       DATA IDENT1 /' '/
00443       DATA IDENT2 /' '/
00444       DATA IDENT3 /'cosmic ray mask '/
00445       DATA CUNIT /' '/
00446       CALL STSPRO('RCOSMIC')
00447       CALL STKRDC('IN_A',1,1,60,IAV,IMAGE,KUN,KNUL,STATUS)
00448       CALL STIGET(IMAGE,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
00449      1                2,NAXIS,NPIX,START,STEP
00450      1                ,IDENT1,CUNIT,PNTRI,IMNI,STATUS)
00451 
00452       CALL STKRDR('PARAMS',1,5,IAV,PARAM,KUN,KNUL,STATUS)
00453       CALL STIGET('middumma',D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
00454      1                2,NAXIS,NPIX,START,STEP
00455      1                ,IDENT2,CUNIT,PNTRF,IMNF,STATUS)
00456       SKY = PARAM(1)
00457       GAIN = PARAM(2)
00458       RON = PARAM(3)
00459       NS = PARAM(4)
00460       RC = PARAM(5)
00461 
00462 */
00463 
00464 
00465    check_nomsg(*flt=cpl_image_duplicate(ima));
00466    check_nomsg(uves_filter_image_median(flt,1,1,false));
00467 
00468 
00469 
00470 /*
00471 
00472       CALL STKRDC('OUTIMA',1,1,60,IAV,OBJET,KUN,KNUL,STATUS)
00473       CALL STIPUT(OBJET,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
00474      1                 NAXIS,NPIX,START,STEP
00475      1                ,IDENT1,CUNIT,PNTRO,IMNO,STATUS)
00476 
00477       SIZEX = 1
00478       DO I=1,NAXIS
00479          SIZEX = SIZEX*NPIX(I)
00480       ENDDO
00481       CALL STKRDC('COSMIC',1,1,60,IAV,COSMIC,KUN,KNUL,STATUS)
00482       IF (COSMIC(1:1).EQ.'+') THEN
00483             COSMIC = 'dummy_frame'
00484             IOMODE = F_X_MODE
00485       ELSE
00486             IOMODE = F_O_MODE
00487       ENDIF    
00488       CALL STIPUT(COSMIC,D_I2_FORMAT,IOMODE,F_IMA_TYPE
00489      1                 ,NAXIS,NPIX,START,STEP
00490      1                ,IDENT3,CUNIT,PNTRC,IMNC,STATUS)
00491       CALL COSROUT(MADRID(PNTRI),MADRID(PNTRC),NPIX(1),NPIX(2),
00492      1             RON,GAIN,NS,SKY,RC
00493      1            ,MADRID(PNTRF),MADRID(PNTRO))
00494 
00495       CUTS(1) = 0
00496       CUTS(2) = 1
00497       IF (IOMODE.EQ.F_O_MODE) 
00498      + CALL STDWRR(IMNC,'LHCUTS',CUTS,1,2,KUN,STATUS)
00499       CALL DSCUPT(IMNI,IMNO,' ',STATUS) 
00500       CALL STSEPI
00501       END
00502 
00503 
00504 */
00505 
00506    check_nomsg(uves_cosrout(ima,msk,ron,gain,ns,sky,rc,flt,out));
00507   cleanup:
00508   return CPL_ERROR_NONE;
00509 }
00510 
00511 
00512 
00513 /*---------------------------------------------------------------------------*/
00537 /*---------------------------------------------------------------------------*/
00538 
00539 static cpl_error_code 
00540 uves_cosrout(cpl_image* ima,
00541              cpl_image** msk,
00542              const double ron, 
00543              const double gain,
00544              const int ns,
00545              const double sky,
00546              const double rc,
00547              cpl_image** flt,
00548              cpl_image** out)
00549 {
00550 
00551 
00552 /*
00553 
00554       SUBROUTINE COSROUT(AI,COSMIC,I_IMA,J_IMA,RON,GAIN,
00555      1                   NS,SKY,RC,AM,AO)
00556       INTEGER I_IMA,J_IMA,NUM
00557       INTEGER ORD(10000)
00558       INTEGER K,L
00559       INTEGER IDUMAX,JDUMAX,I1,I2,J1,II,JJ
00560       INTEGER I,J,IMAX,JMAX,IMIN,JMIN
00561       INTEGER FIRST(2),NEXT(2)
00562       INTEGER*2 COSMIC(I_IMA,J_IMA)
00563       REAL*4 VECTEUR(10000),FMAX,ASUM,RC
00564       REAL*4 AI(I_IMA,J_IMA),AO(I_IMA,J_IMA),AM(I_IMA,J_IMA)
00565       REAL*4 SIGMA,SKY,S1,S2
00566       REAL*4 RON,GAIN,NS,AMEDIAN
00567 
00568 */
00569 
00570   int sx=0;
00571   int sy=0;
00572   int i=0;
00573   int j=0;
00574   int k=1;
00575   int pix=0;
00576   int first[2];
00577   int next_x=0;
00578   int next_y=0;
00579   int i_min=0;
00580   int i_max=0;
00581   int j_min=0;
00582   int j_max=0;
00583   int idu_max=0;
00584   int jdu_max=0;
00585   int i1=0;
00586   int i2=0;
00587   int ii=0;
00588   int jj=0;
00589   int j1=0;
00590   int num=0;
00591   int l=0;
00592   int nmax=1e6;
00593   int ord[nmax];
00594 
00595 
00596   float* pi=NULL;
00597   float* po=NULL;
00598   float* pf=NULL;
00599   int* pm=NULL;
00600   float sigma=0;
00601 
00602 
00603   float vec[nmax];
00604 
00605   double f_max=0;
00606   double s1=0;
00607   double s2=0;
00608   double asum=0;
00609   double a_median=0;
00610 
00611   uves_msg_warning("sky=%g gain=%g ron=%g ns=%d rc=%g",sky,gain,ron,ns,rc);
00612   check_nomsg(sx=cpl_image_get_size_x(ima));
00613   check_nomsg(sy=cpl_image_get_size_y(ima));
00614   check_nomsg(pi=cpl_image_get_data_float(ima));
00615   check_nomsg(pf=cpl_image_get_data_float(*flt));
00616   check_nomsg(pm=cpl_image_get_data_int(*msk));
00617 
00618   check_nomsg(*out=cpl_image_duplicate(ima));
00619   check_nomsg(po=cpl_image_get_data_float(*out));
00620 
00621 /*
00622 
00623       DO 10 J=1,J_IMA
00624       DO 5 I=1,I_IMA
00625       AO(I,J)=AI(I,J)
00626       COSMIC(I,J)= 0
00627     5 CONTINUE
00628    10 CONTINUE
00629 
00630 C
00631 C     La boucle suivante selectionne les pixels qui sont
00632 C     significativ+ement au dessus de l'image filtree medianement.
00633 C
00634 C    The flowing loop selects the pixels that are much higher that the 
00635 C    median filter image
00636 C
00637 C     COSMIC =-1 ----> candidate for cosmic
00638 C            = 0 ----> not a cosmic
00639 C            = 1 -----> a cosmic (at the end)
00640 C            = 2 ----> member of the group
00641 C            = 3 ----> member of a group which has been examined
00642 C            = 4 ----> neighbourhood  of the group
00643       K=1
00644       DO 80 J=2,J_IMA-1
00645       DO 70 I=2,I_IMA-1
00646       SIGMA=SQRT(RON**2+AM(I,J)/GAIN)
00647       IF ((AI(I,J)-AM(I,J)).GE.(NS*SIGMA)) THEN
00648             COSMIC(I,J) = -1
00649             K = K+1
00650       ENDIF
00651    70 CONTINUE
00652    80 CONTINUE
00653 
00654 
00655 */
00656 
00657 
00658   uves_msg_warning("Set all pix to = -1 -> candidate for cosmic");
00659   k=1;
00660   for(j=1;j<sy-1;j++) {
00661     for(i=1;i<sx-1;i++) {
00662       pix=j*sx+i;
00663       sigma=sqrt(ron*ron+pf[pix]/gain);
00664       if ( (pi[pix]-pf[pix]) >= (ns*sigma) ) {
00665     pm[pix]=-1;
00666         k++;
00667       }
00668     }
00669   }
00670 
00671 
00672   /*
00673 
00674      La boucle suivante selectionne les pixels qui sont
00675      significativement au dessus de l'image filtree medianement.
00676 
00677      The flowing loop selects the pixels that are much higher that the 
00678      median filter image
00679 
00680 
00681      COSMIC =-1 ----> candidate for cosmic
00682             = 0 ----> not a cosmic
00683             = 1 -----> a cosmic (at the end)
00684             = 2 ----> member of the group
00685             = 3 ----> member of a group which has been examined
00686             = 4 ----> neighbourhood  of the group
00687 
00688   */
00689 
00690 
00691 /*
00692   Ces pixels sont regroupes par ensembles connexes dans la boucle
00693   This pixels are gouped as grouped together if neibours
00694 */
00695 
00696   first[0]=1;
00697   first[1]=1;
00698 
00699  lab100:
00700   check_nomsg(uves_find_next(msk,first[1],&next_x, &next_y));
00701 
00702   if(next_x==-1) return CPL_ERROR_NONE;
00703   i=next_x;
00704   j=next_y;
00705 
00706   uves_msg_debug("p[%d,%d]=  2 -> member of the group",i,j);
00707   pix=j*sx+i;
00708   pm[pix]=2;
00709 
00710   i_min=i;
00711   i_max=i;
00712   j_min=j;
00713   j_max=j;
00714   idu_max=i;
00715   jdu_max=j;
00716   f_max=pi[pix];
00717 
00718  lab110:
00719   i1=0;
00720   i2=0;
00721 
00722 
00723 
00724 /*
00725       FIRST(1) = 2
00726       FIRST(2) = 2
00727   100 CALL FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
00728       IF (NEXT(1).EQ.-1) RETURN
00729       I = NEXT(1)
00730       J = NEXT(2) 
00731       COSMIC(I,J) = 2
00732       IMIN = I
00733       IMAX = I 
00734       JMIN = J
00735       JMAX = J
00736       IDUMAX = I
00737       JDUMAX = J
00738       FMAX = AI(I,J)
00739   110 I1 = 0
00740       I2 = 0
00741       CONTINUE
00742 
00743 */
00744 
00745   for(l=0;l<2;l++) {
00746     for(k=0;k<2;k++) {
00747       ii=i+k-l;
00748       jj=j+k+l-3;
00749       pix=jj*sx+ii;
00750       if(pm[pix]==-1) {
00751     i1=ii;
00752     j1=jj;
00753     i_min=(i_min<ii) ? i_min: ii;
00754     i_max=(i_max>ii) ? i_max: ii;
00755     j_min=(j_min<jj) ? j_min: jj;
00756     j_max=(j_max>jj) ? j_max: jj;
00757         uves_msg_debug("p[%d,%d]= 2 -> member of the group",ii,jj);
00758     pm[pix]=2;
00759     if(pi[pix]>f_max) {
00760       f_max=pi[pix];
00761       idu_max=ii;
00762       idu_max=jj;
00763     }
00764       } else if(pm[pix]==0) {
00765     pm[pix]=4;
00766         uves_msg_debug("p[%d,%d]= 4 -> neighbourhood  of the group",k,l);
00767       }
00768     }
00769   }
00770 
00771 
00772 /*
00773       DO 125 L=1,2
00774           DO 115 K=1,2
00775                II = I+K-L
00776                JJ = J+K+L-3
00777                IF (COSMIC(II,JJ).EQ.-1) THEN
00778                    I1 = II
00779                    J1 = JJ  
00780                    IMIN = MIN(IMIN,II) 
00781                    IMAX = MAX(IMAX,II)
00782                    JMIN = MIN(JMIN,JJ)
00783                    JMAX = MAX(JMAX,JJ)
00784                    COSMIC(II,JJ) = 2
00785                    IF (AI(II,JJ).GT.FMAX) THEN
00786                          FMAX = AI(II,JJ)
00787                          IDUMAX = II
00788                          JDUMAX = JJ
00789                    ENDIF
00790                 ELSE IF (COSMIC(II,JJ).EQ.0) THEN
00791                    COSMIC(II,JJ) = 4
00792                 ENDIF
00793   115     CONTINUE 
00794   125 CONTINUE 
00795 
00796 */
00797 
00798 
00799   pix=j*sx+i;
00800   pm[pix]=3;
00801   uves_msg_debug("p[%d,%d]= 3 -> member of a group which has been examined",i,j);
00802   if(i1 != 0) {
00803     i=i1;
00804     j=j1;
00805     goto lab110;
00806   }
00807 
00808 
00809 /*
00810       COSMIC(I,J) = 3
00811       IF (I1.NE.0) THEN
00812       I = I1
00813       J = J1
00814       GOTO 110
00815       ENDIF    
00816 */
00817 
00818   for(l=j_min;l<=j_max;l++){
00819     for(k=i_min;k<=i_max;k++){
00820       pix=l*sy+k;
00821       if(pm[pix] == 2) {
00822     i=k;
00823     j=l;
00824     goto lab110;
00825       }
00826     }
00827   }
00828   first[0] = next_x+1;
00829   first[1] = next_y; 
00830 
00831 
00832 /*
00833       DO 140 L = JMIN,JMAX  
00834          DO 130 K = IMIN,IMAX
00835               IF (COSMIC(K,L).EQ.2) THEN
00836                  I = K
00837                  J = L
00838                  GOTO 110
00839               ENDIF
00840   130 CONTINUE
00841   140 CONTINUE   
00842       FIRST(1) = NEXT(1)+1
00843       FIRST(2) = NEXT(2) 
00844 
00845 */
00846 
00847 
00848   /*
00849   We start here the real work....
00850   1- decide if the pixel's group is a cosmic
00851   2-replace these values by another one
00852   */
00853   s1=pi[(jdu_max-1)*sx+idu_max-1]+
00854      pi[(jdu_max-1)*sx+idu_max+1]+
00855      pi[(jdu_max-1)*sx+idu_max]+
00856      pi[(jdu_max+1)*sx+idu_max];
00857 
00858   s2=pi[(jdu_max+1)*sy+idu_max-1]+
00859      pi[(jdu_max+1)*sy+idu_max+1]+
00860      pi[(jdu_max)*sy+idu_max-1]+
00861      pi[(jdu_max)*sy+idu_max+1];
00862   asum=(s1+s2)/8.-sky;
00863 
00864 
00865 /*
00866 
00867 C We start here the real work....
00868 C 1- decide if the pixel's group is a cosmic
00869 C 2-replace these values by another one
00870       
00871       S1 = AI(IDUMAX-1,JDUMAX-1) + 
00872      !     AI(IDUMAX+1,JDUMAX-1) +     
00873      !     AI(IDUMAX,JDUMAX-1)   +
00874      !     AI(IDUMAX,JDUMAX+1)
00875 
00876       S2 = AI(IDUMAX-1,JDUMAX+1) + 
00877      !     AI(IDUMAX+1,JDUMAX+1) +
00878      !     AI(IDUMAX-1,JDUMAX)   + 
00879      !     AI(IDUMAX+1,JDUMAX)
00880       ASUM = (S1+S2)/8.-SKY
00881 
00882 */
00883 
00884   if((f_max-sky) > rc*asum) {
00885     num=0;
00886     for( l = j_min-1; l <= j_max+1; l++) {
00887       for( k = i_min-1; k<= i_max+1;k++) {
00888     if(pm[l*sx+k]==4) {
00889       vec[num]=pi[l*sx+k];
00890       num++;
00891     }
00892       }
00893     }
00894 
00895 
00896 /*
00897 
00898       IF ((FMAX-SKY).GT.RC*ASUM) THEN
00899          NUM = 1
00900          DO L = JMIN-1,JMAX+1
00901             DO K = IMIN-1,IMAX+1
00902                IF (COSMIC(K,L).EQ.4) THEN
00903                    VECTEUR(NUM) = AI(K,L)
00904                    NUM = NUM+1
00905                ENDIF    
00906             ENDDO
00907          ENDDO
00908 
00909 */
00910 
00911     uves_sort(num-1,vec,ord);
00912     a_median=vec[ord[(num-1)/2]];
00913     for(l = j_min-1; l <= j_max+1 ; l++){
00914       for(k = i_min-1 ; k <= i_max+1 ; k++){
00915     if(pm[l*sx+k] == 3) {
00916        pm[l*sx+k]=1;
00917            uves_msg_debug("p[%d,%d]= 1 -> a cosmic (at the end)",k,l);
00918 
00919        po[l*sx+k]=a_median;
00920     } else if (pm[l*sx+k] == 4) {
00921        po[l*sx+k]=0;
00922        po[l*sx+k]=a_median;//here we set to median instead than 0
00923     }
00924       }
00925     }
00926 
00927 
00928 /*
00929          CALL SORT(NUM-1,VECTEUR,ORD)
00930          AMEDIAN = VECTEUR(ORD((NUM-1)/2))
00931          DO L = JMIN-1,JMAX+1
00932             DO K = IMIN-1,IMAX+1
00933                IF (COSMIC(K,L).EQ.3) THEN
00934                    COSMIC(K,L) = 1
00935                    AO(K,L) = AMEDIAN
00936                ELSE IF (COSMIC(K,L).EQ.4) THEN
00937                    COSMIC(K,L) = 0
00938                ENDIF
00939             ENDDO
00940          ENDDO
00941 */
00942 
00943   } else {
00944     for( l = j_min-1 ; l <= j_max+1 ; l++) {
00945       for( k = i_min-1 ; k <= i_max+1 ; k++) {
00946     if(pm[l*sx+k] != -1) {
00947            uves_msg_debug("p[%d,%d]= 0 -> not a cosmic",k,l);
00948        pm[l*sx+k] = 0;
00949     }
00950       }
00951     }
00952   }
00953 
00954 
00955   if (next_x >0) goto lab100;
00956 
00957 
00958 /*
00959       ELSE 
00960          DO L = JMIN-1,JMAX+1
00961             DO K = IMIN-1,IMAX+1
00962                IF (COSMIC(K,L).NE.-1) COSMIC(K,L) = 0
00963             ENDDO
00964           ENDDO
00965       ENDIF
00966         
00967       
00968  
00969       IF (NEXT(1).GT.0) GOTO 100
00970 C
00971 C
00972 C
00973       RETURN
00974       END
00975 
00976 
00977 */
00978 
00979 
00980   cleanup:
00981 
00982   return CPL_ERROR_NONE;
00983 
00984 }
00985 
00986 
00987 
00988 
00989 
00990 static cpl_error_code 
00991 uves_find_next(cpl_image** msk,
00992                const int first_y,
00993                int* next_x,
00994                int* next_y)
00995 {
00996   int sx=cpl_image_get_size_x(*msk);
00997   int sy=cpl_image_get_size_y(*msk);
00998   int i=0;
00999   int j=0;
01000   int* pc=NULL;
01001   int pix=0;
01002 
01003 
01004 
01005   check_nomsg(pc=cpl_image_get_data_int(*msk));
01006   for(j=first_y;j<sy;j++) {
01007     for(i=1;i<sx;i++) {
01008       pix=j*sx+i;
01009       if(pc[pix]==-1) {
01010     *next_x=i;
01011     *next_y=j;
01012     return CPL_ERROR_NONE;
01013       }
01014     }
01015   }
01016 
01017   *next_x=-1;
01018   *next_y=-1;
01019   cleanup:
01020   return CPL_ERROR_NONE;
01021 
01022 }
01023 
01024 /*
01025 
01026       SUBROUTINE FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
01027       INTEGER I_IMA,J_IMA,FIRST(2),NEXT(2)
01028       INTEGER I,J
01029       INTEGER*2 COSMIC(I_IMA,J_IMA)
01030       DO J = FIRST(2), J_IMA
01031           DO I = 2, I_IMA
01032              IF (COSMIC(I,J).EQ.-1) THEN
01033                  NEXT(1) = I
01034                  NEXT(2) = J
01035                  RETURN
01036              ENDIF
01037           ENDDO
01038       ENDDO 
01039       NEXT(1) = -1
01040       NEXT(2) = -1
01041       RETURN
01042       END
01043 
01044 */
01045 
01046 
01047 //Be carefull with F77 and C indexing
01048 static cpl_error_code
01049 uves_sort(const int kmax,float* inp, int* ord)
01050 {
01051   int k=0;
01052   int j=0;
01053   int l=0;
01054   float f=0;
01055   int i_min=0;
01056   int i_max=0;
01057   int i=0;
01058 
01059   for(k=0;k<kmax;k++) {
01060     ord[k]=k;
01061   }
01062 
01063   if(inp[0]>inp[1]) {
01064     ord[0]=1;
01065     ord[1]=0;
01066   }
01067 
01068   for(j=2;j<kmax;j++) {
01069     f=inp[j];
01070     l=inp[j-1];
01071 
01072 /*
01073       SUBROUTINE SORT(KMAX,INP,ORD)
01074       INTEGER KMAX,IMIN,IMAX,I,J,K,L
01075       INTEGER ORD(10000)
01076       REAL*4 INP(10000),F
01077       DO 4100 J=1,KMAX
01078       ORD(J)=J
01079  4100 CONTINUE
01080       IF (INP(1).GT.INP(2)) THEN 
01081              ORD(1)=2
01082              ORD(2)=1
01083       END IF
01084       DO 4400 J=3,KMAX
01085       F=INP(J)
01086       L=ORD(J-1)
01087 */
01088 
01089   if(inp[l]<=f) goto lab4400;
01090     l=ord[0];
01091     i_min=0;
01092     if(f<=inp[l]) goto lab4250;
01093     i_max=j-1;
01094   lab4200:
01095     i=(i_min+i_max)/2;
01096     l=ord[i];
01097 
01098 /*
01099       IF (INP(L).LE.F) GO TO 4400
01100       L=ORD(1)
01101       IMIN=1
01102       IF (F.LE.INP(L)) GO TO 4250
01103       IMAX=J-1
01104  4200 I=(IMIN+IMAX)/2
01105       L=ORD(I)
01106 */
01107 
01108     if(inp[l]<f) {
01109       i_min=i;
01110     } else {
01111       i_max=i;
01112     }
01113     if(i_max>(i_min+1)) goto lab4200;
01114     i_min=i_max;
01115   lab4250:
01116     for(k=j-2;k>=i_min;k--) {
01117       ord[k+1]=ord[k];
01118     }
01119     ord[i_min]=j;
01120   lab4400:
01121     return CPL_ERROR_NONE;
01122   }
01123     return CPL_ERROR_NONE;
01124 }
01125 
01126 /*
01127       IF (INP(L).LT.F) THEN
01128               IMIN=I
01129               ELSE
01130               IMAX=I
01131       END IF
01132       IF (IMAX.GT.(IMIN+1)) GO TO 4200
01133       IMIN=IMAX
01134  4250 DO 4300 K=J-1,IMIN,-1
01135       ORD(K+1)=ORD(K)
01136  4300 CONTINUE
01137       ORD(IMIN)=J
01138  4400 CONTINUE
01139       RETURN
01140       END
01141 */
01142 
01143 /*---------------------------------------------------------------------------*/
01149 /*---------------------------------------------------------------------------*/
01150 
01151 cpl_parameterlist* 
01152 uves_parameterlist_duplicate(const cpl_parameterlist* pin){
01153 
01154    cpl_parameter* p=NULL;
01155    cpl_parameterlist* pout=NULL;
01156 
01157    pout=cpl_parameterlist_new();
01158    p=cpl_parameterlist_get_first((cpl_parameterlist*)pin);
01159    while (p != NULL)
01160    {
01161       cpl_parameterlist_append(pout,p);
01162       p=cpl_parameterlist_get_next((cpl_parameterlist*)pin);
01163    }
01164    return pout;
01165 
01166 }
01183 const char*
01184 uves_string_toupper(char* s)
01185 {
01186 
01187     char *t = s;
01188 
01189     assert(s != NULL);
01190 
01191     while (*t) {
01192         *t = toupper(*t);
01193         t++;
01194     }
01195 
01196     return s;
01197 
01198 }
01199 
01215 const char*
01216 uves_string_tolower(char* s)
01217 {
01218 
01219     char *t = s;
01220 
01221     assert(s != NULL);
01222 
01223     while (*t) {
01224         *t = tolower(*t);
01225         t++;
01226     }
01227 
01228     return s;
01229 
01230 }
01231 
01232 
01233 
01234 
01235 /*----------------------------------------------------------------------------*/
01242 /*----------------------------------------------------------------------------*/
01243 cpl_frameset *
01244 uves_frameset_extract(const cpl_frameset *frames,
01245                       const char *tag)
01246 {
01247     cpl_frameset *subset = NULL;
01248     const cpl_frame *f;
01249 
01250 
01251 
01252     assure( frames != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null frameset" );
01253     assure( tag    != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null tag" );
01254     
01255     subset = cpl_frameset_new();
01256 
01257     for (f = cpl_frameset_find_const(frames, tag);
01258          f != NULL;
01259          f = cpl_frameset_find_const(frames, NULL)) {
01260 
01261         cpl_frameset_insert(subset, cpl_frame_duplicate(f));
01262     }
01263 
01264  cleanup:
01265     return subset;
01266 }
01267 
01268 /*----------------------------------------------------------------------------*/
01278 /*----------------------------------------------------------------------------*/
01279 inline double
01280 uves_pow_int(double x, int y)
01281 {
01282     double result = 1.0;
01283 
01284     /* Invariant is:   result * x ^ y   */
01285     
01286 
01287     while(y != 0)
01288     {
01289         if (y % 2 == 0)
01290         {
01291             x *= x;
01292             y /= 2;
01293         }
01294         else
01295         {
01296             if (y > 0)
01297             {
01298                 result *= x;
01299                 y -= 1;            
01300             }
01301             else
01302             {
01303                 result /= x;
01304                 y += 1;            
01305             }
01306         }
01307     }
01308     
01309     return result;
01310 }
01311 
01312 
01313 
01314 
01315 /*----------------------------------------------------------------------------*/
01324 /*----------------------------------------------------------------------------*/
01325 inline long
01326 uves_round_double(double x)
01327 {
01328     return (x >=0) ? (long)(x+0.5) : (long)(x-0.5);
01329 }
01330 
01331 /*----------------------------------------------------------------------------*/
01340 /*----------------------------------------------------------------------------*/
01341 inline double
01342 uves_max_double(double x, double y)
01343 {
01344     return (x >=y) ? x : y;
01345 }
01346 /*----------------------------------------------------------------------------*/
01355 /*----------------------------------------------------------------------------*/
01356 inline int
01357 uves_max_int(int x, int y)
01358 {
01359     return (x >=y) ? x : y;
01360 }
01361 
01362 /*----------------------------------------------------------------------------*/
01371 /*----------------------------------------------------------------------------*/
01372 inline double
01373 uves_min_double(double x, double y)
01374 {
01375     return (x <=y) ? x : y;
01376 }
01377 /*----------------------------------------------------------------------------*/
01386 /*----------------------------------------------------------------------------*/
01387 inline int
01388 uves_min_int(int x, int y)
01389 {
01390     return (x <=y) ? x : y;
01391 }
01392 
01393 /*----------------------------------------------------------------------------*/
01404 /*----------------------------------------------------------------------------*/
01405 inline double
01406 uves_error_fraction(double x, double y, double dx, double dy)
01407 {
01408     /* Error propagation:
01409      * sigma(x/y)^2 = (1/y sigma(x))^2 + (-x/y^2 sigma(y))^2 
01410      */
01411     return sqrt( dx*dx/(y*y) + x*x*dy*dy/(y*y*y*y) );
01412 }
01413 
01414 
01415 
01416 /*----------------------------------------------------------------------------*/
01425 /*----------------------------------------------------------------------------*/
01426 cpl_error_code
01427 uves_get_version(int *major, int *minor, int *micro)
01428 {
01429     /* Macros are defined in config.h */
01430     if (major != NULL) *major = UVES_MAJOR_VERSION;
01431     if (minor != NULL) *minor = UVES_MINOR_VERSION;
01432     if (micro != NULL) *micro = UVES_MICRO_VERSION;
01433 
01434     return cpl_error_get_code();
01435 }
01436 
01437 
01438 /*----------------------------------------------------------------------------*/
01444 /*----------------------------------------------------------------------------*/
01445 int
01446 uves_get_version_binary(void)
01447 {
01448     return UVES_BINARY_VERSION;
01449 }
01450 
01451 
01452 /*----------------------------------------------------------------------------*/
01460 /*----------------------------------------------------------------------------*/
01461 const char *
01462 uves_get_license(void)
01463 {
01464     return
01465     "This file is part of the ESO UVES Instrument Pipeline\n"
01466     "Copyright (C) 2004,2005,2006 European Southern Observatory\n"
01467     "\n"
01468     "This program is free software; you can redistribute it and/or modify\n"
01469     "it under the terms of the GNU General Public License as published by\n"
01470     "the Free Software Foundation; either version 2 of the License, or\n"
01471     "(at your option) any later version.\n"
01472     "\n"
01473     "This program is distributed in the hope that it will be useful,\n"
01474     "but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
01475     "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n"
01476         "GNU General Public License for more details.\n"
01477         "\n"
01478         "You should have received a copy of the GNU General Public License\n"
01479         "along with this program; if not, write to the Free Software\n"
01480         "Foundation, 51 Franklin St, Fifth Floor, Boston, \n"
01481         "MA  02111-1307  USA" ;
01482 
01483     /* Note that long strings are unsupported in C89 */
01484 }
01485 
01486 /*----------------------------------------------------------------------------*/
01496 /*----------------------------------------------------------------------------*/
01497 /* To change requirements, just edit these numbers */
01498 #define REQ_CPL_MAJOR 3
01499 #define REQ_CPL_MINOR 1
01500 #define REQ_CPL_MICRO 0
01501 
01502 #define REQ_QF_MAJOR 6
01503 #define REQ_QF_MINOR 2
01504 #define REQ_QF_MICRO 0
01505 
01506 void
01507 uves_check_version(void)
01508 {
01509 #ifdef CPL_VERSION_CODE
01510 #if CPL_VERSION_CODE >= CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO)
01511     uves_msg_debug("Compile time CPL version code was %d "
01512                    "(version %d-%d-%d, code %d required)",
01513                    CPL_VERSION_CODE, REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO,
01514                    CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO));
01515 #else
01516 #error CPL version too old
01517 #endif
01518 #else  /* ifdef CPL_VERSION_CODE */
01519 #error CPL_VERSION_CODE not defined. CPL version too old
01520 #endif
01521 
01522     if (cpl_version_get_major() < REQ_CPL_MAJOR ||
01523     (cpl_version_get_major() == REQ_CPL_MAJOR && 
01524      (int) cpl_version_get_minor() < REQ_CPL_MINOR) || /* cast suppresses warning
01525                                                               about comparing unsigned < 0 */
01526     (cpl_version_get_major() == REQ_CPL_MAJOR &&
01527      cpl_version_get_minor() == REQ_CPL_MINOR && 
01528      (int) cpl_version_get_micro() < REQ_CPL_MICRO)
01529     )
01530     {
01531         uves_msg_warning("CPL version %s (%d.%d.%d) (detected) is not supported. "
01532                  "Please update to CPL version %d.%d.%d or later", 
01533                  cpl_version_get_version(),
01534                  cpl_version_get_major(),
01535                  cpl_version_get_minor(),
01536                  cpl_version_get_micro(),
01537                  REQ_CPL_MAJOR,
01538                  REQ_CPL_MINOR,
01539                  REQ_CPL_MICRO);
01540     }
01541     else
01542     {
01543         uves_msg_debug("Runtime CPL version %s (%d.%d.%d) detected (%d.%d.%d or later required)",
01544                cpl_version_get_version(),
01545                cpl_version_get_major(),
01546                cpl_version_get_minor(),
01547                cpl_version_get_micro(),
01548                REQ_CPL_MAJOR,
01549                REQ_CPL_MINOR,
01550                REQ_CPL_MICRO);
01551     }
01552 
01553     {
01554     const char *qfts_v = " ";
01555     char *suffix;
01556     
01557     long qfts_major;
01558     long qfts_minor;
01559     long qfts_micro;
01560 
01561     qfts_v = qfits_version();
01562 
01563     assure( qfts_v != NULL, CPL_ERROR_ILLEGAL_INPUT,
01564         "Error reading qfits version");
01565 
01566     /* Parse    "X.[...]" */
01567     qfts_major = strtol(qfts_v, &suffix, 10);
01568     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
01569         CPL_ERROR_ILLEGAL_INPUT, 
01570         "Error parsing version string '%s'. "
01571         "Format 'X.Y.Z' expected", qfts_v);
01572 
01573     /* Parse    "Y.[...]" */
01574     qfts_minor = strtol(suffix+1, &suffix, 10);
01575     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
01576         CPL_ERROR_ILLEGAL_INPUT,
01577         "Error parsing version string '%s'. "
01578         "Format 'X.Y.Z' expected", qfts_v);
01579 
01580     /* Parse    "Z" */
01581     qfts_micro = strtol(suffix+1, &suffix, 10);
01582 
01583     /* If qfits version is earlier than required ... */
01584     if (qfts_major < REQ_QF_MAJOR ||
01585         (qfts_major == REQ_QF_MAJOR && qfts_minor  < REQ_QF_MINOR) ||
01586         (qfts_major == REQ_QF_MAJOR && qfts_minor == REQ_QF_MINOR && 
01587          qfts_micro < REQ_QF_MICRO)
01588         )
01589         {
01590         uves_msg_warning("qfits version %s (detected) is not supported. "
01591                  "Please update to qfits version %d.%d.%d or later", 
01592                  qfts_v,
01593                  REQ_QF_MAJOR,
01594                  REQ_QF_MINOR,
01595                  REQ_QF_MICRO);
01596         }
01597     else
01598         {
01599         uves_msg_debug("qfits version %ld.%ld.%ld detected "
01600                    "(%d.%d.%d or later required)", 
01601                    qfts_major, qfts_minor, qfts_micro,
01602                    REQ_QF_MAJOR,
01603                    REQ_QF_MINOR,
01604                    REQ_QF_MICRO);
01605         }
01606     }
01607     
01608   cleanup:
01609     return;
01610 }
01611 
01612 /*----------------------------------------------------------------------------*/
01624 /*----------------------------------------------------------------------------*/
01625 cpl_error_code
01626 uves_end(const char *recipe_id, const cpl_frameset *frames)
01627 {
01628     cpl_frameset *products = NULL;
01629     const cpl_frame *f;
01630     int warnings = uves_msg_get_warnings();
01631 
01632     recipe_id = recipe_id; /* Suppress warning about unused variable,
01633                   perhaps we the recipe_id later, so
01634                   keep it in the interface. */
01635 
01636 
01637     /* Print (only) output frames */
01638 
01639     products = cpl_frameset_new();
01640     assure_mem( products );
01641 
01642     for (f = cpl_frameset_get_first_const(frames);
01643      f != NULL;
01644      f = cpl_frameset_get_next_const(frames))
01645     {
01646         if (cpl_frame_get_group(f) == CPL_FRAME_GROUP_PRODUCT)
01647         {
01648             check_nomsg(
01649             cpl_frameset_insert(products, cpl_frame_duplicate(f)));
01650         }
01651     }
01652 
01653 /* Don't do this. EsoRex should.
01654    uves_msg_low("Output frames");
01655    check( uves_print_cpl_frameset(products),
01656    "Could not print output frames");
01657 */
01658 
01659     /* Summarize warnings, if any */
01660     if( warnings > 0)
01661     {
01662         uves_msg_warning("Recipe produced %d warning%s (excluding this one)",
01663                  uves_msg_get_warnings(),
01664                  /* Plural? */ (warnings > 1) ? "s" : "");
01665     }
01666 
01667   cleanup:
01668     uves_free_frameset(&products);
01669     return cpl_error_get_code();    
01670 }
01671 
01672 /*----------------------------------------------------------------------------*/
01693 /*----------------------------------------------------------------------------*/
01694 char *
01695 uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist, 
01696         const char *recipe_id, const char *short_descr)
01697 {
01698     char *recipe_string = NULL;
01699     char *stars = NULL;     /* A string of stars */
01700     char *spaces1 = NULL;
01701     char *spaces2 = NULL;
01702     char *spaces3 = NULL;
01703     char *spaces4 = NULL;
01704     char *start_time = NULL;
01705 
01706     start_time = uves_sprintf("%s", qfits_get_datetime_iso8601());
01707 
01708     check( uves_check_version(), "Library validation failed");
01709 
01710     /* Now read parameters and set specified message level */
01711     {
01712     const char *plotter_command;
01713     int msglevel;
01714     
01715     /* Read parameters using context = recipe_id */
01716 
01717         if (0) /* disabled */
01718             check( uves_get_parameter(parlist, NULL, "uves", "msginfolevel", 
01719                                       CPL_TYPE_INT, &msglevel),
01720                    "Could not read parameter");
01721         else
01722             {
01723                 msglevel = -1; /* max verbosity */
01724             }
01725     uves_msg_set_level(msglevel);
01726     check( uves_get_parameter(parlist, NULL, "uves", "plotter",
01727                   CPL_TYPE_STRING, &plotter_command), "Could not read parameter");
01728     
01729     /* Initialize plotting */
01730     check( uves_plot_initialize(plotter_command), 
01731            "Could not initialize plotting");
01732     }    
01733 
01734     /* Print 
01735      *************************
01736      ***   PACAGE_STRING   ***
01737      *** Recipe: recipe_id ***
01738      *************************
01739      */
01740     recipe_string = uves_sprintf("Recipe: %s", recipe_id);
01741     {
01742     int field = uves_max_int(strlen(PACKAGE_STRING), strlen(recipe_string));
01743     int nstars = 3+1 + field + 1+3;
01744     int nspaces1, nspaces2, nspaces3, nspaces4;
01745     int i;
01746     
01747     /* ' ' padding */
01748     nspaces1 = (field - strlen(PACKAGE_STRING)) / 2; 
01749     nspaces2 = field - strlen(PACKAGE_STRING) - nspaces1;
01750 
01751     nspaces3 = (field - strlen(recipe_string)) / 2;
01752     nspaces4 = field - strlen(recipe_string) - nspaces3;
01753 
01754     spaces1 = cpl_calloc(nspaces1 + 1, sizeof(char)); 
01755     spaces2 = cpl_calloc(nspaces2 + 1, sizeof(char));
01756     spaces3 = cpl_calloc(nspaces3 + 1, sizeof(char)); 
01757     spaces4 = cpl_calloc(nspaces4 + 1, sizeof(char));
01758     for (i = 0; i < nspaces1; i++) spaces1[i] = ' ';
01759     for (i = 0; i < nspaces2; i++) spaces2[i] = ' ';
01760     for (i = 0; i < nspaces3; i++) spaces3[i] = ' ';
01761     for (i = 0; i < nspaces4; i++) spaces4[i] = ' ';
01762 
01763     stars = cpl_calloc(nstars + 1, sizeof(char));
01764     for (i = 0; i < nstars; i++) stars[i] = '*';
01765     
01766     uves_msg("%s", stars);
01767     uves_msg("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
01768     uves_msg("*** %s%s%s ***", spaces3, recipe_string, spaces4);
01769     uves_msg("%s", stars);
01770     }
01771 
01772     uves_msg("This recipe %c%s", tolower(short_descr[0]), short_descr+1);
01773 
01774     if (cpl_frameset_is_empty(frames)) {
01775         uves_msg_debug("Guvf cvcryvar unf ernpurq vgf uvtu dhnyvgl qhr na npgvir "
01776                        "hfre pbzzhavgl naq gur erfcbafvoyr naq vqrnyvfgvp jbex bs "
01777                        "vaqvivqhny cvcryvar qrirybcref, naq qrfcvgr orvat 'onfrq ba' "
01778                        "PCY juvpu vf n cvrpr bs cbyvgvpny penc");
01779     }
01780 
01781     /* Set group (RAW/CALIB) of input frames */
01782     /* This is mandatory for the later call of 
01783        cpl_dfs_setup_product_header */
01784     check( uves_dfs_set_groups(frames), "Could not classify input frames");
01785 
01786     /* Print input frames */
01787     uves_msg_low("Input frames");
01788     check( uves_print_cpl_frameset(frames), "Could not print input frames" );
01789 
01790   cleanup:
01791     cpl_free(recipe_string);
01792     cpl_free(stars);
01793     cpl_free(spaces1);
01794     cpl_free(spaces2);
01795     cpl_free(spaces3);
01796     cpl_free(spaces4);
01797     return start_time;
01798 }
01799 
01800 
01801 /*----------------------------------------------------------------------------*/
01829 /*----------------------------------------------------------------------------*/
01830 cpl_image *
01831 uves_average_images(const cpl_image *image1, const cpl_image *noise1,
01832             const cpl_image *image2, const cpl_image *noise2,
01833             cpl_image **noise)
01834 {
01835     cpl_image *result = NULL;
01836     int nx, ny, x, y;
01837 
01838     /* Check input */
01839     assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
01840     assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
01841     assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
01842     assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
01843     assure( noise  != NULL, CPL_ERROR_NULL_INPUT, "Null image");
01844 
01845     assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
01846         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
01847     assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
01848         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
01849     
01850     nx = cpl_image_get_size_x(image1);
01851     ny = cpl_image_get_size_y(image1);
01852 
01853     assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT, 
01854         "Size mismatch %d != %d",
01855         nx,   cpl_image_get_size_x(image2));
01856     assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT, 
01857         "Size mismatch %d != %d", 
01858         nx,   cpl_image_get_size_x(noise1));
01859     assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
01860         "Size mismatch %d != %d", 
01861         nx,   cpl_image_get_size_x(noise2));
01862     assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
01863         "Size mismatch %d != %d", 
01864         ny,   cpl_image_get_size_y(image2));
01865     assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
01866         "Size mismatch %d != %d", 
01867         ny,   cpl_image_get_size_y(noise1));
01868     assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
01869         "Size mismatch %d != %d", 
01870         ny,   cpl_image_get_size_y(noise2));
01871     
01872     result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
01873     *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
01874 
01875     /* Do the calculation */
01876     for (y = 1; y <= ny; y++)
01877     {
01878         for (x = 1; x <= nx; x++)
01879         {
01880             double flux1, flux2;
01881             double sigma1, sigma2;
01882             int pis_rejected1, noise_rejected1;
01883             int pis_rejected2, noise_rejected2;
01884 
01885             flux1  = cpl_image_get(image1, x, y, &pis_rejected1);
01886             flux2  = cpl_image_get(image2, x, y, &pis_rejected2);
01887             sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
01888             sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);
01889 
01890             pis_rejected1 = pis_rejected1 || noise_rejected1;
01891             pis_rejected2 = pis_rejected2 || noise_rejected2;
01892             
01893             if (pis_rejected1 && pis_rejected2)
01894             {
01895                 cpl_image_reject(result, x, y);
01896                 cpl_image_reject(*noise, x, y);
01897             }
01898             else
01899             {
01900                 /* At least one good pixel */
01901 
01902                 double flux, sigma;
01903                 
01904                 if (pis_rejected1 && !pis_rejected2)
01905                 {
01906                     flux = flux2;
01907                     sigma = sigma2;
01908                 }
01909                 else if (!pis_rejected1 && pis_rejected2)
01910                 {
01911                     flux = flux1;
01912                     sigma = sigma1;
01913                 }
01914                 else
01915                 {
01916                     /* Both pixels are good */
01917                     sigma =
01918                     1 / (sigma1*sigma1) +
01919                     1 / (sigma2*sigma2);
01920                     
01921                     flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
01922                     flux /= sigma;
01923                     
01924                     sigma = sqrt(sigma);
01925                 }
01926                 
01927                 cpl_image_set(result, x, y, flux);
01928                 cpl_image_set(*noise, x, y, sigma);
01929             }
01930         }
01931     }
01932     
01933   cleanup:
01934     if (cpl_error_get_code() != CPL_ERROR_NONE) 
01935     {
01936         uves_free_image(&result);
01937     }
01938     return result;
01939 }
01940 
01941 /*----------------------------------------------------------------------------*/
01956 /*----------------------------------------------------------------------------*/
01957 uves_propertylist *
01958 uves_initialize_image_header(const char *ctype1, const char *ctype2, const char *bunit,
01959                  double crval1, double crval2,
01960                  double crpix1, double crpix2,
01961                  double cdelt1, double cdelt2)
01962 {
01963     uves_propertylist *header = NULL;  /* Result */
01964 
01965     header = uves_propertylist_new();
01966 
01967     check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
01968     check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
01969     check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
01970     check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
01971     check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
01972     check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
01973     check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
01974     check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
01975     check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
01976     
01977   cleanup:
01978     return header;
01979 }
01980 
01981 /*----------------------------------------------------------------------------*/
01999 /*----------------------------------------------------------------------------*/
02000 cpl_image *
02001 uves_define_noise(const cpl_image *image, const uves_propertylist *image_header, 
02002           int ncom, enum uves_chip chip)
02003 {
02004     /*
02005           \/  __
02006            \_(__)_...
02007     */
02008 
02009     cpl_image *noise = NULL;      /* Result */
02010 
02011     /* cpl_image *in_med = NULL;     Median filtered input image */
02012 
02013     double ron;                   /* Read-out noise in ADU */
02014     double gain;
02015     int nx, ny, i;
02016     double *noise_data;
02017     const double *image_data;
02018     
02019     /* Read, check input parameters */
02020     assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
02021     
02022     check( ron = uves_pfits_get_ron_adu(image_header, chip),
02023        "Could not read read-out noise");
02024     
02025     check( gain = uves_pfits_get_gain(image_header, chip),
02026        "Could not read gain factor");
02027     assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);
02028 
02029     nx = cpl_image_get_size_x(image);
02030     ny = cpl_image_get_size_y(image);
02031 
02032     /* For efficiency reasons, use pointers to image data buffers */
02033     assure(cpl_image_count_rejected(image) == 0, 
02034        CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
02035     assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
02036        CPL_ERROR_UNSUPPORTED_MODE, 
02037        "Input image is of type %s. double expected", 
02038        uves_tostring_cpl_type(cpl_image_get_type(image)));
02039 
02040     noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
02041     assure_mem( noise );
02042 
02043     noise_data = cpl_image_get_data_double(noise);
02044 
02045     image_data = cpl_image_get_data_double_const(image);
02046 
02047 
02048     /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */
02049 
02050     /* This filter is disabled, as there is often structure on the scale
02051        of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
02052        structure *does* result in worse fits to the data.
02053 
02054        in_med = cpl_image_duplicate(image);
02055        assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
02056        
02057        uves_msg_low("Applying 3x3 median filter");
02058        
02059        check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
02060        image_data = cpl_image_get_data_double(in_med);
02061        
02062        uves_msg_low("Setting pixel flux uncertainty");
02063     */
02064 
02065     for (i = 0; i < nx*ny; i++)
02066     {
02067         double flux;
02068         
02069         /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
02070         /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
02071         flux = image_data[i];
02072         {
02073         double flux_e    = uves_max_double(0, flux) / gain;  /* Flux  (e-)          */
02074         double sigma_e   = sqrt(flux_e);                     /* Photonic noise (e-) */
02075         double sigma_adu = sigma_e * gain;                   /* Photonic noise (ADU)*/
02076         double quant_var = uves_max_double(0, (gain*gain - 1)/12.0);/* Quant. error =
02077                                          * sqrt((g^2-1)/12)
02078                                          */
02079         /* For a number, N, of averaged or median stacked "identical" frames
02080          * (gaussian distribution assumed), the combined noise is
02081          *
02082          *  sigma_N = sigma / sqrt(N*f)
02083          *
02084          *  where (to a good approximation)
02085          *        f ~= { 1    , N = 1
02086          *             { 2/pi , N > 1
02087          *
02088          *  (i.e. the resulting uncertainty is
02089          *   larger than for average stacked inputs where f = 1)
02090          */
02091         
02092         /* We assume median stacked input (master flat, master dark, ...) */
02093         double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
02094         
02095         /* Slow: cpl_image_set(noise, x, y, ... ); */
02096         /* Slow: noise_data[(x-1) + (y-1)*nx] = 
02097                  sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
02098               ((MIDAS) ? 1 : ncom * median_factor)); */
02099         noise_data[i] = sqrt((ron*ron + quant_var + sigma_adu*sigma_adu)
02100                      / (ncom * median_factor));
02101         }
02102     }
02103 
02104   cleanup:
02105     /* uves_free_image(&in_med); */
02106     if (cpl_error_get_code() != CPL_ERROR_NONE)
02107     {
02108         uves_free_image(&noise);
02109     }
02110 
02111     return noise;
02112 }
02113 
02114 
02115 /*----------------------------------------------------------------------------*/
02125 /*----------------------------------------------------------------------------*/
02126 cpl_error_code
02127 uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
02128 {
02129     passure ( image != NULL, " ");
02130     passure ( master_bias != NULL, " ");
02131 
02132     check( cpl_image_subtract(image, master_bias),
02133        "Error subtracting bias");
02134 
02135     /* Due to different bad column correction in image/master_bias,
02136        it might happen that the image has become negative after 
02137        subtracting the bias. Disallow that. */
02138 
02139 #if 0
02140     /* No, for backwards compatibility, allow negative values.
02141      * MIDAS has an inconsistent logic on this matter.
02142      * For master dark frames, the thresholding *is* applied,
02143      * but not for science frames. Therefore we have to
02144      * apply thresholding on a case-by-case base (i.e. from
02145      * the caller).
02146      */
02147     check( cpl_image_threshold(image, 
02148                    0, DBL_MAX,     /* Interval */
02149                    0, DBL_MAX),    /* New values */
02150        "Error thresholding image");
02151 #endif
02152 
02153   cleanup:
02154     return cpl_error_get_code();
02155 }
02156 /*----------------------------------------------------------------------------*/
02169 /*----------------------------------------------------------------------------*/
02170 cpl_error_code
02171 uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
02172            const cpl_image *master_dark,
02173            const uves_propertylist *mdark_header)
02174 {
02175     cpl_image *normalized_mdark = NULL;
02176     double image_exptime = 0.0;
02177     double mdark_exptime = 0.0;
02178 
02179     passure ( image != NULL, " ");
02180     passure ( image_header != NULL, " ");
02181     passure ( master_dark != NULL, " ");
02182     passure ( mdark_header != NULL, " ");
02183 
02184     /* Normalize mdark to same exposure time as input image, then subtract*/
02185     check( image_exptime = uves_pfits_get_exptime(image_header), 
02186        "Error reading input image exposure time");
02187     check( mdark_exptime = uves_pfits_get_exptime(mdark_header), 
02188        "Error reading master dark exposure time");
02189     
02190     uves_msg("Rescaling master dark from %f s to %f s exposure time", 
02191          mdark_exptime, image_exptime);
02192     
02193     check( normalized_mdark = 
02194        cpl_image_multiply_scalar_create(master_dark,
02195                         image_exptime / mdark_exptime),
02196        "Error normalizing master dark");
02197     
02198     check( cpl_image_subtract(image, normalized_mdark), 
02199        "Error subtracting master dark");
02200 
02201   cleanup:
02202     uves_free_image(&normalized_mdark);
02203     return cpl_error_get_code();
02204 }
02205 
02206 /*----------------------------------------------------------------------------*/
02220 /*----------------------------------------------------------------------------*/
02221 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
02222 {
02223     return (first_abs_order +
02224         (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
02225 }
02226 
02227 /*----------------------------------------------------------------------------*/
02241 /*----------------------------------------------------------------------------*/
02242 double
02243 uves_average_reject(cpl_table *t,
02244                     const char *column,
02245                     const char *residual2,
02246                     double kappa)
02247 {
02248     double mean = 0, median, sigma2;
02249     int rejected;
02250     
02251     do {
02252         /* Robust estimation */
02253         median = cpl_table_get_column_median(t, column);
02254 
02255         /* Create column
02256            residual2 = (column - median)^2   */
02257         cpl_table_duplicate_column(t, residual2, t, column);
02258         cpl_table_subtract_scalar(t, residual2, median);
02259         cpl_table_multiply_columns(t, residual2, residual2);
02260 
02261         /* For a Gaussian distribution:
02262          * sigma    ~= median(|residual|) / 0.6744
02263          * sigma^2  ~= median(residual^2) / 0.6744^2  
02264          */
02265 
02266         sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744);
02267 
02268         /* Reject values where
02269            residual^2 > (kappa*sigma)^2
02270         */
02271     check_nomsg( rejected = uves_erase_table_rows(t, residual2,
02272                                                       CPL_GREATER_THAN,
02273                                                       kappa*kappa*sigma2));
02274         
02275         cpl_table_erase_column(t, residual2);
02276 
02277     } while (rejected > 0);
02278 
02279     mean  = cpl_table_get_column_mean(t, column);
02280     
02281   cleanup:
02282     return mean;
02283 }
02284 
02285 /*----------------------------------------------------------------------------*/
02318 /*----------------------------------------------------------------------------*/
02319 polynomial *
02320 uves_polynomial_regression_1d(cpl_table *t,
02321                   const char *X, const char *Y, const char *sigmaY, 
02322                   int degree, 
02323                   const char *polynomial_fit, const char *residual_square,
02324                   double *mean_squared_error, double kappa)
02325 {
02326     int N;
02327     int total_rejected = 0;  /* Rejected in kappa sigma clipping */
02328     int rejected = 0;
02329     double mse;                  /* local mean squared error */
02330     double *x;
02331     double *y;
02332     double *sy;
02333     polynomial *result = NULL;
02334     cpl_vector *vx = NULL;
02335     cpl_vector *vy = NULL;
02336     cpl_vector *vsy = NULL;
02337     cpl_type type;
02338 
02339     /* Check input */
02340     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
02341     assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
02342     assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
02343     assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
02344     assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
02345     assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
02346         "No such column: %s", sigmaY);
02347 
02348     assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
02349         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
02350 
02351     assure( residual_square == NULL || !cpl_table_has_column(t, residual_square), 
02352         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
02353     
02354     /* Check column types */
02355     type = cpl_table_get_column_type(t, Y);
02356     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE, 
02357         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
02358     type = cpl_table_get_column_type(t, X);
02359     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
02360         "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
02361     if (sigmaY != NULL)
02362     {
02363         type = cpl_table_get_column_type(t, sigmaY);
02364         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
02365             CPL_ERROR_INVALID_TYPE, 
02366             "Input column '%s' has wrong type (%s)", 
02367             sigmaY, uves_tostring_cpl_type(type));
02368     }
02369 
02370     check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
02371        "Could not cast table column '%s' to double", X);
02372     check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
02373        "Could not cast table column '%s' to double", Y);
02374     if (sigmaY != NULL)
02375     {
02376         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
02377            "Could not cast table column '%s' to double", sigmaY);
02378     } 
02379     
02380     total_rejected = 0;
02381     rejected = 0;
02382     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
02383        "Could not create column");
02384     do{
02385     check( (N = cpl_table_get_nrow(t),
02386         x = cpl_table_get_data_double(t, "_X_double"),
02387         y = cpl_table_get_data_double(t, "_Y_double")),
02388            "Could not read table data");
02389     
02390     if (sigmaY != NULL) 
02391         {
02392         check( sy = cpl_table_get_data_double(t,  "_sY_double"),
02393                "Could not read table data");
02394         } 
02395     else 
02396         {
02397         sy = NULL;
02398         }
02399     
02400     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
02401 
02402     /* Wrap vectors */
02403     uves_unwrap_vector(&vx);
02404     uves_unwrap_vector(&vy);
02405     
02406     vx = cpl_vector_wrap(N, x);
02407     vy = cpl_vector_wrap(N, y);
02408        
02409     if (sy != NULL)
02410         {
02411         uves_unwrap_vector(&vsy);
02412         vsy = cpl_vector_wrap(N, sy);
02413         }
02414     else
02415         {
02416         vsy = NULL;
02417         }
02418      
02419     /* Fit! */
02420     uves_polynomial_delete(&result);
02421     check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse), 
02422            "Could not fit polynomial");
02423     
02424     /* If requested, calculate residuals and perform kappa-sigma clipping */
02425     if (kappa > 0)
02426         {
02427         double sigma2;   /* sigma squared */
02428         int i;
02429         
02430         for (i = 0; i < N; i++)
02431             {
02432             double xval, yval, yfit;
02433             
02434             check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
02435                 yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
02436                 yfit = uves_polynomial_evaluate_1d(result, xval),
02437     
02438                 cpl_table_set_double(t, "_residual_square", i, 
02439                              (yfit-yval)*(yfit-yval))),
02440                 "Could not evaluate polynomial");
02441             }
02442         
02443         /* For robustness, estimate sigma as (third quartile) / 0.6744
02444          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
02445          * The third quartile is estimated as the median of the absolute residuals,
02446          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
02447          *     sigma^2  ~= median(residual^2) / 0.6744^2  
02448          */
02449         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
02450 
02451         /* Remove points with residual^2 > kappa^2 * sigma^2 */
02452         check( rejected = uves_erase_table_rows(t, "_residual_square", 
02453                             CPL_GREATER_THAN, kappa*kappa*sigma2),
02454                "Could not remove outlier points");
02455         
02456         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
02457                    rejected, N, sqrt(mse));
02458         
02459         /* Update */
02460         total_rejected += rejected;
02461         N = cpl_table_get_nrow(t);
02462         }
02463     
02464 } while (rejected > 0);
02465     
02466     cpl_table_erase_column(t,  "_residual_square");    
02467     
02468     if (kappa > 0)
02469     {    
02470         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
02471               total_rejected,
02472               N + total_rejected,
02473               (100.0*total_rejected)/(N + total_rejected)
02474         );
02475     }
02476     
02477     if (mean_squared_error != NULL) *mean_squared_error = mse;
02478     
02479     /* Add the fitted values to table if requested */
02480     if (polynomial_fit != NULL || residual_square != NULL)
02481     {
02482         int i;
02483         
02484         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
02485            "Could not create column");
02486         for (i = 0; i < N; i++){
02487         double xval;
02488         double yfit;
02489         
02490         check((
02491               xval = cpl_table_get_double(t, "_X_double", i, NULL),
02492               yfit = uves_polynomial_evaluate_1d(result, xval),
02493               cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
02494               "Could not evaluate polynomial");
02495         }
02496         
02497         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
02498         if (residual_square != NULL)
02499         {
02500             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
02501                                t, "_polynomial_fit"),
02502                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
02503                 cpl_table_multiply_columns(t, residual_square, residual_square)),
02504                                                                                /* RS := RS^2 */
02505                 "Could not calculate Residual of fit");
02506         }
02507         
02508         /* Keep the polynomial_fit column if requested */
02509         if (polynomial_fit != NULL)
02510         {
02511             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
02512         }
02513         else
02514         {
02515             cpl_table_erase_column(t, "_polynomial_fit");
02516         }
02517     }
02518     
02519     check(( cpl_table_erase_column(t, "_X_double"),
02520         cpl_table_erase_column(t, "_Y_double")),
02521       "Could not delete temporary columns");
02522     
02523     if (sigmaY != NULL) 
02524     {
02525         check( cpl_table_erase_column(t, "_sY_double"), 
02526            "Could not delete temporary column");
02527     } 
02528     
02529   cleanup:
02530     uves_unwrap_vector(&vx);
02531     uves_unwrap_vector(&vy);
02532     uves_unwrap_vector(&vsy);
02533     if (cpl_error_get_code() != CPL_ERROR_NONE)
02534     {
02535         uves_polynomial_delete(&result);
02536     }
02537     
02538     return result;
02539 }
02540 
02541 
02542 /*----------------------------------------------------------------------------*/
02590 /*----------------------------------------------------------------------------*/
02591 
02592 polynomial *
02593 uves_polynomial_regression_2d(cpl_table *t,
02594                   const char *X1, const char *X2, const char *Y, 
02595                   const char *sigmaY,
02596                   int degree1, int degree2,
02597                   const char *polynomial_fit, const char *residual_square, 
02598                   const char *variance_fit,
02599                   double *mse, double *red_chisq,
02600                   polynomial **variance, double kappa,
02601                               double min_reject)
02602 {
02603     int N;
02604     int rejected;
02605     int total_rejected;
02606     double *x1;
02607     double *x2;
02608     double *y;
02609     double *res;
02610     double *sy;
02611     polynomial *p = NULL;               /* Result */
02612     polynomial *variance_local = NULL;
02613     cpl_vector *vx1 = NULL;
02614     cpl_vector *vx2 = NULL;
02615     cpl_bivector *vx = NULL;
02616     cpl_vector *vy = NULL;
02617     cpl_vector *vsy= NULL;
02618     cpl_type type;
02619 
02620     /* Check input */
02621     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
02622     assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
02623     assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
02624     assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
02625     assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
02626         CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
02627     if (sigmaY != NULL)
02628     {
02629         assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT, 
02630             "No such column: %s", sigmaY);
02631     }
02632     if (polynomial_fit != NULL)
02633     {
02634         assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
02635             "Table already has '%s' column", polynomial_fit);
02636     }
02637     if (residual_square != NULL)
02638     {
02639         assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT, 
02640             "Table already has '%s' column", residual_square);
02641     }
02642     if (variance_fit != NULL)
02643     {
02644         assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
02645             "Table already has '%s' column", variance_fit);
02646     }
02647 
02648     /* Check column types */
02649     type = cpl_table_get_column_type(t, X1);
02650     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
02651         "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
02652     type = cpl_table_get_column_type(t, X2);
02653     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
02654         "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
02655     type = cpl_table_get_column_type(t, Y);
02656     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
02657         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
02658     if (sigmaY != NULL)
02659     {
02660         type = cpl_table_get_column_type(t, sigmaY);
02661         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
02662             "Input column '%s' has wrong type (%s)", 
02663             sigmaY, uves_tostring_cpl_type(type));
02664     }
02665 
02666     /* In the case that these temporary columns already exist, a run-time error will occur */
02667     check( cpl_table_cast_column(t, X1    , "_X1_double", CPL_TYPE_DOUBLE), 
02668        "Could not cast table column to double");
02669     check( cpl_table_cast_column(t, X2    , "_X2_double", CPL_TYPE_DOUBLE),
02670        "Could not cast table column to double");
02671     check( cpl_table_cast_column(t,  Y    ,  "_Y_double", CPL_TYPE_DOUBLE), 
02672        "Could not cast table column to double");
02673     if (sigmaY != NULL)
02674     {
02675         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
02676            "Could not cast table column to double");
02677     }
02678     
02679     total_rejected = 0;
02680     rejected = 0;
02681     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
02682        "Could not create column");
02683 
02684     do {
02685         /* WARNING!!! Code duplication (see below). Be careful
02686            when updating */
02687     check(( N  = cpl_table_get_nrow(t),
02688         x1 = cpl_table_get_data_double(t, "_X1_double"),
02689         x2 = cpl_table_get_data_double(t, "_X2_double"),
02690         y  = cpl_table_get_data_double(t, "_Y_double"),
02691                 res= cpl_table_get_data_double(t, "_residual_square")),
02692           "Could not read table data");
02693     
02694     if (sigmaY != NULL) 
02695         {
02696         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
02697                "Could not read table data");
02698         }
02699     else 
02700         {
02701         sy = NULL;
02702         }
02703 
02704     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
02705     
02706     /* Wrap vectors */
02707     uves_unwrap_vector(&vx1);
02708     uves_unwrap_vector(&vx2);
02709     uves_unwrap_vector(&vy);
02710 
02711     vx1 = cpl_vector_wrap(N, x1);
02712     vx2 = cpl_vector_wrap(N, x2);
02713     vy  = cpl_vector_wrap(N, y);
02714     if (sy != NULL)
02715         {
02716         uves_unwrap_vector(&vsy);
02717         vsy = cpl_vector_wrap(N, sy);
02718         }
02719     else
02720         {
02721         vsy = NULL;
02722         }
02723     
02724     /* Wrap up the bi-vector */
02725     uves_unwrap_bivector_vectors(&vx);
02726     vx = cpl_bivector_wrap_vectors(vx1, vx2);
02727     
02728     /* Fit! */
02729     uves_polynomial_delete(&p);
02730         check( p =  uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
02731                                            NULL, NULL, NULL),
02732                "Could not fit polynomial");
02733 
02734     /* If requested, calculate residuals and perform kappa-sigma clipping */
02735     if (kappa > 0)
02736         {
02737         double sigma2;   /* sigma squared */
02738         int i;
02739 
02740                 cpl_table_fill_column_window_double(t, "_residual_square", 0, 
02741                                                     cpl_table_get_nrow(t), 0.0);
02742 
02743         for (i = 0; i < N; i++)
02744             {
02745                         double yval, yfit;
02746 
02747                         yval  = y[i];
02748                         yfit  = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
02749                         res[i] = (yfit-y[i])*(yfit-y[i]);
02750             }
02751         
02752         /* For robustness, estimate sigma as (third quartile) / 0.6744
02753          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
02754          * The third quartile is estimated as the median of the absolute residuals,
02755          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
02756          *     sigma^2  ~= median(residual^2) / 0.6744^2  
02757          */
02758         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
02759                              
02760 
02761         /* Remove points with residual^2 > kappa^2 * sigma^2 */
02762         check( rejected = uves_erase_table_rows(t, "_residual_square", 
02763                             CPL_GREATER_THAN, kappa*kappa*sigma2),
02764                "Could not remove outlier points");
02765         /* Note! All pointers to table data are now invalid! */
02766 
02767 
02768         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f", 
02769                    rejected, N, sqrt(sigma2));
02770         
02771         /* Update */
02772         total_rejected += rejected;
02773         N = cpl_table_get_nrow(t);
02774         }
02775         
02776     /* Stop also if there are too few points left to make the fit.
02777      * Needed number of points = (degree1+1)(degree2+1) coefficients
02778      *      plus one extra point for chi^2 computation.   */
02779     } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
02780              N >= (degree1 + 1)*(degree2 + 1) + 1);
02781     
02782     if (kappa > 0)
02783     {    
02784         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
02785                 total_rejected,
02786                 N + total_rejected,
02787                 (100.0*total_rejected)/(N + total_rejected)
02788         );
02789     }
02790        
02791     /* Final fit */
02792     {
02793         /* Need to convert to vector again. */
02794 
02795         /* WARNING!!! Code duplication (see above). Be careful
02796            when updating */
02797     check(( N  = cpl_table_get_nrow(t),
02798         x1 = cpl_table_get_data_double(t, "_X1_double"),
02799         x2 = cpl_table_get_data_double(t, "_X2_double"),
02800         y  = cpl_table_get_data_double(t, "_Y_double"),
02801                 res= cpl_table_get_data_double(t, "_residual_square")),
02802           "Could not read table data");
02803     
02804     if (sigmaY != NULL) 
02805         {
02806         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
02807                "Could not read table data");
02808         }
02809     else 
02810         {
02811         sy = NULL;
02812         }
02813 
02814     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
02815     
02816     /* Wrap vectors */
02817     uves_unwrap_vector(&vx1);
02818     uves_unwrap_vector(&vx2);
02819     uves_unwrap_vector(&vy);
02820 
02821     vx1 = cpl_vector_wrap(N, x1);
02822     vx2 = cpl_vector_wrap(N, x2);
02823     vy  = cpl_vector_wrap(N, y);
02824     if (sy != NULL)
02825         {
02826         uves_unwrap_vector(&vsy);
02827         vsy = cpl_vector_wrap(N, sy);
02828         }
02829     else
02830         {
02831         vsy = NULL;
02832         }
02833     
02834     /* Wrap up the bi-vector */
02835     uves_unwrap_bivector_vectors(&vx);
02836     vx = cpl_bivector_wrap_vectors(vx1, vx2);
02837     }
02838 
02839     uves_polynomial_delete(&p);
02840     if (variance_fit != NULL || variance != NULL)
02841         {
02842             /* If requested, also compute variance */
02843             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
02844                                               mse, red_chisq, &variance_local),
02845                    "Could not fit polynomial");
02846         }
02847     else
02848         {
02849             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
02850                                               mse, red_chisq, NULL),
02851                    "Could not fit polynomial");
02852         }
02853 
02854     cpl_table_erase_column(t,  "_residual_square");
02855     
02856     /* Add the fitted values to table as requested */
02857     if (polynomial_fit != NULL || residual_square != NULL)
02858     {
02859         int i;
02860             double *pf;
02861         
02862         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
02863            "Could not create column");
02864 
02865             cpl_table_fill_column_window_double(t, "_polynomial_fit", 0, 
02866                                                 cpl_table_get_nrow(t), 0.0);
02867 
02868             x1 = cpl_table_get_data_double(t, "_X1_double");
02869             x2 = cpl_table_get_data_double(t, "_X2_double");
02870             pf = cpl_table_get_data_double(t, "_polynomial_fit");
02871 
02872         for (i = 0; i < N; i++){
02873 #if 0        
02874         double x1val, x2val, yfit;
02875 
02876         check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
02877             x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
02878             yfit  = uves_polynomial_evaluate_2d(p, x1val, x2val),
02879             
02880             cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
02881             "Could not evaluate polynomial");
02882 
02883 #else
02884                 pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
02885 #endif
02886         }
02887         
02888         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
02889         if (residual_square != NULL)
02890         {
02891             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
02892                                t, "_polynomial_fit"),
02893                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
02894                 cpl_table_multiply_columns(t, residual_square, residual_square)),
02895                                                                    /* RS := RS^2 */
02896                "Could not calculate Residual of fit");
02897         }
02898         
02899         /* Keep the polynomial_fit column if requested */
02900         if (polynomial_fit != NULL)
02901         {
02902             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
02903         }
02904         else
02905         {
02906             cpl_table_erase_column(t, "_polynomial_fit");
02907         }
02908     }
02909     
02910     /* Add variance of poly_fit if requested */
02911     if (variance_fit != NULL)
02912     {
02913         int i;
02914             double *vf;
02915 
02916         check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE), 
02917            "Could not create column");
02918             
02919             cpl_table_fill_column_window_double(t, variance_fit, 0,
02920                                                 cpl_table_get_nrow(t), 0.0);
02921 
02922             x1 = cpl_table_get_data_double(t, "_X1_double");
02923             x2 = cpl_table_get_data_double(t, "_X2_double");
02924             vf = cpl_table_get_data_double(t, variance_fit);
02925 
02926         for (i = 0; i < N; i++)
02927         {
02928 #if 0
02929             double x1val, x2val, yfit_variance;
02930             check(( x1val         = cpl_table_get_double(t, "_X1_double", i, NULL),
02931                 x2val         = cpl_table_get_double(t, "_X2_double", i, NULL),
02932                 yfit_variance = uves_polynomial_evaluate_2d(variance_local, 
02933                                     x1val, x2val),
02934                 
02935                 cpl_table_set_double(t, variance_fit, i, yfit_variance)),
02936                "Could not evaluate polynomial");
02937 #else
02938                     vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
02939 #endif
02940 
02941         }
02942     }
02943     
02944     
02945     check(( cpl_table_erase_column(t, "_X1_double"),
02946         cpl_table_erase_column(t, "_X2_double"),
02947         cpl_table_erase_column(t,  "_Y_double")),
02948       "Could not delete temporary columns");
02949       
02950     if (sigmaY != NULL) 
02951     {
02952         check( cpl_table_erase_column(t, "_sY_double"),
02953            "Could not delete temporary column");
02954     }
02955     
02956   cleanup:
02957     uves_unwrap_bivector_vectors(&vx);
02958     uves_unwrap_vector(&vx1);
02959     uves_unwrap_vector(&vx2);
02960     uves_unwrap_vector(&vy);
02961     uves_unwrap_vector(&vsy);
02962     /* Delete 'variance_local', or return through 'variance' parameter */
02963     if (variance != NULL)
02964     {
02965         *variance = variance_local;
02966     }
02967     else
02968     {
02969         uves_polynomial_delete(&variance_local);
02970     }
02971     if (cpl_error_get_code() != CPL_ERROR_NONE)
02972     {
02973         uves_polynomial_delete(&p);
02974     }
02975 
02976     return p;
02977 }
02978 
02979 /*----------------------------------------------------------------------------*/
03022 /*----------------------------------------------------------------------------*/
03023 
03024 polynomial *
03025 uves_polynomial_regression_2d_autodegree(cpl_table *t,
03026                      const char *X1, const char *X2, const char *Y,
03027                      const char *sigmaY,
03028                      const char *polynomial_fit,
03029                      const char *residual_square, 
03030                      const char *variance_fit,
03031                      double *mean_squared_error, double *red_chisq,
03032                      polynomial **variance, double kappa,
03033                      int maxdeg1, int maxdeg2, double min_rms,
03034                                          double min_reject,
03035                                          bool verbose,
03036                      const double *min_val,
03037                      const double *max_val,
03038                      int npos, double positions[][2])
03039 {
03040     int deg1 = 0;               /* Current degrees                                  */
03041     int deg2 = 0;               /* Current degrees                                  */
03042     int i;
03043 
03044     double **mse = NULL;
03045     bool adjust1 = true;      /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
03046     bool adjust2 = true;      /*   (or held constant)            */
03047     bool finished = false;
03048 
03049     const char *y_unit;
03050     cpl_table *temp = NULL;
03051     polynomial *bivariate_fit = NULL;   /* Result */
03052 
03053     assure( (min_val == NULL && max_val == NULL) || positions != NULL,
03054         CPL_ERROR_NULL_INPUT,
03055         "Missing positions array");    
03056 
03057     check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
03058     if (y_unit == NULL)
03059     {
03060         y_unit = "";
03061     }
03062 
03063     assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT, 
03064        "Illegal max. degrees: (%d, %d)",
03065        maxdeg1, maxdeg2);
03066 
03067     mse = cpl_calloc(maxdeg1+1, sizeof(double *));
03068     assure_mem(mse);
03069     for (i = 0; i < maxdeg1+1; i++)
03070     {
03071         int j;
03072         mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
03073         assure_mem(mse);
03074 
03075         for (j = 0; j < maxdeg2+1; j++)
03076         {
03077             mse[i][j] = -1;
03078         }
03079     }
03080 
03081     temp = cpl_table_duplicate(t);
03082     assure_mem(temp);
03083 
03084     uves_polynomial_delete(&bivariate_fit);
03085     check( bivariate_fit = uves_polynomial_regression_2d(temp,
03086                              X1, X2, Y, sigmaY,
03087                              deg1,
03088                              deg2,
03089                              NULL, NULL, NULL,  /* new columns  */
03090                              &mse[deg1][deg2], NULL, /* chi^2/N */
03091                              NULL,              /* variance pol.*/
03092                              kappa, min_reject),
03093        "Error fitting polynomial");
03094     if (verbose)
03095         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)", 
03096                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
03097                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
03098                      cpl_table_get_nrow(t));
03099     else
03100         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)", 
03101                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
03102                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
03103                      cpl_table_get_nrow(t));
03104     /* Find best values of deg1, deg2 less than or equal to 8,8
03105        (the fitting algorithm is unstable after this point, anyway) */
03106     do
03107     {
03108         int new_deg1, new_deg2;
03109         double m;
03110 
03111         finished = true;
03112 
03113         adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
03114         adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
03115         
03116         /* Try the new degrees
03117 
03118                               (d1+1, d2  ) (d1+2, d2)
03119                        (d1, d2+1) (d1+1, d2+1)
03120                        (d1, d2+2)
03121 
03122            in the following order:
03123 
03124                                      1            3
03125                           1          2
03126                           3
03127 
03128                (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
03129         */
03130         for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
03131         for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
03132             if ( (
03133                  (new_deg1 == deg1+1 && new_deg2 == deg2   && adjust1) ||
03134                  (new_deg1 == deg1+2 && new_deg2 == deg2   && adjust1) ||
03135                  (new_deg1 == deg1   && new_deg2 == deg2+1 && adjust2) ||
03136                  (new_deg1 == deg1   && new_deg2 == deg2+2 && adjust2) ||
03137                  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
03138                  )
03139              && mse[new_deg1][new_deg2] < 0)
03140             {
03141                 int rejected = 0;
03142 
03143                 uves_free_table(&temp);
03144                 temp = cpl_table_duplicate(t);
03145                 assure_mem(temp);
03146 
03147                 uves_polynomial_delete(&bivariate_fit);
03148                 bivariate_fit = uves_polynomial_regression_2d(temp,
03149                                       X1, X2, Y, sigmaY,
03150                                       new_deg1,
03151                                       new_deg2,
03152                                       NULL, NULL, NULL,
03153                                       &(mse[new_deg1]
03154                                         [new_deg2]),
03155                                       NULL,
03156                                       NULL,
03157                                       kappa, min_reject);
03158 
03159                 if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
03160                 {
03161                     uves_error_reset();
03162 
03163                                     if (verbose)
03164                                         uves_msg_low("(%d, %d)-degree: Singular matrix", 
03165                          new_deg1, new_deg2);
03166                                     else
03167                                         uves_msg_debug("(%d, %d)-degree: Singular matrix", 
03168                          new_deg1, new_deg2);
03169                     
03170                     mse[new_deg1][new_deg2] = DBL_MAX/2; 
03171                 }
03172                 else
03173                 {
03174                     assure( cpl_error_get_code() == CPL_ERROR_NONE,
03175                         cpl_error_get_code(),
03176                         "Error fitting (%d, %d)-degree polynomial", 
03177                         new_deg1, new_deg2 );
03178                     
03179                     rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
03180                 
03181                                     if (verbose)
03182                                         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)",
03183                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
03184                                                      rejected, cpl_table_get_nrow(t));
03185                                     else
03186                                         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%d/%d outliers)",
03187                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
03188                                                      rejected, cpl_table_get_nrow(t));
03189 
03190                     /* Reject if fit produced bad values */
03191                     if (min_val != NULL || max_val != NULL)
03192                     {
03193                         for (i = 0; i < npos; i++)
03194                         {
03195                             double val = uves_polynomial_evaluate_2d(
03196                             bivariate_fit,
03197                             positions[i][0], positions[i][1]);
03198                             if (min_val != NULL && val < *min_val)
03199                             {
03200                                 uves_msg_debug("Bad fit: %f < %f", 
03201                                        val,
03202                                        *min_val);
03203                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
03204                                 /* A large number, even if we add a bit */
03205                             }
03206                             if (max_val != NULL && val > *max_val)
03207                             {
03208                                 uves_msg_debug("Bad fit: %f > %f", 
03209                                        val,
03210                                        *max_val);
03211                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
03212                             }
03213                         }
03214                     }
03215                 
03216                     /* For robustness, make sure that we don't accept a solution that
03217                        rejected too many points (say, 80%)
03218                     */
03219                     if (rejected >= (4*cpl_table_get_nrow(t))/5)
03220                     {
03221                         mse[new_deg1][new_deg2] = DBL_MAX/2; 
03222                     }
03223                     
03224                 }/* if fit succeeded */
03225             }
03226         
03227         /* If fit is significantly better (say, 10% improvement in MSE) in either direction, 
03228          * (in (degree,degree)-space) then move in that direction.
03229          *
03230          * First try to move one step horizontal/vertical, 
03231          * otherwise try to move diagonally (i.e. increase both degrees),
03232          * otherwise move two steps horizontal/vertical
03233          *
03234          */
03235         m = mse[deg1][deg2];
03236 
03237         if      (adjust1                              
03238              && (m - mse[deg1+1][deg2])/m > 0.1
03239              && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
03240              /* The condition is read like this:
03241             if 
03242             - we are trying to move right, and
03243             - this is this is a better place than the current, and
03244                 - this is better than moving down */
03245         )
03246         {
03247             deg1++;
03248             finished = false;
03249         }
03250         else if (adjust2 &&
03251              (m - mse[deg1][deg2+1])/m > 0.1
03252              && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
03253         )
03254         {
03255             deg2++;
03256             finished = false;
03257         }
03258         else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
03259         {
03260             deg1++;
03261             deg2++;
03262             finished = false;
03263         }
03264         else if (adjust1
03265              && (m - mse[deg1+2][deg2])/m > 0.1
03266              && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
03267         )
03268         {
03269             deg1 += 2;
03270             finished = false;
03271         }
03272         else if (adjust2 
03273              && (m - mse[deg1][deg2+2])/m > 0.1
03274              && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
03275         {
03276             deg2 += 2;
03277             finished = false;
03278         }
03279 
03280         /* For efficiency, stop if rms reached min_rms */   
03281         finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
03282 
03283     } while (!finished);
03284 
03285     uves_polynomial_delete(&bivariate_fit);
03286     check( bivariate_fit = uves_polynomial_regression_2d(t,
03287                              X1, X2, Y, sigmaY,
03288                              deg1,
03289                              deg2,
03290                              polynomial_fit, residual_square, 
03291                              variance_fit,
03292                              mean_squared_error, red_chisq,
03293                              variance, kappa, min_reject),
03294        "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
03295 
03296     if (verbose)
03297         uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
03298                      sqrt(mse[deg1][deg2]), y_unit);
03299     else
03300         uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
03301                      sqrt(mse[deg1][deg2]), y_unit);
03302     
03303   cleanup:
03304     if (mse != NULL)
03305     {
03306         for (i = 0; i < maxdeg1+1; i++)
03307         {
03308             if (mse[i] != NULL)
03309             {
03310                 cpl_free(mse[i]);
03311             }
03312         }
03313         cpl_free(mse);
03314     }
03315     uves_free_table(&temp);
03316     
03317     return bivariate_fit;    
03318 }
03319 
03320 /*----------------------------------------------------------------------------*/
03330 /*----------------------------------------------------------------------------*/
03331 const char *
03332 uves_remove_string_prefix(const char *s, const char *prefix)
03333 {
03334     const char *result = NULL;
03335     unsigned int prefix_length;
03336 
03337     assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
03338     assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
03339 
03340     prefix_length = strlen(prefix);
03341 
03342     assure( strlen(s) >= prefix_length &&
03343         strncmp(s, prefix, prefix_length) == 0,
03344         CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
03345         prefix, s);
03346     
03347     result = s + prefix_length;
03348     
03349   cleanup:
03350     return result;
03351 }
03352 
03353 
03354 /*----------------------------------------------------------------------------*/
03363 /*----------------------------------------------------------------------------*/
03364 
03365 double uves_gaussrand(void)
03366 {
03367     static double V1, V2, S;
03368     static int phase = 0;
03369     double X;
03370     
03371     if(phase == 0) {
03372     do {
03373         double U1 = (double)rand() / RAND_MAX;
03374         double U2 = (double)rand() / RAND_MAX;
03375         
03376         V1 = 2 * U1 - 1;
03377         V2 = 2 * U2 - 1;
03378         S = V1 * V1 + V2 * V2;
03379     } while(S >= 1 || S == 0);
03380     
03381     X = V1 * sqrt(-2 * log(S) / S);
03382     } else
03383     X = V2 * sqrt(-2 * log(S) / S);
03384     
03385     phase = 1 - phase;
03386     
03387     return X;
03388 }
03389 
03390 /*----------------------------------------------------------------------------*/
03401 /*----------------------------------------------------------------------------*/
03402 
03403 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x, 
03404                 const char *column_y, int *istart )
03405 {
03406     double result = 0;
03407     int n;
03408 
03409     const double *x, *y;
03410     
03411     check( x = cpl_table_get_data_double_const(t, column_x),
03412        "Error reading column '%s'", column_x);
03413     check( y = cpl_table_get_data_double_const(t, column_y),
03414        "Error reading column '%s'", column_y);
03415 
03416     n = cpl_table_get_nrow(t);
03417 
03418     result = uves_spline_hermite(xp, x, y, n, istart);
03419 
03420   cleanup:
03421     return result;
03422 }
03423 
03424 /*----------------------------------------------------------------------------*/
03440 /*----------------------------------------------------------------------------*/
03441 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
03442 {
03443     double yp1, yp2, yp = 0;
03444     double xpi, xpi1, l1, l2, lp1, lp2;
03445     int i;
03446 
03447     if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) )    return 0.0;
03448     if ( x[0] >  x[n-1] && (xp > x[0] || xp < x[n-1]) )    return 0.0;
03449 
03450     if ( x[0] <= x[n-1] )
03451     {
03452         for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
03453         ;
03454     }
03455     else
03456     {
03457         for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
03458         ;
03459     }
03460 
03461     *istart = i;
03462     i--;
03463     
03464     lp1 = 1.0 / (x[i-1] - x[i]);
03465     lp2 = -lp1;
03466 
03467     if ( i == 1 )
03468     {
03469         yp1 = (y[1] - y[0]) / (x[1] - x[0]);
03470     }
03471     else
03472     {
03473         yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
03474     }
03475 
03476     if ( i >= n - 1 )
03477     {
03478         yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
03479     }
03480     else
03481     {
03482         yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
03483     }
03484 
03485     xpi1 = xp - x[i];
03486     xpi  = xp - x[i-1];
03487     l1   = xpi1*lp1;
03488     l2   = xpi*lp2;
03489 
03490     yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 + 
03491          y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 + 
03492          yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
03493 
03494     return yp;
03495 }
03496 
03497 /*----------------------------------------------------------------------------*/
03511 /*----------------------------------------------------------------------------*/
03512 
03513 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
03514 {
03515     int klo, khi, k;
03516     double a, b, h, yp = 0;
03517 
03518     assure_nomsg( x  != NULL, CPL_ERROR_NULL_INPUT);
03519     assure_nomsg( y  != NULL, CPL_ERROR_NULL_INPUT);
03520     assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
03521     assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
03522 
03523     klo = *kstart;
03524     khi = n;
03525 
03526     if ( xp < x[1] || xp > x[n] )
03527     {
03528         return 0.0;
03529     }
03530     else if ( xp == x[1] )
03531     {
03532         return(y[1]);
03533     }
03534     
03535     for ( k = klo; k < n && xp > x[k]; k++ )
03536     ;
03537 
03538     klo = *kstart = k-1;
03539     khi = k;
03540 
03541     h = x[khi] - x[klo];
03542     assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
03543         "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
03544 
03545     a = (x[khi] - xp) / h;
03546     b = (xp - x[klo]) / h;
03547 
03548     yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
03549      (h*h) / 6.0;
03550 
03551   cleanup:
03552     return yp;
03553 }
03554 
03555 /*----------------------------------------------------------------------------*/
03565 /*----------------------------------------------------------------------------*/
03566 bool
03567 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
03568 {
03569     bool is_sorted = true;       /* ... until proven false */
03570     int i;
03571     int N;
03572     double previous, current;    /* column values */
03573 
03574     passure(t != NULL, " ");
03575     passure(cpl_table_has_column(t, column), "No column '%s'", column);
03576     passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
03577     
03578     N = cpl_table_get_nrow(t);
03579 
03580     if (N > 1) 
03581     {
03582         previous = cpl_table_get_double(t, column, 0, NULL);
03583         
03584         for(i = 1; i < N && is_sorted; i++)
03585         {
03586             current = cpl_table_get_double(t, column, i, NULL);
03587             if (!reverse)
03588             {
03589                 /* Check for ascending */
03590                 is_sorted = is_sorted && ( current >= previous );
03591             }
03592             else
03593             {
03594                 /* Check for descending */
03595                 is_sorted = is_sorted && ( current <= previous );
03596             }
03597             
03598             previous = current;
03599         }
03600     }
03601     else
03602     {
03603         /* 0 or 1 rows. Table is sorted */        
03604     }
03605     
03606   cleanup:
03607     return is_sorted;
03608 }
03609 
03610 /*----------------------------------------------------------------------------*/
03616 /*----------------------------------------------------------------------------*/
03617 cpl_table *
03618 uves_ordertable_traces_new(void)
03619 {
03620     cpl_table *result = NULL;
03621     
03622     check((
03623           result = cpl_table_new(0),
03624           cpl_table_new_column(result, "TraceID"  , CPL_TYPE_INT),
03625           cpl_table_new_column(result, "Offset"   , CPL_TYPE_DOUBLE),
03626           cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
03627     "Error creating table");
03628     
03629   cleanup:
03630     return result;
03631 }
03632 
03633 /*----------------------------------------------------------------------------*/
03643 /*----------------------------------------------------------------------------*/
03644 cpl_error_code
03645 uves_ordertable_traces_add(cpl_table *traces, 
03646                int fibre_ID, double fibre_offset, int fibre_mask)
03647 {
03648     int size;
03649 
03650     assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
03651     
03652     /* Write to new table row */
03653     check((
03654           size = cpl_table_get_nrow(traces),
03655           cpl_table_set_size  (traces, size+1),
03656           cpl_table_set_int   (traces, "TraceID"  , size, fibre_ID),
03657           cpl_table_set_double(traces, "Offset"   , size, fibre_offset),
03658           cpl_table_set_int   (traces, "Tracemask", size, fibre_mask)),
03659       "Error updating table");
03660 
03661   cleanup:
03662     return cpl_error_get_code();
03663 }
03664 
03665 
03666 /*
03667  * modified on 2006/04/19
03668  *  jmlarsen:  float[5] -> const double[]
03669  *             changed mapping of indices to parameters
03670  *             Normalized the profile to 1 and changed meaning
03671  *             of (a[3], a[2]) to (integrated flux, stdev)
03672  *             Disabled debugging messages
03673  *
03674  * modified on 2005/07/29 to make dydapar a FORTRAN array
03675  * (indiced from 1 to N instead of 0 to N-1).
03676  * This allows the array to be passed to C functions expecting
03677  * FORTRAN-like arrays.
03678  *
03679  * modified on 2005/08/02 to make the function prototype ANSI
03680  * compliant (so it can be used with the levmar library).
03681  *
03682  * modified on 2005/08/16. The function now expects C-indexed
03683  * arrays as parameters (to allow proper integration). However, the
03684  * arrays are still converted to FORTRAN-indexed arrays internally.
03685  */
03686 
03697 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
03698 
03699  
03700      /*     int na;*/
03701 {
03702   double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
03703   double a2i=0, m = 0, p = 0, dif =0;
03704   double sqrt5 = 2.23606797749979;
03705 
03706   *y=0.0;
03707 //  a2i = 1.0/a[2];
03708   a2i = 1.0/(a[2]*sqrt5);
03709 
03710   dif=x-a[1];
03711   arg=dif*a2i;
03712   arg2=arg*arg;
03713 
03714   fac=1.0+arg2;
03715   fac2=fac*fac;
03716   fac4=fac2*fac2;
03717   fac4i = 1.0/fac4;
03718   
03719 //  m = a[1]*fac4i;
03720   m = a[3]*fac4i * a2i*16/(5.0*M_PI);
03721   *y = m + a[4]*(1.0+dif*a[5]);  
03722   p = 8.0*m/fac*arg*a2i;
03723 
03724   dyda[3] = m/a[3];
03725   dyda[2] = p*dif/a[2] - m/a[2];
03726 
03727 //  dyda[3]=fac4i;
03728   dyda[1]=p-a[4]*a[5];
03729 //  dyda[2]=p*dif*a2i;
03730   dyda[4]=1.0+dif*a[5];
03731   dyda[5]=a[4]*dif;
03732 
03733 
03734 #if 0
03735   {
03736      int i = 0, npar=5 ;
03737      printf("fmoffat_i \n");
03738      for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
03739      
03740      printf("fmoffat_i ");
03741      for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
03742      printf("\n");
03743   }
03744 #endif
03745   
03746 }
03747 
03766 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
03767 //void fmoffa_c(x,a,y, dyda)
03768 
03769 
03770 //     float x,*a,*y,*dyda;
03771 /*int na;*/
03772 {
03773   int npoint = 3;
03774   double const xgl[3] = {-0.387298334621,0.,0.387298334621};
03775   double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
03776   int i=0;
03777   int j=0;
03778   int npar = 5;
03779   double xmod = 0;
03780   double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
03781   double ypar;
03782 
03783 
03784   // Convert C-indexed arrays to FORTRAN-indexed arrays
03785   a    = C_TO_FORTRAN_INDEXING(a);
03786   dyda = C_TO_FORTRAN_INDEXING(dyda);
03787 
03788   *y = 0.0;
03789   for (i = 1;i<=npar;i++) dyda[i] = 0.;
03790   /*  printf("fmoffat_c ");
03791   for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
03792   /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
03793   /*  printf("\n");*/
03794   for (j=0; j < npoint; j++) 
03795       {
03796       xmod = x+xgl[j];
03797 
03798       fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
03799       
03800       *y = *y + ypar*wgl[j];
03801       
03802       for (i = 1; i <= npar; i++)
03803           {
03804           dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
03805           }
03806 
03807      /*      if (j == 2) 
03808     for (i = 1;i<=npar;i++) 
03809       {
03810         dyda[i] = dydapar[i];
03811       };
03812      */
03813     }
03814 
03815 #if 0
03816       printf("fmoffat_c ");
03817       for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
03818       printf("\n");
03819 #endif
03820 }
03821 
03822 /*----------------------------------------------------------------------------*/
03830 /*----------------------------------------------------------------------------*/
03831 int
03832 uves_moffat(const double x[], const double a[], double *result)
03833 {
03834     double dyda[5];
03835 
03836     fmoffa_c(x[0], a, result, dyda);
03837 
03838     return 0;
03839 }
03840 
03841 /*----------------------------------------------------------------------------*/
03849 /*----------------------------------------------------------------------------*/
03850 int
03851 uves_moffat_derivative(const double x[], const double a[], double result[])
03852 {
03853     double y;
03854 
03855     fmoffa_c(x[0], a, &y, result);
03856 
03857     return 0;
03858 }
03859 
03860 /*----------------------------------------------------------------------------*/
03880 /*----------------------------------------------------------------------------*/
03881 
03882 int
03883 uves_gauss(const double x[], const double a[], double *result)
03884 {
03885     double my    = a[0];
03886     double sigma = a[1];
03887 
03888     if (sigma == 0)
03889     {
03890         /* Dirac's delta function */
03891         if (x[0] == my)
03892         {
03893             *result = DBL_MAX;
03894         }
03895         else
03896         {
03897             *result = 0;
03898         }
03899         return 0;
03900     }
03901     else
03902     {
03903         double A     = a[2];
03904         double B     = a[3];
03905         
03906         *result = B    +
03907         A/(sqrt(2*M_PI*sigma*sigma)) *
03908         exp(- (x[0] - my)*(x[0] - my)
03909             / (2*sigma*sigma));
03910     }
03911     
03912     return 0;
03913 }
03914 
03915 /*----------------------------------------------------------------------------*/
03935 /*----------------------------------------------------------------------------*/
03936 
03937 int
03938 uves_gauss_derivative(const double x[], const double a[], double result[])
03939 {
03940     double my    = a[0];
03941     double sigma = a[1];
03942     double A     = a[2];
03943     /* a[3] not used */
03944 
03945     double factor;
03946    
03947     /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03948      *
03949      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
03950      *          = A * fac. * (x-my)  / s^2
03951      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
03952      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
03953      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
03954      *          = fac.
03955      * df/dB    = 1
03956      */
03957     
03958     if (sigma == 0)
03959     {
03960         /* Derivative of Dirac's delta function */
03961         result[0] = 0;
03962         result[1] = 0;
03963         result[2] = 0;
03964         result[3] = 0;
03965         return 0;
03966     }
03967 
03968     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
03969     / (sqrt(2*M_PI*sigma*sigma));
03970 
03971     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
03972     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
03973     result[2] = factor;
03974     result[3] = 1;
03975 
03976     return 0;
03977 }
03978 
03979 /*----------------------------------------------------------------------------*/
04000 /*----------------------------------------------------------------------------*/
04001 
04002 int
04003 uves_gauss_linear(const double x[], const double a[], double *result)
04004 {
04005     double my    = a[0];
04006     double sigma = a[1];
04007 
04008     if (sigma == 0)
04009     {
04010         /* Dirac's delta function */
04011         if (x[0] == my)
04012         {
04013             *result = DBL_MAX;
04014         }
04015         else
04016         {
04017             *result = 0;
04018         }
04019         return 0;
04020     }
04021     else
04022     {
04023         double A     = a[2];
04024         double B     = a[3];
04025         double C     = a[4];
04026         
04027         *result = B    + C*(x[0] - my) +
04028         A/(sqrt(2*M_PI*sigma*sigma)) *
04029         exp(- (x[0] - my)*(x[0] - my)
04030             / (2*sigma*sigma));
04031     }
04032     
04033     return 0;
04034 }
04035 
04036 /*----------------------------------------------------------------------------*/
04059 /*----------------------------------------------------------------------------*/
04060 
04061 int
04062 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
04063 {
04064     double my    = a[0];
04065     double sigma = a[1];
04066     double A     = a[2];
04067     /* a[3] not used */
04068     double C     = a[4];
04069 
04070     double factor;
04071    
04072     /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04073      *
04074      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
04075      *          = A * fac. * (x-my)  / s^2   - C
04076      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
04077      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
04078      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04079      *          = fac.
04080      * df/dB    = 1
04081      *
04082      * df/dC    = x-my
04083      */
04084     
04085     if (sigma == 0)
04086     {
04087         /* Derivative of Dirac's delta function */
04088         result[0] = -C;
04089         result[1] = 0;
04090         result[2] = 0;
04091         result[3] = 0;
04092         result[4] = x[0];
04093         return 0;
04094     }
04095 
04096     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
04097     / (sqrt(2*M_PI*sigma*sigma));
04098 
04099     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
04100     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
04101     result[2] = factor;
04102     result[3] = 1;
04103     result[4] = x[0] - my;
04104 
04105     return 0;
04106 }
04107 
04108 
04109 
04110 
04111 /*----------------------------------------------------------------------------*/
04124 /*----------------------------------------------------------------------------*/
04125 cpl_image *
04126 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
04127                   const cpl_image *spectrum, const cpl_image *sky,
04128                   const cpl_image *cosmic_image,
04129                   const uves_extract_profile *profile,
04130                   cpl_image **image_noise, uves_propertylist **image_header)
04131 {
04132     cpl_image *image = NULL;
04133 
04134     cpl_binary *bpm = NULL;
04135     bool loop_y = false;
04136 
04137     double ron = 3;
04138     double gain = 1.0; //fixme
04139     bool new_format = true;
04140 
04141     image        = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
04142     assure_mem( image );
04143     if (image_noise != NULL) {
04144         *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
04145         assure_mem( *image_noise );
04146         cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
04147     }
04148 
04149     if (image_header != NULL) {
04150         *image_header = uves_propertylist_new();
04151       
04152         uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
04153         uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
04154         uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
04155     }
04156 
04157     for (uves_iterate_set_first(pos,
04158                                 1, pos->nx,
04159                                 pos->minorder, pos->maxorder,
04160                                 bpm,
04161                                 loop_y);
04162          !uves_iterate_finished(pos); 
04163          uves_iterate_increment(pos)) {
04164       
04165         /* Manual loop over y */
04166         uves_extract_profile_set(profile, pos, NULL);
04167         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
04168 
04169             /* Get empirical and model profile */
04170             double flux, sky_flux;
04171             int bad;
04172             int spectrum_row = pos->order - pos->minorder + 1;
04173             double noise;
04174             double prof = uves_extract_profile_evaluate(profile, pos);
04175           
04176             if (sky != NULL)
04177                 {
04178                     sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
04179                 }
04180             else
04181                 {
04182                     sky_flux = 0;
04183                 }
04184 
04185             flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
04186           
04187             //fixme: check this formula
04188             noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
04189 //          uves_msg_error("%f", prof);
04190             cpl_image_set(image, pos->x, pos->y, 
04191                           flux);
04192             if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
04193           
04194         }
04195     }
04196 
04197     if (cosmic_image != NULL) {
04198         double cr_val = 2*cpl_image_get_max(image);
04199         /* assign high pixel value to CR pixels */
04200         
04201         loop_y = true;
04202         
04203         for (uves_iterate_set_first(pos,
04204                                     1, pos->nx,
04205                                     pos->minorder, pos->maxorder,
04206                                     bpm,
04207                                     loop_y);
04208              !uves_iterate_finished(pos); 
04209              uves_iterate_increment(pos)) {
04210             
04211             int is_rejected;
04212             if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
04213                 cpl_image_set(image, pos->x, pos->y, cr_val);
04214             }
04215         }
04216     }
04217     
04218   cleanup:
04219     return image;
04220 }
04221 
04222 void 
04223 uves_frameset_dump(cpl_frameset* set)
04224 {
04225 
04226   cpl_frame* frm=NULL;
04227   int sz=0;
04228   int i=0;
04229 
04230   cknull(set,"Null input frameset");
04231   check_nomsg(sz=cpl_frameset_get_size(set));
04232   check_nomsg(frm=cpl_frameset_get_first(set));
04233   do{
04234     uves_msg("frame %d tag %s filename %s group %d",
04235          i,
04236              cpl_frame_get_tag(frm),
04237              cpl_frame_get_filename(frm),
04238              cpl_frame_get_group(frm));
04239     i++;
04240   } while ((frm=cpl_frameset_get_next(set)) != NULL);
04241 
04242   cleanup:
04243 
04244   return ;
04245 }
04246 

Generated on Fri Apr 18 14:11:43 2008 for UVES Pipeline Reference Manual by  doxygen 1.5.1