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: 2013/02/13 10:05:01 $
00023  * $Revision: 1.202 $
00024  * $Name: HEAD $
00025  */
00026 
00027 #ifdef HAVE_CONFIG_H
00028 #  include <config.h>
00029 #endif
00030 
00031 /*---------------------------------------------------------------------------*/
00037 /*---------------------------------------------------------------------------*/
00038 
00039 /*-----------------------------------------------------------------------------
00040                             Includes
00041  ----------------------------------------------------------------------------*/
00042 #include <uves_utils.h>
00043 #include <uves_utils_cpl.h>
00044 #include <irplib_ksigma_clip.h>
00045 /*
00046  * System Headers
00047  */
00048 #include <errno.h>
00049 #include <uves.h>
00050 #include <uves_extract_profile.h>
00051 #include <uves_plot.h>
00052 #include <uves_dfs.h>
00053 #include <uves_pfits.h>
00054 #include <uves_utils_wrappers.h>
00055 #include <uves_wavecal_utils.h>
00056 #include <uves_msg.h>
00057 #include <uves_dump.h>
00058 #include <uves_error.h>
00059 
00060 #include <irplib_utils.h>
00061 
00062 #include <cpl.h>
00063 #include <uves_time.h> /* iso time */
00064 
00065 #include <ctype.h>  /* tolower */
00066 #include <stdbool.h>
00067 #include <float.h>
00068 
00069 /*-----------------------------------------------------------------------------
00070                             Defines
00071  ----------------------------------------------------------------------------*/
00072 // The following macros are used to provide a fast
00073 // and readable way to convert C-indexes to FORTRAN-indexes.
00074 #define C_TO_FORTRAN_INDEXING(a) &a[-1]
00075 #define FORTRAN_TO_C_INDEXING(a) &a[1]
00076 
00078 /*-----------------------------------------------------------------------------
00079                             Functions prototypes
00080  ----------------------------------------------------------------------------*/
00081 
00082 
00083 static cpl_error_code 
00084 uves_cosrout(cpl_image* ima,
00085              cpl_image** msk,
00086              const double ron, 
00087              const double gain,
00088              const int ns,
00089              const double sky,
00090              const double rc,
00091              cpl_image** flt,
00092              cpl_image** out);
00093 
00094 static cpl_image * 
00095 uves_gen_lowpass(const int xs, 
00096                   const int ys, 
00097                   const double sigma_x, 
00098                   const double sigma_y);
00099 
00100 static cpl_error_code 
00101 uves_find_next(cpl_image** msk,
00102                const int first_y,
00103                int* next_x,
00104            int* next_y);
00105 
00106 static cpl_error_code
00107 uves_sort(const int kmax,float* inp, int* ord);
00108 
00109 /*-----------------------------------------------------------------------------
00110                             Implementation
00111  ----------------------------------------------------------------------------*/
00112 
00113 
00114 /*---------------------------------------------------------------------------*/
00159 /*---------------------------------------------------------------------------*/
00160 
00161 cpl_error_code
00162 uves_rcosmic(cpl_image* ima,
00163              cpl_image** flt,
00164              cpl_image** out,
00165              cpl_image** msk,
00166              const double sky,
00167              const double ron,
00168              const double gain,
00169              const int ns,
00170              const double rc)
00171 
00172 {
00173 
00174 
00175 /*
00176 
00177 
00178       PROGRAM RCOSMIC
00179       INTEGER*4 IAV,I
00180       INTEGER*4 STATUS,MADRID,SIZEX,IOMODE
00181       INTEGER*4 NAXIS,NPIX(2),IMNI,IMNO,IMNF,IMNC
00182       INTEGER*8 PNTRI,PNTRF,PNTRO,PNTRC
00183       INTEGER*4 KUN,KNUL
00184       CHARACTER*60 IMAGE,OBJET,COSMIC
00185       CHARACTER*72 IDENT1,IDENT2,IDENT3
00186       CHARACTER*48 CUNIT
00187       DOUBLE PRECISION START(2),STEP(2)
00188       REAL*4 SKY,GAIN,RON,NS,RC,PARAM(5),CUTS(2)
00189       INCLUDE 'MID_INCLUDE:ST_DEF.INC'
00190       COMMON/VMR/MADRID(1)
00191       INCLUDE 'MID_INCLUDE:ST_DAT.INC'
00192       DATA IDENT1 /' '/
00193       DATA IDENT2 /' '/
00194       DATA IDENT3 /'cosmic ray mask '/
00195       DATA CUNIT /' '/
00196       CALL STSPRO('RCOSMIC')
00197       CALL STKRDC('IN_A',1,1,60,IAV,IMAGE,KUN,KNUL,STATUS)
00198       CALL STIGET(IMAGE,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
00199      1                2,NAXIS,NPIX,START,STEP
00200      1                ,IDENT1,CUNIT,PNTRI,IMNI,STATUS)
00201 
00202       CALL STKRDR('PARAMS',1,5,IAV,PARAM,KUN,KNUL,STATUS)
00203       CALL STIGET('middumma',D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
00204      1                2,NAXIS,NPIX,START,STEP
00205      1                ,IDENT2,CUNIT,PNTRF,IMNF,STATUS)
00206       SKY = PARAM(1)
00207       GAIN = PARAM(2)
00208       RON = PARAM(3)
00209       NS = PARAM(4)
00210       RC = PARAM(5)
00211 
00212 */
00213 
00214 
00215    check_nomsg(*flt=cpl_image_duplicate(ima));
00216    check_nomsg(uves_filter_image_median(flt,1,1,false));
00217 
00218 
00219 
00220 /*
00221 
00222       CALL STKRDC('OUTIMA',1,1,60,IAV,OBJET,KUN,KNUL,STATUS)
00223       CALL STIPUT(OBJET,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
00224      1                 NAXIS,NPIX,START,STEP
00225      1                ,IDENT1,CUNIT,PNTRO,IMNO,STATUS)
00226 
00227       SIZEX = 1
00228       DO I=1,NAXIS
00229          SIZEX = SIZEX*NPIX(I)
00230       ENDDO
00231       CALL STKRDC('COSMIC',1,1,60,IAV,COSMIC,KUN,KNUL,STATUS)
00232       IF (COSMIC(1:1).EQ.'+') THEN
00233             COSMIC = 'dummy_frame'
00234             IOMODE = F_X_MODE
00235       ELSE
00236             IOMODE = F_O_MODE
00237       ENDIF    
00238       CALL STIPUT(COSMIC,D_I2_FORMAT,IOMODE,F_IMA_TYPE
00239      1                 ,NAXIS,NPIX,START,STEP
00240      1                ,IDENT3,CUNIT,PNTRC,IMNC,STATUS)
00241       CALL COSROUT(MADRID(PNTRI),MADRID(PNTRC),NPIX(1),NPIX(2),
00242      1             RON,GAIN,NS,SKY,RC
00243      1            ,MADRID(PNTRF),MADRID(PNTRO))
00244 
00245       CUTS(1) = 0
00246       CUTS(2) = 1
00247       IF (IOMODE.EQ.F_O_MODE) 
00248      + CALL STDWRR(IMNC,'LHCUTS',CUTS,1,2,KUN,STATUS)
00249       CALL DSCUPT(IMNI,IMNO,' ',STATUS) 
00250       CALL STSEPI
00251       END
00252 
00253 
00254 */
00255 
00256    check_nomsg(uves_cosrout(ima,msk,ron,gain,ns,sky,rc,flt,out));
00257   cleanup:
00258   return CPL_ERROR_NONE;
00259 }
00260 
00261 
00262 /*---------------------------------------------------------------------------*/
00275 /*---------------------------------------------------------------------------*/
00276 static double 
00277 uves_ksigma_vector(cpl_vector *values,double klow, double khigh, int kiter)
00278 {
00279     cpl_vector *accepted;
00280     double  mean  = 0.0;
00281     double  sigma = 0.0;
00282     double *data  = cpl_vector_get_data(values);
00283     int     n     = cpl_vector_get_size(values);
00284     int     ngood = n;
00285     int     count = 0;
00286     int     i;
00287  
00288     /*
00289      * At first iteration the mean is taken as the median, and the
00290      * standard deviation relative to this value is computed.
00291      */
00292 
00293     check_nomsg(mean = cpl_vector_get_median(values));
00294 
00295     for (i = 0; i < n; i++) {
00296         sigma += (mean - data[i]) * (mean - data[i]);
00297     }
00298     sigma = sqrt(sigma / (n - 1));
00299 
00300     while (kiter) {
00301         count = 0;
00302         for (i = 0; i < ngood; i++) {
00303             if (data[i]-mean < khigh*sigma && mean-data[i] < klow*sigma) {
00304                 data[count] = data[i];
00305                 ++count;
00306             }
00307         }
00308 
00309         if (count == 0) // This cannot happen at first iteration.
00310             break;      // So we can break: we have already computed a mean.
00311 
00312         /*
00313          * The mean must be computed even if no element was rejected
00314          * (count == ngood), because at first iteration median instead
00315          * of mean was computed.
00316          */
00317 
00318         check_nomsg(accepted = cpl_vector_wrap(count, data));
00319         check_nomsg(mean = cpl_vector_get_mean(accepted));
00320         if(count>1) {
00321            check_nomsg(sigma = cpl_vector_get_stdev(accepted));
00322         }
00323         check_nomsg(cpl_vector_unwrap(accepted));
00324 
00325         if (count == ngood) {
00326             break;
00327         }
00328         ngood = count;
00329         --kiter;
00330     }
00331   cleanup:
00332 
00333     return mean;
00334 }
00335 
00336 
00355 cpl_image *
00356 uves_ksigma_stack(const cpl_imagelist *imlist, double klow, double khigh, int kiter)
00357 {
00358     int         ni, nx, ny, npix;
00359     cpl_image  *out_ima=NULL;
00360     cpl_imagelist  *loc_iml=NULL;
00361     double      *pout_ima=NULL;
00362     cpl_image  *image=NULL;
00363     const double     **data=NULL;
00364     double     *med=NULL;
00365     cpl_vector *time_line=NULL;
00366   
00367     double     *ptime_line=NULL;
00368     int         i, j;
00369    double mean_of_medians=0;
00370 
00371     passure(imlist != NULL, "Null input imagelist!");
00372 
00373     ni         = cpl_imagelist_get_size(imlist);
00374     loc_iml        = cpl_imagelist_duplicate(imlist);
00375     image      = cpl_imagelist_get(loc_iml, 0);
00376     nx         = cpl_image_get_size_x(image);
00377     ny         = cpl_image_get_size_y(image);
00378     npix       = nx * ny;
00379 
00380     out_ima    = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
00381     pout_ima   = cpl_image_get_data_double(out_ima);
00382 
00383     time_line  = cpl_vector_new(ni);
00384    
00385     ptime_line = cpl_vector_get_data(time_line);
00386 
00387     data = cpl_calloc(sizeof(double *), ni);
00388     med  = cpl_calloc(sizeof(double), ni);
00389 
00390     for (i = 0; i < ni; i++) {
00391         image = cpl_imagelist_get(loc_iml, i);
00392         med[i]=cpl_image_get_median(image);
00393         cpl_image_subtract_scalar(image,med[i]);
00394         data[i] = cpl_image_get_data_double(image);
00395         mean_of_medians+=med[i];
00396     }
00397     mean_of_medians/=ni;
00398 
00399     for (i = 0; i < npix; i++) {
00400         for (j = 0; j < ni; j++) {
00401              ptime_line[j] = data[j][i];
00402          }
00403         check_nomsg(pout_ima[i] = uves_ksigma_vector(time_line, klow, khigh, kiter)); 
00404     }
00405  
00406     cpl_image_add_scalar(out_ima,mean_of_medians);
00407 
00408   cleanup:
00409     cpl_free(data);
00410     cpl_free(med);
00411     cpl_vector_delete(time_line);
00412     uves_free_imagelist(&loc_iml);
00413 
00414     return out_ima;
00415 
00416 } 
00417 
00418 
00419 
00451 cpl_image *
00452 uves_get_wave_map(
00453                   cpl_image * ima_sci,
00454           const char *context,
00455                   const cpl_parameterlist *parameters,
00456           const cpl_table *ordertable,
00457           const cpl_table *linetable,
00458           const polynomial* order_locations,
00459           const polynomial *dispersion_relation,
00460           const int first_abs_order,
00461           const int last_abs_order,
00462           const int slit_size)
00463 {
00464 
00465   cpl_image* wave_map=NULL;
00466   double* pwmap=NULL;
00467   int ord_min=0;
00468   int ord_max=0;
00469   int i=0;
00470   int j=0;
00471   double xpos=0;
00472   double ypos=0;
00473   double wlen=0;
00474   
00475   int nx=0;
00476   int ny=0;
00477   int aord=0;
00478   int order=0;
00479   int jj=0;
00480   int norders=0;
00481   int hs=0;
00482 
00483   uves_msg("Creating wave map");
00484   /* set half slit size */
00485   hs=slit_size/2;
00486 
00487   /* get wave map size */ 
00488   nx = cpl_image_get_size_x(ima_sci);
00489   ny = cpl_image_get_size_y(ima_sci);
00490      
00491   /* get ord min-max */
00492   ord_min=cpl_table_get_column_min(ordertable,"Order");
00493   ord_max=cpl_table_get_column_max(ordertable,"Order");
00494   norders=ord_max-ord_min+1;
00495 
00496   check_nomsg(wave_map=cpl_image_new(nx,ny,CPL_TYPE_DOUBLE));
00497   pwmap=cpl_image_get_data_double(wave_map);
00498 
00499   for (order = 1; order <= norders; order++){
00500     /* wave solution need absolute order value */
00501     aord = uves_absolute_order(first_abs_order, last_abs_order, order);
00502     for (i=0;i<nx;i++) {
00503       xpos=(double)i;
00504       wlen=uves_polynomial_evaluate_2d(dispersion_relation,xpos,aord)/aord;
00505       ypos=uves_polynomial_evaluate_2d(order_locations,xpos,order);
00506       for (jj=-hs;jj<hs;jj++) {
00507     j=(int)(ypos+jj+0.5);
00508         /* check the point is on the detector */
00509     if( (j>0) && ( (j*nx+i)<nx*ny) ) {
00510       pwmap[j*nx+i]=wlen;
00511     }
00512       }
00513     }
00514   }
00515 
00516   /*
00517   check_nomsg(cpl_image_save(wave_map,"wmap.fits",CPL_BPP_IEEE_FLOAT,NULL,
00518                  CPL_IO_DEFAULT));
00519   */
00520  cleanup:
00521   return wave_map;
00522 }
00523 
00524 
00525 
00526 
00527 
00528 
00529 
00550 cpl_image *
00551 uves_flat_create_normalized_master2(cpl_imagelist * flats,
00552                                     const cpl_table *ordertable,
00553                                     const polynomial* order_locations,
00554                                     const cpl_image* mflat)
00555 {
00556 
00557    cpl_imagelist* flats_norm=NULL;
00558 
00559    cpl_image* master_flat=NULL;
00560    /* cpl_image* img=NULL; */
00561    cpl_image* flat=NULL;
00562    cpl_image* flat_mflat=NULL;
00563 
00564    cpl_vector* vec_flux=NULL;
00565    double* pvec_flux=NULL;
00566 
00567    int ni=0;
00568    int i=0;
00569    int sx=0;
00570    int sy=0;
00571    int ord_min=0;
00572    int ord_max=0;
00573    int nord=0;
00574    int nsam=10;
00575    int x_space=10;
00576    int llx=0;
00577    int lly=0;
00578    int urx=0;
00579    int ury=0;
00580    int hbox_sx=0;
00581    int hbox_sy=0;
00582    int ord=0;
00583    int absord=0;
00584    int pos_x=0;
00585    int pos_y=0;
00586    double x=0;
00587    double y=0;
00588    double flux_median=0;
00589    double mean_explevel=0;
00590    /* double exptime=0; */
00591    int is=0;
00592    int k=0;
00593 
00594    ni=cpl_imagelist_get_size(flats);
00595    
00596    /* evaluate medain on many windows distribuited all over orders of flats */
00597    sx         = cpl_image_get_size_x(mflat);
00598    sy         = cpl_image_get_size_y(mflat);
00599 
00600 
00601    ord_min=cpl_table_get_column_min(ordertable,"Order");
00602    ord_max=cpl_table_get_column_max(ordertable,"Order");
00603    nord=ord_max-ord_min+1;
00604 
00605    hbox_sx=(int)((sx-2*x_space)/(2*nsam)+0.5);
00606    flats_norm=cpl_imagelist_new();
00607    for(i=0;i<ni;i++) {
00608    uves_free_vector(&vec_flux);
00609    vec_flux=cpl_vector_new(nord*nsam);
00610    pvec_flux=cpl_vector_get_data(vec_flux);
00611      uves_free_image(&flat_mflat);
00612      uves_free_image(&flat);
00613       check_nomsg(flat = cpl_image_duplicate(cpl_imagelist_get(flats, i)));
00614       /* normalize flats by master flat */
00615       flat_mflat=cpl_image_duplicate(flat);
00616       cpl_image_divide(flat_mflat,mflat);
00617       
00618       k=0;
00619       for(ord=0;ord<nord;ord++) {
00620          absord=ord+ord_min;
00621          pos_x=-hbox_sx;
00622          for(is=0;is<nsam;is++) {
00623             pos_x+=(2*hbox_sx+x_space);
00624             x=(int)(pos_x+0.5);
00625 
00626             check_nomsg(y=uves_polynomial_evaluate_2d(order_locations, 
00627                                                       x, absord));
00628             pos_y=(int)(y+0.5);
00629 
00630             check_nomsg(llx=uves_max_int(pos_x-hbox_sx,1));
00631             check_nomsg(lly=uves_max_int(pos_y-hbox_sy,1));
00632             check_nomsg(llx=uves_min_int(llx,sx));
00633             check_nomsg(lly=uves_min_int(lly,sy));
00634 
00635             check_nomsg(urx=uves_min_int(pos_x+hbox_sx,sx));
00636             check_nomsg(ury=uves_min_int(pos_y+hbox_sy,sy));
00637             check_nomsg(urx=uves_max_int(urx,1));
00638             check_nomsg(ury=uves_max_int(ury,1));
00639 
00640             check_nomsg(llx=uves_min_int(llx,urx));
00641             check_nomsg(lly=uves_min_int(lly,ury));
00642 
00643         check_nomsg(pvec_flux[k]=0);
00644 
00645             check_nomsg(pvec_flux[k]=cpl_image_get_median_window(flat_mflat,llx,lly,urx,ury));
00646 
00647             k++;
00648          }
00649 
00650       }
00651 
00652       flux_median=cpl_vector_get_median(vec_flux);
00653       uves_msg("Flat %d normalize factor iter2: %g",i,flux_median);
00654       cpl_image_divide_scalar(flat,flux_median);
00655       cpl_imagelist_set(flats_norm,cpl_image_duplicate(flat),i);
00656       mean_explevel+=flux_median;
00657    }
00658    mean_explevel/=ni;
00659    
00660    check_nomsg(cpl_imagelist_multiply_scalar(flats_norm,mean_explevel));
00661 
00662    check( master_flat = cpl_imagelist_collapse_median_create(flats_norm),
00663           "Error computing median");
00664 
00665 
00666 
00667 
00668   cleanup:
00669 
00670    uves_free_imagelist(&flats_norm);
00671    uves_free_vector(&vec_flux);
00672    uves_free_image(&flat_mflat);
00673    uves_free_image(&flat);
00674    uves_check_rec_status(0);
00675    return master_flat;
00676 
00677 }
00678 
00679 
00701 cpl_image *
00702 uves_flat_create_normalized_master(cpl_imagelist * flats,
00703                                    const cpl_table *ordertable,
00704                                    const polynomial* order_locations,
00705                    const cpl_vector* gain_vals ,
00706                    double* fnoise)
00707 {
00708    int         ni;
00709    cpl_image  *image=NULL;
00710    cpl_image* master_flat=NULL;
00711    cpl_imagelist* flats_norm=NULL;
00712    int   k=0;
00713    int ord_min=0;
00714    int ord_max=0;
00715    int nord=0;
00716    double flux_mean=0;
00717    int nsam=10;
00718    int x_space=10;
00719    int hbox_sx=0;
00720    int hbox_sy=10;
00721    int is=0;
00722    int pos_x=0;
00723    int pos_y=0;
00724    int llx=0;
00725    int lly=0;
00726    int urx=0;
00727    int ury=0;
00728 
00729    double x=0;
00730    double y=0;
00731    int sx=0;
00732    int sy=0;
00733    cpl_vector* vec_flux_ord=NULL;
00734    cpl_vector* vec_flux_sam=NULL;
00735    double* pvec_flux_ord=NULL;
00736    double* pvec_flux_sam=NULL;
00737    int absord=0;
00738    int ord=0;
00739    const double* pgain_vals=NULL;
00740    double fnoise_local=0;
00741 
00742    passure(flats != NULL, "Null input flats imagelist!");
00743    passure(order_locations != NULL, "Null input order locations polinomial!");
00744 
00745    ni         = cpl_imagelist_get_size(flats);
00746 
00747    image      = cpl_image_duplicate(cpl_imagelist_get(flats, 0));
00748    sx         = cpl_image_get_size_x(image);
00749    sy         = cpl_image_get_size_y(image);
00750 
00751    uves_free_image(&image);
00752    ord_min=cpl_table_get_column_min(ordertable,"Order");
00753    ord_max=cpl_table_get_column_max(ordertable,"Order");
00754    nord=ord_max-ord_min+1;
00755    vec_flux_ord=cpl_vector_new(nord);
00756    vec_flux_sam=cpl_vector_new(nsam);
00757    pvec_flux_ord=cpl_vector_get_data(vec_flux_ord);
00758    pvec_flux_sam=cpl_vector_get_data(vec_flux_sam);
00759    hbox_sx=(int)((sx-2*x_space)/(2*nsam)+0.5);
00760    flats_norm=cpl_imagelist_new();
00761    pgain_vals=cpl_vector_get_data_const(gain_vals);
00762 
00763    for(k=0;k<ni;k++) {
00764       uves_free_image(&image);
00765       image = cpl_image_duplicate(cpl_imagelist_get(flats, k));
00766       for(ord=0;ord<nord;ord++) {
00767          absord=ord+ord_min;
00768          pos_x=-hbox_sx;
00769          for(is=0;is<nsam;is++) {
00770             pos_x+=(2*hbox_sx+x_space);
00771             x=(int)(pos_x+0.5);
00772 
00773             check_nomsg(y=uves_polynomial_evaluate_2d(order_locations, 
00774                                                       x, absord));
00775             pos_y=(int)(y+0.5);
00776 
00777             llx=uves_max_int(pos_x-hbox_sx,1);
00778             lly=uves_max_int(pos_y-hbox_sy,1);
00779             llx=uves_min_int(llx,sx);
00780             lly=uves_min_int(lly,sy);
00781 
00782             urx=uves_min_int(pos_x+hbox_sx,sx);
00783             ury=uves_min_int(pos_y+hbox_sy,sy);
00784             urx=uves_max_int(urx,1);
00785             ury=uves_max_int(ury,1);
00786 
00787             llx=uves_min_int(llx,urx);
00788             lly=uves_min_int(lly,ury);
00789 
00790             check_nomsg(pvec_flux_sam[is]=cpl_image_get_median_window(image,llx,lly,urx,ury));
00791 
00792          }
00793          pvec_flux_ord[ord]=cpl_vector_get_mean(vec_flux_sam);
00794       }
00795 
00796       flux_mean=cpl_vector_get_mean(vec_flux_ord);
00797       uves_msg("Flat %d normalize factor inter1: %g",k,flux_mean);
00798       fnoise_local+=pgain_vals[k]*flux_mean;
00799       cpl_image_divide_scalar(image,flux_mean);
00800       cpl_imagelist_set(flats_norm,cpl_image_duplicate(image),k);
00801    }
00802    *fnoise=1./sqrt(fnoise_local);
00803    check( master_flat = cpl_imagelist_collapse_median_create(flats_norm),
00804           "Error computing median");
00805  
00806    uves_msg("FNOISE %g ",*fnoise);
00807   cleanup:
00808 
00809    uves_free_vector(&vec_flux_ord);
00810    uves_free_vector(&vec_flux_sam);
00811    uves_free_image(&image);
00812    uves_free_imagelist(&flats_norm);
00813 
00814 
00815    return master_flat;
00816 
00817 }
00818 
00819 /*---------------------------------------------------------------------------*/
00843 /*---------------------------------------------------------------------------*/
00844 
00845 static cpl_error_code 
00846 uves_cosrout(cpl_image* ima,
00847              cpl_image** msk,
00848              const double ron, 
00849              const double gain,
00850              const int ns,
00851              const double sky,
00852              const double rc,
00853              cpl_image** flt,
00854              cpl_image** out)
00855 {
00856 
00857 
00858 /*
00859 
00860       SUBROUTINE COSROUT(AI,COSMIC,I_IMA,J_IMA,RON,GAIN,
00861      1                   NS,SKY,RC,AM,AO)
00862       INTEGER I_IMA,J_IMA,NUM
00863       INTEGER ORD(10000)
00864       INTEGER K,L
00865       INTEGER IDUMAX,JDUMAX,I1,I2,J1,II,JJ
00866       INTEGER I,J,IMAX,JMAX,IMIN,JMIN
00867       INTEGER FIRST(2),NEXT(2)
00868       INTEGER*2 COSMIC(I_IMA,J_IMA)
00869       REAL*4 VECTEUR(10000),FMAX,ASUM,RC
00870       REAL*4 AI(I_IMA,J_IMA),AO(I_IMA,J_IMA),AM(I_IMA,J_IMA)
00871       REAL*4 SIGMA,SKY,S1,S2
00872       REAL*4 RON,GAIN,NS,AMEDIAN
00873 
00874 */
00875 
00876   int sx=0;
00877   int sy=0;
00878   int i=0;
00879   int j=0;
00880   int k=1;
00881   int pix=0;
00882   int first[2];
00883   int next_x=0;
00884   int next_y=0;
00885   int i_min=0;
00886   int i_max=0;
00887   int j_min=0;
00888   int j_max=0;
00889   int idu_max=0;
00890   int jdu_max=0;
00891   int i1=0;
00892   int i2=0;
00893   int ii=0;
00894   int jj=0;
00895   int j1=0;
00896   int num=0;
00897   int l=0;
00898   int nmax=1e6;
00899   int ord[nmax];
00900 
00901 
00902   float* pi=NULL;
00903   float* po=NULL;
00904   float* pf=NULL;
00905   int* pm=NULL;
00906   float sigma=0;
00907 
00908 
00909   float vec[nmax];
00910 
00911   double f_max=0;
00912   double s1=0;
00913   double s2=0;
00914   double asum=0;
00915   double a_median=0;
00916 
00917   uves_msg_warning("sky=%g gain=%g ron=%g ns=%d rc=%g",sky,gain,ron,ns,rc);
00918   check_nomsg(sx=cpl_image_get_size_x(ima));
00919   check_nomsg(sy=cpl_image_get_size_y(ima));
00920   check_nomsg(pi=cpl_image_get_data_float(ima));
00921   //*flt=cpl_image_new(sx,sy,CPL_TYPE_FLOAT);
00922   *msk=cpl_image_new(sx,sy,CPL_TYPE_INT);
00923 
00924   check_nomsg(pf=cpl_image_get_data_float(*flt));
00925   check_nomsg(pm=cpl_image_get_data_int(*msk));
00926 
00927   check_nomsg(*out=cpl_image_duplicate(ima));
00928   check_nomsg(po=cpl_image_get_data_float(*out));
00929 
00930 /*
00931 
00932       DO 10 J=1,J_IMA
00933       DO 5 I=1,I_IMA
00934       AO(I,J)=AI(I,J)
00935       COSMIC(I,J)= 0
00936     5 CONTINUE
00937    10 CONTINUE
00938 
00939 C
00940 C     La boucle suivante selectionne les pixels qui sont
00941 C     significativ+ement au dessus de l'image filtree medianement.
00942 C
00943 C    The flowing loop selects the pixels that are much higher that the 
00944 C    median filter image
00945 C
00946 C     COSMIC =-1 ----> candidate for cosmic
00947 C            = 0 ----> not a cosmic
00948 C            = 1 -----> a cosmic (at the end)
00949 C            = 2 ----> member of the group
00950 C            = 3 ----> member of a group which has been examined
00951 C            = 4 ----> neighbourhood  of the group
00952       K=1
00953       DO 80 J=2,J_IMA-1
00954       DO 70 I=2,I_IMA-1
00955       SIGMA=SQRT(RON**2+AM(I,J)/GAIN)
00956       IF ((AI(I,J)-AM(I,J)).GE.(NS*SIGMA)) THEN
00957             COSMIC(I,J) = -1
00958             K = K+1
00959       ENDIF
00960    70 CONTINUE
00961    80 CONTINUE
00962 
00963 
00964 */
00965 
00966 
00967   uves_msg_warning("Set all pix to = -1 -> candidate for cosmic");
00968   k=1;
00969   for(j=1;j<sy-1;j++) {
00970     for(i=1;i<sx-1;i++) {
00971       pix=j*sx+i;
00972       sigma=sqrt(ron*ron+pf[pix]/gain);
00973       if ( (pi[pix]-pf[pix]) >= (ns*sigma) ) {
00974     pm[pix]=-1;
00975         k++;
00976       }
00977     }
00978   }
00979 
00980 
00981   /*
00982 
00983      La boucle suivante selectionne les pixels qui sont
00984      significativement au dessus de l'image filtree medianement.
00985 
00986      The flowing loop selects the pixels that are much higher that the 
00987      median filter image
00988 
00989 
00990      COSMIC =-1 ----> candidate for cosmic
00991             = 0 ----> not a cosmic
00992             = 1 -----> a cosmic (at the end)
00993             = 2 ----> member of the group
00994             = 3 ----> member of a group which has been examined
00995             = 4 ----> neighbourhood  of the group
00996 
00997   */
00998 
00999 
01000 /*
01001   Ces pixels sont regroupes par ensembles connexes dans la boucle
01002   This pixels are gouped as grouped together if neibours
01003 */
01004 
01005   first[0]=1;
01006   first[1]=1;
01007 
01008  lab100:
01009   check_nomsg(uves_find_next(msk,first[1],&next_x, &next_y));
01010 
01011   if(next_x==-1) return CPL_ERROR_NONE;
01012   i=next_x;
01013   j=next_y;
01014 
01015   uves_msg_debug("p[%d,%d]=  2 -> member of the group",i,j);
01016   pix=j*sx+i;
01017   pm[pix]=2;
01018 
01019   i_min=i;
01020   i_max=i;
01021   j_min=j;
01022   j_max=j;
01023   idu_max=i;
01024   jdu_max=j;
01025   f_max=pi[pix];
01026 
01027  lab110:
01028   i1=0;
01029   i2=0;
01030 
01031 
01032 
01033 /*
01034       FIRST(1) = 2
01035       FIRST(2) = 2
01036   100 CALL FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
01037       IF (NEXT(1).EQ.-1) RETURN
01038       I = NEXT(1)
01039       J = NEXT(2) 
01040       COSMIC(I,J) = 2
01041       IMIN = I
01042       IMAX = I 
01043       JMIN = J
01044       JMAX = J
01045       IDUMAX = I
01046       JDUMAX = J
01047       FMAX = AI(I,J)
01048   110 I1 = 0
01049       I2 = 0
01050       CONTINUE
01051 
01052 */
01053 
01054   for(l=0;l<2;l++) {
01055     for(k=0;k<2;k++) {
01056       ii=i+k-l;
01057       jj=j+k+l-3;
01058       pix=jj*sx+ii;
01059       if(pm[pix]==-1) {
01060     i1=ii;
01061     j1=jj;
01062     i_min=(i_min<ii) ? i_min: ii;
01063     i_max=(i_max>ii) ? i_max: ii;
01064     j_min=(j_min<jj) ? j_min: jj;
01065     j_max=(j_max>jj) ? j_max: jj;
01066         uves_msg_debug("p[%d,%d]= 2 -> member of the group",ii,jj);
01067     pm[pix]=2;
01068     if(pi[pix]>f_max) {
01069       f_max=pi[pix];
01070       idu_max=ii;
01071       idu_max=jj;
01072     }
01073       } else if(pm[pix]==0) {
01074     pm[pix]=4;
01075         uves_msg_debug("p[%d,%d]= 4 -> neighbourhood  of the group",k,l);
01076       }
01077     }
01078   }
01079 
01080 
01081 /*
01082       DO 125 L=1,2
01083           DO 115 K=1,2
01084                II = I+K-L
01085                JJ = J+K+L-3
01086                IF (COSMIC(II,JJ).EQ.-1) THEN
01087                    I1 = II
01088                    J1 = JJ  
01089                    IMIN = MIN(IMIN,II) 
01090                    IMAX = MAX(IMAX,II)
01091                    JMIN = MIN(JMIN,JJ)
01092                    JMAX = MAX(JMAX,JJ)
01093                    COSMIC(II,JJ) = 2
01094                    IF (AI(II,JJ).GT.FMAX) THEN
01095                          FMAX = AI(II,JJ)
01096                          IDUMAX = II
01097                          JDUMAX = JJ
01098                    ENDIF
01099                 ELSE IF (COSMIC(II,JJ).EQ.0) THEN
01100                    COSMIC(II,JJ) = 4
01101                 ENDIF
01102   115     CONTINUE 
01103   125 CONTINUE 
01104 
01105 */
01106 
01107 
01108   pix=j*sx+i;
01109   pm[pix]=3;
01110   uves_msg_debug("p[%d,%d]= 3 -> member of a group which has been examined",i,j);
01111   if(i1 != 0) {
01112     i=i1;
01113     j=j1;
01114     goto lab110;
01115   }
01116 
01117 
01118 /*
01119       COSMIC(I,J) = 3
01120       IF (I1.NE.0) THEN
01121       I = I1
01122       J = J1
01123       GOTO 110
01124       ENDIF    
01125 */
01126 
01127   for(l=j_min;l<=j_max;l++){
01128     for(k=i_min;k<=i_max;k++){
01129       pix=l*sy+k;
01130       if(pm[pix] == 2) {
01131     i=k;
01132     j=l;
01133     goto lab110;
01134       }
01135     }
01136   }
01137   first[0] = next_x+1;
01138   first[1] = next_y; 
01139 
01140 
01141 /*
01142       DO 140 L = JMIN,JMAX  
01143          DO 130 K = IMIN,IMAX
01144               IF (COSMIC(K,L).EQ.2) THEN
01145                  I = K
01146                  J = L
01147                  GOTO 110
01148               ENDIF
01149   130 CONTINUE
01150   140 CONTINUE   
01151       FIRST(1) = NEXT(1)+1
01152       FIRST(2) = NEXT(2) 
01153 
01154 */
01155 
01156 
01157   /*
01158   We start here the real work....
01159   1- decide if the pixel's group is a cosmic
01160   2-replace these values by another one
01161   */
01162   s1=pi[(jdu_max-1)*sx+idu_max-1]+
01163      pi[(jdu_max-1)*sx+idu_max+1]+
01164      pi[(jdu_max-1)*sx+idu_max]+
01165      pi[(jdu_max+1)*sx+idu_max];
01166 
01167   s2=pi[(jdu_max+1)*sy+idu_max-1]+
01168      pi[(jdu_max+1)*sy+idu_max+1]+
01169      pi[(jdu_max)*sy+idu_max-1]+
01170      pi[(jdu_max)*sy+idu_max+1];
01171   asum=(s1+s2)/8.-sky;
01172 
01173 
01174 /*
01175 
01176 C We start here the real work....
01177 C 1- decide if the pixel's group is a cosmic
01178 C 2-replace these values by another one
01179       
01180       S1 = AI(IDUMAX-1,JDUMAX-1) + 
01181      !     AI(IDUMAX+1,JDUMAX-1) +     
01182      !     AI(IDUMAX,JDUMAX-1)   +
01183      !     AI(IDUMAX,JDUMAX+1)
01184 
01185       S2 = AI(IDUMAX-1,JDUMAX+1) + 
01186      !     AI(IDUMAX+1,JDUMAX+1) +
01187      !     AI(IDUMAX-1,JDUMAX)   + 
01188      !     AI(IDUMAX+1,JDUMAX)
01189       ASUM = (S1+S2)/8.-SKY
01190 
01191 */
01192 
01193   if((f_max-sky) > rc*asum) {
01194     num=0;
01195     for( l = j_min-1; l <= j_max+1; l++) {
01196       for( k = i_min-1; k<= i_max+1;k++) {
01197     if(pm[l*sx+k]==4) {
01198       vec[num]=pi[l*sx+k];
01199       num++;
01200     }
01201       }
01202     }
01203 
01204 
01205 /*
01206 
01207       IF ((FMAX-SKY).GT.RC*ASUM) THEN
01208          NUM = 1
01209          DO L = JMIN-1,JMAX+1
01210             DO K = IMIN-1,IMAX+1
01211                IF (COSMIC(K,L).EQ.4) THEN
01212                    VECTEUR(NUM) = AI(K,L)
01213                    NUM = NUM+1
01214                ENDIF    
01215             ENDDO
01216          ENDDO
01217 
01218 */
01219 
01220     uves_sort(num-1,vec,ord);
01221     a_median=vec[ord[(num-1)/2]];
01222     for(l = j_min-1; l <= j_max+1 ; l++){
01223       for(k = i_min-1 ; k <= i_max+1 ; k++){
01224     if(pm[l*sx+k] == 3) {
01225        pm[l*sx+k]=1;
01226            uves_msg_debug("p[%d,%d]= 1 -> a cosmic (at the end)",k,l);
01227 
01228        po[l*sx+k]=a_median;
01229     } else if (pm[l*sx+k] == 4) {
01230        po[l*sx+k]=0;
01231        po[l*sx+k]=a_median;//here we set to median instead than 0
01232     }
01233       }
01234     }
01235 
01236 
01237 /*
01238          CALL SORT(NUM-1,VECTEUR,ORD)
01239          AMEDIAN = VECTEUR(ORD((NUM-1)/2))
01240          DO L = JMIN-1,JMAX+1
01241             DO K = IMIN-1,IMAX+1
01242                IF (COSMIC(K,L).EQ.3) THEN
01243                    COSMIC(K,L) = 1
01244                    AO(K,L) = AMEDIAN
01245                ELSE IF (COSMIC(K,L).EQ.4) THEN
01246                    COSMIC(K,L) = 0
01247                ENDIF
01248             ENDDO
01249          ENDDO
01250 */
01251 
01252   } else {
01253     for( l = j_min-1 ; l <= j_max+1 ; l++) {
01254       for( k = i_min-1 ; k <= i_max+1 ; k++) {
01255     if(pm[l*sx+k] != -1) {
01256            uves_msg_debug("p[%d,%d]= 0 -> not a cosmic",k,l);
01257        pm[l*sx+k] = 0;
01258     }
01259       }
01260     }
01261   }
01262 
01263 
01264   if (next_x >0) goto lab100;
01265 
01266 
01267 /*
01268       ELSE 
01269          DO L = JMIN-1,JMAX+1
01270             DO K = IMIN-1,IMAX+1
01271                IF (COSMIC(K,L).NE.-1) COSMIC(K,L) = 0
01272             ENDDO
01273           ENDDO
01274       ENDIF
01275         
01276       
01277  
01278       IF (NEXT(1).GT.0) GOTO 100
01279 C
01280 C
01281 C
01282       RETURN
01283       END
01284 
01285 
01286 */
01287 
01288 
01289   cleanup:
01290 
01291   return CPL_ERROR_NONE;
01292 
01293 }
01294 
01295 
01296 
01297 
01298 
01299 static cpl_error_code 
01300 uves_find_next(cpl_image** msk,
01301                const int first_y,
01302                int* next_x,
01303                int* next_y)
01304 {
01305   int sx=cpl_image_get_size_x(*msk);
01306   int sy=cpl_image_get_size_y(*msk);
01307   int i=0;
01308   int j=0;
01309   int* pc=NULL;
01310   int pix=0;
01311 
01312 
01313 
01314   check_nomsg(pc=cpl_image_get_data_int(*msk));
01315   for(j=first_y;j<sy;j++) {
01316     for(i=1;i<sx;i++) {
01317       pix=j*sx+i;
01318       if(pc[pix]==-1) {
01319     *next_x=i;
01320     *next_y=j;
01321     return CPL_ERROR_NONE;
01322       }
01323     }
01324   }
01325 
01326   *next_x=-1;
01327   *next_y=-1;
01328   cleanup:
01329   return CPL_ERROR_NONE;
01330 
01331 }
01332 
01333 /*
01334 
01335       SUBROUTINE FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
01336       INTEGER I_IMA,J_IMA,FIRST(2),NEXT(2)
01337       INTEGER I,J
01338       INTEGER*2 COSMIC(I_IMA,J_IMA)
01339       DO J = FIRST(2), J_IMA
01340           DO I = 2, I_IMA
01341              IF (COSMIC(I,J).EQ.-1) THEN
01342                  NEXT(1) = I
01343                  NEXT(2) = J
01344                  RETURN
01345              ENDIF
01346           ENDDO
01347       ENDDO 
01348       NEXT(1) = -1
01349       NEXT(2) = -1
01350       RETURN
01351       END
01352 
01353 */
01354 
01355 
01356 //Be carefull with F77 and C indexing
01357 static cpl_error_code
01358 uves_sort(const int kmax,float* inp, int* ord)
01359 {
01360   int k=0;
01361   int j=0;
01362   int l=0;
01363   float f=0;
01364   int i_min=0;
01365   int i_max=0;
01366   int i=0;
01367 
01368   for(k=0;k<kmax;k++) {
01369     ord[k]=k;
01370   }
01371 
01372   if(inp[0]>inp[1]) {
01373     ord[0]=1;
01374     ord[1]=0;
01375   }
01376 
01377   for(j=2;j<kmax;j++) {
01378     f=inp[j];
01379     l=inp[j-1];
01380 
01381 /*
01382       SUBROUTINE SORT(KMAX,INP,ORD)
01383       INTEGER KMAX,IMIN,IMAX,I,J,K,L
01384       INTEGER ORD(10000)
01385       REAL*4 INP(10000),F
01386       DO 4100 J=1,KMAX
01387       ORD(J)=J
01388  4100 CONTINUE
01389       IF (INP(1).GT.INP(2)) THEN 
01390              ORD(1)=2
01391              ORD(2)=1
01392       END IF
01393       DO 4400 J=3,KMAX
01394       F=INP(J)
01395       L=ORD(J-1)
01396 */
01397 
01398   if(inp[l]<=f) goto lab4400;
01399     l=ord[0];
01400     i_min=0;
01401     if(f<=inp[l]) goto lab4250;
01402     i_max=j-1;
01403   lab4200:
01404     i=(i_min+i_max)/2;
01405     l=ord[i];
01406 
01407 /*
01408       IF (INP(L).LE.F) GO TO 4400
01409       L=ORD(1)
01410       IMIN=1
01411       IF (F.LE.INP(L)) GO TO 4250
01412       IMAX=J-1
01413  4200 I=(IMIN+IMAX)/2
01414       L=ORD(I)
01415 */
01416 
01417     if(inp[l]<f) {
01418       i_min=i;
01419     } else {
01420       i_max=i;
01421     }
01422     if(i_max>(i_min+1)) goto lab4200;
01423     i_min=i_max;
01424   lab4250:
01425     for(k=j-2;k>=i_min;k--) {
01426       ord[k+1]=ord[k];
01427     }
01428     ord[i_min]=j;
01429   lab4400:
01430     return CPL_ERROR_NONE;
01431   }
01432     return CPL_ERROR_NONE;
01433 }
01434 
01435 /*
01436       IF (INP(L).LT.F) THEN
01437               IMIN=I
01438               ELSE
01439               IMAX=I
01440       END IF
01441       IF (IMAX.GT.(IMIN+1)) GO TO 4200
01442       IMIN=IMAX
01443  4250 DO 4300 K=J-1,IMIN,-1
01444       ORD(K+1)=ORD(K)
01445  4300 CONTINUE
01446       ORD(IMIN)=J
01447  4400 CONTINUE
01448       RETURN
01449       END
01450 */
01451 
01452 /*---------------------------------------------------------------------------*/
01458 /*---------------------------------------------------------------------------*/
01459 
01460 cpl_parameterlist* 
01461 uves_parameterlist_duplicate(const cpl_parameterlist* pin){
01462 
01463    cpl_parameter* p=NULL;
01464    cpl_parameterlist* pout=NULL;
01465 
01466    pout=cpl_parameterlist_new();
01467    p=cpl_parameterlist_get_first((cpl_parameterlist*)pin);
01468    while (p != NULL)
01469    {
01470       cpl_parameterlist_append(pout,p);
01471       p=cpl_parameterlist_get_next((cpl_parameterlist*)pin);
01472    }
01473    return pout;
01474 
01475 }
01492 const char*
01493 uves_string_toupper(char* s)
01494 {
01495 
01496     char *t = s;
01497 
01498     if( s == NULL) { 
01499        cpl_error_set(cpl_func,CPL_ERROR_NULL_INPUT); 
01500        return NULL;
01501     };
01502     while (*t) {
01503         *t = toupper(*t);
01504         t++;
01505     }
01506 
01507     return s;
01508 
01509 }
01510 
01526 const char*
01527 uves_string_tolower(char* s)
01528 {
01529 
01530     char *t = s;
01531 
01532     if( s == NULL) { 
01533        cpl_error_set(cpl_func,CPL_ERROR_NULL_INPUT); 
01534        return NULL;
01535     };
01536     while (*t) {
01537         *t = tolower(*t);
01538         t++;
01539     }
01540 
01541     return s;
01542 
01543 }
01544 
01545 
01546 
01547 
01548 /*----------------------------------------------------------------------------*/
01555 /*----------------------------------------------------------------------------*/
01556 cpl_frameset *
01557 uves_frameset_extract(const cpl_frameset *frames,
01558                       const char *tag)
01559 {
01560     cpl_frameset *subset = NULL;
01561     const cpl_frame *f;
01562 
01563 
01564 
01565     assure( frames != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null frameset" );
01566     assure( tag    != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null tag" );
01567     
01568     subset = cpl_frameset_new();
01569 
01570     for (f = cpl_frameset_find_const(frames, tag);
01571          f != NULL;
01572          f = cpl_frameset_find_const(frames, NULL)) {
01573 
01574         cpl_frameset_insert(subset, cpl_frame_duplicate(f));
01575     }
01576 
01577  cleanup:
01578     return subset;
01579 }
01580 
01581 /*----------------------------------------------------------------------------*/
01591 /*----------------------------------------------------------------------------*/
01592 double
01593 uves_pow_int(double x, int y)
01594 {
01595     double result = 1.0;
01596 
01597     /* Invariant is:   result * x ^ y   */
01598     
01599 
01600     while(y != 0)
01601     {
01602         if (y % 2 == 0)
01603         {
01604             x *= x;
01605             y /= 2;
01606         }
01607         else
01608         {
01609             if (y > 0)
01610             {
01611                 result *= x;
01612                 y -= 1;            
01613             }
01614             else
01615             {
01616                 result /= x;
01617                 y += 1;            
01618             }
01619         }
01620     }
01621     
01622     return result;
01623 }
01624 
01625 
01626 
01627 
01628 /*----------------------------------------------------------------------------*/
01637 /*----------------------------------------------------------------------------*/
01638 long
01639 uves_round_double(double x)
01640 {
01641     return (x >=0) ? (long)(x+0.5) : (long)(x-0.5);
01642 }
01643 
01644 /*----------------------------------------------------------------------------*/
01653 /*----------------------------------------------------------------------------*/
01654 double
01655 uves_max_double(double x, double y)
01656 {
01657     return (x >=y) ? x : y;
01658 }
01659 /*----------------------------------------------------------------------------*/
01668 /*----------------------------------------------------------------------------*/
01669 int
01670 uves_max_int(int x, int y)
01671 {
01672     return (x >=y) ? x : y;
01673 }
01674 
01675 /*----------------------------------------------------------------------------*/
01684 /*----------------------------------------------------------------------------*/
01685 double
01686 uves_min_double(double x, double y)
01687 {
01688     return (x <=y) ? x : y;
01689 }
01690 /*----------------------------------------------------------------------------*/
01699 /*----------------------------------------------------------------------------*/
01700 int
01701 uves_min_int(int x, int y)
01702 {
01703     return (x <=y) ? x : y;
01704 }
01705 
01706 /*----------------------------------------------------------------------------*/
01717 /*----------------------------------------------------------------------------*/
01718 double
01719 uves_error_fraction(double x, double y, double dx, double dy)
01720 {
01721     /* Error propagation:
01722      * sigma(x/y)^2 = (1/y sigma(x))^2 + (-x/y^2 sigma(y))^2 
01723      */
01724     return sqrt( dx*dx/(y*y) + x*x*dy*dy/(y*y*y*y) );
01725 }
01726 
01727 
01728 
01729 /*----------------------------------------------------------------------------*/
01738 /*----------------------------------------------------------------------------*/
01739 cpl_error_code
01740 uves_get_version(int *major, int *minor, int *micro)
01741 {
01742     /* Macros are defined in config.h */
01743     if (major != NULL) *major = UVES_MAJOR_VERSION;
01744     if (minor != NULL) *minor = UVES_MINOR_VERSION;
01745     if (micro != NULL) *micro = UVES_MICRO_VERSION;
01746 
01747     return cpl_error_get_code();
01748 }
01749 
01750 
01751 /*----------------------------------------------------------------------------*/
01757 /*----------------------------------------------------------------------------*/
01758 int
01759 uves_get_version_binary(void)
01760 {
01761     return UVES_BINARY_VERSION;
01762 }
01763 
01764 
01765 /*----------------------------------------------------------------------------*/
01773 /*----------------------------------------------------------------------------*/
01774 const char *
01775 uves_get_license(void)
01776 {
01777     return
01778     "This file is part of the ESO UVES Instrument Pipeline\n"
01779     "Copyright (C) 2004,2005,2006 European Southern Observatory\n"
01780     "\n"
01781     "This program is free software; you can redistribute it and/or modify\n"
01782     "it under the terms of the GNU General Public License as published by\n"
01783     "the Free Software Foundation; either version 2 of the License, or\n"
01784     "(at your option) any later version.\n"
01785     "\n"
01786     "This program is distributed in the hope that it will be useful,\n"
01787     "but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
01788     "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the\n"
01789         "GNU General Public License for more details.\n"
01790         "\n"
01791         "You should have received a copy of the GNU General Public License\n"
01792         "along with this program; if not, write to the Free Software\n"
01793         "Foundation, 51 Franklin St, Fifth Floor, Boston, \n"
01794         "MA  02111-1307  USA" ;
01795 
01796     /* Note that long strings are unsupported in C89 */
01797 }
01798 
01799 /*----------------------------------------------------------------------------*/
01809 /*----------------------------------------------------------------------------*/
01810 /* To change requirements, just edit these numbers */
01811 #define REQ_CPL_MAJOR 3
01812 #define REQ_CPL_MINOR 1
01813 #define REQ_CPL_MICRO 0
01814 
01815 #define REQ_QF_MAJOR 6
01816 #define REQ_QF_MINOR 2
01817 #define REQ_QF_MICRO 0
01818 
01819 void
01820 uves_check_version(void)
01821 {
01822 #ifdef CPL_VERSION_CODE
01823 #if CPL_VERSION_CODE >= CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO)
01824     uves_msg_debug("Compile time CPL version code was %d "
01825                    "(version %d-%d-%d, code %d required)",
01826                    CPL_VERSION_CODE, REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO,
01827                    CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO));
01828 #else
01829 #error CPL version too old
01830 #endif
01831 #else  /* ifdef CPL_VERSION_CODE */
01832 #error CPL_VERSION_CODE not defined. CPL version too old
01833 #endif
01834 
01835     if (cpl_version_get_major() < REQ_CPL_MAJOR ||
01836     (cpl_version_get_major() == REQ_CPL_MAJOR && 
01837      (int) cpl_version_get_minor() < REQ_CPL_MINOR) || /* cast suppresses warning
01838                                                               about comparing unsigned < 0 */
01839     (cpl_version_get_major() == REQ_CPL_MAJOR &&
01840      cpl_version_get_minor() == REQ_CPL_MINOR && 
01841      (int) cpl_version_get_micro() < REQ_CPL_MICRO)
01842     )
01843     {
01844         uves_msg_warning("CPL version %s (%d.%d.%d) (detected) is not supported. "
01845                  "Please update to CPL version %d.%d.%d or later", 
01846                  cpl_version_get_version(),
01847                  cpl_version_get_major(),
01848                  cpl_version_get_minor(),
01849                  cpl_version_get_micro(),
01850                  REQ_CPL_MAJOR,
01851                  REQ_CPL_MINOR,
01852                  REQ_CPL_MICRO);
01853     }
01854     else
01855     {
01856         uves_msg_debug("Runtime CPL version %s (%d.%d.%d) detected (%d.%d.%d or later required)",
01857                cpl_version_get_version(),
01858                cpl_version_get_major(),
01859                cpl_version_get_minor(),
01860                cpl_version_get_micro(),
01861                REQ_CPL_MAJOR,
01862                REQ_CPL_MINOR,
01863                REQ_CPL_MICRO);
01864     }
01865 
01866     {
01867     const char *qfts_v = " ";
01868     char *suffix;
01869     
01870     long qfts_major;
01871     long qfts_minor;
01872     long qfts_micro;
01873 
01874     qfts_v = qfits_version();
01875 
01876     assure( qfts_v != NULL, CPL_ERROR_ILLEGAL_INPUT,
01877         "Error reading qfits version");
01878 
01879     /* Parse    "X.[...]" */
01880     qfts_major = strtol(qfts_v, &suffix, 10);
01881     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
01882         CPL_ERROR_ILLEGAL_INPUT, 
01883         "Error parsing version string '%s'. "
01884         "Format 'X.Y.Z' expected", qfts_v);
01885 
01886     /* Parse    "Y.[...]" */
01887     qfts_minor = strtol(suffix+1, &suffix, 10);
01888     assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0', 
01889         CPL_ERROR_ILLEGAL_INPUT,
01890         "Error parsing version string '%s'. "
01891         "Format 'X.Y.Z' expected", qfts_v);
01892 
01893     /* Parse    "Z" */
01894     qfts_micro = strtol(suffix+1, &suffix, 10);
01895 
01896     /* If qfits version is earlier than required ... */
01897     if (qfts_major < REQ_QF_MAJOR ||
01898         (qfts_major == REQ_QF_MAJOR && qfts_minor  < REQ_QF_MINOR) ||
01899         (qfts_major == REQ_QF_MAJOR && qfts_minor == REQ_QF_MINOR && 
01900          qfts_micro < REQ_QF_MICRO)
01901         )
01902         {
01903         uves_msg_warning("qfits version %s (detected) is not supported. "
01904                  "Please update to qfits version %d.%d.%d or later", 
01905                  qfts_v,
01906                  REQ_QF_MAJOR,
01907                  REQ_QF_MINOR,
01908                  REQ_QF_MICRO);
01909         }
01910     else
01911         {
01912         uves_msg_debug("qfits version %ld.%ld.%ld detected "
01913                    "(%d.%d.%d or later required)", 
01914                    qfts_major, qfts_minor, qfts_micro,
01915                    REQ_QF_MAJOR,
01916                    REQ_QF_MINOR,
01917                    REQ_QF_MICRO);
01918         }
01919     }
01920     
01921   cleanup:
01922     return;
01923 }
01924 
01925 /*----------------------------------------------------------------------------*/
01937 /*----------------------------------------------------------------------------*/
01938 cpl_error_code
01939 uves_end(const char *recipe_id, const cpl_frameset *frames)
01940 {
01941     cpl_frameset *products = NULL;
01942     const cpl_frame *f;
01943     int warnings = uves_msg_get_warnings();
01944 
01945     recipe_id = recipe_id; /* Suppress warning about unused variable,
01946                   perhaps we the recipe_id later, so
01947                   keep it in the interface. */
01948 
01949 
01950     /* Print (only) output frames */
01951 
01952     products = cpl_frameset_new();
01953     assure_mem( products );
01954 
01955     for (f = cpl_frameset_get_first_const(frames);
01956      f != NULL;
01957      f = cpl_frameset_get_next_const(frames))
01958     {
01959         if (cpl_frame_get_group(f) == CPL_FRAME_GROUP_PRODUCT)
01960         {
01961             check_nomsg(
01962             cpl_frameset_insert(products, cpl_frame_duplicate(f)));
01963         }
01964     }
01965 
01966 /* Don't do this. EsoRex should.
01967    uves_msg_low("Output frames");
01968    check( uves_print_cpl_frameset(products),
01969    "Could not print output frames");
01970 */
01971 
01972     /* Summarize warnings, if any */
01973     if( warnings > 0)
01974     {
01975         uves_msg_warning("Recipe produced %d warning%s (excluding this one)",
01976                  uves_msg_get_warnings(),
01977                  /* Plural? */ (warnings > 1) ? "s" : "");
01978     }
01979 
01980   cleanup:
01981     uves_free_frameset(&products);
01982     return cpl_error_get_code();    
01983 }
01984 
01985 /*----------------------------------------------------------------------------*/
02006 /*----------------------------------------------------------------------------*/
02007 char *
02008 uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist, 
02009         const char *recipe_id, const char *short_descr)
02010 {
02011     char *recipe_string = NULL;
02012     char *stars = NULL;     /* A string of stars */
02013     char *spaces1 = NULL;
02014     char *spaces2 = NULL;
02015     char *spaces3 = NULL;
02016     char *spaces4 = NULL;
02017     char *start_time = NULL;
02018 
02019     start_time = uves_sprintf("%s", uves_get_datetime_iso8601());
02020 
02021     check( uves_check_version(), "Library validation failed");
02022 
02023     /* Now read parameters and set specified message level */
02024     {
02025     const char *plotter_command;
02026     int msglevel;
02027     
02028     /* Read parameters using context = recipe_id */
02029 
02030         if (0) /* disabled */
02031             check( uves_get_parameter(parlist, NULL, "uves", "msginfolevel", 
02032                                       CPL_TYPE_INT, &msglevel),
02033                    "Could not read parameter");
02034         else
02035             {
02036                 msglevel = -1; /* max verbosity */
02037             }
02038     uves_msg_set_level(msglevel);
02039     check( uves_get_parameter(parlist, NULL, "uves", "plotter",
02040                   CPL_TYPE_STRING, &plotter_command), "Could not read parameter");
02041     
02042     /* Initialize plotting */
02043     check( uves_plot_initialize(plotter_command), 
02044            "Could not initialize plotting");
02045     }    
02046 
02047     /* Print 
02048      *************************
02049      ***   PACAGE_STRING   ***
02050      *** Recipe: recipe_id ***
02051      *************************
02052      */
02053     recipe_string = uves_sprintf("Recipe: %s", recipe_id);
02054     {
02055     int field = uves_max_int(strlen(PACKAGE_STRING), strlen(recipe_string));
02056     int nstars = 3+1 + field + 1+3;
02057     int nspaces1, nspaces2, nspaces3, nspaces4;
02058     int i;
02059     
02060     /* ' ' padding */
02061     nspaces1 = (field - strlen(PACKAGE_STRING)) / 2; 
02062     nspaces2 = field - strlen(PACKAGE_STRING) - nspaces1;
02063 
02064     nspaces3 = (field - strlen(recipe_string)) / 2;
02065     nspaces4 = field - strlen(recipe_string) - nspaces3;
02066 
02067     spaces1 = cpl_calloc(nspaces1 + 1, sizeof(char)); 
02068     spaces2 = cpl_calloc(nspaces2 + 1, sizeof(char));
02069     spaces3 = cpl_calloc(nspaces3 + 1, sizeof(char)); 
02070     spaces4 = cpl_calloc(nspaces4 + 1, sizeof(char));
02071     for (i = 0; i < nspaces1; i++) spaces1[i] = ' ';
02072     for (i = 0; i < nspaces2; i++) spaces2[i] = ' ';
02073     for (i = 0; i < nspaces3; i++) spaces3[i] = ' ';
02074     for (i = 0; i < nspaces4; i++) spaces4[i] = ' ';
02075 
02076     stars = cpl_calloc(nstars + 1, sizeof(char));
02077     for (i = 0; i < nstars; i++) stars[i] = '*';
02078     
02079     uves_msg("%s", stars);
02080     uves_msg("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
02081     uves_msg("*** %s%s%s ***", spaces3, recipe_string, spaces4);
02082     uves_msg("%s", stars);
02083     }
02084 
02085     uves_msg("This recipe %c%s", tolower(short_descr[0]), short_descr+1);
02086 
02087     if (cpl_frameset_is_empty(frames)) {
02088         uves_msg_debug("Guvf cvcryvar unf ernpurq vgf uvtu dhnyvgl qhr na npgvir "
02089                        "hfre pbzzhavgl naq gur erfcbafvoyr naq vqrnyvfgvp jbex bs "
02090                        "vaqvivqhny cvcryvar qrirybcref, naq qrfcvgr orvat 'onfrq ba' "
02091                        "PCY juvpu vf n cvrpr bs cbyvgvpny penc");
02092     }
02093 
02094     /* Set group (RAW/CALIB) of input frames */
02095     /* This is mandatory for the later call of 
02096        cpl_dfs_setup_product_header */
02097     check( uves_dfs_set_groups(frames), "Could not classify input frames");
02098 
02099     /* Print input frames */
02100     uves_msg_low("Input frames");
02101     check( uves_print_cpl_frameset(frames), "Could not print input frames" );
02102 
02103   cleanup:
02104     cpl_free(recipe_string);
02105     cpl_free(stars);
02106     cpl_free(spaces1);
02107     cpl_free(spaces2);
02108     cpl_free(spaces3);
02109     cpl_free(spaces4);
02110     return start_time;
02111 }
02112 
02113 
02114 /*----------------------------------------------------------------------------*/
02142 /*----------------------------------------------------------------------------*/
02143 cpl_image *
02144 uves_average_images(const cpl_image *image1, const cpl_image *noise1,
02145             const cpl_image *image2, const cpl_image *noise2,
02146             cpl_image **noise)
02147 {
02148     cpl_image *result = NULL;
02149     cpl_size nx, ny; 
02150     int x, y;
02151 
02152     /* Check input */
02153     assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02154     assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02155     assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02156     assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02157     assure( noise  != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02158 
02159     assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
02160         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
02161     assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
02162         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
02163     
02164     nx = cpl_image_get_size_x(image1);
02165     ny = cpl_image_get_size_y(image1);
02166 
02167     assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT, 
02168         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02169         nx,   cpl_image_get_size_x(image2));
02170     assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT, 
02171         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02172         nx,   cpl_image_get_size_x(noise1));
02173     assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
02174         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02175         nx,   cpl_image_get_size_x(noise2));
02176     assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
02177         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02178         ny,   cpl_image_get_size_y(image2));
02179     assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
02180         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02181         ny,   cpl_image_get_size_y(noise1));
02182     assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
02183         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02184         ny,   cpl_image_get_size_y(noise2));
02185     
02186     result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
02187     *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
02188 
02189     /* Do the calculation */
02190     for (y = 1; y <= ny; y++)
02191     {
02192         for (x = 1; x <= nx; x++)
02193         {
02194             double flux1, flux2;
02195             double sigma1, sigma2;
02196             int pis_rejected1, noise_rejected1;
02197             int pis_rejected2, noise_rejected2;
02198 
02199             flux1  = cpl_image_get(image1, x, y, &pis_rejected1);
02200             flux2  = cpl_image_get(image2, x, y, &pis_rejected2);
02201             sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
02202             sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);
02203 
02204             pis_rejected1 = pis_rejected1 || noise_rejected1;
02205             pis_rejected2 = pis_rejected2 || noise_rejected2;
02206             
02207             if (pis_rejected1 && pis_rejected2)
02208             {
02209                 cpl_image_reject(result, x, y);
02210                 cpl_image_reject(*noise, x, y);
02211             }
02212             else
02213             {
02214                 /* At least one good pixel */
02215 
02216                 double flux, sigma;
02217                 
02218                 if (pis_rejected1 && !pis_rejected2)
02219                 {
02220                     flux = flux2;
02221                     sigma = sigma2;
02222                 }
02223                 else if (!pis_rejected1 && pis_rejected2)
02224                 {
02225                     flux = flux1;
02226                     sigma = sigma1;
02227                 }
02228                 else
02229                 {
02230                     /* Both pixels are good */
02231                     sigma =
02232                     1 / (sigma1*sigma1) +
02233                     1 / (sigma2*sigma2);
02234                     
02235                     flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
02236                     flux /= sigma;
02237                     
02238                     sigma = sqrt(sigma);
02239                 }
02240                 
02241                 cpl_image_set(result, x, y, flux);
02242                 cpl_image_set(*noise, x, y, sigma);
02243             }
02244         }
02245     }
02246     
02247   cleanup:
02248     if (cpl_error_get_code() != CPL_ERROR_NONE) 
02249     {
02250         uves_free_image(&result);
02251     }
02252     return result;
02253 }
02254 
02255 /*----------------------------------------------------------------------------*/
02270 /*----------------------------------------------------------------------------*/
02271 uves_propertylist *
02272 uves_initialize_image_header(const char *ctype1, const char *ctype2, const char *bunit,
02273                  double crval1, double crval2,
02274                  double crpix1, double crpix2,
02275                  double cdelt1, double cdelt2)
02276 {
02277     uves_propertylist *header = NULL;  /* Result */
02278 
02279     header = uves_propertylist_new();
02280 
02281     check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
02282     check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
02283     check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
02284     check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
02285     check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
02286     check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
02287     check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
02288     check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
02289     check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
02290     
02291   cleanup:
02292     return header;
02293 }
02294 
02295 /*----------------------------------------------------------------------------*/
02313 /*----------------------------------------------------------------------------*/
02314 cpl_image *
02315 uves_define_noise(const cpl_image *image, 
02316                   const uves_propertylist *image_header,
02317                   int ncom, enum uves_chip chip)
02318 {
02319     /*
02320           \/  __
02321            \_(__)_...
02322     */
02323 
02324     cpl_image *noise = NULL;      /* Result */
02325 
02326     /* cpl_image *in_med = NULL;     Median filtered input image */
02327 
02328     double ron;                   /* Read-out noise in ADU */
02329     double gain;
02330     int nx, ny, i;
02331     double *noise_data;
02332     const double *image_data;
02333     bool has_bnoise=false;
02334     bool has_dnoise=false;
02335     double bnoise=0;
02336     double dnoise=0;
02337     double dtime=0;
02338     double bnoise2=0;
02339     double dnoise2=0;
02340     double exptime=0;
02341     double exptime2=0;
02342     double tot_noise2=0;
02343     double var_bias_dark=0;
02344 
02345     /* Read, check input parameters */
02346     assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
02347     
02348     check( ron = uves_pfits_get_ron_adu(image_header, chip),
02349        "Could not read read-out noise");
02350     
02351     check( gain = uves_pfits_get_gain(image_header, chip),
02352        "Could not read gain factor");
02353     assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);
02354 
02355     nx = cpl_image_get_size_x(image);
02356     ny = cpl_image_get_size_y(image);
02357 
02358     /* For efficiency reasons, use pointers to image data buffers */
02359     assure(cpl_image_count_rejected(image) == 0, 
02360        CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
02361     assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
02362        CPL_ERROR_UNSUPPORTED_MODE, 
02363        "Input image is of type %s. double expected", 
02364        uves_tostring_cpl_type(cpl_image_get_type(image)));
02365 
02366     noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
02367     assure_mem( noise );
02368 
02369     noise_data = cpl_image_get_data_double(noise);
02370 
02371     image_data = cpl_image_get_data_double_const(image);
02372 
02373 
02374     if(image_header != NULL) {
02375        has_bnoise=uves_propertylist_contains(image_header,UVES_BNOISE);
02376        has_dnoise=uves_propertylist_contains(image_header,UVES_DNOISE);
02377     }
02378 
02379     if(has_bnoise) {
02380        bnoise=uves_propertylist_get_double(image_header,UVES_BNOISE);
02381        bnoise2=bnoise*bnoise;
02382     }
02383 
02384     if(has_dnoise) {
02385        dnoise=uves_propertylist_get_double(image_header,UVES_DNOISE);
02386        dnoise2=dnoise*dnoise;
02387        dtime=uves_propertylist_get_double(image_header,UVES_DTIME);
02388        exptime=uves_pfits_get_exptime(image_header);
02389        exptime2=exptime*exptime/dtime/dtime;
02390     }
02391     var_bias_dark=bnoise2+dnoise2*exptime2;
02392     uves_msg_debug("bnoise=%g dnoise=%g sci exptime=%g dark exptime=%g",
02393          bnoise,dnoise,exptime,dtime);
02394 
02395     /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */
02396 
02397     /* This filter is disabled, as there is often structure on the scale
02398        of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
02399        structure *does* result in worse fits to the data.
02400 
02401        in_med = cpl_image_duplicate(image);
02402        assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
02403        
02404        uves_msg_low("Applying 3x3 median filter");
02405        
02406        check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
02407        image_data = cpl_image_get_data_double(in_med);
02408        
02409        uves_msg_low("Setting pixel flux uncertainty");
02410     */
02411 
02412     /* We assume median stacked input (master flat, master dark, ...) */
02413     double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
02414     double gain2=gain*gain;
02415         
02416     double quant_var = uves_max_double(0, (1 - gain2)/12.0);
02417     /* Quant. error =
02418      * sqrt((g^2-1)/12)
02419      */
02420     double flux_var_adu=0;
02421     double ron2=ron*ron;
02422     double inv_ncom_median_factor=1./(ncom * median_factor);
02423     for (i = 0; i < nx*ny; i++)
02424     {
02425          
02426         /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
02427         /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
02428         flux_var_adu =  uves_max_double(image_data[i],0)*gain;
02429         
02430         /* For a number, N, of averaged or median stacked "identical" frames
02431          * (gaussian distribution assumed), the combined noise is
02432          *
02433          *  sigma_N = sigma / sqrt(N*f)
02434          *
02435          *  where (to a good approximation)
02436          *        f ~= { 1    , N = 1
02437          *             { 2/pi , N > 1
02438          *
02439          *  (i.e. the resulting uncertainty is
02440          *   larger than for average stacked inputs where f = 1)
02441          */
02442         
02443         /* Slow: cpl_image_set(noise, x, y, ... ); */
02444         /* Slow: noise_data[(x-1) + (y-1)*nx] = 
02445                  sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
02446               ((MIDAS) ? 1 : ncom * median_factor)); */
02447 
02448         
02449       tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor)+
02450          var_bias_dark;
02451 
02452       /*
02453       tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor);
02454       */
02455         noise_data[i] = sqrt(tot_noise2);
02456     }
02457 
02458   cleanup:
02459     /* uves_free_image(&in_med); */
02460     if (cpl_error_get_code() != CPL_ERROR_NONE)
02461     {
02462         uves_free_image(&noise);
02463     }
02464 
02465     return noise;
02466 }
02467 
02468 
02469 /*----------------------------------------------------------------------------*/
02479 /*----------------------------------------------------------------------------*/
02480 cpl_error_code
02481 uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
02482 {
02483     passure ( image != NULL, " ");
02484     passure ( master_bias != NULL, " ");
02485 
02486     check( cpl_image_subtract(image, master_bias),
02487        "Error subtracting bias");
02488 
02489     /* Due to different bad column correction in image/master_bias,
02490        it might happen that the image has become negative after 
02491        subtracting the bias. Disallow that. */
02492 
02493 #if 0
02494     /* No, for backwards compatibility, allow negative values.
02495      * MIDAS has an inconsistent logic on this matter.
02496      * For master dark frames, the thresholding *is* applied,
02497      * but not for science frames. Therefore we have to
02498      * apply thresholding on a case-by-case base (i.e. from
02499      * the caller).
02500      */
02501     check( cpl_image_threshold(image, 
02502                    0, DBL_MAX,     /* Interval */
02503                    0, DBL_MAX),    /* New values */
02504        "Error thresholding image");
02505 #endif
02506 
02507   cleanup:
02508     return cpl_error_get_code();
02509 }
02510 /*----------------------------------------------------------------------------*/
02523 /*----------------------------------------------------------------------------*/
02524 cpl_error_code
02525 uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
02526            const cpl_image *master_dark,
02527            const uves_propertylist *mdark_header)
02528 {
02529     cpl_image *normalized_mdark = NULL;
02530     double image_exptime = 0.0;
02531     double mdark_exptime = 0.0;
02532 
02533     passure ( image != NULL, " ");
02534     passure ( image_header != NULL, " ");
02535     passure ( master_dark != NULL, " ");
02536     passure ( mdark_header != NULL, " ");
02537 
02538     /* Normalize mdark to same exposure time as input image, then subtract*/
02539     check( image_exptime = uves_pfits_get_exptime(image_header), 
02540        "Error reading input image exposure time");
02541     check( mdark_exptime = uves_pfits_get_exptime(mdark_header), 
02542        "Error reading master dark exposure time");
02543     
02544     uves_msg("Rescaling master dark from %f s to %f s exposure time", 
02545          mdark_exptime, image_exptime);
02546     
02547     check( normalized_mdark = 
02548        cpl_image_multiply_scalar_create(master_dark,
02549                         image_exptime / mdark_exptime),
02550        "Error normalizing master dark");
02551     
02552     check( cpl_image_subtract(image, normalized_mdark), 
02553        "Error subtracting master dark");
02554 
02555     uves_msg_warning("noise rescaled master dark %g",cpl_image_get_stdev(normalized_mdark));
02556 
02557 
02558   cleanup:
02559     uves_free_image(&normalized_mdark);
02560     return cpl_error_get_code();
02561 }
02562 
02563 /*----------------------------------------------------------------------------*/
02577 /*----------------------------------------------------------------------------*/
02578 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
02579 {
02580     return (first_abs_order +
02581         (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
02582 }
02583 
02584 /*----------------------------------------------------------------------------*/
02598 /*----------------------------------------------------------------------------*/
02599 double
02600 uves_average_reject(cpl_table *t,
02601                     const char *column,
02602                     const char *residual2,
02603                     double kappa)
02604 {
02605     double mean = 0, median, sigma2;
02606     int rejected;
02607     
02608     do {
02609         /* Robust estimation */
02610       check_nomsg(median = cpl_table_get_column_median(t, column));
02611 
02612         /* Create column
02613            residual2 = (column - median)^2   */
02614       check_nomsg(cpl_table_duplicate_column(t, residual2, t, column));
02615       check_nomsg(cpl_table_subtract_scalar(t, residual2, median));
02616       check_nomsg(cpl_table_multiply_columns(t, residual2, residual2));
02617 
02618         /* For a Gaussian distribution:
02619          * sigma    ~= median(|residual|) / 0.6744
02620          * sigma^2  ~= median(residual^2) / 0.6744^2  
02621          */
02622 
02623       check_nomsg(sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744));
02624 
02625         /* Reject values where
02626            residual^2 > (kappa*sigma)^2
02627         */
02628     check_nomsg( rejected = uves_erase_table_rows(t, residual2,
02629                                                       CPL_GREATER_THAN,
02630                                                       kappa*kappa*sigma2));
02631         
02632     check_nomsg(cpl_table_erase_column(t, residual2));
02633 
02634     } while (rejected > 0);
02635 
02636     check_nomsg(mean  = cpl_table_get_column_mean(t, column));
02637     
02638   cleanup:
02639     return mean;
02640 }
02641 
02642 /*----------------------------------------------------------------------------*/
02675 /*----------------------------------------------------------------------------*/
02676 polynomial *
02677 uves_polynomial_regression_1d(cpl_table *t,
02678                   const char *X, const char *Y, const char *sigmaY, 
02679                   int degree, 
02680                   const char *polynomial_fit, const char *residual_square,
02681                   double *mean_squared_error, double kappa)
02682 {
02683     int N;
02684     int total_rejected = 0;  /* Rejected in kappa sigma clipping */
02685     int rejected = 0;
02686     double mse;                  /* local mean squared error */
02687     double *x;
02688     double *y;
02689     double *sy;
02690     polynomial *result = NULL;
02691     cpl_vector *vx = NULL;
02692     cpl_vector *vy = NULL;
02693     cpl_vector *vsy = NULL;
02694     cpl_type type;
02695 
02696     /* Check input */
02697     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
02698     assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
02699     assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
02700     assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
02701     assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
02702     assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
02703         "No such column: %s", sigmaY);
02704 
02705     assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
02706         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
02707 
02708     assure( residual_square == NULL || !cpl_table_has_column(t, residual_square), 
02709         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
02710     
02711     /* Check column types */
02712     type = cpl_table_get_column_type(t, Y);
02713     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE, 
02714         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
02715     type = cpl_table_get_column_type(t, X);
02716     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
02717         "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
02718     if (sigmaY != NULL)
02719     {
02720         type = cpl_table_get_column_type(t, sigmaY);
02721         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
02722             CPL_ERROR_INVALID_TYPE, 
02723             "Input column '%s' has wrong type (%s)", 
02724             sigmaY, uves_tostring_cpl_type(type));
02725     }
02726 
02727     check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
02728        "Could not cast table column '%s' to double", X);
02729     check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
02730        "Could not cast table column '%s' to double", Y);
02731     if (sigmaY != NULL)
02732     {
02733         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
02734            "Could not cast table column '%s' to double", sigmaY);
02735     } 
02736     
02737 
02738     total_rejected = 0;
02739     rejected = 0;
02740     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
02741        "Could not create column");
02742     do{
02743     check( (N = cpl_table_get_nrow(t),
02744         x = cpl_table_get_data_double(t, "_X_double"),
02745         y = cpl_table_get_data_double(t, "_Y_double")),
02746            "Could not read table data");
02747     
02748     if (sigmaY != NULL) 
02749         {
02750         check( sy = cpl_table_get_data_double(t,  "_sY_double"),
02751                "Could not read table data");
02752         } 
02753     else 
02754         {
02755         sy = NULL;
02756         }
02757   
02758     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table. "
02759             "No points to fit in poly 1d regression. At least 2 needed");
02760 
02761     assure( N > degree, CPL_ERROR_ILLEGAL_INPUT, "%d points to fit in poly 1d "
02762            "regression of degree %d. At least %d needed.",
02763             N,degree,degree+1);
02764 
02765     /* Wrap vectors */
02766     uves_unwrap_vector(&vx);
02767     uves_unwrap_vector(&vy);
02768     
02769     vx = cpl_vector_wrap(N, x);
02770     vy = cpl_vector_wrap(N, y);
02771        
02772     if (sy != NULL)
02773         {
02774         uves_unwrap_vector(&vsy);
02775         vsy = cpl_vector_wrap(N, sy);
02776         }
02777     else
02778         {
02779         vsy = NULL;
02780         }
02781      
02782     /* Fit! */
02783     uves_polynomial_delete(&result);
02784     check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse), 
02785            "Could not fit polynomial");
02786     
02787     /* If requested, calculate residuals and perform kappa-sigma clipping */
02788     if (kappa > 0)
02789         {
02790         double sigma2;   /* sigma squared */
02791         int i;
02792         
02793         for (i = 0; i < N; i++)
02794             {
02795             double xval, yval, yfit;
02796             
02797             check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
02798                 yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
02799                 yfit = uves_polynomial_evaluate_1d(result, xval),
02800     
02801                 cpl_table_set_double(t, "_residual_square", i, 
02802                              (yfit-yval)*(yfit-yval))),
02803                 "Could not evaluate polynomial");
02804             }
02805         
02806         /* For robustness, estimate sigma as (third quartile) / 0.6744
02807          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
02808          * The third quartile is estimated as the median of the absolute residuals,
02809          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
02810          *     sigma^2  ~= median(residual^2) / 0.6744^2  
02811          */
02812         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
02813 
02814         /* Remove points with residual^2 > kappa^2 * sigma^2 */
02815         check( rejected = uves_erase_table_rows(t, "_residual_square", 
02816                             CPL_GREATER_THAN, kappa*kappa*sigma2),
02817                "Could not remove outlier points");
02818         
02819         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
02820                    rejected, N, sqrt(mse));
02821         
02822         /* Update */
02823         total_rejected += rejected;
02824         N = cpl_table_get_nrow(t);
02825         }
02826     
02827 } while (rejected > 0);
02828     
02829     cpl_table_erase_column(t,  "_residual_square");    
02830     
02831     if (kappa > 0)
02832     {    
02833         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
02834               total_rejected,
02835               N + total_rejected,
02836               (100.0*total_rejected)/(N + total_rejected)
02837         );
02838     }
02839     
02840     if (mean_squared_error != NULL) *mean_squared_error = mse;
02841     
02842     /* Add the fitted values to table if requested */
02843     if (polynomial_fit != NULL || residual_square != NULL)
02844     {
02845         int i;
02846         
02847         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
02848            "Could not create column");
02849         for (i = 0; i < N; i++){
02850         double xval;
02851         double yfit;
02852         
02853         check((
02854               xval = cpl_table_get_double(t, "_X_double", i, NULL),
02855               yfit = uves_polynomial_evaluate_1d(result, xval),
02856               cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
02857               "Could not evaluate polynomial");
02858         }
02859         
02860         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
02861         if (residual_square != NULL)
02862         {
02863             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
02864                                t, "_polynomial_fit"),
02865                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
02866                 cpl_table_multiply_columns(t, residual_square, residual_square)),
02867                                                                                /* RS := RS^2 */
02868                 "Could not calculate Residual of fit");
02869         }
02870         
02871         /* Keep the polynomial_fit column if requested */
02872         if (polynomial_fit != NULL)
02873         {
02874             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
02875         }
02876         else
02877         {
02878             cpl_table_erase_column(t, "_polynomial_fit");
02879         }
02880     }
02881     
02882     check(( cpl_table_erase_column(t, "_X_double"),
02883         cpl_table_erase_column(t, "_Y_double")),
02884       "Could not delete temporary columns");
02885     
02886     if (sigmaY != NULL) 
02887     {
02888         check( cpl_table_erase_column(t, "_sY_double"), 
02889            "Could not delete temporary column");
02890     } 
02891     
02892   cleanup:
02893     uves_unwrap_vector(&vx);
02894     uves_unwrap_vector(&vy);
02895     uves_unwrap_vector(&vsy);
02896     if (cpl_error_get_code() != CPL_ERROR_NONE)
02897     {
02898         uves_polynomial_delete(&result);
02899     }
02900     
02901     return result;
02902 }
02903 
02904 
02905 /*----------------------------------------------------------------------------*/
02953 /*----------------------------------------------------------------------------*/
02954 
02955 polynomial *
02956 uves_polynomial_regression_2d(cpl_table *t,
02957                   const char *X1, const char *X2, const char *Y, 
02958                   const char *sigmaY,
02959                   int degree1, int degree2,
02960                   const char *polynomial_fit, const char *residual_square, 
02961                   const char *variance_fit,
02962                   double *mse, double *red_chisq,
02963                   polynomial **variance, double kappa,
02964                               double min_reject)
02965 {
02966     int N;
02967     int rejected;
02968     int total_rejected;
02969     double *x1;
02970     double *x2;
02971     double *y;
02972     double *res;
02973     double *sy;
02974     polynomial *p = NULL;               /* Result */
02975     polynomial *variance_local = NULL;
02976     cpl_vector *vx1 = NULL;
02977     cpl_vector *vx2 = NULL;
02978     cpl_bivector *vx = NULL;
02979     cpl_vector *vy = NULL;
02980     cpl_vector *vsy= NULL;
02981     cpl_type type;
02982 
02983     /* Check input */
02984     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
02985     N  = cpl_table_get_nrow(t);
02986     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "The table with column to compute regression has 0 rows!");
02987     assure( N > 8, CPL_ERROR_ILLEGAL_INPUT, "For poly regression you need at least 9 points. The table with column to compute regression has %d rows!",N);
02988 
02989     assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
02990     assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
02991     assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
02992     assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
02993         CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
02994     if (sigmaY != NULL)
02995     {
02996         assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT, 
02997             "No such column: %s", sigmaY);
02998     }
02999     if (polynomial_fit != NULL)
03000     {
03001         assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
03002             "Table already has '%s' column", polynomial_fit);
03003     }
03004     if (residual_square != NULL)
03005     {
03006         assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT, 
03007             "Table already has '%s' column", residual_square);
03008     }
03009     if (variance_fit != NULL)
03010     {
03011         assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
03012             "Table already has '%s' column", variance_fit);
03013     }
03014 
03015     /* Check column types */
03016     type = cpl_table_get_column_type(t, X1);
03017     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03018         "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
03019     type = cpl_table_get_column_type(t, X2);
03020     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03021         "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
03022     type = cpl_table_get_column_type(t, Y);
03023     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03024         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
03025     if (sigmaY != NULL)
03026     {
03027         type = cpl_table_get_column_type(t, sigmaY);
03028         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03029             "Input column '%s' has wrong type (%s)", 
03030             sigmaY, uves_tostring_cpl_type(type));
03031     }
03032 
03033     /* In the case that these temporary columns already exist, a run-time error will occur */
03034     check( cpl_table_cast_column(t, X1    , "_X1_double", CPL_TYPE_DOUBLE), 
03035        "Could not cast table column to double");
03036     check( cpl_table_cast_column(t, X2    , "_X2_double", CPL_TYPE_DOUBLE),
03037        "Could not cast table column to double");
03038     check( cpl_table_cast_column(t,  Y    ,  "_Y_double", CPL_TYPE_DOUBLE), 
03039        "Could not cast table column to double");
03040     if (sigmaY != NULL)
03041     {
03042         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
03043            "Could not cast table column to double");
03044     }
03045     
03046     total_rejected = 0;
03047     rejected = 0;
03048     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
03049        "Could not create column");
03050 
03051     do {
03052         /* WARNING!!! Code duplication (see below). Be careful
03053            when updating */
03054     check(( N  = cpl_table_get_nrow(t),
03055         x1 = cpl_table_get_data_double(t, "_X1_double"),
03056         x2 = cpl_table_get_data_double(t, "_X2_double"),
03057         y  = cpl_table_get_data_double(t, "_Y_double"),
03058                 res= cpl_table_get_data_double(t, "_residual_square")),
03059           "Could not read table data");
03060     
03061     if (sigmaY != NULL) 
03062         {
03063         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
03064                "Could not read table data");
03065         }
03066     else 
03067         {
03068         sy = NULL;
03069         }
03070 
03071     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
03072     
03073     /* Wrap vectors */
03074     uves_unwrap_vector(&vx1);
03075     uves_unwrap_vector(&vx2);
03076     uves_unwrap_vector(&vy);
03077 
03078     vx1 = cpl_vector_wrap(N, x1);
03079     vx2 = cpl_vector_wrap(N, x2);
03080     vy  = cpl_vector_wrap(N, y);
03081     if (sy != NULL)
03082         {
03083         uves_unwrap_vector(&vsy);
03084         vsy = cpl_vector_wrap(N, sy);
03085         }
03086     else
03087         {
03088         vsy = NULL;
03089         }
03090     
03091     /* Wrap up the bi-vector */
03092     uves_unwrap_bivector_vectors(&vx);
03093     vx = cpl_bivector_wrap_vectors(vx1, vx2);
03094   
03095     /* Fit! */
03096     uves_polynomial_delete(&p);
03097         check( p =  uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
03098                                            NULL, NULL, NULL),
03099                "Could not fit polynomial");
03100 
03101     /* If requested, calculate residuals and perform kappa-sigma clipping */
03102     if (kappa > 0)
03103         {
03104         double sigma2;   /* sigma squared */
03105         int i;
03106 
03107                 cpl_table_fill_column_window_double(t, "_residual_square", 0, 
03108                                                     cpl_table_get_nrow(t), 0.0);
03109 
03110         for (i = 0; i < N; i++)
03111             {
03112                         double yval, yfit;
03113 
03114                         yval  = y[i];
03115                         yfit  = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
03116                         res[i] = (yfit-y[i])*(yfit-y[i]);
03117             }
03118         
03119         /* For robustness, estimate sigma as (third quartile) / 0.6744
03120          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
03121          * The third quartile is estimated as the median of the absolute residuals,
03122          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
03123          *     sigma^2  ~= median(residual^2) / 0.6744^2  
03124          */
03125         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
03126                              
03127 
03128         /* Remove points with residual^2 > kappa^2 * sigma^2 */
03129         check( rejected = uves_erase_table_rows(t, "_residual_square", 
03130                             CPL_GREATER_THAN, kappa*kappa*sigma2),
03131                "Could not remove outlier points");
03132         /* Note! All pointers to table data are now invalid! */
03133 
03134 
03135         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f", 
03136                    rejected, N, sqrt(sigma2));
03137         
03138         /* Update */
03139         total_rejected += rejected;
03140         N = cpl_table_get_nrow(t);
03141         }
03142         
03143     /* Stop also if there are too few points left to make the fit.
03144      * Needed number of points = (degree1+1)(degree2+1) coefficients
03145      *      plus one extra point for chi^2 computation.   */
03146     } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
03147              N >= (degree1 + 1)*(degree2 + 1) + 1);
03148     
03149     if (kappa > 0)
03150     {    
03151         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
03152                 total_rejected,
03153                 N + total_rejected,
03154                 (100.0*total_rejected)/(N + total_rejected)
03155         );
03156     }
03157        
03158     /* Final fit */
03159     {
03160         /* Need to convert to vector again. */
03161 
03162         /* WARNING!!! Code duplication (see above). Be careful
03163            when updating */
03164     check(( N  = cpl_table_get_nrow(t),
03165         x1 = cpl_table_get_data_double(t, "_X1_double"),
03166         x2 = cpl_table_get_data_double(t, "_X2_double"),
03167         y  = cpl_table_get_data_double(t, "_Y_double"),
03168                 res= cpl_table_get_data_double(t, "_residual_square")),
03169           "Could not read table data");
03170     
03171     if (sigmaY != NULL) 
03172         {
03173         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
03174                "Could not read table data");
03175         }
03176     else 
03177         {
03178         sy = NULL;
03179         }
03180 
03181     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
03182     
03183     /* Wrap vectors */
03184     uves_unwrap_vector(&vx1);
03185     uves_unwrap_vector(&vx2);
03186     uves_unwrap_vector(&vy);
03187 
03188     vx1 = cpl_vector_wrap(N, x1);
03189     vx2 = cpl_vector_wrap(N, x2);
03190     vy  = cpl_vector_wrap(N, y);
03191     if (sy != NULL)
03192         {
03193         uves_unwrap_vector(&vsy);
03194         vsy = cpl_vector_wrap(N, sy);
03195         }
03196     else
03197         {
03198         vsy = NULL;
03199         }
03200     
03201     /* Wrap up the bi-vector */
03202     uves_unwrap_bivector_vectors(&vx);
03203     vx = cpl_bivector_wrap_vectors(vx1, vx2);
03204     }
03205 
03206     uves_polynomial_delete(&p);
03207     if (variance_fit != NULL || variance != NULL)
03208         {
03209             /* If requested, also compute variance */
03210             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
03211                                               mse, red_chisq, &variance_local),
03212                    "Could not fit polynomial");
03213         }
03214     else
03215         {
03216             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
03217                                               mse, red_chisq, NULL),
03218                    "Could not fit polynomial");
03219         }
03220 
03221     cpl_table_erase_column(t,  "_residual_square");
03222     
03223     /* Add the fitted values to table as requested */
03224     if (polynomial_fit != NULL || residual_square != NULL)
03225     {
03226         int i;
03227             double *pf;
03228         
03229         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
03230            "Could not create column");
03231 
03232             cpl_table_fill_column_window_double(t, "_polynomial_fit", 0, 
03233                                                 cpl_table_get_nrow(t), 0.0);
03234 
03235             x1 = cpl_table_get_data_double(t, "_X1_double");
03236             x2 = cpl_table_get_data_double(t, "_X2_double");
03237             pf = cpl_table_get_data_double(t, "_polynomial_fit");
03238 
03239         for (i = 0; i < N; i++){
03240 #if 0        
03241         double x1val, x2val, yfit;
03242 
03243         check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
03244             x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
03245             yfit  = uves_polynomial_evaluate_2d(p, x1val, x2val),
03246             
03247             cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
03248             "Could not evaluate polynomial");
03249 
03250 #else
03251                 pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
03252 #endif
03253         }
03254         
03255         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
03256         if (residual_square != NULL)
03257         {
03258             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
03259                                t, "_polynomial_fit"),
03260                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
03261                 cpl_table_multiply_columns(t, residual_square, residual_square)),
03262                                                                    /* RS := RS^2 */
03263                "Could not calculate Residual of fit");
03264         }
03265         
03266         /* Keep the polynomial_fit column if requested */
03267         if (polynomial_fit != NULL)
03268         {
03269             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
03270         }
03271         else
03272         {
03273             cpl_table_erase_column(t, "_polynomial_fit");
03274         }
03275     }
03276     
03277     /* Add variance of poly_fit if requested */
03278     if (variance_fit != NULL)
03279     {
03280         int i;
03281             double *vf;
03282 
03283         check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE), 
03284            "Could not create column");
03285             
03286             cpl_table_fill_column_window_double(t, variance_fit, 0,
03287                                                 cpl_table_get_nrow(t), 0.0);
03288 
03289             x1 = cpl_table_get_data_double(t, "_X1_double");
03290             x2 = cpl_table_get_data_double(t, "_X2_double");
03291             vf = cpl_table_get_data_double(t, variance_fit);
03292 
03293         for (i = 0; i < N; i++)
03294         {
03295 #if 0
03296             double x1val, x2val, yfit_variance;
03297             check(( x1val         = cpl_table_get_double(t, "_X1_double", i, NULL),
03298                 x2val         = cpl_table_get_double(t, "_X2_double", i, NULL),
03299                 yfit_variance = uves_polynomial_evaluate_2d(variance_local, 
03300                                     x1val, x2val),
03301                 
03302                 cpl_table_set_double(t, variance_fit, i, yfit_variance)),
03303                "Could not evaluate polynomial");
03304 #else
03305                     vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
03306 #endif
03307 
03308         }
03309     }
03310     
03311     
03312     check(( cpl_table_erase_column(t, "_X1_double"),
03313         cpl_table_erase_column(t, "_X2_double"),
03314         cpl_table_erase_column(t,  "_Y_double")),
03315       "Could not delete temporary columns");
03316       
03317     if (sigmaY != NULL) 
03318     {
03319         check( cpl_table_erase_column(t, "_sY_double"),
03320            "Could not delete temporary column");
03321     }
03322     
03323   cleanup:
03324     uves_unwrap_bivector_vectors(&vx);
03325     uves_unwrap_vector(&vx1);
03326     uves_unwrap_vector(&vx2);
03327     uves_unwrap_vector(&vy);
03328     uves_unwrap_vector(&vsy);
03329     /* Delete 'variance_local', or return through 'variance' parameter */
03330     if (variance != NULL)
03331     {
03332         *variance = variance_local;
03333     }
03334     else
03335     {
03336         uves_polynomial_delete(&variance_local);
03337     }
03338     if (cpl_error_get_code() != CPL_ERROR_NONE)
03339     {
03340         uves_polynomial_delete(&p);
03341     }
03342 
03343     return p;
03344 }
03345 
03346 /*----------------------------------------------------------------------------*/
03389 /*----------------------------------------------------------------------------*/
03390 
03391 polynomial *
03392 uves_polynomial_regression_2d_autodegree(cpl_table *t,
03393                      const char *X1, const char *X2, const char *Y,
03394                      const char *sigmaY,
03395                      const char *polynomial_fit,
03396                      const char *residual_square, 
03397                      const char *variance_fit,
03398                      double *mean_squared_error, double *red_chisq,
03399                      polynomial **variance, double kappa,
03400                      int maxdeg1, int maxdeg2, double min_rms,
03401                                          double min_reject,
03402                                          bool verbose,
03403                      const double *min_val,
03404                      const double *max_val,
03405                      int npos, double positions[][2])
03406 {
03407     int deg1 = 0;               /* Current degrees                                  */
03408     int deg2 = 0;               /* Current degrees                                  */
03409     int i;
03410 
03411     double **mse = NULL;
03412     bool adjust1 = true;      /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
03413     bool adjust2 = true;      /*   (or held constant)            */
03414     bool finished = false;
03415 
03416     const char *y_unit;
03417     cpl_table *temp = NULL;
03418     polynomial *bivariate_fit = NULL;   /* Result */
03419 
03420     assure( (min_val == NULL && max_val == NULL) || positions != NULL,
03421         CPL_ERROR_NULL_INPUT,
03422         "Missing positions array");    
03423 
03424     check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
03425     if (y_unit == NULL)
03426     {
03427         y_unit = "";
03428     }
03429 
03430     assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT, 
03431        "Illegal max. degrees: (%d, %d)",
03432        maxdeg1, maxdeg2);
03433 
03434     mse = cpl_calloc(maxdeg1+1, sizeof(double *));
03435     assure_mem(mse);
03436     for (i = 0; i < maxdeg1+1; i++)
03437     {
03438         int j;
03439         mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
03440         assure_mem(mse);
03441 
03442         for (j = 0; j < maxdeg2+1; j++)
03443         {
03444             mse[i][j] = -1;
03445         }
03446     }
03447 
03448     temp = cpl_table_duplicate(t);
03449     assure_mem(temp);
03450 
03451     uves_polynomial_delete(&bivariate_fit);
03452     check( bivariate_fit = uves_polynomial_regression_2d(temp,
03453                              X1, X2, Y, sigmaY,
03454                              deg1,
03455                              deg2,
03456                              NULL, NULL, NULL,  /* new columns  */
03457                              &mse[deg1][deg2], NULL, /* chi^2/N */
03458                              NULL,              /* variance pol.*/
03459                              kappa, min_reject),
03460        "Error fitting polynomial");
03461     if (verbose)
03462         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
03463                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
03464                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
03465                      cpl_table_get_nrow(t));
03466     else
03467         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
03468                        deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
03469                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
03470                      cpl_table_get_nrow(t));
03471     /* Find best values of deg1, deg2 less than or equal to 8,8
03472        (the fitting algorithm is unstable after this point, anyway) */
03473     do
03474     {
03475         int new_deg1, new_deg2;
03476         double m;
03477 
03478         finished = true;
03479 
03480         adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
03481         adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
03482         
03483         /* Try the new degrees
03484 
03485                               (d1+1, d2  ) (d1+2, d2)
03486                        (d1, d2+1) (d1+1, d2+1)
03487                        (d1, d2+2)
03488 
03489            in the following order:
03490 
03491                                      1            3
03492                           1          2
03493                           3
03494 
03495                (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
03496         */
03497         for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
03498         for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
03499             if ( (
03500                  (new_deg1 == deg1+1 && new_deg2 == deg2   && adjust1) ||
03501                  (new_deg1 == deg1+2 && new_deg2 == deg2   && adjust1) ||
03502                  (new_deg1 == deg1   && new_deg2 == deg2+1 && adjust2) ||
03503                  (new_deg1 == deg1   && new_deg2 == deg2+2 && adjust2) ||
03504                  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
03505                  )
03506              && mse[new_deg1][new_deg2] < 0)
03507             {
03508                 int rejected = 0;
03509 
03510                 uves_free_table(&temp);
03511                 temp = cpl_table_duplicate(t);
03512                 assure_mem(temp);
03513 
03514                 uves_polynomial_delete(&bivariate_fit);
03515                 bivariate_fit = uves_polynomial_regression_2d(temp,
03516                                       X1, X2, Y, sigmaY,
03517                                       new_deg1,
03518                                       new_deg2,
03519                                       NULL, NULL, NULL,
03520                                       &(mse[new_deg1]
03521                                         [new_deg2]),
03522                                       NULL,
03523                                       NULL,
03524                                       kappa, min_reject);
03525 
03526                 if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
03527                 {
03528                     uves_error_reset();
03529 
03530                                     if (verbose)
03531                                         uves_msg_low("(%d, %d)-degree: Singular matrix", 
03532                          new_deg1, new_deg2);
03533                                     else
03534                                         uves_msg_debug("(%d, %d)-degree: Singular matrix", 
03535                          new_deg1, new_deg2);
03536                     
03537                     mse[new_deg1][new_deg2] = DBL_MAX/2; 
03538                 }
03539                 else
03540                 {
03541                     assure( cpl_error_get_code() == CPL_ERROR_NONE,
03542                         cpl_error_get_code(),
03543                         "Error fitting (%d, %d)-degree polynomial", 
03544                         new_deg1, new_deg2 );
03545                     
03546                     rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
03547                 
03548                                     if (verbose)
03549                                         uves_msg_low("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
03550                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
03551                                                      rejected, cpl_table_get_nrow(t));
03552                                     else
03553                                         uves_msg_debug("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
03554                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
03555                                                      rejected, cpl_table_get_nrow(t));
03556 
03557                     /* Reject if fit produced bad values */
03558                     if (min_val != NULL || max_val != NULL)
03559                     {
03560                         for (i = 0; i < npos; i++)
03561                         {
03562                             double val = uves_polynomial_evaluate_2d(
03563                             bivariate_fit,
03564                             positions[i][0], positions[i][1]);
03565                             if (min_val != NULL && val < *min_val)
03566                             {
03567                                 uves_msg_debug("Bad fit: %f < %f", 
03568                                        val,
03569                                        *min_val);
03570                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
03571                                 /* A large number, even if we add a bit */
03572                             }
03573                             if (max_val != NULL && val > *max_val)
03574                             {
03575                                 uves_msg_debug("Bad fit: %f > %f", 
03576                                        val,
03577                                        *max_val);
03578                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
03579                             }
03580                         }
03581                     }
03582                 
03583                     /* For robustness, make sure that we don't accept a solution that
03584                        rejected too many points (say, 80%)
03585                     */
03586                     if (rejected >= (4*cpl_table_get_nrow(t))/5)
03587                     {
03588                         mse[new_deg1][new_deg2] = DBL_MAX/2; 
03589                     }
03590                     
03591                 }/* if fit succeeded */
03592             }
03593         
03594         /* If fit is significantly better (say, 10% improvement in MSE) in either direction, 
03595          * (in (degree,degree)-space) then move in that direction.
03596          *
03597          * First try to move one step horizontal/vertical, 
03598          * otherwise try to move diagonally (i.e. increase both degrees),
03599          * otherwise move two steps horizontal/vertical
03600          *
03601          */
03602         m = mse[deg1][deg2];
03603 
03604         if      (adjust1                              
03605              && (m - mse[deg1+1][deg2])/m > 0.1
03606              && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
03607              /* The condition is read like this:
03608             if 
03609             - we are trying to move right, and
03610             - this is this is a better place than the current, and
03611                 - this is better than moving down */
03612         )
03613         {
03614             deg1++;
03615             finished = false;
03616         }
03617         else if (adjust2 &&
03618              (m - mse[deg1][deg2+1])/m > 0.1
03619              && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
03620         )
03621         {
03622             deg2++;
03623             finished = false;
03624         }
03625         else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
03626         {
03627             deg1++;
03628             deg2++;
03629             finished = false;
03630         }
03631         else if (adjust1
03632              && (m - mse[deg1+2][deg2])/m > 0.1
03633              && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
03634         )
03635         {
03636             deg1 += 2;
03637             finished = false;
03638         }
03639         else if (adjust2 
03640              && (m - mse[deg1][deg2+2])/m > 0.1
03641              && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
03642         {
03643             deg2 += 2;
03644             finished = false;
03645         }
03646 
03647         /* For efficiency, stop if rms reached min_rms */   
03648         finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
03649 
03650     } while (!finished);
03651 
03652     uves_polynomial_delete(&bivariate_fit);
03653     check( bivariate_fit = uves_polynomial_regression_2d(t,
03654                              X1, X2, Y, sigmaY,
03655                              deg1,
03656                              deg2,
03657                              polynomial_fit, residual_square, 
03658                              variance_fit,
03659                              mean_squared_error, red_chisq,
03660                              variance, kappa, min_reject),
03661        "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
03662 
03663     if (verbose)
03664         uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
03665                      sqrt(mse[deg1][deg2]), y_unit);
03666     else
03667         uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
03668                      sqrt(mse[deg1][deg2]), y_unit);
03669     
03670   cleanup:
03671     if (mse != NULL)
03672     {
03673         for (i = 0; i < maxdeg1+1; i++)
03674         {
03675             if (mse[i] != NULL)
03676             {
03677                 cpl_free(mse[i]);
03678             }
03679         }
03680         cpl_free(mse);
03681     }
03682     uves_free_table(&temp);
03683     
03684     return bivariate_fit;    
03685 }
03686 
03687 /*----------------------------------------------------------------------------*/
03697 /*----------------------------------------------------------------------------*/
03698 const char *
03699 uves_remove_string_prefix(const char *s, const char *prefix)
03700 {
03701     const char *result = NULL;
03702     unsigned int prefix_length;
03703 
03704     assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
03705     assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
03706 
03707     prefix_length = strlen(prefix);
03708 
03709     assure( strlen(s) >= prefix_length &&
03710         strncmp(s, prefix, prefix_length) == 0,
03711         CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
03712         prefix, s);
03713     
03714     result = s + prefix_length;
03715     
03716   cleanup:
03717     return result;
03718 }
03719 
03720 
03721 /*----------------------------------------------------------------------------*/
03730 /*----------------------------------------------------------------------------*/
03731 
03732 double uves_gaussrand(void)
03733 {
03734     static double V1, V2, S;
03735     static int phase = 0;
03736     double X;
03737     
03738     if(phase == 0) {
03739     do {
03740         double U1 = (double)rand() / RAND_MAX;
03741         double U2 = (double)rand() / RAND_MAX;
03742         
03743         V1 = 2 * U1 - 1;
03744         V2 = 2 * U2 - 1;
03745         S = V1 * V1 + V2 * V2;
03746     } while(S >= 1 || S == 0);
03747     
03748     X = V1 * sqrt(-2 * log(S) / S);
03749     } else
03750     X = V2 * sqrt(-2 * log(S) / S);
03751     
03752     phase = 1 - phase;
03753     
03754     return X;
03755 }
03756 
03757 /*----------------------------------------------------------------------------*/
03768 /*----------------------------------------------------------------------------*/
03769 
03770 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x, 
03771                 const char *column_y, int *istart )
03772 {
03773     double result = 0;
03774     int n;
03775 
03776     const double *x, *y;
03777     
03778     check( x = cpl_table_get_data_double_const(t, column_x),
03779        "Error reading column '%s'", column_x);
03780     check( y = cpl_table_get_data_double_const(t, column_y),
03781        "Error reading column '%s'", column_y);
03782 
03783     n = cpl_table_get_nrow(t);
03784 
03785     result = uves_spline_hermite(xp, x, y, n, istart);
03786 
03787   cleanup:
03788     return result;
03789 }
03790 
03791 /*----------------------------------------------------------------------------*/
03807 /*----------------------------------------------------------------------------*/
03808 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
03809 {
03810     double yp1, yp2, yp = 0;
03811     double xpi, xpi1, l1, l2, lp1, lp2;
03812     int i;
03813 
03814     if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) )    return 0.0;
03815     if ( x[0] >  x[n-1] && (xp > x[0] || xp < x[n-1]) )    return 0.0;
03816 
03817     if ( x[0] <= x[n-1] )
03818     {
03819         for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
03820         ;
03821     }
03822     else
03823     {
03824         for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
03825         ;
03826     }
03827 
03828     *istart = i;
03829     i--;
03830     
03831     lp1 = 1.0 / (x[i-1] - x[i]);
03832     lp2 = -lp1;
03833 
03834     if ( i == 1 )
03835     {
03836         yp1 = (y[1] - y[0]) / (x[1] - x[0]);
03837     }
03838     else
03839     {
03840         yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
03841     }
03842 
03843     if ( i >= n - 1 )
03844     {
03845         yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
03846     }
03847     else
03848     {
03849         yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
03850     }
03851 
03852     xpi1 = xp - x[i];
03853     xpi  = xp - x[i-1];
03854     l1   = xpi1*lp1;
03855     l2   = xpi*lp2;
03856 
03857     yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 + 
03858          y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 + 
03859          yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
03860 
03861     return yp;
03862 }
03863 
03864 /*----------------------------------------------------------------------------*/
03878 /*----------------------------------------------------------------------------*/
03879 
03880 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
03881 {
03882     int klo, khi, k;
03883     double a, b, h, yp = 0;
03884 
03885     assure_nomsg( x  != NULL, CPL_ERROR_NULL_INPUT);
03886     assure_nomsg( y  != NULL, CPL_ERROR_NULL_INPUT);
03887     assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
03888     assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
03889 
03890     klo = *kstart;
03891     khi = n;
03892 
03893     if ( xp < x[1] || xp > x[n] )
03894     {
03895         return 0.0;
03896     }
03897     else if ( xp == x[1] )
03898     {
03899         return(y[1]);
03900     }
03901     
03902     for ( k = klo; k < n && xp > x[k]; k++ )
03903     ;
03904 
03905     klo = *kstart = k-1;
03906     khi = k;
03907 
03908     h = x[khi] - x[klo];
03909     assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
03910         "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
03911 
03912     a = (x[khi] - xp) / h;
03913     b = (xp - x[klo]) / h;
03914 
03915     yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
03916      (h*h) / 6.0;
03917 
03918   cleanup:
03919     return yp;
03920 }
03921 
03922 /*----------------------------------------------------------------------------*/
03932 /*----------------------------------------------------------------------------*/
03933 bool
03934 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
03935 {
03936     bool is_sorted = true;       /* ... until proven false */
03937     int i;
03938     int N;
03939     double previous, current;    /* column values */
03940 
03941     passure(t != NULL, " ");
03942     passure(cpl_table_has_column(t, column), "No column '%s'", column);
03943     passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
03944     
03945     N = cpl_table_get_nrow(t);
03946 
03947     if (N > 1) 
03948     {
03949         previous = cpl_table_get_double(t, column, 0, NULL);
03950         
03951         for(i = 1; i < N && is_sorted; i++)
03952         {
03953             current = cpl_table_get_double(t, column, i, NULL);
03954             if (!reverse)
03955             {
03956                 /* Check for ascending */
03957                 is_sorted = is_sorted && ( current >= previous );
03958             }
03959             else
03960             {
03961                 /* Check for descending */
03962                 is_sorted = is_sorted && ( current <= previous );
03963             }
03964             
03965             previous = current;
03966         }
03967     }
03968     else
03969     {
03970         /* 0 or 1 rows. Table is sorted */        
03971     }
03972     
03973   cleanup:
03974     return is_sorted;
03975 }
03976 
03977 /*----------------------------------------------------------------------------*/
03983 /*----------------------------------------------------------------------------*/
03984 cpl_table *
03985 uves_ordertable_traces_new(void)
03986 {
03987     cpl_table *result = NULL;
03988     
03989     check((
03990           result = cpl_table_new(0),
03991           cpl_table_new_column(result, "TraceID"  , CPL_TYPE_INT),
03992           cpl_table_new_column(result, "Offset"   , CPL_TYPE_DOUBLE),
03993           cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
03994     "Error creating table");
03995     
03996   cleanup:
03997     return result;
03998 }
03999 
04000 /*----------------------------------------------------------------------------*/
04010 /*----------------------------------------------------------------------------*/
04011 cpl_error_code
04012 uves_ordertable_traces_add(cpl_table *traces, 
04013                int fibre_ID, double fibre_offset, int fibre_mask)
04014 {
04015     int size;
04016 
04017     assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
04018     
04019     /* Write to new table row */
04020     check((
04021           size = cpl_table_get_nrow(traces),
04022           cpl_table_set_size  (traces, size+1),
04023           cpl_table_set_int   (traces, "TraceID"  , size, fibre_ID),
04024           cpl_table_set_double(traces, "Offset"   , size, fibre_offset),
04025           cpl_table_set_int   (traces, "Tracemask", size, fibre_mask)),
04026       "Error updating table");
04027 
04028   cleanup:
04029     return cpl_error_get_code();
04030 }
04031 
04032 
04033 /*----------------------------------------------------------------------------*/
04039 /*----------------------------------------------------------------------------*/
04040 cpl_error_code
04041 uves_tablename_remove_units(const char* tname)
04042 {
04043    cpl_table* tab=NULL;
04044    uves_propertylist* head=NULL;
04045    tab=cpl_table_load(tname,1,0);
04046    head=uves_propertylist_load(tname,0);
04047    uves_table_remove_units(&tab);
04048    check_nomsg(uves_table_save(tab,head,NULL,tname,CPL_IO_DEFAULT));
04049 
04050   cleanup:
04051    uves_free_table(&tab);
04052    uves_free_propertylist(&head);
04053    return cpl_error_get_code();
04054 }
04055 
04056 
04057 
04058 /*----------------------------------------------------------------------------*/
04065 /*----------------------------------------------------------------------------*/
04066 cpl_error_code
04067 uves_tablenames_unify_units(const char* tname2, const char* tname1)
04068 {
04069    cpl_table* tab1=NULL;
04070    cpl_table* tab2=NULL;
04071    uves_propertylist* head2=NULL;
04072 
04073    tab1=cpl_table_load(tname1,1,0);
04074 
04075    tab2=cpl_table_load(tname2,1,0);
04076    head2=uves_propertylist_load(tname2,0);
04077 
04078    uves_table_unify_units(&tab2,&tab1);
04079    check_nomsg(uves_table_save(tab2,head2,NULL,tname2,CPL_IO_DEFAULT));
04080 
04081   cleanup:
04082    uves_free_table(&tab1);
04083    uves_free_table(&tab2);
04084    uves_free_propertylist(&head2);
04085    return cpl_error_get_code();
04086 
04087 }
04088 
04089 
04090 
04091 /*----------------------------------------------------------------------------*/
04097 /*----------------------------------------------------------------------------*/
04098 cpl_error_code
04099 uves_table_remove_units(cpl_table **table)
04100 {
04101     int ncols;
04102     const char* colname=NULL;
04103     int i=0;
04104     cpl_array *names=NULL;
04105 
04106     assure( *table != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
04107     ncols = cpl_table_get_ncol(*table);
04108     names = cpl_table_get_column_names(*table);
04109     for(i=0;i<ncols;i++) {
04110        colname=cpl_array_get_string(names, i);
04111        cpl_table_set_column_unit(*table,colname,NULL);
04112     }
04113 
04114   cleanup:
04115     uves_free_array(&names);
04116 
04117     return cpl_error_get_code();
04118 }
04119 
04120 
04121 
04122 /*----------------------------------------------------------------------------*/
04129 /*----------------------------------------------------------------------------*/
04130 cpl_error_code
04131 uves_table_unify_units(cpl_table **table2,  cpl_table **table1)
04132 {
04133     int ncols1;
04134     int ncols2;
04135     const char* colname=NULL;
04136     const char* unit1=NULL;
04137 
04138     int i=0;
04139     cpl_array *names=NULL;
04140 
04141     assure( table1 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
04142     assure( *table2 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
04143     ncols1 = cpl_table_get_ncol(*table1);
04144     ncols2 = cpl_table_get_ncol(*table2);
04145     assure( ncols1 == ncols2, CPL_ERROR_NULL_INPUT, 
04146             "n columns (tab1) != n columns (tab2)");
04147 
04148     names = cpl_table_get_column_names(*table1);
04149     for(i=0;i<ncols1;i++) {
04150        colname=cpl_array_get_string(names, i);
04151        unit1=cpl_table_get_column_unit(*table1,colname);
04152        cpl_table_set_column_unit(*table2,colname,unit1);
04153     }
04154 
04155   cleanup:
04156     uves_free_array(&names);
04157 
04158     return cpl_error_get_code();
04159 }
04160 
04161 /*
04162  * modified on 2006/04/19
04163  *  jmlarsen:  float[5] -> const double[]
04164  *             changed mapping of indices to parameters
04165  *             Normalized the profile to 1 and changed meaning
04166  *             of (a[3], a[2]) to (integrated flux, stdev)
04167  *             Disabled debugging messages
04168  *
04169  * modified on 2005/07/29 to make dydapar a FORTRAN array
04170  * (indiced from 1 to N instead of 0 to N-1).
04171  * This allows the array to be passed to C functions expecting
04172  * FORTRAN-like arrays.
04173  *
04174  * modified on 2005/08/02 to make the function prototype ANSI
04175  * compliant (so it can be used with the levmar library).
04176  *
04177  * modified on 2005/08/16. The function now expects C-indexed
04178  * arrays as parameters (to allow proper integration). However, the
04179  * arrays are still converted to FORTRAN-indexed arrays internally.
04180  */
04181 
04192 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
04193 
04194  
04195      /*     int na;*/
04196 {
04197   double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
04198   double a2i=0, m = 0, p = 0, dif =0;
04199   double sqrt5 = 2.23606797749979;
04200 
04201   *y=0.0;
04202 //  a2i = 1.0/a[2];
04203   a2i = 1.0/(a[2]*sqrt5);
04204 
04205   dif=x-a[1];
04206   arg=dif*a2i;
04207   arg2=arg*arg;
04208 
04209   fac=1.0+arg2;
04210   fac2=fac*fac;
04211   fac4=fac2*fac2;
04212   fac4i = 1.0/fac4;
04213   
04214 //  m = a[1]*fac4i;
04215   m = a[3]*fac4i * a2i*16/(5.0*M_PI);
04216   *y = m + a[4]*(1.0+dif*a[5]);  
04217   p = 8.0*m/fac*arg*a2i;
04218 
04219   dyda[3] = m/a[3];
04220   dyda[2] = p*dif/a[2] - m/a[2];
04221 
04222 //  dyda[3]=fac4i;
04223   dyda[1]=p-a[4]*a[5];
04224 //  dyda[2]=p*dif*a2i;
04225   dyda[4]=1.0+dif*a[5];
04226   dyda[5]=a[4]*dif;
04227 
04228 
04229 #if 0
04230   {
04231      int i = 0, npar=5 ;
04232      printf("fmoffat_i \n");
04233      for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
04234      
04235      printf("fmoffat_i ");
04236      for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
04237      printf("\n");
04238   }
04239 #endif
04240   
04241 }
04242 
04261 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
04262 //void fmoffa_c(x,a,y, dyda)
04263 
04264 
04265 //     float x,*a,*y,*dyda;
04266 /*int na;*/
04267 {
04268   int npoint = 3;
04269   double const xgl[3] = {-0.387298334621,0.,0.387298334621};
04270   double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
04271   int i=0;
04272   int j=0;
04273   int npar = 5;
04274   double xmod = 0;
04275   double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
04276   double ypar;
04277 
04278 
04279   // Convert C-indexed arrays to FORTRAN-indexed arrays
04280   a    = C_TO_FORTRAN_INDEXING(a);
04281   dyda = C_TO_FORTRAN_INDEXING(dyda);
04282 
04283   *y = 0.0;
04284   for (i = 1;i<=npar;i++) dyda[i] = 0.;
04285   /*  printf("fmoffat_c ");
04286   for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
04287   /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
04288   /*  printf("\n");*/
04289   for (j=0; j < npoint; j++) 
04290       {
04291       xmod = x+xgl[j];
04292 
04293       fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
04294       
04295       *y = *y + ypar*wgl[j];
04296       
04297       for (i = 1; i <= npar; i++)
04298           {
04299           dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
04300           }
04301 
04302      /*      if (j == 2) 
04303     for (i = 1;i<=npar;i++) 
04304       {
04305         dyda[i] = dydapar[i];
04306       };
04307      */
04308     }
04309 
04310 #if 0
04311       printf("fmoffat_c ");
04312       for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
04313       printf("\n");
04314 #endif
04315 }
04316 
04317 /*----------------------------------------------------------------------------*/
04325 /*----------------------------------------------------------------------------*/
04326 int
04327 uves_moffat(const double x[], const double a[], double *result)
04328 {
04329     double dyda[5];
04330 
04331     fmoffa_c(x[0], a, result, dyda);
04332 
04333     return 0;
04334 }
04335 
04336 /*----------------------------------------------------------------------------*/
04344 /*----------------------------------------------------------------------------*/
04345 int
04346 uves_moffat_derivative(const double x[], const double a[], double result[])
04347 {
04348     double y;
04349 
04350     fmoffa_c(x[0], a, &y, result);
04351 
04352     return 0;
04353 }
04354 
04355 /*----------------------------------------------------------------------------*/
04375 /*----------------------------------------------------------------------------*/
04376 
04377 int
04378 uves_gauss(const double x[], const double a[], double *result)
04379 {
04380     double my    = a[0];
04381     double sigma = a[1];
04382 
04383     if (sigma == 0)
04384     {
04385         /* Dirac's delta function */
04386         if (x[0] == my)
04387         {
04388             *result = DBL_MAX;
04389         }
04390         else
04391         {
04392             *result = 0;
04393         }
04394         return 0;
04395     }
04396     else
04397     {
04398         double A     = a[2];
04399         double B     = a[3];
04400         
04401         *result = B    +
04402         A/(sqrt(2*M_PI*sigma*sigma)) *
04403         exp(- (x[0] - my)*(x[0] - my)
04404             / (2*sigma*sigma));
04405     }
04406     
04407     return 0;
04408 }
04409 
04410 /*----------------------------------------------------------------------------*/
04430 /*----------------------------------------------------------------------------*/
04431 
04432 int
04433 uves_gauss_derivative(const double x[], const double a[], double result[])
04434 {
04435     double my    = a[0];
04436     double sigma = a[1];
04437     double A     = a[2];
04438     /* a[3] not used */
04439 
04440     double factor;
04441    
04442     /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04443      *
04444      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
04445      *          = A * fac. * (x-my)  / s^2
04446      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
04447      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
04448      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04449      *          = fac.
04450      * df/dB    = 1
04451      */
04452     
04453     if (sigma == 0)
04454     {
04455         /* Derivative of Dirac's delta function */
04456         result[0] = 0;
04457         result[1] = 0;
04458         result[2] = 0;
04459         result[3] = 0;
04460         return 0;
04461     }
04462 
04463     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
04464     / (sqrt(2*M_PI*sigma*sigma));
04465 
04466     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
04467     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
04468     result[2] = factor;
04469     result[3] = 1;
04470 
04471     return 0;
04472 }
04473 
04474 /*----------------------------------------------------------------------------*/
04495 /*----------------------------------------------------------------------------*/
04496 
04497 int
04498 uves_gauss_linear(const double x[], const double a[], double *result)
04499 {
04500     double my    = a[0];
04501     double sigma = a[1];
04502 
04503     if (sigma == 0)
04504     {
04505         /* Dirac's delta function */
04506         if (x[0] == my)
04507         {
04508             *result = DBL_MAX;
04509         }
04510         else
04511         {
04512             *result = 0;
04513         }
04514         return 0;
04515     }
04516     else
04517     {
04518         double A     = a[2];
04519         double B     = a[3];
04520         double C     = a[4];
04521         
04522         *result = B    + C*(x[0] - my) +
04523         A/(sqrt(2*M_PI*sigma*sigma)) *
04524         exp(- (x[0] - my)*(x[0] - my)
04525             / (2*sigma*sigma));
04526     }
04527     
04528     return 0;
04529 }
04530 
04531 /*----------------------------------------------------------------------------*/
04554 /*----------------------------------------------------------------------------*/
04555 
04556 int
04557 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
04558 {
04559     double my    = a[0];
04560     double sigma = a[1];
04561     double A     = a[2];
04562     /* a[3] not used */
04563     double C     = a[4];
04564 
04565     double factor;
04566    
04567     /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04568      *
04569      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
04570      *          = A * fac. * (x-my)  / s^2   - C
04571      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
04572      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
04573      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04574      *          = fac.
04575      * df/dB    = 1
04576      *
04577      * df/dC    = x-my
04578      */
04579     
04580     if (sigma == 0)
04581     {
04582         /* Derivative of Dirac's delta function */
04583         result[0] = -C;
04584         result[1] = 0;
04585         result[2] = 0;
04586         result[3] = 0;
04587         result[4] = x[0];
04588         return 0;
04589     }
04590 
04591     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
04592     / (sqrt(2*M_PI*sigma*sigma));
04593 
04594     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
04595     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
04596     result[2] = factor;
04597     result[3] = 1;
04598     result[4] = x[0] - my;
04599 
04600     return 0;
04601 }
04602 
04603 
04604 
04605 
04606 /*----------------------------------------------------------------------------*/
04619 /*----------------------------------------------------------------------------*/
04620 cpl_image *
04621 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
04622                   const cpl_image *spectrum, const cpl_image *sky,
04623                   const cpl_image *cosmic_image,
04624                   const uves_extract_profile *profile,
04625                   cpl_image **image_noise, uves_propertylist **image_header)
04626 {
04627     cpl_image *image = NULL;
04628 
04629     cpl_binary *bpm = NULL;
04630     bool loop_y = false;
04631 
04632     double ron = 3;
04633     double gain = 1.0; //fixme
04634     bool new_format = true;
04635 
04636     image        = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
04637     assure_mem( image );
04638     if (image_noise != NULL) {
04639         *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
04640         assure_mem( *image_noise );
04641         cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
04642     }
04643 
04644     if (image_header != NULL) {
04645         *image_header = uves_propertylist_new();
04646       
04647         uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
04648         uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
04649         uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
04650     }
04651 
04652     for (uves_iterate_set_first(pos,
04653                                 1, pos->nx,
04654                                 pos->minorder, pos->maxorder,
04655                                 bpm,
04656                                 loop_y);
04657          !uves_iterate_finished(pos); 
04658          uves_iterate_increment(pos)) {
04659       
04660         /* Manual loop over y */
04661         uves_extract_profile_set(profile, pos, NULL);
04662         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
04663 
04664             /* Get empirical and model profile */
04665             double flux, sky_flux;
04666             int bad;
04667             int spectrum_row = pos->order - pos->minorder + 1;
04668             double noise;
04669             double prof = uves_extract_profile_evaluate(profile, pos);
04670           
04671             if (sky != NULL)
04672                 {
04673                     sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
04674                 }
04675             else
04676                 {
04677                     sky_flux = 0;
04678                 }
04679 
04680             flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
04681           
04682             //fixme: check this formula
04683             noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
04684 //          uves_msg_error("%f", prof);
04685             cpl_image_set(image, pos->x, pos->y, 
04686                           flux);
04687             if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
04688           
04689         }
04690     }
04691 
04692     if (cosmic_image != NULL) {
04693         double cr_val = 2*cpl_image_get_max(image);
04694         /* assign high pixel value to CR pixels */
04695         
04696         loop_y = true;
04697         
04698         for (uves_iterate_set_first(pos,
04699                                     1, pos->nx,
04700                                     pos->minorder, pos->maxorder,
04701                                     bpm,
04702                                     loop_y);
04703              !uves_iterate_finished(pos); 
04704              uves_iterate_increment(pos)) {
04705             
04706             int is_rejected;
04707             if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
04708                 cpl_image_set(image, pos->x, pos->y, cr_val);
04709             }
04710         }
04711     }
04712     
04713   cleanup:
04714     return image;
04715 }
04716 
04717 void 
04718 uves_frameset_dump(cpl_frameset* set)
04719 {
04720 
04721   cpl_frame* frm=NULL;
04722   int sz=0;
04723   int i=0;
04724 
04725   cknull(set,"Null input frameset");
04726   check_nomsg(sz=cpl_frameset_get_size(set));
04727   check_nomsg(frm=cpl_frameset_get_first(set));
04728   do{
04729     uves_msg("frame %d tag %s filename %s group %d",
04730          i,
04731              cpl_frame_get_tag(frm),
04732              cpl_frame_get_filename(frm),
04733              cpl_frame_get_group(frm));
04734     i++;
04735   } while ((frm=cpl_frameset_get_next(set)) != NULL);
04736 
04737   cleanup:
04738 
04739   return ;
04740 }
04741 
04742 
04743 
04744 
04745 /*-------------------------------------------------------------------------*/
04759 /*--------------------------------------------------------------------------*/
04760 
04761 cpl_image *
04762 uves_image_smooth_x(cpl_image * inp, const int r)
04763 {
04764 
04765   /*
04766    @param xp     x-value to interpolate
04767    @param x      x-values
04768    @param y      y-values
04769    @param n      array length
04770    @param istart    (input/output) initial row (set to 0 to search all row)
04771 
04772   */
04773   float* pinp=NULL;
04774   float* pout=NULL;
04775   int sx=0;
04776   int sy=0;
04777   int i=0;
04778   int j=0;
04779   int k=0;
04780 
04781   cpl_image* out=NULL;
04782 
04783   cknull(inp,"Null in put image, exit");
04784   check_nomsg(out=cpl_image_duplicate(inp));
04785   check_nomsg(sx=cpl_image_get_size_x(inp));
04786   check_nomsg(sy=cpl_image_get_size_y(inp));
04787   check_nomsg(pinp=cpl_image_get_data_float(inp));
04788   check_nomsg(pout=cpl_image_get_data_float(out));
04789   for(j=0;j<sy;j++) {
04790     for(i=r;i<sx-r;i++) {
04791       for(k=-r;k<r;k++) {
04792     pout[j*sx+i]+=pinp[j*sx+i+k];
04793       }
04794       pout[j*sx+i]/=2*r;
04795     }
04796   }
04797 
04798  cleanup:
04799 
04800   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04801     return NULL;
04802   } else {
04803     return out;
04804 
04805   }
04806 
04807 }
04808 
04809 
04810 
04811 
04812 
04813 /*-------------------------------------------------------------------------*/
04827 /*--------------------------------------------------------------------------*/
04828 
04829 cpl_image *
04830 uves_image_smooth_y(cpl_image * inp, const int r)
04831 {
04832 
04833   /*
04834    @param xp     x-value to interpolate
04835    @param x      x-values
04836    @param y      y-values
04837    @param n      array length
04838    @param istart    (input/output) initial row (set to 0 to search all row)
04839 
04840   */
04841   float* pinp=NULL;
04842   float* pout=NULL;
04843   int sx=0;
04844   int sy=0;
04845   int i=0;
04846   int j=0;
04847   int k=0;
04848 
04849   cpl_image* out=NULL;
04850 
04851   cknull(inp,"Null in put image, exit");
04852   check_nomsg(out=cpl_image_duplicate(inp));
04853   check_nomsg(sx=cpl_image_get_size_x(inp));
04854   check_nomsg(sy=cpl_image_get_size_y(inp));
04855   check_nomsg(pinp=cpl_image_get_data_float(inp));
04856   check_nomsg(pout=cpl_image_get_data_float(out));
04857   for(j=r;j<sy-r;j++) {
04858     for(i=0;i<sx;i++) {
04859       for(k=-r;k<r;k++) {
04860     pout[j*sx+i]+=pinp[(j+k)*sx+i];
04861       }
04862       pout[j*sx+i]/=2*r;
04863     }
04864   }
04865 
04866  cleanup:
04867 
04868   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04869     return NULL;
04870   } else {
04871     return out;
04872 
04873   }
04874 
04875 }
04876 
04877 
04878 /*-------------------------------------------------------------------------*/
04892 /*--------------------------------------------------------------------------*/
04893 
04894 cpl_image *
04895 uves_image_smooth_mean_x(cpl_image * inp, const int r)
04896 {
04897 
04898   /*
04899    @param xp     x-value to interpolate
04900    @param x      x-values
04901    @param y      y-values
04902    @param n      array length
04903    @param istart    (input/output) initial row (set to 0 to search all row)
04904 
04905   */
04906   float* pinp=NULL;
04907   float* pout=NULL;
04908   int sx=0;
04909   int sy=0;
04910   int i=0;
04911   int j=0;
04912   int k=0;
04913 
04914   cpl_image* out=NULL;
04915 
04916   cknull(inp,"Null in put image, exit");
04917   check_nomsg(out=cpl_image_duplicate(inp));
04918   check_nomsg(sx=cpl_image_get_size_x(inp));
04919   check_nomsg(sy=cpl_image_get_size_y(inp));
04920   check_nomsg(pinp=cpl_image_get_data_float(inp));
04921   check_nomsg(pout=cpl_image_get_data_float(out));
04922   for(j=0;j<sy;j++) {
04923     for(i=r;i<sx-r;i++) {
04924       for(k=-r;k<r;k++) {
04925     pout[j*sx+i]+=pinp[j*sx+i+k];
04926       }
04927       pout[j*sx+i]/=2*r;
04928     }
04929   }
04930 
04931  cleanup:
04932 
04933   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04934     return NULL;
04935   } else {
04936     return out;
04937 
04938   }
04939 
04940 }
04941 
04942 
04943 /*-------------------------------------------------------------------------*/
04957 /*--------------------------------------------------------------------------*/
04958 
04959 cpl_image *
04960 uves_image_smooth_median_x(cpl_image * inp, const int r)
04961 {
04962 
04963   /*
04964    @param xp     x-value to interpolate
04965    @param x      x-values
04966    @param y      y-values
04967    @param n      array length
04968    @param istart    (input/output) initial row (set to 0 to search all row)
04969 
04970   */
04971   float* pout=NULL;
04972   int sx=0;
04973   int sy=0;
04974   int i=0;
04975   int j=0;
04976 
04977   cpl_image* out=NULL;
04978 
04979 
04980   cknull(inp,"Null in put image, exit");
04981   check_nomsg(out=cpl_image_duplicate(inp));
04982   check_nomsg(sx=cpl_image_get_size_x(inp));
04983   check_nomsg(sy=cpl_image_get_size_y(inp));
04984   check_nomsg(pout=cpl_image_get_data_float(out));
04985 
04986   for(j=1;j<sy;j++) {
04987     for(i=1+r;i<sx-r;i++) {
04988       pout[j*sx+i]=(float)cpl_image_get_median_window(inp,i,j,i+r,j);
04989     }
04990   }
04991 
04992  cleanup:
04993 
04994   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04995     return NULL;
04996   } else {
04997     return out;
04998 
04999   }
05000 
05001 }
05002 
05003 /*-------------------------------------------------------------------------*/
05016 /*--------------------------------------------------------------------------*/
05017 
05018 cpl_image *
05019 uves_image_smooth_fft(cpl_image * inp, const int fx)
05020 {
05021 
05022   int sx=0;
05023   int sy=0;
05024 
05025   cpl_image* out=NULL;
05026   cpl_image* im_re=NULL;
05027   cpl_image* im_im=NULL;
05028   cpl_image* ifft_re=NULL;
05029   cpl_image* ifft_im=NULL;
05030   cpl_image* filter=NULL; 
05031 
05032   int sigma_x=fx;
05033   int sigma_y=0;
05034 
05035   cknull(inp,"Null in put image, exit");
05036   check_nomsg(im_re = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
05037   check_nomsg(im_im = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
05038 
05039   // Compute FFT
05040   check_nomsg(cpl_image_fft(im_re,im_im,CPL_FFT_DEFAULT));
05041 
05042   check_nomsg(sx=cpl_image_get_size_x(inp));
05043   check_nomsg(sy=cpl_image_get_size_y(inp));
05044   sigma_x=sx;
05045 
05046   //Generates filter image
05047   check_nomsg(filter = uves_gen_lowpass(sx,sy,sigma_x,sigma_y));
05048 
05049   //Apply filter
05050   cpl_image_multiply(im_re,filter);
05051   cpl_image_multiply(im_im,filter);
05052 
05053   uves_free_image(&filter);
05054 
05055   check_nomsg(ifft_re = cpl_image_duplicate(im_re));
05056   check_nomsg(ifft_im = cpl_image_duplicate(im_im));
05057 
05058   uves_free_image(&im_re);
05059   uves_free_image(&im_im);
05060 
05061   //Computes FFT-INVERSE
05062   check_nomsg(cpl_image_fft(ifft_re,ifft_im,CPL_FFT_INVERSE));
05063   check_nomsg(out = cpl_image_cast(ifft_re, CPL_TYPE_FLOAT));
05064 
05065  cleanup:
05066 
05067   uves_free_image(&ifft_re);
05068   uves_free_image(&ifft_im);
05069   uves_free_image(&filter);
05070   uves_free_image(&im_re);
05071   uves_free_image(&im_im);
05072 
05073   if(cpl_error_get_code() != CPL_ERROR_NONE) {
05074     return NULL;
05075   } else {
05076     return out;
05077   }
05078 
05079 }
05080 
05081 /*-------------------------------------------------------------------------*/
05090 /*--------------------------------------------------------------------------*/
05091 cpl_vector * 
05092 uves_imagelist_get_clean_mean_levels(cpl_imagelist* iml, double kappa)
05093 {
05094 
05095    cpl_image* img=NULL;
05096    int size=0;
05097    int i=0;
05098    cpl_vector* values=NULL;
05099    double* pval=NULL;
05100    double mean=0;
05101    double stdev=0;
05102   
05103    check_nomsg(size=cpl_imagelist_get_size(iml));
05104    check_nomsg(values=cpl_vector_new(size));
05105    pval=cpl_vector_get_data(values);
05106    for(i=0;i<size;i++) {
05107       img=cpl_imagelist_get(iml,i);
05108       irplib_ksigma_clip(img,1,1,
05109                          cpl_image_get_size_x(img),
05110                          cpl_image_get_size_y(img),
05111                          5,kappa,1.e-5,&mean,&stdev);
05112       uves_msg("Ima %d mean level: %g",i+1,mean);
05113       pval[i]=mean;
05114    }
05115 
05116   cleanup:
05117 
05118    return values;
05119 }
05120 
05121 
05122 /*-------------------------------------------------------------------------*/
05131 /*--------------------------------------------------------------------------*/
05132 cpl_error_code
05133 uves_imagelist_subtract_values(cpl_imagelist** iml, cpl_vector* values)
05134 {
05135 
05136    cpl_image* img=NULL;
05137    int size=0;
05138    int i=0;
05139    double* pval=NULL;
05140   
05141    check_nomsg(size=cpl_imagelist_get_size(*iml));
05142    pval=cpl_vector_get_data(values);
05143    for(i=0;i<size;i++) {
05144       img=cpl_imagelist_get(*iml,i);
05145       cpl_image_subtract_scalar(img,pval[i]);
05146       cpl_imagelist_set(*iml,img,i);
05147    }
05148 
05149   cleanup:
05150 
05151    return cpl_error_get_code();
05152 }
05153 
05154 
05155 /*-------------------------------------------------------------------------*/
05171 /*--------------------------------------------------------------------------*/
05172 static cpl_image * 
05173 uves_gen_lowpass(const int xs, 
05174                   const int ys, 
05175                   const double sigma_x, 
05176                   const double sigma_y)
05177 {
05178 
05179     int i= 0.0;
05180     int j= 0.0;
05181     int hlx= 0.0;
05182     int hly = 0.0;
05183     double x= 0.0;
05184     double y= 0.0;
05185     double gaussval= 0.0;
05186     double inv_sigma_x=1./sigma_x;
05187     double inv_sigma_y=1./sigma_y;
05188 
05189     float *data;
05190 
05191     cpl_image   *lowpass_image=NULL;
05192 
05193 
05194     lowpass_image = cpl_image_new (xs, ys, CPL_TYPE_FLOAT);
05195     if (lowpass_image == NULL) {
05196         uves_msg_error("Cannot generate lowpass filter <%s>",
05197                         cpl_error_get_message());
05198         return NULL;
05199     }
05200 
05201     hlx = xs/2;
05202     hly = ys/2;
05203 
05204     data = cpl_image_get_data_float(lowpass_image);
05205         
05206 /* Given an image with pixels 0<=i<N, 0<=j<M then the convolution image
05207    has the following properties:
05208 
05209    ima[0][0] = 1
05210    ima[i][0] = ima[N-i][0] = exp (-0.5 * (i/sig_i)^2)   1<=i<N/2
05211    ima[0][j] = ima[0][M-j] = exp (-0.5 * (j/sig_j)^2)   1<=j<M/2
05212    ima[i][j] = ima[N-i][j] = ima[i][M-j] = ima[N-i][M-j] 
05213              = exp (-0.5 * ((i/sig_i)^2 + (j/sig_j)^2)) 
05214 */
05215 
05216     data[0] = 1.0;
05217 
05218     /* first row */
05219     for (i=1 ; i<=hlx ; i++) {
05220         x = i * inv_sigma_x;
05221         gaussval = exp(-0.5*x*x);
05222         data[i] = gaussval;
05223         data[xs-i] = gaussval;
05224     }
05225 
05226     for (j=1; j<=hly ; j++) {
05227         y = j * inv_sigma_y;
05228       /* first column */
05229         data[j*xs] = exp(-0.5*y*y);
05230         data[(ys-j)*xs] = exp(-0.5*y*y);
05231 
05232         for (i=1 ; i<=hlx ; i++) {
05233     /* Use internal symetries */
05234             x = i * inv_sigma_x;
05235             gaussval = exp (-0.5*(x*x+y*y));
05236             data[j*xs+i] = gaussval;
05237             data[(j+1)*xs-i] = gaussval;
05238             data[(ys-j)*xs+i] = gaussval;
05239             data[(ys+1-j)*xs-i] = gaussval;
05240 
05241         }
05242     }
05243 
05244     /* FIXME: for the moment, reset errno which is coming from exp()
05245             in first for-loop at i=348. This is causing cfitsio to
05246             fail when loading an extension image (bug in cfitsio too).
05247     */
05248     if(errno != 0)
05249         errno = 0;
05250     
05251     return lowpass_image;
05252 }
05253 /*-------------------------------------------------------------------------*/
05261 /*--------------------------------------------------------------------------*/
05262 cpl_image*
05263 uves_image_mflat_detect_blemishes(const cpl_image* flat, 
05264                                   const uves_propertylist* head)
05265 {
05266 
05267    cpl_image* result=NULL;
05268    cpl_image* diff=NULL;
05269    cpl_image* flat_smooth=NULL;
05270    cpl_array* val=NULL;
05271    cpl_matrix* mx=NULL;
05272 
05273    int binx=0;
05274    int biny=0;
05275    int sx=0;
05276    int sy=0;
05277    int size=0;
05278    int i=0;
05279    int j=0;
05280    int k=0;
05281    int niter=3;
05282    int filter_width_x=7;
05283    int filter_width_y=7;
05284 
05285    double mean=0;
05286    double stdev=0;
05287    double stdev_x_4=0;
05288 
05289    double med_flat=0;
05290 
05291    double* pres=NULL;
05292    const double* pima=NULL;
05293    double* pval=NULL;
05294    double* pdif=NULL;
05295    int npixs=0;
05296 
05297    /* check input is valid */
05298    passure( flat !=NULL , "NULL input flat ");
05299    passure( head !=NULL , "NULL input head ");
05300   
05301    /* get image and bin sizes */
05302    sx=cpl_image_get_size_x(flat);
05303    sy=cpl_image_get_size_y(flat);
05304    npixs=sx*sy;
05305 
05306    binx=uves_pfits_get_binx(head);
05307    biny=uves_pfits_get_biny(head);
05308 
05309    /* set proper x/y filter width. Start values are 3 */
05310    if (binx>1) filter_width_x=5;
05311    if (biny>1) filter_width_y=5;
05312 
05313 
05314    /* create residuals image from smoothed flat */
05315    check_nomsg(mx=cpl_matrix_new(filter_width_x,filter_width_y));
05316   
05317   for(j=0; j< filter_width_y; j++){
05318     for(i=0; i< filter_width_x; i++){
05319       cpl_matrix_set( mx, i,j,1.0);
05320     }
05321   }
05322   
05323    check_nomsg(diff=cpl_image_duplicate(flat));
05324 
05325    check_nomsg(flat_smooth=uves_image_filter_median(flat,mx));
05326    /*
05327    check_nomsg(cpl_image_save(flat_smooth,"flat_smooth.fits",
05328                   CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
05329    */
05330    check_nomsg(cpl_image_subtract(diff,flat_smooth));
05331    /*
05332    check_nomsg(cpl_image_save(diff,"diff.fits",
05333                   CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
05334    */  
05335    /* compute median of flat */
05336    check_nomsg(med_flat=cpl_image_get_median(flat));
05337 
05338    /* prepare array of flat pixel values greater than the median */
05339    val=cpl_array_new(npixs,CPL_TYPE_DOUBLE);
05340    check_nomsg(cpl_array_fill_window_double(val,0,npixs,0));
05341    check_nomsg(pval=cpl_array_get_data_double(val));
05342    check_nomsg(pima=cpl_image_get_data_double_const(flat));
05343    check_nomsg(pdif=cpl_image_get_data_double(diff));
05344    k=0;
05345    for(i=0;i<npixs;i++) {
05346      if(pima[i]>med_flat) {
05347         pval[k]=pdif[i]; 
05348         k++;
05349      } 
05350    }   
05351 
05352    check_nomsg(cpl_array_set_size(val,k));
05353    
05354    /* computes 4 sigma clip mean of values */
05355    check_nomsg(mean=cpl_array_get_mean(val));
05356    check_nomsg(stdev=cpl_array_get_stdev(val));
05357    stdev_x_4=stdev*4.;
05358    check_nomsg(size=cpl_array_get_size(val));
05359 
05360    for(i=0;i<niter;i++) {
05361      for(k=0;k<size;k++) {
05362        if(fabs(pval[k]-mean)>stdev_x_4) {
05363      cpl_array_set_invalid(val,k);
05364        }
05365      }
05366      mean=cpl_array_get_mean(val);
05367      stdev=cpl_array_get_stdev(val);
05368      stdev_x_4=stdev*4.;
05369    }
05370 
05371    /* compute absolute value of difference image */
05372    result=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
05373    pres=cpl_image_get_data_double(result);
05374    for(i=0;i<npixs;i++) {
05375      if(fabs(pdif[i])<stdev_x_4) {
05376        pres[i]=1.;
05377      }
05378    }
05379 
05380    /* save result to debug */
05381    /*
05382    check_nomsg(cpl_image_save(result,"blemish.fits",CPL_BPP_IEEE_FLOAT,NULL,
05383             CPL_IO_DEFAULT));
05384    */
05385 
05386  cleanup:
05387    uves_free_array(&val);
05388    uves_free_image(&diff);
05389    uves_free_image(&flat_smooth);
05390    uves_free_matrix(&mx);
05391    return result;
05392 }
05393 
05394 

Generated on 3 Mar 2013 for UVES Pipeline Reference Manual by  doxygen 1.6.1