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: 2012/03/02 16:27:44 $
00023  * $Revision: 1.200 $
00024  * $Name: uves-5_0_0 $
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_ksigma_clip.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     cpl_size nx, ny; 
02148     int x, y;
02149 
02150     /* Check input */
02151     assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02152     assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02153     assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02154     assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02155     assure( noise  != NULL, CPL_ERROR_NULL_INPUT, "Null image");
02156 
02157     assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
02158         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
02159     assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
02160         "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
02161     
02162     nx = cpl_image_get_size_x(image1);
02163     ny = cpl_image_get_size_y(image1);
02164 
02165     assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT, 
02166         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02167         nx,   cpl_image_get_size_x(image2));
02168     assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT, 
02169         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02170         nx,   cpl_image_get_size_x(noise1));
02171     assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
02172         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02173         nx,   cpl_image_get_size_x(noise2));
02174     assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
02175         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02176         ny,   cpl_image_get_size_y(image2));
02177     assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
02178         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02179         ny,   cpl_image_get_size_y(noise1));
02180     assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
02181         "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
02182         ny,   cpl_image_get_size_y(noise2));
02183     
02184     result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
02185     *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
02186 
02187     /* Do the calculation */
02188     for (y = 1; y <= ny; y++)
02189     {
02190         for (x = 1; x <= nx; x++)
02191         {
02192             double flux1, flux2;
02193             double sigma1, sigma2;
02194             int pis_rejected1, noise_rejected1;
02195             int pis_rejected2, noise_rejected2;
02196 
02197             flux1  = cpl_image_get(image1, x, y, &pis_rejected1);
02198             flux2  = cpl_image_get(image2, x, y, &pis_rejected2);
02199             sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
02200             sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);
02201 
02202             pis_rejected1 = pis_rejected1 || noise_rejected1;
02203             pis_rejected2 = pis_rejected2 || noise_rejected2;
02204             
02205             if (pis_rejected1 && pis_rejected2)
02206             {
02207                 cpl_image_reject(result, x, y);
02208                 cpl_image_reject(*noise, x, y);
02209             }
02210             else
02211             {
02212                 /* At least one good pixel */
02213 
02214                 double flux, sigma;
02215                 
02216                 if (pis_rejected1 && !pis_rejected2)
02217                 {
02218                     flux = flux2;
02219                     sigma = sigma2;
02220                 }
02221                 else if (!pis_rejected1 && pis_rejected2)
02222                 {
02223                     flux = flux1;
02224                     sigma = sigma1;
02225                 }
02226                 else
02227                 {
02228                     /* Both pixels are good */
02229                     sigma =
02230                     1 / (sigma1*sigma1) +
02231                     1 / (sigma2*sigma2);
02232                     
02233                     flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
02234                     flux /= sigma;
02235                     
02236                     sigma = sqrt(sigma);
02237                 }
02238                 
02239                 cpl_image_set(result, x, y, flux);
02240                 cpl_image_set(*noise, x, y, sigma);
02241             }
02242         }
02243     }
02244     
02245   cleanup:
02246     if (cpl_error_get_code() != CPL_ERROR_NONE) 
02247     {
02248         uves_free_image(&result);
02249     }
02250     return result;
02251 }
02252 
02253 /*----------------------------------------------------------------------------*/
02268 /*----------------------------------------------------------------------------*/
02269 uves_propertylist *
02270 uves_initialize_image_header(const char *ctype1, const char *ctype2, const char *bunit,
02271                  double crval1, double crval2,
02272                  double crpix1, double crpix2,
02273                  double cdelt1, double cdelt2)
02274 {
02275     uves_propertylist *header = NULL;  /* Result */
02276 
02277     header = uves_propertylist_new();
02278 
02279     check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
02280     check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
02281     check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
02282     check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
02283     check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
02284     check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
02285     check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
02286     check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
02287     check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
02288     
02289   cleanup:
02290     return header;
02291 }
02292 
02293 /*----------------------------------------------------------------------------*/
02311 /*----------------------------------------------------------------------------*/
02312 cpl_image *
02313 uves_define_noise(const cpl_image *image, 
02314                   const uves_propertylist *image_header,
02315                   int ncom, enum uves_chip chip)
02316 {
02317     /*
02318           \/  __
02319            \_(__)_...
02320     */
02321 
02322     cpl_image *noise = NULL;      /* Result */
02323 
02324     /* cpl_image *in_med = NULL;     Median filtered input image */
02325 
02326     double ron;                   /* Read-out noise in ADU */
02327     double gain;
02328     int nx, ny, i;
02329     double *noise_data;
02330     const double *image_data;
02331     bool has_bnoise=false;
02332     bool has_dnoise=false;
02333     double bnoise=0;
02334     double dnoise=0;
02335     double dtime=0;
02336     double bnoise2=0;
02337     double dnoise2=0;
02338     double exptime=0;
02339     double exptime2=0;
02340     double tot_noise2=0;
02341     double var_bias_dark=0;
02342 
02343     /* Read, check input parameters */
02344     assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
02345     
02346     check( ron = uves_pfits_get_ron_adu(image_header, chip),
02347        "Could not read read-out noise");
02348     
02349     check( gain = uves_pfits_get_gain(image_header, chip),
02350        "Could not read gain factor");
02351     assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);
02352 
02353     nx = cpl_image_get_size_x(image);
02354     ny = cpl_image_get_size_y(image);
02355 
02356     /* For efficiency reasons, use pointers to image data buffers */
02357     assure(cpl_image_count_rejected(image) == 0, 
02358        CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
02359     assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
02360        CPL_ERROR_UNSUPPORTED_MODE, 
02361        "Input image is of type %s. double expected", 
02362        uves_tostring_cpl_type(cpl_image_get_type(image)));
02363 
02364     noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
02365     assure_mem( noise );
02366 
02367     noise_data = cpl_image_get_data_double(noise);
02368 
02369     image_data = cpl_image_get_data_double_const(image);
02370 
02371 
02372     if(image_header != NULL) {
02373        has_bnoise=uves_propertylist_contains(image_header,UVES_BNOISE);
02374        has_dnoise=uves_propertylist_contains(image_header,UVES_DNOISE);
02375     }
02376 
02377     if(has_bnoise) {
02378        bnoise=uves_propertylist_get_double(image_header,UVES_BNOISE);
02379        bnoise2=bnoise*bnoise;
02380     }
02381 
02382     if(has_dnoise) {
02383        dnoise=uves_propertylist_get_double(image_header,UVES_DNOISE);
02384        dnoise2=dnoise*dnoise;
02385        dtime=uves_propertylist_get_double(image_header,UVES_DTIME);
02386        exptime=uves_pfits_get_exptime(image_header);
02387        exptime2=exptime*exptime/dtime/dtime;
02388     }
02389     var_bias_dark=bnoise2+dnoise2*exptime2;
02390     uves_msg_debug("bnoise=%g dnoise=%g sci exptime=%g dark exptime=%g",
02391          bnoise,dnoise,exptime,dtime);
02392 
02393     /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */
02394 
02395     /* This filter is disabled, as there is often structure on the scale
02396        of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
02397        structure *does* result in worse fits to the data.
02398 
02399        in_med = cpl_image_duplicate(image);
02400        assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
02401        
02402        uves_msg_low("Applying 3x3 median filter");
02403        
02404        check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
02405        image_data = cpl_image_get_data_double(in_med);
02406        
02407        uves_msg_low("Setting pixel flux uncertainty");
02408     */
02409 
02410     /* We assume median stacked input (master flat, master dark, ...) */
02411     double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
02412     double gain2=gain*gain;
02413         
02414     double quant_var = uves_max_double(0, (1 - gain2)/12.0);
02415     /* Quant. error =
02416      * sqrt((g^2-1)/12)
02417      */
02418     double flux_var_adu=0;
02419     double ron2=ron*ron;
02420     double inv_ncom_median_factor=1./(ncom * median_factor);
02421     for (i = 0; i < nx*ny; i++)
02422     {
02423          
02424         /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
02425         /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
02426         flux_var_adu =  uves_max_double(image_data[i],0)*gain;
02427         
02428         /* For a number, N, of averaged or median stacked "identical" frames
02429          * (gaussian distribution assumed), the combined noise is
02430          *
02431          *  sigma_N = sigma / sqrt(N*f)
02432          *
02433          *  where (to a good approximation)
02434          *        f ~= { 1    , N = 1
02435          *             { 2/pi , N > 1
02436          *
02437          *  (i.e. the resulting uncertainty is
02438          *   larger than for average stacked inputs where f = 1)
02439          */
02440         
02441         /* Slow: cpl_image_set(noise, x, y, ... ); */
02442         /* Slow: noise_data[(x-1) + (y-1)*nx] = 
02443                  sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
02444               ((MIDAS) ? 1 : ncom * median_factor)); */
02445 
02446         
02447       tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor)+
02448          var_bias_dark;
02449 
02450       /*
02451       tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor);
02452       */
02453         noise_data[i] = sqrt(tot_noise2);
02454     }
02455 
02456   cleanup:
02457     /* uves_free_image(&in_med); */
02458     if (cpl_error_get_code() != CPL_ERROR_NONE)
02459     {
02460         uves_free_image(&noise);
02461     }
02462 
02463     return noise;
02464 }
02465 
02466 
02467 /*----------------------------------------------------------------------------*/
02477 /*----------------------------------------------------------------------------*/
02478 cpl_error_code
02479 uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
02480 {
02481     passure ( image != NULL, " ");
02482     passure ( master_bias != NULL, " ");
02483 
02484     check( cpl_image_subtract(image, master_bias),
02485        "Error subtracting bias");
02486 
02487     /* Due to different bad column correction in image/master_bias,
02488        it might happen that the image has become negative after 
02489        subtracting the bias. Disallow that. */
02490 
02491 #if 0
02492     /* No, for backwards compatibility, allow negative values.
02493      * MIDAS has an inconsistent logic on this matter.
02494      * For master dark frames, the thresholding *is* applied,
02495      * but not for science frames. Therefore we have to
02496      * apply thresholding on a case-by-case base (i.e. from
02497      * the caller).
02498      */
02499     check( cpl_image_threshold(image, 
02500                    0, DBL_MAX,     /* Interval */
02501                    0, DBL_MAX),    /* New values */
02502        "Error thresholding image");
02503 #endif
02504 
02505   cleanup:
02506     return cpl_error_get_code();
02507 }
02508 /*----------------------------------------------------------------------------*/
02521 /*----------------------------------------------------------------------------*/
02522 cpl_error_code
02523 uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
02524            const cpl_image *master_dark,
02525            const uves_propertylist *mdark_header)
02526 {
02527     cpl_image *normalized_mdark = NULL;
02528     double image_exptime = 0.0;
02529     double mdark_exptime = 0.0;
02530 
02531     passure ( image != NULL, " ");
02532     passure ( image_header != NULL, " ");
02533     passure ( master_dark != NULL, " ");
02534     passure ( mdark_header != NULL, " ");
02535 
02536     /* Normalize mdark to same exposure time as input image, then subtract*/
02537     check( image_exptime = uves_pfits_get_exptime(image_header), 
02538        "Error reading input image exposure time");
02539     check( mdark_exptime = uves_pfits_get_exptime(mdark_header), 
02540        "Error reading master dark exposure time");
02541     
02542     uves_msg("Rescaling master dark from %f s to %f s exposure time", 
02543          mdark_exptime, image_exptime);
02544     
02545     check( normalized_mdark = 
02546        cpl_image_multiply_scalar_create(master_dark,
02547                         image_exptime / mdark_exptime),
02548        "Error normalizing master dark");
02549     
02550     check( cpl_image_subtract(image, normalized_mdark), 
02551        "Error subtracting master dark");
02552 
02553     uves_msg_warning("noise rescaled master dark %g",cpl_image_get_stdev(normalized_mdark));
02554 
02555 
02556   cleanup:
02557     uves_free_image(&normalized_mdark);
02558     return cpl_error_get_code();
02559 }
02560 
02561 /*----------------------------------------------------------------------------*/
02575 /*----------------------------------------------------------------------------*/
02576 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
02577 {
02578     return (first_abs_order +
02579         (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
02580 }
02581 
02582 /*----------------------------------------------------------------------------*/
02596 /*----------------------------------------------------------------------------*/
02597 double
02598 uves_average_reject(cpl_table *t,
02599                     const char *column,
02600                     const char *residual2,
02601                     double kappa)
02602 {
02603     double mean = 0, median, sigma2;
02604     int rejected;
02605     
02606     do {
02607         /* Robust estimation */
02608       check_nomsg(median = cpl_table_get_column_median(t, column));
02609 
02610         /* Create column
02611            residual2 = (column - median)^2   */
02612       check_nomsg(cpl_table_duplicate_column(t, residual2, t, column));
02613       check_nomsg(cpl_table_subtract_scalar(t, residual2, median));
02614       check_nomsg(cpl_table_multiply_columns(t, residual2, residual2));
02615 
02616         /* For a Gaussian distribution:
02617          * sigma    ~= median(|residual|) / 0.6744
02618          * sigma^2  ~= median(residual^2) / 0.6744^2  
02619          */
02620 
02621       check_nomsg(sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744));
02622 
02623         /* Reject values where
02624            residual^2 > (kappa*sigma)^2
02625         */
02626     check_nomsg( rejected = uves_erase_table_rows(t, residual2,
02627                                                       CPL_GREATER_THAN,
02628                                                       kappa*kappa*sigma2));
02629         
02630     check_nomsg(cpl_table_erase_column(t, residual2));
02631 
02632     } while (rejected > 0);
02633 
02634     check_nomsg(mean  = cpl_table_get_column_mean(t, column));
02635     
02636   cleanup:
02637     return mean;
02638 }
02639 
02640 /*----------------------------------------------------------------------------*/
02673 /*----------------------------------------------------------------------------*/
02674 polynomial *
02675 uves_polynomial_regression_1d(cpl_table *t,
02676                   const char *X, const char *Y, const char *sigmaY, 
02677                   int degree, 
02678                   const char *polynomial_fit, const char *residual_square,
02679                   double *mean_squared_error, double kappa)
02680 {
02681     int N;
02682     int total_rejected = 0;  /* Rejected in kappa sigma clipping */
02683     int rejected = 0;
02684     double mse;                  /* local mean squared error */
02685     double *x;
02686     double *y;
02687     double *sy;
02688     polynomial *result = NULL;
02689     cpl_vector *vx = NULL;
02690     cpl_vector *vy = NULL;
02691     cpl_vector *vsy = NULL;
02692     cpl_type type;
02693 
02694     /* Check input */
02695     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
02696     assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
02697     assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
02698     assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
02699     assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
02700     assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
02701         "No such column: %s", sigmaY);
02702 
02703     assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
02704         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
02705 
02706     assure( residual_square == NULL || !cpl_table_has_column(t, residual_square), 
02707         CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
02708     
02709     /* Check column types */
02710     type = cpl_table_get_column_type(t, Y);
02711     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE, 
02712         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
02713     type = cpl_table_get_column_type(t, X);
02714     assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
02715         "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
02716     if (sigmaY != NULL)
02717     {
02718         type = cpl_table_get_column_type(t, sigmaY);
02719         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
02720             CPL_ERROR_INVALID_TYPE, 
02721             "Input column '%s' has wrong type (%s)", 
02722             sigmaY, uves_tostring_cpl_type(type));
02723     }
02724 
02725     check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
02726        "Could not cast table column '%s' to double", X);
02727     check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
02728        "Could not cast table column '%s' to double", Y);
02729     if (sigmaY != NULL)
02730     {
02731         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
02732            "Could not cast table column '%s' to double", sigmaY);
02733     } 
02734     
02735 
02736     total_rejected = 0;
02737     rejected = 0;
02738     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
02739        "Could not create column");
02740     do{
02741     check( (N = cpl_table_get_nrow(t),
02742         x = cpl_table_get_data_double(t, "_X_double"),
02743         y = cpl_table_get_data_double(t, "_Y_double")),
02744            "Could not read table data");
02745     
02746     if (sigmaY != NULL) 
02747         {
02748         check( sy = cpl_table_get_data_double(t,  "_sY_double"),
02749                "Could not read table data");
02750         } 
02751     else 
02752         {
02753         sy = NULL;
02754         }
02755   
02756     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table. "
02757             "No points to fit in poly 1d regression. At least 2 needed");
02758 
02759     assure( N > degree, CPL_ERROR_ILLEGAL_INPUT, "%d points to fit in poly 1d "
02760            "regression of degree %d. At least %d needed.",
02761             N,degree,degree+1);
02762 
02763     /* Wrap vectors */
02764     uves_unwrap_vector(&vx);
02765     uves_unwrap_vector(&vy);
02766     
02767     vx = cpl_vector_wrap(N, x);
02768     vy = cpl_vector_wrap(N, y);
02769        
02770     if (sy != NULL)
02771         {
02772         uves_unwrap_vector(&vsy);
02773         vsy = cpl_vector_wrap(N, sy);
02774         }
02775     else
02776         {
02777         vsy = NULL;
02778         }
02779      
02780     /* Fit! */
02781     uves_polynomial_delete(&result);
02782     check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse), 
02783            "Could not fit polynomial");
02784     
02785     /* If requested, calculate residuals and perform kappa-sigma clipping */
02786     if (kappa > 0)
02787         {
02788         double sigma2;   /* sigma squared */
02789         int i;
02790         
02791         for (i = 0; i < N; i++)
02792             {
02793             double xval, yval, yfit;
02794             
02795             check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
02796                 yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
02797                 yfit = uves_polynomial_evaluate_1d(result, xval),
02798     
02799                 cpl_table_set_double(t, "_residual_square", i, 
02800                              (yfit-yval)*(yfit-yval))),
02801                 "Could not evaluate polynomial");
02802             }
02803         
02804         /* For robustness, estimate sigma as (third quartile) / 0.6744
02805          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
02806          * The third quartile is estimated as the median of the absolute residuals,
02807          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
02808          *     sigma^2  ~= median(residual^2) / 0.6744^2  
02809          */
02810         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
02811 
02812         /* Remove points with residual^2 > kappa^2 * sigma^2 */
02813         check( rejected = uves_erase_table_rows(t, "_residual_square", 
02814                             CPL_GREATER_THAN, kappa*kappa*sigma2),
02815                "Could not remove outlier points");
02816         
02817         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
02818                    rejected, N, sqrt(mse));
02819         
02820         /* Update */
02821         total_rejected += rejected;
02822         N = cpl_table_get_nrow(t);
02823         }
02824     
02825 } while (rejected > 0);
02826     
02827     cpl_table_erase_column(t,  "_residual_square");    
02828     
02829     if (kappa > 0)
02830     {    
02831         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
02832               total_rejected,
02833               N + total_rejected,
02834               (100.0*total_rejected)/(N + total_rejected)
02835         );
02836     }
02837     
02838     if (mean_squared_error != NULL) *mean_squared_error = mse;
02839     
02840     /* Add the fitted values to table if requested */
02841     if (polynomial_fit != NULL || residual_square != NULL)
02842     {
02843         int i;
02844         
02845         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
02846            "Could not create column");
02847         for (i = 0; i < N; i++){
02848         double xval;
02849         double yfit;
02850         
02851         check((
02852               xval = cpl_table_get_double(t, "_X_double", i, NULL),
02853               yfit = uves_polynomial_evaluate_1d(result, xval),
02854               cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
02855               "Could not evaluate polynomial");
02856         }
02857         
02858         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
02859         if (residual_square != NULL)
02860         {
02861             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
02862                                t, "_polynomial_fit"),
02863                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
02864                 cpl_table_multiply_columns(t, residual_square, residual_square)),
02865                                                                                /* RS := RS^2 */
02866                 "Could not calculate Residual of fit");
02867         }
02868         
02869         /* Keep the polynomial_fit column if requested */
02870         if (polynomial_fit != NULL)
02871         {
02872             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
02873         }
02874         else
02875         {
02876             cpl_table_erase_column(t, "_polynomial_fit");
02877         }
02878     }
02879     
02880     check(( cpl_table_erase_column(t, "_X_double"),
02881         cpl_table_erase_column(t, "_Y_double")),
02882       "Could not delete temporary columns");
02883     
02884     if (sigmaY != NULL) 
02885     {
02886         check( cpl_table_erase_column(t, "_sY_double"), 
02887            "Could not delete temporary column");
02888     } 
02889     
02890   cleanup:
02891     uves_unwrap_vector(&vx);
02892     uves_unwrap_vector(&vy);
02893     uves_unwrap_vector(&vsy);
02894     if (cpl_error_get_code() != CPL_ERROR_NONE)
02895     {
02896         uves_polynomial_delete(&result);
02897     }
02898     
02899     return result;
02900 }
02901 
02902 
02903 /*----------------------------------------------------------------------------*/
02951 /*----------------------------------------------------------------------------*/
02952 
02953 polynomial *
02954 uves_polynomial_regression_2d(cpl_table *t,
02955                   const char *X1, const char *X2, const char *Y, 
02956                   const char *sigmaY,
02957                   int degree1, int degree2,
02958                   const char *polynomial_fit, const char *residual_square, 
02959                   const char *variance_fit,
02960                   double *mse, double *red_chisq,
02961                   polynomial **variance, double kappa,
02962                               double min_reject)
02963 {
02964     int N;
02965     int rejected;
02966     int total_rejected;
02967     double *x1;
02968     double *x2;
02969     double *y;
02970     double *res;
02971     double *sy;
02972     polynomial *p = NULL;               /* Result */
02973     polynomial *variance_local = NULL;
02974     cpl_vector *vx1 = NULL;
02975     cpl_vector *vx2 = NULL;
02976     cpl_bivector *vx = NULL;
02977     cpl_vector *vy = NULL;
02978     cpl_vector *vsy= NULL;
02979     cpl_type type;
02980 
02981     /* Check input */
02982     assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
02983     N  = cpl_table_get_nrow(t);
02984     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "The table with column to compute regression has 0 rows!");
02985     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);
02986 
02987     assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
02988     assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
02989     assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
02990     assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
02991         CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
02992     if (sigmaY != NULL)
02993     {
02994         assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT, 
02995             "No such column: %s", sigmaY);
02996     }
02997     if (polynomial_fit != NULL)
02998     {
02999         assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
03000             "Table already has '%s' column", polynomial_fit);
03001     }
03002     if (residual_square != NULL)
03003     {
03004         assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT, 
03005             "Table already has '%s' column", residual_square);
03006     }
03007     if (variance_fit != NULL)
03008     {
03009         assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
03010             "Table already has '%s' column", variance_fit);
03011     }
03012 
03013     /* Check column types */
03014     type = cpl_table_get_column_type(t, X1);
03015     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03016         "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
03017     type = cpl_table_get_column_type(t, X2);
03018     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03019         "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
03020     type = cpl_table_get_column_type(t, Y);
03021     assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03022         "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
03023     if (sigmaY != NULL)
03024     {
03025         type = cpl_table_get_column_type(t, sigmaY);
03026         assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
03027             "Input column '%s' has wrong type (%s)", 
03028             sigmaY, uves_tostring_cpl_type(type));
03029     }
03030 
03031     /* In the case that these temporary columns already exist, a run-time error will occur */
03032     check( cpl_table_cast_column(t, X1    , "_X1_double", CPL_TYPE_DOUBLE), 
03033        "Could not cast table column to double");
03034     check( cpl_table_cast_column(t, X2    , "_X2_double", CPL_TYPE_DOUBLE),
03035        "Could not cast table column to double");
03036     check( cpl_table_cast_column(t,  Y    ,  "_Y_double", CPL_TYPE_DOUBLE), 
03037        "Could not cast table column to double");
03038     if (sigmaY != NULL)
03039     {
03040         check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE), 
03041            "Could not cast table column to double");
03042     }
03043     
03044     total_rejected = 0;
03045     rejected = 0;
03046     check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE), 
03047        "Could not create column");
03048 
03049     do {
03050         /* WARNING!!! Code duplication (see below). Be careful
03051            when updating */
03052     check(( N  = cpl_table_get_nrow(t),
03053         x1 = cpl_table_get_data_double(t, "_X1_double"),
03054         x2 = cpl_table_get_data_double(t, "_X2_double"),
03055         y  = cpl_table_get_data_double(t, "_Y_double"),
03056                 res= cpl_table_get_data_double(t, "_residual_square")),
03057           "Could not read table data");
03058     
03059     if (sigmaY != NULL) 
03060         {
03061         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
03062                "Could not read table data");
03063         }
03064     else 
03065         {
03066         sy = NULL;
03067         }
03068 
03069     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
03070     
03071     /* Wrap vectors */
03072     uves_unwrap_vector(&vx1);
03073     uves_unwrap_vector(&vx2);
03074     uves_unwrap_vector(&vy);
03075 
03076     vx1 = cpl_vector_wrap(N, x1);
03077     vx2 = cpl_vector_wrap(N, x2);
03078     vy  = cpl_vector_wrap(N, y);
03079     if (sy != NULL)
03080         {
03081         uves_unwrap_vector(&vsy);
03082         vsy = cpl_vector_wrap(N, sy);
03083         }
03084     else
03085         {
03086         vsy = NULL;
03087         }
03088     
03089     /* Wrap up the bi-vector */
03090     uves_unwrap_bivector_vectors(&vx);
03091     vx = cpl_bivector_wrap_vectors(vx1, vx2);
03092   
03093     /* Fit! */
03094     uves_polynomial_delete(&p);
03095         check( p =  uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
03096                                            NULL, NULL, NULL),
03097                "Could not fit polynomial");
03098 
03099     /* If requested, calculate residuals and perform kappa-sigma clipping */
03100     if (kappa > 0)
03101         {
03102         double sigma2;   /* sigma squared */
03103         int i;
03104 
03105                 cpl_table_fill_column_window_double(t, "_residual_square", 0, 
03106                                                     cpl_table_get_nrow(t), 0.0);
03107 
03108         for (i = 0; i < N; i++)
03109             {
03110                         double yval, yfit;
03111 
03112                         yval  = y[i];
03113                         yfit  = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
03114                         res[i] = (yfit-y[i])*(yfit-y[i]);
03115             }
03116         
03117         /* For robustness, estimate sigma as (third quartile) / 0.6744
03118          * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
03119          * The third quartile is estimated as the median of the absolute residuals,
03120          * so  sigma    ~= median(|residual|) / 0.6744  , i.e.
03121          *     sigma^2  ~= median(residual^2) / 0.6744^2  
03122          */
03123         sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
03124                              
03125 
03126         /* Remove points with residual^2 > kappa^2 * sigma^2 */
03127         check( rejected = uves_erase_table_rows(t, "_residual_square", 
03128                             CPL_GREATER_THAN, kappa*kappa*sigma2),
03129                "Could not remove outlier points");
03130         /* Note! All pointers to table data are now invalid! */
03131 
03132 
03133         uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f", 
03134                    rejected, N, sqrt(sigma2));
03135         
03136         /* Update */
03137         total_rejected += rejected;
03138         N = cpl_table_get_nrow(t);
03139         }
03140         
03141     /* Stop also if there are too few points left to make the fit.
03142      * Needed number of points = (degree1+1)(degree2+1) coefficients
03143      *      plus one extra point for chi^2 computation.   */
03144     } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
03145              N >= (degree1 + 1)*(degree2 + 1) + 1);
03146     
03147     if (kappa > 0)
03148     {    
03149         uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
03150                 total_rejected,
03151                 N + total_rejected,
03152                 (100.0*total_rejected)/(N + total_rejected)
03153         );
03154     }
03155        
03156     /* Final fit */
03157     {
03158         /* Need to convert to vector again. */
03159 
03160         /* WARNING!!! Code duplication (see above). Be careful
03161            when updating */
03162     check(( N  = cpl_table_get_nrow(t),
03163         x1 = cpl_table_get_data_double(t, "_X1_double"),
03164         x2 = cpl_table_get_data_double(t, "_X2_double"),
03165         y  = cpl_table_get_data_double(t, "_Y_double"),
03166                 res= cpl_table_get_data_double(t, "_residual_square")),
03167           "Could not read table data");
03168     
03169     if (sigmaY != NULL) 
03170         {
03171         check (sy = cpl_table_get_data_double(t,  "_sY_double"),
03172                "Could not read table data");
03173         }
03174     else 
03175         {
03176         sy = NULL;
03177         }
03178 
03179     assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
03180     
03181     /* Wrap vectors */
03182     uves_unwrap_vector(&vx1);
03183     uves_unwrap_vector(&vx2);
03184     uves_unwrap_vector(&vy);
03185 
03186     vx1 = cpl_vector_wrap(N, x1);
03187     vx2 = cpl_vector_wrap(N, x2);
03188     vy  = cpl_vector_wrap(N, y);
03189     if (sy != NULL)
03190         {
03191         uves_unwrap_vector(&vsy);
03192         vsy = cpl_vector_wrap(N, sy);
03193         }
03194     else
03195         {
03196         vsy = NULL;
03197         }
03198     
03199     /* Wrap up the bi-vector */
03200     uves_unwrap_bivector_vectors(&vx);
03201     vx = cpl_bivector_wrap_vectors(vx1, vx2);
03202     }
03203 
03204     uves_polynomial_delete(&p);
03205     if (variance_fit != NULL || variance != NULL)
03206         {
03207             /* If requested, also compute variance */
03208             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
03209                                               mse, red_chisq, &variance_local),
03210                    "Could not fit polynomial");
03211         }
03212     else
03213         {
03214             check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2, 
03215                                               mse, red_chisq, NULL),
03216                    "Could not fit polynomial");
03217         }
03218 
03219     cpl_table_erase_column(t,  "_residual_square");
03220     
03221     /* Add the fitted values to table as requested */
03222     if (polynomial_fit != NULL || residual_square != NULL)
03223     {
03224         int i;
03225             double *pf;
03226         
03227         check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE), 
03228            "Could not create column");
03229 
03230             cpl_table_fill_column_window_double(t, "_polynomial_fit", 0, 
03231                                                 cpl_table_get_nrow(t), 0.0);
03232 
03233             x1 = cpl_table_get_data_double(t, "_X1_double");
03234             x2 = cpl_table_get_data_double(t, "_X2_double");
03235             pf = cpl_table_get_data_double(t, "_polynomial_fit");
03236 
03237         for (i = 0; i < N; i++){
03238 #if 0        
03239         double x1val, x2val, yfit;
03240 
03241         check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
03242             x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
03243             yfit  = uves_polynomial_evaluate_2d(p, x1val, x2val),
03244             
03245             cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
03246             "Could not evaluate polynomial");
03247 
03248 #else
03249                 pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
03250 #endif
03251         }
03252         
03253         /* Add residual^2  =  (Polynomial fit  -  Y)^2  if requested */
03254         if (residual_square != NULL)
03255         {
03256             check(( cpl_table_duplicate_column(t, residual_square,     /* RS := PF */
03257                                t, "_polynomial_fit"),
03258                 cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
03259                 cpl_table_multiply_columns(t, residual_square, residual_square)),
03260                                                                    /* RS := RS^2 */
03261                "Could not calculate Residual of fit");
03262         }
03263         
03264         /* Keep the polynomial_fit column if requested */
03265         if (polynomial_fit != NULL)
03266         {
03267             cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
03268         }
03269         else
03270         {
03271             cpl_table_erase_column(t, "_polynomial_fit");
03272         }
03273     }
03274     
03275     /* Add variance of poly_fit if requested */
03276     if (variance_fit != NULL)
03277     {
03278         int i;
03279             double *vf;
03280 
03281         check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE), 
03282            "Could not create column");
03283             
03284             cpl_table_fill_column_window_double(t, variance_fit, 0,
03285                                                 cpl_table_get_nrow(t), 0.0);
03286 
03287             x1 = cpl_table_get_data_double(t, "_X1_double");
03288             x2 = cpl_table_get_data_double(t, "_X2_double");
03289             vf = cpl_table_get_data_double(t, variance_fit);
03290 
03291         for (i = 0; i < N; i++)
03292         {
03293 #if 0
03294             double x1val, x2val, yfit_variance;
03295             check(( x1val         = cpl_table_get_double(t, "_X1_double", i, NULL),
03296                 x2val         = cpl_table_get_double(t, "_X2_double", i, NULL),
03297                 yfit_variance = uves_polynomial_evaluate_2d(variance_local, 
03298                                     x1val, x2val),
03299                 
03300                 cpl_table_set_double(t, variance_fit, i, yfit_variance)),
03301                "Could not evaluate polynomial");
03302 #else
03303                     vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
03304 #endif
03305 
03306         }
03307     }
03308     
03309     
03310     check(( cpl_table_erase_column(t, "_X1_double"),
03311         cpl_table_erase_column(t, "_X2_double"),
03312         cpl_table_erase_column(t,  "_Y_double")),
03313       "Could not delete temporary columns");
03314       
03315     if (sigmaY != NULL) 
03316     {
03317         check( cpl_table_erase_column(t, "_sY_double"),
03318            "Could not delete temporary column");
03319     }
03320     
03321   cleanup:
03322     uves_unwrap_bivector_vectors(&vx);
03323     uves_unwrap_vector(&vx1);
03324     uves_unwrap_vector(&vx2);
03325     uves_unwrap_vector(&vy);
03326     uves_unwrap_vector(&vsy);
03327     /* Delete 'variance_local', or return through 'variance' parameter */
03328     if (variance != NULL)
03329     {
03330         *variance = variance_local;
03331     }
03332     else
03333     {
03334         uves_polynomial_delete(&variance_local);
03335     }
03336     if (cpl_error_get_code() != CPL_ERROR_NONE)
03337     {
03338         uves_polynomial_delete(&p);
03339     }
03340 
03341     return p;
03342 }
03343 
03344 /*----------------------------------------------------------------------------*/
03387 /*----------------------------------------------------------------------------*/
03388 
03389 polynomial *
03390 uves_polynomial_regression_2d_autodegree(cpl_table *t,
03391                      const char *X1, const char *X2, const char *Y,
03392                      const char *sigmaY,
03393                      const char *polynomial_fit,
03394                      const char *residual_square, 
03395                      const char *variance_fit,
03396                      double *mean_squared_error, double *red_chisq,
03397                      polynomial **variance, double kappa,
03398                      int maxdeg1, int maxdeg2, double min_rms,
03399                                          double min_reject,
03400                                          bool verbose,
03401                      const double *min_val,
03402                      const double *max_val,
03403                      int npos, double positions[][2])
03404 {
03405     int deg1 = 0;               /* Current degrees                                  */
03406     int deg2 = 0;               /* Current degrees                                  */
03407     int i;
03408 
03409     double **mse = NULL;
03410     bool adjust1 = true;      /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
03411     bool adjust2 = true;      /*   (or held constant)            */
03412     bool finished = false;
03413 
03414     const char *y_unit;
03415     cpl_table *temp = NULL;
03416     polynomial *bivariate_fit = NULL;   /* Result */
03417 
03418     assure( (min_val == NULL && max_val == NULL) || positions != NULL,
03419         CPL_ERROR_NULL_INPUT,
03420         "Missing positions array");    
03421 
03422     check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
03423     if (y_unit == NULL)
03424     {
03425         y_unit = "";
03426     }
03427 
03428     assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT, 
03429        "Illegal max. degrees: (%d, %d)",
03430        maxdeg1, maxdeg2);
03431 
03432     mse = cpl_calloc(maxdeg1+1, sizeof(double *));
03433     assure_mem(mse);
03434     for (i = 0; i < maxdeg1+1; i++)
03435     {
03436         int j;
03437         mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
03438         assure_mem(mse);
03439 
03440         for (j = 0; j < maxdeg2+1; j++)
03441         {
03442             mse[i][j] = -1;
03443         }
03444     }
03445 
03446     temp = cpl_table_duplicate(t);
03447     assure_mem(temp);
03448 
03449     uves_polynomial_delete(&bivariate_fit);
03450     check( bivariate_fit = uves_polynomial_regression_2d(temp,
03451                              X1, X2, Y, sigmaY,
03452                              deg1,
03453                              deg2,
03454                              NULL, NULL, NULL,  /* new columns  */
03455                              &mse[deg1][deg2], NULL, /* chi^2/N */
03456                              NULL,              /* variance pol.*/
03457                              kappa, min_reject),
03458        "Error fitting polynomial");
03459     if (verbose)
03460         uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
03461                      deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
03462                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
03463                      cpl_table_get_nrow(t));
03464     else
03465         uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
03466                        deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
03467                      cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
03468                      cpl_table_get_nrow(t));
03469     /* Find best values of deg1, deg2 less than or equal to 8,8
03470        (the fitting algorithm is unstable after this point, anyway) */
03471     do
03472     {
03473         int new_deg1, new_deg2;
03474         double m;
03475 
03476         finished = true;
03477 
03478         adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
03479         adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
03480         
03481         /* Try the new degrees
03482 
03483                               (d1+1, d2  ) (d1+2, d2)
03484                        (d1, d2+1) (d1+1, d2+1)
03485                        (d1, d2+2)
03486 
03487            in the following order:
03488 
03489                                      1            3
03490                           1          2
03491                           3
03492 
03493                (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
03494         */
03495         for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
03496         for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
03497             if ( (
03498                  (new_deg1 == deg1+1 && new_deg2 == deg2   && adjust1) ||
03499                  (new_deg1 == deg1+2 && new_deg2 == deg2   && adjust1) ||
03500                  (new_deg1 == deg1   && new_deg2 == deg2+1 && adjust2) ||
03501                  (new_deg1 == deg1   && new_deg2 == deg2+2 && adjust2) ||
03502                  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
03503                  )
03504              && mse[new_deg1][new_deg2] < 0)
03505             {
03506                 int rejected = 0;
03507 
03508                 uves_free_table(&temp);
03509                 temp = cpl_table_duplicate(t);
03510                 assure_mem(temp);
03511 
03512                 uves_polynomial_delete(&bivariate_fit);
03513                 bivariate_fit = uves_polynomial_regression_2d(temp,
03514                                       X1, X2, Y, sigmaY,
03515                                       new_deg1,
03516                                       new_deg2,
03517                                       NULL, NULL, NULL,
03518                                       &(mse[new_deg1]
03519                                         [new_deg2]),
03520                                       NULL,
03521                                       NULL,
03522                                       kappa, min_reject);
03523 
03524                 if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
03525                 {
03526                     uves_error_reset();
03527 
03528                                     if (verbose)
03529                                         uves_msg_low("(%d, %d)-degree: Singular matrix", 
03530                          new_deg1, new_deg2);
03531                                     else
03532                                         uves_msg_debug("(%d, %d)-degree: Singular matrix", 
03533                          new_deg1, new_deg2);
03534                     
03535                     mse[new_deg1][new_deg2] = DBL_MAX/2; 
03536                 }
03537                 else
03538                 {
03539                     assure( cpl_error_get_code() == CPL_ERROR_NONE,
03540                         cpl_error_get_code(),
03541                         "Error fitting (%d, %d)-degree polynomial", 
03542                         new_deg1, new_deg2 );
03543                     
03544                     rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
03545                 
03546                                     if (verbose)
03547                                         uves_msg_low("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
03548                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
03549                                                      rejected, cpl_table_get_nrow(t));
03550                                     else
03551                                         uves_msg_debug("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
03552                                                      new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
03553                                                      rejected, cpl_table_get_nrow(t));
03554 
03555                     /* Reject if fit produced bad values */
03556                     if (min_val != NULL || max_val != NULL)
03557                     {
03558                         for (i = 0; i < npos; i++)
03559                         {
03560                             double val = uves_polynomial_evaluate_2d(
03561                             bivariate_fit,
03562                             positions[i][0], positions[i][1]);
03563                             if (min_val != NULL && val < *min_val)
03564                             {
03565                                 uves_msg_debug("Bad fit: %f < %f", 
03566                                        val,
03567                                        *min_val);
03568                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
03569                                 /* A large number, even if we add a bit */
03570                             }
03571                             if (max_val != NULL && val > *max_val)
03572                             {
03573                                 uves_msg_debug("Bad fit: %f > %f", 
03574                                        val,
03575                                        *max_val);
03576                                 mse[new_deg1][new_deg2] = DBL_MAX/2; 
03577                             }
03578                         }
03579                     }
03580                 
03581                     /* For robustness, make sure that we don't accept a solution that
03582                        rejected too many points (say, 80%)
03583                     */
03584                     if (rejected >= (4*cpl_table_get_nrow(t))/5)
03585                     {
03586                         mse[new_deg1][new_deg2] = DBL_MAX/2; 
03587                     }
03588                     
03589                 }/* if fit succeeded */
03590             }
03591         
03592         /* If fit is significantly better (say, 10% improvement in MSE) in either direction, 
03593          * (in (degree,degree)-space) then move in that direction.
03594          *
03595          * First try to move one step horizontal/vertical, 
03596          * otherwise try to move diagonally (i.e. increase both degrees),
03597          * otherwise move two steps horizontal/vertical
03598          *
03599          */
03600         m = mse[deg1][deg2];
03601 
03602         if      (adjust1                              
03603              && (m - mse[deg1+1][deg2])/m > 0.1
03604              && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
03605              /* The condition is read like this:
03606             if 
03607             - we are trying to move right, and
03608             - this is this is a better place than the current, and
03609                 - this is better than moving down */
03610         )
03611         {
03612             deg1++;
03613             finished = false;
03614         }
03615         else if (adjust2 &&
03616              (m - mse[deg1][deg2+1])/m > 0.1
03617              && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
03618         )
03619         {
03620             deg2++;
03621             finished = false;
03622         }
03623         else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
03624         {
03625             deg1++;
03626             deg2++;
03627             finished = false;
03628         }
03629         else if (adjust1
03630              && (m - mse[deg1+2][deg2])/m > 0.1
03631              && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
03632         )
03633         {
03634             deg1 += 2;
03635             finished = false;
03636         }
03637         else if (adjust2 
03638              && (m - mse[deg1][deg2+2])/m > 0.1
03639              && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
03640         {
03641             deg2 += 2;
03642             finished = false;
03643         }
03644 
03645         /* For efficiency, stop if rms reached min_rms */   
03646         finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
03647 
03648     } while (!finished);
03649 
03650     uves_polynomial_delete(&bivariate_fit);
03651     check( bivariate_fit = uves_polynomial_regression_2d(t,
03652                              X1, X2, Y, sigmaY,
03653                              deg1,
03654                              deg2,
03655                              polynomial_fit, residual_square, 
03656                              variance_fit,
03657                              mean_squared_error, red_chisq,
03658                              variance, kappa, min_reject),
03659        "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
03660 
03661     if (verbose)
03662         uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
03663                      sqrt(mse[deg1][deg2]), y_unit);
03664     else
03665         uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2, 
03666                      sqrt(mse[deg1][deg2]), y_unit);
03667     
03668   cleanup:
03669     if (mse != NULL)
03670     {
03671         for (i = 0; i < maxdeg1+1; i++)
03672         {
03673             if (mse[i] != NULL)
03674             {
03675                 cpl_free(mse[i]);
03676             }
03677         }
03678         cpl_free(mse);
03679     }
03680     uves_free_table(&temp);
03681     
03682     return bivariate_fit;    
03683 }
03684 
03685 /*----------------------------------------------------------------------------*/
03695 /*----------------------------------------------------------------------------*/
03696 const char *
03697 uves_remove_string_prefix(const char *s, const char *prefix)
03698 {
03699     const char *result = NULL;
03700     unsigned int prefix_length;
03701 
03702     assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
03703     assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
03704 
03705     prefix_length = strlen(prefix);
03706 
03707     assure( strlen(s) >= prefix_length &&
03708         strncmp(s, prefix, prefix_length) == 0,
03709         CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
03710         prefix, s);
03711     
03712     result = s + prefix_length;
03713     
03714   cleanup:
03715     return result;
03716 }
03717 
03718 
03719 /*----------------------------------------------------------------------------*/
03728 /*----------------------------------------------------------------------------*/
03729 
03730 double uves_gaussrand(void)
03731 {
03732     static double V1, V2, S;
03733     static int phase = 0;
03734     double X;
03735     
03736     if(phase == 0) {
03737     do {
03738         double U1 = (double)rand() / RAND_MAX;
03739         double U2 = (double)rand() / RAND_MAX;
03740         
03741         V1 = 2 * U1 - 1;
03742         V2 = 2 * U2 - 1;
03743         S = V1 * V1 + V2 * V2;
03744     } while(S >= 1 || S == 0);
03745     
03746     X = V1 * sqrt(-2 * log(S) / S);
03747     } else
03748     X = V2 * sqrt(-2 * log(S) / S);
03749     
03750     phase = 1 - phase;
03751     
03752     return X;
03753 }
03754 
03755 /*----------------------------------------------------------------------------*/
03766 /*----------------------------------------------------------------------------*/
03767 
03768 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x, 
03769                 const char *column_y, int *istart )
03770 {
03771     double result = 0;
03772     int n;
03773 
03774     const double *x, *y;
03775     
03776     check( x = cpl_table_get_data_double_const(t, column_x),
03777        "Error reading column '%s'", column_x);
03778     check( y = cpl_table_get_data_double_const(t, column_y),
03779        "Error reading column '%s'", column_y);
03780 
03781     n = cpl_table_get_nrow(t);
03782 
03783     result = uves_spline_hermite(xp, x, y, n, istart);
03784 
03785   cleanup:
03786     return result;
03787 }
03788 
03789 /*----------------------------------------------------------------------------*/
03805 /*----------------------------------------------------------------------------*/
03806 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
03807 {
03808     double yp1, yp2, yp = 0;
03809     double xpi, xpi1, l1, l2, lp1, lp2;
03810     int i;
03811 
03812     if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) )    return 0.0;
03813     if ( x[0] >  x[n-1] && (xp > x[0] || xp < x[n-1]) )    return 0.0;
03814 
03815     if ( x[0] <= x[n-1] )
03816     {
03817         for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
03818         ;
03819     }
03820     else
03821     {
03822         for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
03823         ;
03824     }
03825 
03826     *istart = i;
03827     i--;
03828     
03829     lp1 = 1.0 / (x[i-1] - x[i]);
03830     lp2 = -lp1;
03831 
03832     if ( i == 1 )
03833     {
03834         yp1 = (y[1] - y[0]) / (x[1] - x[0]);
03835     }
03836     else
03837     {
03838         yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
03839     }
03840 
03841     if ( i >= n - 1 )
03842     {
03843         yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
03844     }
03845     else
03846     {
03847         yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
03848     }
03849 
03850     xpi1 = xp - x[i];
03851     xpi  = xp - x[i-1];
03852     l1   = xpi1*lp1;
03853     l2   = xpi*lp2;
03854 
03855     yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 + 
03856          y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 + 
03857          yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
03858 
03859     return yp;
03860 }
03861 
03862 /*----------------------------------------------------------------------------*/
03876 /*----------------------------------------------------------------------------*/
03877 
03878 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
03879 {
03880     int klo, khi, k;
03881     double a, b, h, yp = 0;
03882 
03883     assure_nomsg( x  != NULL, CPL_ERROR_NULL_INPUT);
03884     assure_nomsg( y  != NULL, CPL_ERROR_NULL_INPUT);
03885     assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
03886     assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
03887 
03888     klo = *kstart;
03889     khi = n;
03890 
03891     if ( xp < x[1] || xp > x[n] )
03892     {
03893         return 0.0;
03894     }
03895     else if ( xp == x[1] )
03896     {
03897         return(y[1]);
03898     }
03899     
03900     for ( k = klo; k < n && xp > x[k]; k++ )
03901     ;
03902 
03903     klo = *kstart = k-1;
03904     khi = k;
03905 
03906     h = x[khi] - x[klo];
03907     assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
03908         "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
03909 
03910     a = (x[khi] - xp) / h;
03911     b = (xp - x[klo]) / h;
03912 
03913     yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
03914      (h*h) / 6.0;
03915 
03916   cleanup:
03917     return yp;
03918 }
03919 
03920 /*----------------------------------------------------------------------------*/
03930 /*----------------------------------------------------------------------------*/
03931 bool
03932 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
03933 {
03934     bool is_sorted = true;       /* ... until proven false */
03935     int i;
03936     int N;
03937     double previous, current;    /* column values */
03938 
03939     passure(t != NULL, " ");
03940     passure(cpl_table_has_column(t, column), "No column '%s'", column);
03941     passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
03942     
03943     N = cpl_table_get_nrow(t);
03944 
03945     if (N > 1) 
03946     {
03947         previous = cpl_table_get_double(t, column, 0, NULL);
03948         
03949         for(i = 1; i < N && is_sorted; i++)
03950         {
03951             current = cpl_table_get_double(t, column, i, NULL);
03952             if (!reverse)
03953             {
03954                 /* Check for ascending */
03955                 is_sorted = is_sorted && ( current >= previous );
03956             }
03957             else
03958             {
03959                 /* Check for descending */
03960                 is_sorted = is_sorted && ( current <= previous );
03961             }
03962             
03963             previous = current;
03964         }
03965     }
03966     else
03967     {
03968         /* 0 or 1 rows. Table is sorted */        
03969     }
03970     
03971   cleanup:
03972     return is_sorted;
03973 }
03974 
03975 /*----------------------------------------------------------------------------*/
03981 /*----------------------------------------------------------------------------*/
03982 cpl_table *
03983 uves_ordertable_traces_new(void)
03984 {
03985     cpl_table *result = NULL;
03986     
03987     check((
03988           result = cpl_table_new(0),
03989           cpl_table_new_column(result, "TraceID"  , CPL_TYPE_INT),
03990           cpl_table_new_column(result, "Offset"   , CPL_TYPE_DOUBLE),
03991           cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
03992     "Error creating table");
03993     
03994   cleanup:
03995     return result;
03996 }
03997 
03998 /*----------------------------------------------------------------------------*/
04008 /*----------------------------------------------------------------------------*/
04009 cpl_error_code
04010 uves_ordertable_traces_add(cpl_table *traces, 
04011                int fibre_ID, double fibre_offset, int fibre_mask)
04012 {
04013     int size;
04014 
04015     assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
04016     
04017     /* Write to new table row */
04018     check((
04019           size = cpl_table_get_nrow(traces),
04020           cpl_table_set_size  (traces, size+1),
04021           cpl_table_set_int   (traces, "TraceID"  , size, fibre_ID),
04022           cpl_table_set_double(traces, "Offset"   , size, fibre_offset),
04023           cpl_table_set_int   (traces, "Tracemask", size, fibre_mask)),
04024       "Error updating table");
04025 
04026   cleanup:
04027     return cpl_error_get_code();
04028 }
04029 
04030 
04031 /*----------------------------------------------------------------------------*/
04037 /*----------------------------------------------------------------------------*/
04038 cpl_error_code
04039 uves_tablename_remove_units(const char* tname)
04040 {
04041    cpl_table* tab=NULL;
04042    uves_propertylist* head=NULL;
04043    tab=cpl_table_load(tname,1,0);
04044    head=uves_propertylist_load(tname,0);
04045    uves_table_remove_units(&tab);
04046    check_nomsg(uves_table_save(tab,head,NULL,tname,CPL_IO_DEFAULT));
04047 
04048   cleanup:
04049    uves_free_table(&tab);
04050    uves_free_propertylist(&head);
04051    return cpl_error_get_code();
04052 }
04053 
04054 
04055 
04056 /*----------------------------------------------------------------------------*/
04063 /*----------------------------------------------------------------------------*/
04064 cpl_error_code
04065 uves_tablenames_unify_units(const char* tname2, const char* tname1)
04066 {
04067    cpl_table* tab1=NULL;
04068    cpl_table* tab2=NULL;
04069    uves_propertylist* head2=NULL;
04070 
04071    tab1=cpl_table_load(tname1,1,0);
04072 
04073    tab2=cpl_table_load(tname2,1,0);
04074    head2=uves_propertylist_load(tname2,0);
04075 
04076    uves_table_unify_units(&tab2,&tab1);
04077    check_nomsg(uves_table_save(tab2,head2,NULL,tname2,CPL_IO_DEFAULT));
04078 
04079   cleanup:
04080    uves_free_table(&tab1);
04081    uves_free_table(&tab2);
04082    uves_free_propertylist(&head2);
04083    return cpl_error_get_code();
04084 
04085 }
04086 
04087 
04088 
04089 /*----------------------------------------------------------------------------*/
04095 /*----------------------------------------------------------------------------*/
04096 cpl_error_code
04097 uves_table_remove_units(cpl_table **table)
04098 {
04099     int ncols;
04100     const char* colname=NULL;
04101     int i=0;
04102     cpl_array *names=NULL;
04103 
04104     assure( *table != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
04105     ncols = cpl_table_get_ncol(*table);
04106     names = cpl_table_get_column_names(*table);
04107     for(i=0;i<ncols;i++) {
04108        colname=cpl_array_get_string(names, i);
04109        cpl_table_set_column_unit(*table,colname,NULL);
04110     }
04111 
04112   cleanup:
04113     uves_free_array(&names);
04114 
04115     return cpl_error_get_code();
04116 }
04117 
04118 
04119 
04120 /*----------------------------------------------------------------------------*/
04127 /*----------------------------------------------------------------------------*/
04128 cpl_error_code
04129 uves_table_unify_units(cpl_table **table2,  cpl_table **table1)
04130 {
04131     int ncols1;
04132     int ncols2;
04133     const char* colname=NULL;
04134     const char* unit1=NULL;
04135 
04136     int i=0;
04137     cpl_array *names=NULL;
04138 
04139     assure( table1 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
04140     assure( *table2 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
04141     ncols1 = cpl_table_get_ncol(*table1);
04142     ncols2 = cpl_table_get_ncol(*table2);
04143     assure( ncols1 == ncols2, CPL_ERROR_NULL_INPUT, 
04144             "n columns (tab1) != n columns (tab2)");
04145 
04146     names = cpl_table_get_column_names(*table1);
04147     for(i=0;i<ncols1;i++) {
04148        colname=cpl_array_get_string(names, i);
04149        unit1=cpl_table_get_column_unit(*table1,colname);
04150        cpl_table_set_column_unit(*table2,colname,unit1);
04151     }
04152 
04153   cleanup:
04154     uves_free_array(&names);
04155 
04156     return cpl_error_get_code();
04157 }
04158 
04159 /*
04160  * modified on 2006/04/19
04161  *  jmlarsen:  float[5] -> const double[]
04162  *             changed mapping of indices to parameters
04163  *             Normalized the profile to 1 and changed meaning
04164  *             of (a[3], a[2]) to (integrated flux, stdev)
04165  *             Disabled debugging messages
04166  *
04167  * modified on 2005/07/29 to make dydapar a FORTRAN array
04168  * (indiced from 1 to N instead of 0 to N-1).
04169  * This allows the array to be passed to C functions expecting
04170  * FORTRAN-like arrays.
04171  *
04172  * modified on 2005/08/02 to make the function prototype ANSI
04173  * compliant (so it can be used with the levmar library).
04174  *
04175  * modified on 2005/08/16. The function now expects C-indexed
04176  * arrays as parameters (to allow proper integration). However, the
04177  * arrays are still converted to FORTRAN-indexed arrays internally.
04178  */
04179 
04190 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
04191 
04192  
04193      /*     int na;*/
04194 {
04195   double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
04196   double a2i=0, m = 0, p = 0, dif =0;
04197   double sqrt5 = 2.23606797749979;
04198 
04199   *y=0.0;
04200 //  a2i = 1.0/a[2];
04201   a2i = 1.0/(a[2]*sqrt5);
04202 
04203   dif=x-a[1];
04204   arg=dif*a2i;
04205   arg2=arg*arg;
04206 
04207   fac=1.0+arg2;
04208   fac2=fac*fac;
04209   fac4=fac2*fac2;
04210   fac4i = 1.0/fac4;
04211   
04212 //  m = a[1]*fac4i;
04213   m = a[3]*fac4i * a2i*16/(5.0*M_PI);
04214   *y = m + a[4]*(1.0+dif*a[5]);  
04215   p = 8.0*m/fac*arg*a2i;
04216 
04217   dyda[3] = m/a[3];
04218   dyda[2] = p*dif/a[2] - m/a[2];
04219 
04220 //  dyda[3]=fac4i;
04221   dyda[1]=p-a[4]*a[5];
04222 //  dyda[2]=p*dif*a2i;
04223   dyda[4]=1.0+dif*a[5];
04224   dyda[5]=a[4]*dif;
04225 
04226 
04227 #if 0
04228   {
04229      int i = 0, npar=5 ;
04230      printf("fmoffat_i \n");
04231      for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
04232      
04233      printf("fmoffat_i ");
04234      for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
04235      printf("\n");
04236   }
04237 #endif
04238   
04239 }
04240 
04259 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
04260 //void fmoffa_c(x,a,y, dyda)
04261 
04262 
04263 //     float x,*a,*y,*dyda;
04264 /*int na;*/
04265 {
04266   int npoint = 3;
04267   double const xgl[3] = {-0.387298334621,0.,0.387298334621};
04268   double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
04269   int i=0;
04270   int j=0;
04271   int npar = 5;
04272   double xmod = 0;
04273   double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
04274   double ypar;
04275 
04276 
04277   // Convert C-indexed arrays to FORTRAN-indexed arrays
04278   a    = C_TO_FORTRAN_INDEXING(a);
04279   dyda = C_TO_FORTRAN_INDEXING(dyda);
04280 
04281   *y = 0.0;
04282   for (i = 1;i<=npar;i++) dyda[i] = 0.;
04283   /*  printf("fmoffat_c ");
04284   for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
04285   /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
04286   /*  printf("\n");*/
04287   for (j=0; j < npoint; j++) 
04288       {
04289       xmod = x+xgl[j];
04290 
04291       fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
04292       
04293       *y = *y + ypar*wgl[j];
04294       
04295       for (i = 1; i <= npar; i++)
04296           {
04297           dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
04298           }
04299 
04300      /*      if (j == 2) 
04301     for (i = 1;i<=npar;i++) 
04302       {
04303         dyda[i] = dydapar[i];
04304       };
04305      */
04306     }
04307 
04308 #if 0
04309       printf("fmoffat_c ");
04310       for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
04311       printf("\n");
04312 #endif
04313 }
04314 
04315 /*----------------------------------------------------------------------------*/
04323 /*----------------------------------------------------------------------------*/
04324 int
04325 uves_moffat(const double x[], const double a[], double *result)
04326 {
04327     double dyda[5];
04328 
04329     fmoffa_c(x[0], a, result, dyda);
04330 
04331     return 0;
04332 }
04333 
04334 /*----------------------------------------------------------------------------*/
04342 /*----------------------------------------------------------------------------*/
04343 int
04344 uves_moffat_derivative(const double x[], const double a[], double result[])
04345 {
04346     double y;
04347 
04348     fmoffa_c(x[0], a, &y, result);
04349 
04350     return 0;
04351 }
04352 
04353 /*----------------------------------------------------------------------------*/
04373 /*----------------------------------------------------------------------------*/
04374 
04375 int
04376 uves_gauss(const double x[], const double a[], double *result)
04377 {
04378     double my    = a[0];
04379     double sigma = a[1];
04380 
04381     if (sigma == 0)
04382     {
04383         /* Dirac's delta function */
04384         if (x[0] == my)
04385         {
04386             *result = DBL_MAX;
04387         }
04388         else
04389         {
04390             *result = 0;
04391         }
04392         return 0;
04393     }
04394     else
04395     {
04396         double A     = a[2];
04397         double B     = a[3];
04398         
04399         *result = B    +
04400         A/(sqrt(2*M_PI*sigma*sigma)) *
04401         exp(- (x[0] - my)*(x[0] - my)
04402             / (2*sigma*sigma));
04403     }
04404     
04405     return 0;
04406 }
04407 
04408 /*----------------------------------------------------------------------------*/
04428 /*----------------------------------------------------------------------------*/
04429 
04430 int
04431 uves_gauss_derivative(const double x[], const double a[], double result[])
04432 {
04433     double my    = a[0];
04434     double sigma = a[1];
04435     double A     = a[2];
04436     /* a[3] not used */
04437 
04438     double factor;
04439    
04440     /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04441      *
04442      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
04443      *          = A * fac. * (x-my)  / s^2
04444      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
04445      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
04446      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04447      *          = fac.
04448      * df/dB    = 1
04449      */
04450     
04451     if (sigma == 0)
04452     {
04453         /* Derivative of Dirac's delta function */
04454         result[0] = 0;
04455         result[1] = 0;
04456         result[2] = 0;
04457         result[3] = 0;
04458         return 0;
04459     }
04460 
04461     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
04462     / (sqrt(2*M_PI*sigma*sigma));
04463 
04464     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
04465     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
04466     result[2] = factor;
04467     result[3] = 1;
04468 
04469     return 0;
04470 }
04471 
04472 /*----------------------------------------------------------------------------*/
04493 /*----------------------------------------------------------------------------*/
04494 
04495 int
04496 uves_gauss_linear(const double x[], const double a[], double *result)
04497 {
04498     double my    = a[0];
04499     double sigma = a[1];
04500 
04501     if (sigma == 0)
04502     {
04503         /* Dirac's delta function */
04504         if (x[0] == my)
04505         {
04506             *result = DBL_MAX;
04507         }
04508         else
04509         {
04510             *result = 0;
04511         }
04512         return 0;
04513     }
04514     else
04515     {
04516         double A     = a[2];
04517         double B     = a[3];
04518         double C     = a[4];
04519         
04520         *result = B    + C*(x[0] - my) +
04521         A/(sqrt(2*M_PI*sigma*sigma)) *
04522         exp(- (x[0] - my)*(x[0] - my)
04523             / (2*sigma*sigma));
04524     }
04525     
04526     return 0;
04527 }
04528 
04529 /*----------------------------------------------------------------------------*/
04552 /*----------------------------------------------------------------------------*/
04553 
04554 int
04555 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
04556 {
04557     double my    = a[0];
04558     double sigma = a[1];
04559     double A     = a[2];
04560     /* a[3] not used */
04561     double C     = a[4];
04562 
04563     double factor;
04564    
04565     /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04566      *
04567      * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my)  / s^2
04568      *          = A * fac. * (x-my)  / s^2   - C
04569      * df/ds    = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
04570      *          = A * fac. * ((x-my)^2 / s^2 - 1) / s
04571      * df/dA    = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
04572      *          = fac.
04573      * df/dB    = 1
04574      *
04575      * df/dC    = x-my
04576      */
04577     
04578     if (sigma == 0)
04579     {
04580         /* Derivative of Dirac's delta function */
04581         result[0] = -C;
04582         result[1] = 0;
04583         result[2] = 0;
04584         result[3] = 0;
04585         result[4] = x[0];
04586         return 0;
04587     }
04588 
04589     factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
04590     / (sqrt(2*M_PI*sigma*sigma));
04591 
04592     result[0] = A * factor * (x[0]-my) / (sigma*sigma);
04593     result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
04594     result[2] = factor;
04595     result[3] = 1;
04596     result[4] = x[0] - my;
04597 
04598     return 0;
04599 }
04600 
04601 
04602 
04603 
04604 /*----------------------------------------------------------------------------*/
04617 /*----------------------------------------------------------------------------*/
04618 cpl_image *
04619 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
04620                   const cpl_image *spectrum, const cpl_image *sky,
04621                   const cpl_image *cosmic_image,
04622                   const uves_extract_profile *profile,
04623                   cpl_image **image_noise, uves_propertylist **image_header)
04624 {
04625     cpl_image *image = NULL;
04626 
04627     cpl_binary *bpm = NULL;
04628     bool loop_y = false;
04629 
04630     double ron = 3;
04631     double gain = 1.0; //fixme
04632     bool new_format = true;
04633 
04634     image        = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
04635     assure_mem( image );
04636     if (image_noise != NULL) {
04637         *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
04638         assure_mem( *image_noise );
04639         cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
04640     }
04641 
04642     if (image_header != NULL) {
04643         *image_header = uves_propertylist_new();
04644       
04645         uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
04646         uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
04647         uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
04648     }
04649 
04650     for (uves_iterate_set_first(pos,
04651                                 1, pos->nx,
04652                                 pos->minorder, pos->maxorder,
04653                                 bpm,
04654                                 loop_y);
04655          !uves_iterate_finished(pos); 
04656          uves_iterate_increment(pos)) {
04657       
04658         /* Manual loop over y */
04659         uves_extract_profile_set(profile, pos, NULL);
04660         for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
04661 
04662             /* Get empirical and model profile */
04663             double flux, sky_flux;
04664             int bad;
04665             int spectrum_row = pos->order - pos->minorder + 1;
04666             double noise;
04667             double prof = uves_extract_profile_evaluate(profile, pos);
04668           
04669             if (sky != NULL)
04670                 {
04671                     sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
04672                 }
04673             else
04674                 {
04675                     sky_flux = 0;
04676                 }
04677 
04678             flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
04679           
04680             //fixme: check this formula
04681             noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
04682 //          uves_msg_error("%f", prof);
04683             cpl_image_set(image, pos->x, pos->y, 
04684                           flux);
04685             if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
04686           
04687         }
04688     }
04689 
04690     if (cosmic_image != NULL) {
04691         double cr_val = 2*cpl_image_get_max(image);
04692         /* assign high pixel value to CR pixels */
04693         
04694         loop_y = true;
04695         
04696         for (uves_iterate_set_first(pos,
04697                                     1, pos->nx,
04698                                     pos->minorder, pos->maxorder,
04699                                     bpm,
04700                                     loop_y);
04701              !uves_iterate_finished(pos); 
04702              uves_iterate_increment(pos)) {
04703             
04704             int is_rejected;
04705             if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
04706                 cpl_image_set(image, pos->x, pos->y, cr_val);
04707             }
04708         }
04709     }
04710     
04711   cleanup:
04712     return image;
04713 }
04714 
04715 void 
04716 uves_frameset_dump(cpl_frameset* set)
04717 {
04718 
04719   cpl_frame* frm=NULL;
04720   int sz=0;
04721   int i=0;
04722 
04723   cknull(set,"Null input frameset");
04724   check_nomsg(sz=cpl_frameset_get_size(set));
04725   check_nomsg(frm=cpl_frameset_get_first(set));
04726   do{
04727     uves_msg("frame %d tag %s filename %s group %d",
04728          i,
04729              cpl_frame_get_tag(frm),
04730              cpl_frame_get_filename(frm),
04731              cpl_frame_get_group(frm));
04732     i++;
04733   } while ((frm=cpl_frameset_get_next(set)) != NULL);
04734 
04735   cleanup:
04736 
04737   return ;
04738 }
04739 
04740 
04741 
04742 
04743 /*-------------------------------------------------------------------------*/
04757 /*--------------------------------------------------------------------------*/
04758 
04759 cpl_image *
04760 uves_image_smooth_x(cpl_image * inp, const int r)
04761 {
04762 
04763   /*
04764    @param xp     x-value to interpolate
04765    @param x      x-values
04766    @param y      y-values
04767    @param n      array length
04768    @param istart    (input/output) initial row (set to 0 to search all row)
04769 
04770   */
04771   float* pinp=NULL;
04772   float* pout=NULL;
04773   int sx=0;
04774   int sy=0;
04775   int i=0;
04776   int j=0;
04777   int k=0;
04778 
04779   cpl_image* out=NULL;
04780 
04781   cknull(inp,"Null in put image, exit");
04782   check_nomsg(out=cpl_image_duplicate(inp));
04783   check_nomsg(sx=cpl_image_get_size_x(inp));
04784   check_nomsg(sy=cpl_image_get_size_y(inp));
04785   check_nomsg(pinp=cpl_image_get_data_float(inp));
04786   check_nomsg(pout=cpl_image_get_data_float(out));
04787   for(j=0;j<sy;j++) {
04788     for(i=r;i<sx-r;i++) {
04789       for(k=-r;k<r;k++) {
04790     pout[j*sx+i]+=pinp[j*sx+i+k];
04791       }
04792       pout[j*sx+i]/=2*r;
04793     }
04794   }
04795 
04796  cleanup:
04797 
04798   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04799     return NULL;
04800   } else {
04801     return out;
04802 
04803   }
04804 
04805 }
04806 
04807 
04808 
04809 
04810 
04811 /*-------------------------------------------------------------------------*/
04825 /*--------------------------------------------------------------------------*/
04826 
04827 cpl_image *
04828 uves_image_smooth_y(cpl_image * inp, const int r)
04829 {
04830 
04831   /*
04832    @param xp     x-value to interpolate
04833    @param x      x-values
04834    @param y      y-values
04835    @param n      array length
04836    @param istart    (input/output) initial row (set to 0 to search all row)
04837 
04838   */
04839   float* pinp=NULL;
04840   float* pout=NULL;
04841   int sx=0;
04842   int sy=0;
04843   int i=0;
04844   int j=0;
04845   int k=0;
04846 
04847   cpl_image* out=NULL;
04848 
04849   cknull(inp,"Null in put image, exit");
04850   check_nomsg(out=cpl_image_duplicate(inp));
04851   check_nomsg(sx=cpl_image_get_size_x(inp));
04852   check_nomsg(sy=cpl_image_get_size_y(inp));
04853   check_nomsg(pinp=cpl_image_get_data_float(inp));
04854   check_nomsg(pout=cpl_image_get_data_float(out));
04855   for(j=r;j<sy-r;j++) {
04856     for(i=0;i<sx;i++) {
04857       for(k=-r;k<r;k++) {
04858     pout[j*sx+i]+=pinp[(j+k)*sx+i];
04859       }
04860       pout[j*sx+i]/=2*r;
04861     }
04862   }
04863 
04864  cleanup:
04865 
04866   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04867     return NULL;
04868   } else {
04869     return out;
04870 
04871   }
04872 
04873 }
04874 
04875 
04876 /*-------------------------------------------------------------------------*/
04890 /*--------------------------------------------------------------------------*/
04891 
04892 cpl_image *
04893 uves_image_smooth_mean_x(cpl_image * inp, const int r)
04894 {
04895 
04896   /*
04897    @param xp     x-value to interpolate
04898    @param x      x-values
04899    @param y      y-values
04900    @param n      array length
04901    @param istart    (input/output) initial row (set to 0 to search all row)
04902 
04903   */
04904   float* pinp=NULL;
04905   float* pout=NULL;
04906   int sx=0;
04907   int sy=0;
04908   int i=0;
04909   int j=0;
04910   int k=0;
04911 
04912   cpl_image* out=NULL;
04913 
04914   cknull(inp,"Null in put image, exit");
04915   check_nomsg(out=cpl_image_duplicate(inp));
04916   check_nomsg(sx=cpl_image_get_size_x(inp));
04917   check_nomsg(sy=cpl_image_get_size_y(inp));
04918   check_nomsg(pinp=cpl_image_get_data_float(inp));
04919   check_nomsg(pout=cpl_image_get_data_float(out));
04920   for(j=0;j<sy;j++) {
04921     for(i=r;i<sx-r;i++) {
04922       for(k=-r;k<r;k++) {
04923     pout[j*sx+i]+=pinp[j*sx+i+k];
04924       }
04925       pout[j*sx+i]/=2*r;
04926     }
04927   }
04928 
04929  cleanup:
04930 
04931   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04932     return NULL;
04933   } else {
04934     return out;
04935 
04936   }
04937 
04938 }
04939 
04940 
04941 /*-------------------------------------------------------------------------*/
04955 /*--------------------------------------------------------------------------*/
04956 
04957 cpl_image *
04958 uves_image_smooth_median_x(cpl_image * inp, const int r)
04959 {
04960 
04961   /*
04962    @param xp     x-value to interpolate
04963    @param x      x-values
04964    @param y      y-values
04965    @param n      array length
04966    @param istart    (input/output) initial row (set to 0 to search all row)
04967 
04968   */
04969   float* pout=NULL;
04970   int sx=0;
04971   int sy=0;
04972   int i=0;
04973   int j=0;
04974 
04975   cpl_image* out=NULL;
04976 
04977 
04978   cknull(inp,"Null in put image, exit");
04979   check_nomsg(out=cpl_image_duplicate(inp));
04980   check_nomsg(sx=cpl_image_get_size_x(inp));
04981   check_nomsg(sy=cpl_image_get_size_y(inp));
04982   check_nomsg(pout=cpl_image_get_data_float(out));
04983 
04984   for(j=1;j<sy;j++) {
04985     for(i=1+r;i<sx-r;i++) {
04986       pout[j*sx+i]=(float)cpl_image_get_median_window(inp,i,j,i+r,j);
04987     }
04988   }
04989 
04990  cleanup:
04991 
04992   if(cpl_error_get_code() != CPL_ERROR_NONE) {
04993     return NULL;
04994   } else {
04995     return out;
04996 
04997   }
04998 
04999 }
05000 
05001 /*-------------------------------------------------------------------------*/
05014 /*--------------------------------------------------------------------------*/
05015 
05016 cpl_image *
05017 uves_image_smooth_fft(cpl_image * inp, const int fx)
05018 {
05019 
05020   int sx=0;
05021   int sy=0;
05022 
05023   cpl_image* out=NULL;
05024   cpl_image* im_re=NULL;
05025   cpl_image* im_im=NULL;
05026   cpl_image* ifft_re=NULL;
05027   cpl_image* ifft_im=NULL;
05028   cpl_image* filter=NULL; 
05029 
05030   int sigma_x=fx;
05031   int sigma_y=0;
05032 
05033   cknull(inp,"Null in put image, exit");
05034   check_nomsg(im_re = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
05035   check_nomsg(im_im = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
05036 
05037   // Compute FFT
05038   check_nomsg(cpl_image_fft(im_re,im_im,CPL_FFT_DEFAULT));
05039 
05040   check_nomsg(sx=cpl_image_get_size_x(inp));
05041   check_nomsg(sy=cpl_image_get_size_y(inp));
05042   sigma_x=sx;
05043 
05044   //Generates filter image
05045   check_nomsg(filter = uves_gen_lowpass(sx,sy,sigma_x,sigma_y));
05046 
05047   //Apply filter
05048   cpl_image_multiply(im_re,filter);
05049   cpl_image_multiply(im_im,filter);
05050 
05051   uves_free_image(&filter);
05052 
05053   check_nomsg(ifft_re = cpl_image_duplicate(im_re));
05054   check_nomsg(ifft_im = cpl_image_duplicate(im_im));
05055 
05056   uves_free_image(&im_re);
05057   uves_free_image(&im_im);
05058 
05059   //Computes FFT-INVERSE
05060   check_nomsg(cpl_image_fft(ifft_re,ifft_im,CPL_FFT_INVERSE));
05061   check_nomsg(out = cpl_image_cast(ifft_re, CPL_TYPE_FLOAT));
05062 
05063  cleanup:
05064 
05065   uves_free_image(&ifft_re);
05066   uves_free_image(&ifft_im);
05067   uves_free_image(&filter);
05068   uves_free_image(&im_re);
05069   uves_free_image(&im_im);
05070 
05071   if(cpl_error_get_code() != CPL_ERROR_NONE) {
05072     return NULL;
05073   } else {
05074     return out;
05075   }
05076 
05077 }
05078 
05079 /*-------------------------------------------------------------------------*/
05088 /*--------------------------------------------------------------------------*/
05089 cpl_vector * 
05090 uves_imagelist_get_clean_mean_levels(cpl_imagelist* iml, double kappa)
05091 {
05092 
05093    cpl_image* img=NULL;
05094    int size=0;
05095    int i=0;
05096    cpl_vector* values=NULL;
05097    double* pval=NULL;
05098    double mean=0;
05099    double stdev=0;
05100   
05101    check_nomsg(size=cpl_imagelist_get_size(iml));
05102    check_nomsg(values=cpl_vector_new(size));
05103    pval=cpl_vector_get_data(values);
05104    for(i=0;i<size;i++) {
05105       img=cpl_imagelist_get(iml,i);
05106       irplib_ksigma_clip(img,1,1,
05107                          cpl_image_get_size_x(img),
05108                          cpl_image_get_size_y(img),
05109                          5,kappa,1.e-5,&mean,&stdev);
05110       uves_msg("Ima %d mean level: %g",i+1,mean);
05111       pval[i]=mean;
05112    }
05113 
05114   cleanup:
05115 
05116    return values;
05117 }
05118 
05119 
05120 /*-------------------------------------------------------------------------*/
05129 /*--------------------------------------------------------------------------*/
05130 cpl_error_code
05131 uves_imagelist_subtract_values(cpl_imagelist** iml, cpl_vector* values)
05132 {
05133 
05134    cpl_image* img=NULL;
05135    int size=0;
05136    int i=0;
05137    double* pval=NULL;
05138   
05139    check_nomsg(size=cpl_imagelist_get_size(*iml));
05140    pval=cpl_vector_get_data(values);
05141    for(i=0;i<size;i++) {
05142       img=cpl_imagelist_get(*iml,i);
05143       cpl_image_subtract_scalar(img,pval[i]);
05144       cpl_imagelist_set(*iml,img,i);
05145    }
05146 
05147   cleanup:
05148 
05149    return cpl_error_get_code();
05150 }
05151 
05152 
05153 /*-------------------------------------------------------------------------*/
05169 /*--------------------------------------------------------------------------*/
05170 static cpl_image * 
05171 uves_gen_lowpass(const int xs, 
05172                   const int ys, 
05173                   const double sigma_x, 
05174                   const double sigma_y)
05175 {
05176 
05177     int i= 0.0;
05178     int j= 0.0;
05179     int hlx= 0.0;
05180     int hly = 0.0;
05181     double x= 0.0;
05182     double y= 0.0;
05183     double gaussval= 0.0;
05184     double inv_sigma_x=1./sigma_x;
05185     double inv_sigma_y=1./sigma_y;
05186 
05187     float *data;
05188 
05189     cpl_image   *lowpass_image=NULL;
05190 
05191 
05192     lowpass_image = cpl_image_new (xs, ys, CPL_TYPE_FLOAT);
05193     if (lowpass_image == NULL) {
05194         uves_msg_error("Cannot generate lowpass filter <%s>",
05195                         cpl_error_get_message());
05196         return NULL;
05197     }
05198 
05199     hlx = xs/2;
05200     hly = ys/2;
05201 
05202     data = cpl_image_get_data_float(lowpass_image);
05203         
05204 /* Given an image with pixels 0<=i<N, 0<=j<M then the convolution image
05205    has the following properties:
05206 
05207    ima[0][0] = 1
05208    ima[i][0] = ima[N-i][0] = exp (-0.5 * (i/sig_i)^2)   1<=i<N/2
05209    ima[0][j] = ima[0][M-j] = exp (-0.5 * (j/sig_j)^2)   1<=j<M/2
05210    ima[i][j] = ima[N-i][j] = ima[i][M-j] = ima[N-i][M-j] 
05211              = exp (-0.5 * ((i/sig_i)^2 + (j/sig_j)^2)) 
05212 */
05213 
05214     data[0] = 1.0;
05215 
05216     /* first row */
05217     for (i=1 ; i<=hlx ; i++) {
05218         x = i * inv_sigma_x;
05219         gaussval = exp(-0.5*x*x);
05220         data[i] = gaussval;
05221         data[xs-i] = gaussval;
05222     }
05223 
05224     for (j=1; j<=hly ; j++) {
05225         y = j * inv_sigma_y;
05226       /* first column */
05227         data[j*xs] = exp(-0.5*y*y);
05228         data[(ys-j)*xs] = exp(-0.5*y*y);
05229 
05230         for (i=1 ; i<=hlx ; i++) {
05231     /* Use internal symetries */
05232             x = i * inv_sigma_x;
05233             gaussval = exp (-0.5*(x*x+y*y));
05234             data[j*xs+i] = gaussval;
05235             data[(j+1)*xs-i] = gaussval;
05236             data[(ys-j)*xs+i] = gaussval;
05237             data[(ys+1-j)*xs-i] = gaussval;
05238 
05239         }
05240     }
05241 
05242     /* FIXME: for the moment, reset errno which is coming from exp()
05243             in first for-loop at i=348. This is causing cfitsio to
05244             fail when loading an extension image (bug in cfitsio too).
05245     */
05246     if(errno != 0)
05247         errno = 0;
05248     
05249     return lowpass_image;
05250 }
05251 /*-------------------------------------------------------------------------*/
05259 /*--------------------------------------------------------------------------*/
05260 cpl_image*
05261 uves_image_mflat_detect_blemishes(const cpl_image* flat, 
05262                                   const uves_propertylist* head)
05263 {
05264 
05265    cpl_image* result=NULL;
05266    cpl_image* diff=NULL;
05267    cpl_image* flat_smooth=NULL;
05268    cpl_array* val=NULL;
05269    cpl_matrix* mx=NULL;
05270 
05271    int binx=0;
05272    int biny=0;
05273    int sx=0;
05274    int sy=0;
05275    int size=0;
05276    int i=0;
05277    int j=0;
05278    int k=0;
05279    int niter=3;
05280    int filter_width_x=7;
05281    int filter_width_y=7;
05282 
05283    double mean=0;
05284    double stdev=0;
05285    double stdev_x_4=0;
05286 
05287    double med_flat=0;
05288 
05289    double* pres=NULL;
05290    const double* pima=NULL;
05291    double* pval=NULL;
05292    double* pdif=NULL;
05293    int npixs=0;
05294 
05295    /* check input is valid */
05296    passure( flat !=NULL , "NULL input flat ");
05297    passure( head !=NULL , "NULL input head ");
05298   
05299    /* get image and bin sizes */
05300    sx=cpl_image_get_size_x(flat);
05301    sy=cpl_image_get_size_y(flat);
05302    npixs=sx*sy;
05303 
05304    binx=uves_pfits_get_binx(head);
05305    biny=uves_pfits_get_biny(head);
05306 
05307    /* set proper x/y filter width. Start values are 3 */
05308    if (binx>1) filter_width_x=5;
05309    if (biny>1) filter_width_y=5;
05310 
05311 
05312    /* create residuals image from smoothed flat */
05313    check_nomsg(mx=cpl_matrix_new(filter_width_x,filter_width_y));
05314   
05315   for(j=0; j< filter_width_y; j++){
05316     for(i=0; i< filter_width_x; i++){
05317       cpl_matrix_set( mx, i,j,1.0);
05318     }
05319   }
05320   
05321    check_nomsg(diff=cpl_image_duplicate(flat));
05322 
05323    check_nomsg(flat_smooth=uves_image_filter_median(flat,mx));
05324    /*
05325    check_nomsg(cpl_image_save(flat_smooth,"flat_smooth.fits",
05326                   CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
05327    */
05328    check_nomsg(cpl_image_subtract(diff,flat_smooth));
05329    /*
05330    check_nomsg(cpl_image_save(diff,"diff.fits",
05331                   CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
05332    */  
05333    /* compute median of flat */
05334    check_nomsg(med_flat=cpl_image_get_median(flat));
05335 
05336    /* prepare array of flat pixel values greater than the median */
05337    val=cpl_array_new(npixs,CPL_TYPE_DOUBLE);
05338    check_nomsg(cpl_array_fill_window_double(val,0,npixs,0));
05339    check_nomsg(pval=cpl_array_get_data_double(val));
05340    check_nomsg(pima=cpl_image_get_data_double_const(flat));
05341    check_nomsg(pdif=cpl_image_get_data_double(diff));
05342    k=0;
05343    for(i=0;i<npixs;i++) {
05344      if(pima[i]>med_flat) {
05345         pval[k]=pdif[i]; 
05346         k++;
05347      } 
05348    }   
05349 
05350    check_nomsg(cpl_array_set_size(val,k));
05351    
05352    /* computes 4 sigma clip mean of values */
05353    check_nomsg(mean=cpl_array_get_mean(val));
05354    check_nomsg(stdev=cpl_array_get_stdev(val));
05355    stdev_x_4=stdev*4.;
05356    check_nomsg(size=cpl_array_get_size(val));
05357 
05358    for(i=0;i<niter;i++) {
05359      for(k=0;k<size;k++) {
05360        if(fabs(pval[k]-mean)>stdev_x_4) {
05361      cpl_array_set_invalid(val,k);
05362        }
05363      }
05364      mean=cpl_array_get_mean(val);
05365      stdev=cpl_array_get_stdev(val);
05366      stdev_x_4=stdev*4.;
05367    }
05368 
05369    /* compute absolute value of difference image */
05370    result=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
05371    pres=cpl_image_get_data_double(result);
05372    for(i=0;i<npixs;i++) {
05373      if(fabs(pdif[i])<stdev_x_4) {
05374        pres[i]=1.;
05375      }
05376    }
05377 
05378    /* save result to debug */
05379    /*
05380    check_nomsg(cpl_image_save(result,"blemish.fits",CPL_BPP_IEEE_FLOAT,NULL,
05381             CPL_IO_DEFAULT));
05382    */
05383 
05384  cleanup:
05385    uves_free_array(&val);
05386    uves_free_image(&diff);
05387    uves_free_image(&flat_smooth);
05388    uves_free_matrix(&mx);
05389    return result;
05390 }
05391 
05392 

Generated on 9 Mar 2012 for UVES Pipeline Reference Manual by  doxygen 1.6.1