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

Generated on 8 Mar 2011 for UVES Pipeline Reference Manual by  doxygen 1.6.1