UVES Pipeline Reference Manual  5.4.0
uves_utils.c
1 /* *
2  * This file is part of the ESO UVES Pipeline *
3  * Copyright (C) 2004,2005 European Southern Observatory *
4  * *
5  * This library is free software; you can redistribute it and/or modify *
6  * it under the terms of the GNU General Public License as published by *
7  * the Free Software Foundation; either version 2 of the License, or *
8  * (at your option) any later version. *
9  * *
10  * This program is distributed in the hope that it will be useful, *
11  * but WITHOUT ANY WARRANTY; without even the implied warranty of *
12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the *
13  * GNU General Public License for more details. *
14  * *
15  * You should have received a copy of the GNU General Public License *
16  * along with this program; if not, write to the Free Software *
17  * Foundation, 51 Franklin St, Fifth Floor, Boston, MA 02111-1307 USA *
18  * */
19 
20 /*
21  * $Author: amodigli $
22  * $Date: 2013-04-16 15:36:11 $
23  * $Revision: 1.204 $
24  * $Name: not supported by cvs2svn $
25  */
26 
27 #ifdef HAVE_CONFIG_H
28 # include <config.h>
29 #endif
30 
31 /*---------------------------------------------------------------------------*/
37 /*---------------------------------------------------------------------------*/
38 
39 /*-----------------------------------------------------------------------------
40  Includes
41  ----------------------------------------------------------------------------*/
42 #include <uves_utils.h>
43 #include <uves_utils_cpl.h>
44 #include <irplib_ksigma_clip.h>
45 /*
46  * System Headers
47  */
48 #include <errno.h>
49 #include <uves.h>
50 #include <uves_extract_profile.h>
51 #include <uves_plot.h>
52 #include <uves_dfs.h>
53 #include <uves_pfits.h>
54 #include <uves_utils_wrappers.h>
55 #include <uves_wavecal_utils.h>
56 #include <uves_msg.h>
57 #include <uves_dump.h>
58 #include <uves_error.h>
59 
60 #include <irplib_utils.h>
61 
62 #include <cpl.h>
63 #include <uves_time.h> /* iso time */
64 
65 #include <ctype.h> /* tolower */
66 #include <stdbool.h>
67 #include <float.h>
68 
69 /*-----------------------------------------------------------------------------
70  Defines
71  ----------------------------------------------------------------------------*/
72 // The following macros are used to provide a fast
73 // and readable way to convert C-indexes to FORTRAN-indexes.
74 #define C_TO_FORTRAN_INDEXING(a) &a[-1]
75 #define FORTRAN_TO_C_INDEXING(a) &a[1]
76 
78 /*-----------------------------------------------------------------------------
79  Functions prototypes
80  ----------------------------------------------------------------------------*/
81 
82 
83 static cpl_error_code
84 uves_cosrout(cpl_image* ima,
85  cpl_image** msk,
86  const double ron,
87  const double gain,
88  const int ns,
89  const double sky,
90  const double rc,
91  cpl_image** flt,
92  cpl_image** out);
93 
94 static cpl_image *
95 uves_gen_lowpass(const int xs,
96  const int ys,
97  const double sigma_x,
98  const double sigma_y);
99 
100 static cpl_error_code
101 uves_find_next(cpl_image** msk,
102  const int first_y,
103  int* next_x,
104  int* next_y);
105 
106 static cpl_error_code
107 uves_sort(const int kmax,float* inp, int* ord);
108 
109 /*-----------------------------------------------------------------------------
110  Implementation
111  ----------------------------------------------------------------------------*/
112 
113 
114 /*---------------------------------------------------------------------------*/
159 /*---------------------------------------------------------------------------*/
160 
161 cpl_error_code
162 uves_rcosmic(cpl_image* ima,
163  cpl_image** flt,
164  cpl_image** out,
165  cpl_image** msk,
166  const double sky,
167  const double ron,
168  const double gain,
169  const int ns,
170  const double rc)
171 
172 {
173 
174 
175 /*
176 
177 
178  PROGRAM RCOSMIC
179  INTEGER*4 IAV,I
180  INTEGER*4 STATUS,MADRID,SIZEX,IOMODE
181  INTEGER*4 NAXIS,NPIX(2),IMNI,IMNO,IMNF,IMNC
182  INTEGER*8 PNTRI,PNTRF,PNTRO,PNTRC
183  INTEGER*4 KUN,KNUL
184  CHARACTER*60 IMAGE,OBJET,COSMIC
185  CHARACTER*72 IDENT1,IDENT2,IDENT3
186  CHARACTER*48 CUNIT
187  DOUBLE PRECISION START(2),STEP(2)
188  REAL*4 SKY,GAIN,RON,NS,RC,PARAM(5),CUTS(2)
189  INCLUDE 'MID_INCLUDE:ST_DEF.INC'
190  COMMON/VMR/MADRID(1)
191  INCLUDE 'MID_INCLUDE:ST_DAT.INC'
192  DATA IDENT1 /' '/
193  DATA IDENT2 /' '/
194  DATA IDENT3 /'cosmic ray mask '/
195  DATA CUNIT /' '/
196  CALL STSPRO('RCOSMIC')
197  CALL STKRDC('IN_A',1,1,60,IAV,IMAGE,KUN,KNUL,STATUS)
198  CALL STIGET(IMAGE,D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
199  1 2,NAXIS,NPIX,START,STEP
200  1 ,IDENT1,CUNIT,PNTRI,IMNI,STATUS)
201 
202  CALL STKRDR('PARAMS',1,5,IAV,PARAM,KUN,KNUL,STATUS)
203  CALL STIGET('middumma',D_R4_FORMAT,F_I_MODE,F_IMA_TYPE,
204  1 2,NAXIS,NPIX,START,STEP
205  1 ,IDENT2,CUNIT,PNTRF,IMNF,STATUS)
206  SKY = PARAM(1)
207  GAIN = PARAM(2)
208  RON = PARAM(3)
209  NS = PARAM(4)
210  RC = PARAM(5)
211 
212 */
213 
214 
215  check_nomsg(*flt=cpl_image_duplicate(ima));
216  check_nomsg(uves_filter_image_median(flt,1,1,false));
217 
218 
219 
220 /*
221 
222  CALL STKRDC('OUTIMA',1,1,60,IAV,OBJET,KUN,KNUL,STATUS)
223  CALL STIPUT(OBJET,D_R4_FORMAT,F_O_MODE,F_IMA_TYPE,
224  1 NAXIS,NPIX,START,STEP
225  1 ,IDENT1,CUNIT,PNTRO,IMNO,STATUS)
226 
227  SIZEX = 1
228  DO I=1,NAXIS
229  SIZEX = SIZEX*NPIX(I)
230  ENDDO
231  CALL STKRDC('COSMIC',1,1,60,IAV,COSMIC,KUN,KNUL,STATUS)
232  IF (COSMIC(1:1).EQ.'+') THEN
233  COSMIC = 'dummy_frame'
234  IOMODE = F_X_MODE
235  ELSE
236  IOMODE = F_O_MODE
237  ENDIF
238  CALL STIPUT(COSMIC,D_I2_FORMAT,IOMODE,F_IMA_TYPE
239  1 ,NAXIS,NPIX,START,STEP
240  1 ,IDENT3,CUNIT,PNTRC,IMNC,STATUS)
241  CALL COSROUT(MADRID(PNTRI),MADRID(PNTRC),NPIX(1),NPIX(2),
242  1 RON,GAIN,NS,SKY,RC
243  1 ,MADRID(PNTRF),MADRID(PNTRO))
244 
245  CUTS(1) = 0
246  CUTS(2) = 1
247  IF (IOMODE.EQ.F_O_MODE)
248  + CALL STDWRR(IMNC,'LHCUTS',CUTS,1,2,KUN,STATUS)
249  CALL DSCUPT(IMNI,IMNO,' ',STATUS)
250  CALL STSEPI
251  END
252 
253 
254 */
255 
256  check_nomsg(uves_cosrout(ima,msk,ron,gain,ns,sky,rc,flt,out));
257  cleanup:
258  return CPL_ERROR_NONE;
259 }
260 
261 
262 /*---------------------------------------------------------------------------*/
275 /*---------------------------------------------------------------------------*/
276 static double
277 uves_ksigma_vector(cpl_vector *values,double klow, double khigh, int kiter)
278 {
279  cpl_vector *accepted;
280  double mean = 0.0;
281  double sigma = 0.0;
282  double *data = cpl_vector_get_data(values);
283  int n = cpl_vector_get_size(values);
284  int ngood = n;
285  int count = 0;
286  int i;
287 
288  /*
289  * At first iteration the mean is taken as the median, and the
290  * standard deviation relative to this value is computed.
291  */
292 
293  check_nomsg(mean = cpl_vector_get_median(values));
294 
295  for (i = 0; i < n; i++) {
296  sigma += (mean - data[i]) * (mean - data[i]);
297  }
298  sigma = sqrt(sigma / (n - 1));
299 
300  while (kiter) {
301  count = 0;
302  for (i = 0; i < ngood; i++) {
303  if (data[i]-mean < khigh*sigma && mean-data[i] < klow*sigma) {
304  data[count] = data[i];
305  ++count;
306  }
307  }
308 
309  if (count == 0) // This cannot happen at first iteration.
310  break; // So we can break: we have already computed a mean.
311 
312  /*
313  * The mean must be computed even if no element was rejected
314  * (count == ngood), because at first iteration median instead
315  * of mean was computed.
316  */
317 
318  check_nomsg(accepted = cpl_vector_wrap(count, data));
319  check_nomsg(mean = cpl_vector_get_mean(accepted));
320  if(count>1) {
321  check_nomsg(sigma = cpl_vector_get_stdev(accepted));
322  }
323  check_nomsg(cpl_vector_unwrap(accepted));
324 
325  if (count == ngood) {
326  break;
327  }
328  ngood = count;
329  --kiter;
330  }
331  cleanup:
332 
333  return mean;
334 }
335 
336 
355 cpl_image *
356 uves_ksigma_stack(const cpl_imagelist *imlist, double klow, double khigh, int kiter)
357 {
358  int ni, nx, ny, npix;
359  cpl_image *out_ima=NULL;
360  cpl_imagelist *loc_iml=NULL;
361  double *pout_ima=NULL;
362  cpl_image *image=NULL;
363  const double **data=NULL;
364  double *med=NULL;
365  cpl_vector *time_line=NULL;
366 
367  double *ptime_line=NULL;
368  int i, j;
369  double mean_of_medians=0;
370 
371  passure(imlist != NULL, "Null input imagelist!");
372 
373  ni = cpl_imagelist_get_size(imlist);
374  loc_iml = cpl_imagelist_duplicate(imlist);
375  image = cpl_imagelist_get(loc_iml, 0);
376  nx = cpl_image_get_size_x(image);
377  ny = cpl_image_get_size_y(image);
378  npix = nx * ny;
379 
380  out_ima = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
381  pout_ima = cpl_image_get_data_double(out_ima);
382 
383  time_line = cpl_vector_new(ni);
384 
385  ptime_line = cpl_vector_get_data(time_line);
386 
387  data = cpl_calloc(sizeof(double *), ni);
388  med = cpl_calloc(sizeof(double), ni);
389 
390  for (i = 0; i < ni; i++) {
391  image = cpl_imagelist_get(loc_iml, i);
392  med[i]=cpl_image_get_median(image);
393  cpl_image_subtract_scalar(image,med[i]);
394  data[i] = cpl_image_get_data_double(image);
395  mean_of_medians+=med[i];
396  }
397  mean_of_medians/=ni;
398 
399  for (i = 0; i < npix; i++) {
400  for (j = 0; j < ni; j++) {
401  ptime_line[j] = data[j][i];
402  }
403  check_nomsg(pout_ima[i] = uves_ksigma_vector(time_line, klow, khigh, kiter));
404  }
405 
406  cpl_image_add_scalar(out_ima,mean_of_medians);
407 
408  cleanup:
409  cpl_free(data);
410  cpl_free(med);
411  cpl_vector_delete(time_line);
412  uves_free_imagelist(&loc_iml);
413 
414  return out_ima;
415 
416 }
417 
418 
419 
451 cpl_image *
453  cpl_image * ima_sci,
454  const char *context,
455  const cpl_parameterlist *parameters,
456  const cpl_table *ordertable,
457  const cpl_table *linetable,
458  const polynomial* order_locations,
459  const polynomial *dispersion_relation,
460  const int first_abs_order,
461  const int last_abs_order,
462  const int slit_size)
463 {
464 
465  cpl_image* wave_map=NULL;
466  double* pwmap=NULL;
467  int ord_min=0;
468  int ord_max=0;
469  int i=0;
470  int j=0;
471  double xpos=0;
472  double ypos=0;
473  double wlen=0;
474 
475  int nx=0;
476  int ny=0;
477  int aord=0;
478  int order=0;
479  int jj=0;
480  int norders=0;
481  int hs=0;
482 
483  uves_msg("Creating wave map");
484  /* set half slit size */
485  hs=slit_size/2;
486 
487  /* get wave map size */
488  nx = cpl_image_get_size_x(ima_sci);
489  ny = cpl_image_get_size_y(ima_sci);
490 
491  /* get ord min-max */
492  ord_min=cpl_table_get_column_min(ordertable,"Order");
493  ord_max=cpl_table_get_column_max(ordertable,"Order");
494  norders=ord_max-ord_min+1;
495 
496  check_nomsg(wave_map=cpl_image_new(nx,ny,CPL_TYPE_DOUBLE));
497  pwmap=cpl_image_get_data_double(wave_map);
498 
499  for (order = 1; order <= norders; order++){
500  /* wave solution need absolute order value */
501  aord = uves_absolute_order(first_abs_order, last_abs_order, order);
502  for (i=0;i<nx;i++) {
503  xpos=(double)i;
504  wlen=uves_polynomial_evaluate_2d(dispersion_relation,xpos,aord)/aord;
505  ypos=uves_polynomial_evaluate_2d(order_locations,xpos,order);
506  for (jj=-hs;jj<hs;jj++) {
507  j=(int)(ypos+jj+0.5);
508  /* check the point is on the detector */
509  if( (j>0) && ( (j*nx+i)<nx*ny) ) {
510  pwmap[j*nx+i]=wlen;
511  }
512  }
513  }
514  }
515 
516  /*
517  check_nomsg(cpl_image_save(wave_map,"wmap.fits",CPL_BPP_IEEE_FLOAT,NULL,
518  CPL_IO_DEFAULT));
519  */
520  cleanup:
521  return wave_map;
522 }
523 
524 
525 
526 
527 
528 
529 
550 cpl_image *
552  const cpl_table *ordertable,
553  const polynomial* order_locations,
554  const cpl_image* mflat)
555 {
556 
557  cpl_imagelist* flats_norm=NULL;
558 
559  cpl_image* master_flat=NULL;
560  /* cpl_image* img=NULL; */
561  cpl_image* flat=NULL;
562  cpl_image* flat_mflat=NULL;
563 
564  cpl_vector* vec_flux=NULL;
565  double* pvec_flux=NULL;
566 
567  int ni=0;
568  int i=0;
569  int sx=0;
570  int sy=0;
571  int ord_min=0;
572  int ord_max=0;
573  int nord=0;
574  int nsam=10;
575  int x_space=10;
576  int llx=0;
577  int lly=0;
578  int urx=0;
579  int ury=0;
580  int hbox_sx=0;
581  int hbox_sy=0;
582  int ord=0;
583  int absord=0;
584  int pos_x=0;
585  int pos_y=0;
586  double x=0;
587  double y=0;
588  double flux_median=0;
589  double mean_explevel=0;
590  /* double exptime=0; */
591  int is=0;
592  int k=0;
593 
594  ni=cpl_imagelist_get_size(flats);
595 
596  /* evaluate medain on many windows distribuited all over orders of flats */
597  sx = cpl_image_get_size_x(mflat);
598  sy = cpl_image_get_size_y(mflat);
599 
600 
601  ord_min=cpl_table_get_column_min(ordertable,"Order");
602  ord_max=cpl_table_get_column_max(ordertable,"Order");
603  nord=ord_max-ord_min+1;
604 
605  hbox_sx=(int)((sx-2*x_space)/(2*nsam)+0.5);
606  flats_norm=cpl_imagelist_new();
607  for(i=0;i<ni;i++) {
608  uves_free_vector(&vec_flux);
609  vec_flux=cpl_vector_new(nord*nsam);
610  pvec_flux=cpl_vector_get_data(vec_flux);
611  uves_free_image(&flat_mflat);
612  uves_free_image(&flat);
613  check_nomsg(flat = cpl_image_duplicate(cpl_imagelist_get(flats, i)));
614  /* normalize flats by master flat */
615  flat_mflat=cpl_image_duplicate(flat);
616  cpl_image_divide(flat_mflat,mflat);
617 
618  k=0;
619  for(ord=0;ord<nord;ord++) {
620  absord=ord+ord_min;
621  pos_x=-hbox_sx;
622  for(is=0;is<nsam;is++) {
623  pos_x+=(2*hbox_sx+x_space);
624  x=(int)(pos_x+0.5);
625 
626  check_nomsg(y=uves_polynomial_evaluate_2d(order_locations,
627  x, absord));
628  pos_y=(int)(y+0.5);
629 
630  check_nomsg(llx=uves_max_int(pos_x-hbox_sx,1));
631  check_nomsg(lly=uves_max_int(pos_y-hbox_sy,1));
632  check_nomsg(llx=uves_min_int(llx,sx));
633  check_nomsg(lly=uves_min_int(lly,sy));
634 
635  check_nomsg(urx=uves_min_int(pos_x+hbox_sx,sx));
636  check_nomsg(ury=uves_min_int(pos_y+hbox_sy,sy));
637  check_nomsg(urx=uves_max_int(urx,1));
638  check_nomsg(ury=uves_max_int(ury,1));
639 
640  check_nomsg(llx=uves_min_int(llx,urx));
641  check_nomsg(lly=uves_min_int(lly,ury));
642 
643  check_nomsg(pvec_flux[k]=0);
644 
645  check_nomsg(pvec_flux[k]=cpl_image_get_median_window(flat_mflat,llx,lly,urx,ury));
646 
647  k++;
648  }
649 
650  }
651 
652  flux_median=cpl_vector_get_median(vec_flux);
653  uves_msg("Flat %d normalize factor iter2: %g",i,flux_median);
654  cpl_image_divide_scalar(flat,flux_median);
655  cpl_imagelist_set(flats_norm,cpl_image_duplicate(flat),i);
656  mean_explevel+=flux_median;
657  }
658  mean_explevel/=ni;
659 
660  check_nomsg(cpl_imagelist_multiply_scalar(flats_norm,mean_explevel));
661 
662  check( master_flat = cpl_imagelist_collapse_median_create(flats_norm),
663  "Error computing median");
664 
665 
666 
667 
668  cleanup:
669 
670  uves_free_imagelist(&flats_norm);
671  uves_free_vector(&vec_flux);
672  uves_free_image(&flat_mflat);
673  uves_free_image(&flat);
674  uves_check_rec_status(0);
675  return master_flat;
676 
677 }
678 
679 
701 cpl_image *
703  const cpl_table *ordertable,
704  const polynomial* order_locations,
705  const cpl_vector* gain_vals ,
706  double* fnoise)
707 {
708  int ni;
709  cpl_image *image=NULL;
710  cpl_image* master_flat=NULL;
711  cpl_imagelist* flats_norm=NULL;
712  int k=0;
713  int ord_min=0;
714  int ord_max=0;
715  int nord=0;
716  double flux_mean=0;
717  int nsam=10;
718  int x_space=10;
719  int hbox_sx=0;
720  int hbox_sy=10;
721  int is=0;
722  int pos_x=0;
723  int pos_y=0;
724  int llx=0;
725  int lly=0;
726  int urx=0;
727  int ury=0;
728 
729  double x=0;
730  double y=0;
731  int sx=0;
732  int sy=0;
733  cpl_vector* vec_flux_ord=NULL;
734  cpl_vector* vec_flux_sam=NULL;
735  double* pvec_flux_ord=NULL;
736  double* pvec_flux_sam=NULL;
737  int absord=0;
738  int ord=0;
739  const double* pgain_vals=NULL;
740  double fnoise_local=0;
741 
742  passure(flats != NULL, "Null input flats imagelist!");
743  passure(order_locations != NULL, "Null input order locations polinomial!");
744 
745  ni = cpl_imagelist_get_size(flats);
746 
747  image = cpl_image_duplicate(cpl_imagelist_get(flats, 0));
748  sx = cpl_image_get_size_x(image);
749  sy = cpl_image_get_size_y(image);
750 
751  uves_free_image(&image);
752  ord_min=cpl_table_get_column_min(ordertable,"Order");
753  ord_max=cpl_table_get_column_max(ordertable,"Order");
754  nord=ord_max-ord_min+1;
755  vec_flux_ord=cpl_vector_new(nord);
756  vec_flux_sam=cpl_vector_new(nsam);
757  pvec_flux_ord=cpl_vector_get_data(vec_flux_ord);
758  pvec_flux_sam=cpl_vector_get_data(vec_flux_sam);
759  hbox_sx=(int)((sx-2*x_space)/(2*nsam)+0.5);
760  flats_norm=cpl_imagelist_new();
761  pgain_vals=cpl_vector_get_data_const(gain_vals);
762 
763  for(k=0;k<ni;k++) {
764  uves_free_image(&image);
765  image = cpl_image_duplicate(cpl_imagelist_get(flats, k));
766  for(ord=0;ord<nord;ord++) {
767  absord=ord+ord_min;
768  pos_x=-hbox_sx;
769  for(is=0;is<nsam;is++) {
770  pos_x+=(2*hbox_sx+x_space);
771  x=(int)(pos_x+0.5);
772 
773  check_nomsg(y=uves_polynomial_evaluate_2d(order_locations,
774  x, absord));
775  pos_y=(int)(y+0.5);
776 
777  llx=uves_max_int(pos_x-hbox_sx,1);
778  lly=uves_max_int(pos_y-hbox_sy,1);
779  llx=uves_min_int(llx,sx);
780  lly=uves_min_int(lly,sy);
781 
782  urx=uves_min_int(pos_x+hbox_sx,sx);
783  ury=uves_min_int(pos_y+hbox_sy,sy);
784  urx=uves_max_int(urx,1);
785  ury=uves_max_int(ury,1);
786 
787  llx=uves_min_int(llx,urx);
788  lly=uves_min_int(lly,ury);
789 
790  check_nomsg(pvec_flux_sam[is]=cpl_image_get_median_window(image,llx,lly,urx,ury));
791 
792  }
793  pvec_flux_ord[ord]=cpl_vector_get_mean(vec_flux_sam);
794  }
795 
796  flux_mean=cpl_vector_get_mean(vec_flux_ord);
797  uves_msg("Flat %d normalize factor inter1: %g",k,flux_mean);
798  fnoise_local+=pgain_vals[k]*flux_mean;
799  cpl_image_divide_scalar(image,flux_mean);
800  cpl_imagelist_set(flats_norm,cpl_image_duplicate(image),k);
801  }
802  *fnoise=1./sqrt(fnoise_local);
803  check( master_flat = cpl_imagelist_collapse_median_create(flats_norm),
804  "Error computing median");
805 
806  uves_msg("FNOISE %g ",*fnoise);
807  cleanup:
808 
809  uves_free_vector(&vec_flux_ord);
810  uves_free_vector(&vec_flux_sam);
811  uves_free_image(&image);
812  uves_free_imagelist(&flats_norm);
813 
814 
815  return master_flat;
816 
817 }
818 
819 /*---------------------------------------------------------------------------*/
843 /*---------------------------------------------------------------------------*/
844 
845 static cpl_error_code
846 uves_cosrout(cpl_image* ima,
847  cpl_image** msk,
848  const double ron,
849  const double gain,
850  const int ns,
851  const double sky,
852  const double rc,
853  cpl_image** flt,
854  cpl_image** out)
855 {
856 
857 
858 /*
859 
860  SUBROUTINE COSROUT(AI,COSMIC,I_IMA,J_IMA,RON,GAIN,
861  1 NS,SKY,RC,AM,AO)
862  INTEGER I_IMA,J_IMA,NUM
863  INTEGER ORD(10000)
864  INTEGER K,L
865  INTEGER IDUMAX,JDUMAX,I1,I2,J1,II,JJ
866  INTEGER I,J,IMAX,JMAX,IMIN,JMIN
867  INTEGER FIRST(2),NEXT(2)
868  INTEGER*2 COSMIC(I_IMA,J_IMA)
869  REAL*4 VECTEUR(10000),FMAX,ASUM,RC
870  REAL*4 AI(I_IMA,J_IMA),AO(I_IMA,J_IMA),AM(I_IMA,J_IMA)
871  REAL*4 SIGMA,SKY,S1,S2
872  REAL*4 RON,GAIN,NS,AMEDIAN
873 
874 */
875 
876  int sx=0;
877  int sy=0;
878  int i=0;
879  int j=0;
880  int k=1;
881  int pix=0;
882  int first[2];
883  int next_x=0;
884  int next_y=0;
885  int i_min=0;
886  int i_max=0;
887  int j_min=0;
888  int j_max=0;
889  int idu_max=0;
890  int jdu_max=0;
891  int i1=0;
892  int i2=0;
893  int ii=0;
894  int jj=0;
895  int j1=0;
896  int num=0;
897  int l=0;
898  int nmax=1e6;
899  int ord[nmax];
900 
901 
902  float* pi=NULL;
903  float* po=NULL;
904  float* pf=NULL;
905  int* pm=NULL;
906  float sigma=0;
907 
908 
909  float vec[nmax];
910 
911  double f_max=0;
912  double s1=0;
913  double s2=0;
914  double asum=0;
915  double a_median=0;
916 
917  uves_msg_warning("sky=%g gain=%g ron=%g ns=%d rc=%g",sky,gain,ron,ns,rc);
918  check_nomsg(sx=cpl_image_get_size_x(ima));
919  check_nomsg(sy=cpl_image_get_size_y(ima));
920  check_nomsg(pi=cpl_image_get_data_float(ima));
921  //*flt=cpl_image_new(sx,sy,CPL_TYPE_FLOAT);
922  *msk=cpl_image_new(sx,sy,CPL_TYPE_INT);
923 
924  check_nomsg(pf=cpl_image_get_data_float(*flt));
925  check_nomsg(pm=cpl_image_get_data_int(*msk));
926 
927  check_nomsg(*out=cpl_image_duplicate(ima));
928  check_nomsg(po=cpl_image_get_data_float(*out));
929 
930 /*
931 
932  DO 10 J=1,J_IMA
933  DO 5 I=1,I_IMA
934  AO(I,J)=AI(I,J)
935  COSMIC(I,J)= 0
936  5 CONTINUE
937  10 CONTINUE
938 
939 C
940 C La boucle suivante selectionne les pixels qui sont
941 C significativ+ement au dessus de l'image filtree medianement.
942 C
943 C The flowing loop selects the pixels that are much higher that the
944 C median filter image
945 C
946 C COSMIC =-1 ----> candidate for cosmic
947 C = 0 ----> not a cosmic
948 C = 1 -----> a cosmic (at the end)
949 C = 2 ----> member of the group
950 C = 3 ----> member of a group which has been examined
951 C = 4 ----> neighbourhood of the group
952  K=1
953  DO 80 J=2,J_IMA-1
954  DO 70 I=2,I_IMA-1
955  SIGMA=SQRT(RON**2+AM(I,J)/GAIN)
956  IF ((AI(I,J)-AM(I,J)).GE.(NS*SIGMA)) THEN
957  COSMIC(I,J) = -1
958  K = K+1
959  ENDIF
960  70 CONTINUE
961  80 CONTINUE
962 
963 
964 */
965 
966 
967  uves_msg_warning("Set all pix to = -1 -> candidate for cosmic");
968  k=1;
969  for(j=1;j<sy-1;j++) {
970  for(i=1;i<sx-1;i++) {
971  pix=j*sx+i;
972  sigma=sqrt(ron*ron+pf[pix]/gain);
973  if ( (pi[pix]-pf[pix]) >= (ns*sigma) ) {
974  pm[pix]=-1;
975  k++;
976  }
977  }
978  }
979 
980 
981  /*
982 
983  La boucle suivante selectionne les pixels qui sont
984  significativement au dessus de l'image filtree medianement.
985 
986  The flowing loop selects the pixels that are much higher that the
987  median filter image
988 
989 
990  COSMIC =-1 ----> candidate for cosmic
991  = 0 ----> not a cosmic
992  = 1 -----> a cosmic (at the end)
993  = 2 ----> member of the group
994  = 3 ----> member of a group which has been examined
995  = 4 ----> neighbourhood of the group
996 
997  */
998 
999 
1000 /*
1001  Ces pixels sont regroupes par ensembles connexes dans la boucle
1002  This pixels are gouped as grouped together if neibours
1003 */
1004 
1005  first[0]=1;
1006  first[1]=1;
1007 
1008  lab100:
1009  check_nomsg(uves_find_next(msk,first[1],&next_x, &next_y));
1010 
1011  if(next_x==-1) return CPL_ERROR_NONE;
1012  i=next_x;
1013  j=next_y;
1014 
1015  uves_msg_debug("p[%d,%d]= 2 -> member of the group",i,j);
1016  pix=j*sx+i;
1017  pm[pix]=2;
1018 
1019  i_min=i;
1020  i_max=i;
1021  j_min=j;
1022  j_max=j;
1023  idu_max=i;
1024  jdu_max=j;
1025  f_max=pi[pix];
1026 
1027  lab110:
1028  i1=0;
1029  i2=0;
1030 
1031 
1032 
1033 /*
1034  FIRST(1) = 2
1035  FIRST(2) = 2
1036  100 CALL FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
1037  IF (NEXT(1).EQ.-1) RETURN
1038  I = NEXT(1)
1039  J = NEXT(2)
1040  COSMIC(I,J) = 2
1041  IMIN = I
1042  IMAX = I
1043  JMIN = J
1044  JMAX = J
1045  IDUMAX = I
1046  JDUMAX = J
1047  FMAX = AI(I,J)
1048  110 I1 = 0
1049  I2 = 0
1050  CONTINUE
1051 
1052 */
1053 
1054  for(l=0;l<2;l++) {
1055  for(k=0;k<2;k++) {
1056  ii=i+k-l;
1057  jj=j+k+l-3;
1058  pix=jj*sx+ii;
1059  if(pm[pix]==-1) {
1060  i1=ii;
1061  j1=jj;
1062  i_min=(i_min<ii) ? i_min: ii;
1063  i_max=(i_max>ii) ? i_max: ii;
1064  j_min=(j_min<jj) ? j_min: jj;
1065  j_max=(j_max>jj) ? j_max: jj;
1066  uves_msg_debug("p[%d,%d]= 2 -> member of the group",ii,jj);
1067  pm[pix]=2;
1068  if(pi[pix]>f_max) {
1069  f_max=pi[pix];
1070  idu_max=ii;
1071  idu_max=jj;
1072  }
1073  } else if(pm[pix]==0) {
1074  pm[pix]=4;
1075  uves_msg_debug("p[%d,%d]= 4 -> neighbourhood of the group",k,l);
1076  }
1077  }
1078  }
1079 
1080 
1081 /*
1082  DO 125 L=1,2
1083  DO 115 K=1,2
1084  II = I+K-L
1085  JJ = J+K+L-3
1086  IF (COSMIC(II,JJ).EQ.-1) THEN
1087  I1 = II
1088  J1 = JJ
1089  IMIN = MIN(IMIN,II)
1090  IMAX = MAX(IMAX,II)
1091  JMIN = MIN(JMIN,JJ)
1092  JMAX = MAX(JMAX,JJ)
1093  COSMIC(II,JJ) = 2
1094  IF (AI(II,JJ).GT.FMAX) THEN
1095  FMAX = AI(II,JJ)
1096  IDUMAX = II
1097  JDUMAX = JJ
1098  ENDIF
1099  ELSE IF (COSMIC(II,JJ).EQ.0) THEN
1100  COSMIC(II,JJ) = 4
1101  ENDIF
1102  115 CONTINUE
1103  125 CONTINUE
1104 
1105 */
1106 
1107 
1108  pix=j*sx+i;
1109  pm[pix]=3;
1110  uves_msg_debug("p[%d,%d]= 3 -> member of a group which has been examined",i,j);
1111  if(i1 != 0) {
1112  i=i1;
1113  j=j1;
1114  goto lab110;
1115  }
1116 
1117 
1118 /*
1119  COSMIC(I,J) = 3
1120  IF (I1.NE.0) THEN
1121  I = I1
1122  J = J1
1123  GOTO 110
1124  ENDIF
1125 */
1126 
1127  for(l=j_min;l<=j_max;l++){
1128  for(k=i_min;k<=i_max;k++){
1129  pix=l*sy+k;
1130  if(pm[pix] == 2) {
1131  i=k;
1132  j=l;
1133  goto lab110;
1134  }
1135  }
1136  }
1137  first[0] = next_x+1;
1138  first[1] = next_y;
1139 
1140 
1141 /*
1142  DO 140 L = JMIN,JMAX
1143  DO 130 K = IMIN,IMAX
1144  IF (COSMIC(K,L).EQ.2) THEN
1145  I = K
1146  J = L
1147  GOTO 110
1148  ENDIF
1149  130 CONTINUE
1150  140 CONTINUE
1151  FIRST(1) = NEXT(1)+1
1152  FIRST(2) = NEXT(2)
1153 
1154 */
1155 
1156 
1157  /*
1158  We start here the real work....
1159  1- decide if the pixel's group is a cosmic
1160  2-replace these values by another one
1161  */
1162  s1=pi[(jdu_max-1)*sx+idu_max-1]+
1163  pi[(jdu_max-1)*sx+idu_max+1]+
1164  pi[(jdu_max-1)*sx+idu_max]+
1165  pi[(jdu_max+1)*sx+idu_max];
1166 
1167  s2=pi[(jdu_max+1)*sy+idu_max-1]+
1168  pi[(jdu_max+1)*sy+idu_max+1]+
1169  pi[(jdu_max)*sy+idu_max-1]+
1170  pi[(jdu_max)*sy+idu_max+1];
1171  asum=(s1+s2)/8.-sky;
1172 
1173 
1174 /*
1175 
1176 C We start here the real work....
1177 C 1- decide if the pixel's group is a cosmic
1178 C 2-replace these values by another one
1179 
1180  S1 = AI(IDUMAX-1,JDUMAX-1) +
1181  ! AI(IDUMAX+1,JDUMAX-1) +
1182  ! AI(IDUMAX,JDUMAX-1) +
1183  ! AI(IDUMAX,JDUMAX+1)
1184 
1185  S2 = AI(IDUMAX-1,JDUMAX+1) +
1186  ! AI(IDUMAX+1,JDUMAX+1) +
1187  ! AI(IDUMAX-1,JDUMAX) +
1188  ! AI(IDUMAX+1,JDUMAX)
1189  ASUM = (S1+S2)/8.-SKY
1190 
1191 */
1192 
1193  if((f_max-sky) > rc*asum) {
1194  num=0;
1195  for( l = j_min-1; l <= j_max+1; l++) {
1196  for( k = i_min-1; k<= i_max+1;k++) {
1197  if(pm[l*sx+k]==4) {
1198  vec[num]=pi[l*sx+k];
1199  num++;
1200  }
1201  }
1202  }
1203 
1204 
1205 /*
1206 
1207  IF ((FMAX-SKY).GT.RC*ASUM) THEN
1208  NUM = 1
1209  DO L = JMIN-1,JMAX+1
1210  DO K = IMIN-1,IMAX+1
1211  IF (COSMIC(K,L).EQ.4) THEN
1212  VECTEUR(NUM) = AI(K,L)
1213  NUM = NUM+1
1214  ENDIF
1215  ENDDO
1216  ENDDO
1217 
1218 */
1219 
1220  uves_sort(num-1,vec,ord);
1221  a_median=vec[ord[(num-1)/2]];
1222  for(l = j_min-1; l <= j_max+1 ; l++){
1223  for(k = i_min-1 ; k <= i_max+1 ; k++){
1224  if(pm[l*sx+k] == 3) {
1225  pm[l*sx+k]=1;
1226  uves_msg_debug("p[%d,%d]= 1 -> a cosmic (at the end)",k,l);
1227 
1228  po[l*sx+k]=a_median;
1229  } else if (pm[l*sx+k] == 4) {
1230  po[l*sx+k]=0;
1231  po[l*sx+k]=a_median;//here we set to median instead than 0
1232  }
1233  }
1234  }
1235 
1236 
1237 /*
1238  CALL SORT(NUM-1,VECTEUR,ORD)
1239  AMEDIAN = VECTEUR(ORD((NUM-1)/2))
1240  DO L = JMIN-1,JMAX+1
1241  DO K = IMIN-1,IMAX+1
1242  IF (COSMIC(K,L).EQ.3) THEN
1243  COSMIC(K,L) = 1
1244  AO(K,L) = AMEDIAN
1245  ELSE IF (COSMIC(K,L).EQ.4) THEN
1246  COSMIC(K,L) = 0
1247  ENDIF
1248  ENDDO
1249  ENDDO
1250 */
1251 
1252  } else {
1253  for( l = j_min-1 ; l <= j_max+1 ; l++) {
1254  for( k = i_min-1 ; k <= i_max+1 ; k++) {
1255  if(pm[l*sx+k] != -1) {
1256  uves_msg_debug("p[%d,%d]= 0 -> not a cosmic",k,l);
1257  pm[l*sx+k] = 0;
1258  }
1259  }
1260  }
1261  }
1262 
1263 
1264  if (next_x >0) goto lab100;
1265 
1266 
1267 /*
1268  ELSE
1269  DO L = JMIN-1,JMAX+1
1270  DO K = IMIN-1,IMAX+1
1271  IF (COSMIC(K,L).NE.-1) COSMIC(K,L) = 0
1272  ENDDO
1273  ENDDO
1274  ENDIF
1275 
1276 
1277 
1278  IF (NEXT(1).GT.0) GOTO 100
1279 C
1280 C
1281 C
1282  RETURN
1283  END
1284 
1285 
1286 */
1287 
1288 
1289  cleanup:
1290 
1291  return CPL_ERROR_NONE;
1292 
1293 }
1294 
1295 
1296 
1297 
1298 
1299 static cpl_error_code
1300 uves_find_next(cpl_image** msk,
1301  const int first_y,
1302  int* next_x,
1303  int* next_y)
1304 {
1305  int sx=cpl_image_get_size_x(*msk);
1306  int sy=cpl_image_get_size_y(*msk);
1307  int i=0;
1308  int j=0;
1309  int* pc=NULL;
1310  int pix=0;
1311 
1312 
1313 
1314  check_nomsg(pc=cpl_image_get_data_int(*msk));
1315  for(j=first_y;j<sy;j++) {
1316  for(i=1;i<sx;i++) {
1317  pix=j*sx+i;
1318  if(pc[pix]==-1) {
1319  *next_x=i;
1320  *next_y=j;
1321  return CPL_ERROR_NONE;
1322  }
1323  }
1324  }
1325 
1326  *next_x=-1;
1327  *next_y=-1;
1328  cleanup:
1329  return CPL_ERROR_NONE;
1330 
1331 }
1332 
1333 /*
1334 
1335  SUBROUTINE FINDNEXT(COSMIC,I_IMA,J_IMA,FIRST,NEXT)
1336  INTEGER I_IMA,J_IMA,FIRST(2),NEXT(2)
1337  INTEGER I,J
1338  INTEGER*2 COSMIC(I_IMA,J_IMA)
1339  DO J = FIRST(2), J_IMA
1340  DO I = 2, I_IMA
1341  IF (COSMIC(I,J).EQ.-1) THEN
1342  NEXT(1) = I
1343  NEXT(2) = J
1344  RETURN
1345  ENDIF
1346  ENDDO
1347  ENDDO
1348  NEXT(1) = -1
1349  NEXT(2) = -1
1350  RETURN
1351  END
1352 
1353 */
1354 
1355 
1356 //Be carefull with F77 and C indexing
1357 static cpl_error_code
1358 uves_sort(const int kmax,float* inp, int* ord)
1359 {
1360  int k=0;
1361  int j=0;
1362  int l=0;
1363  float f=0;
1364  int i_min=0;
1365  int i_max=0;
1366  int i=0;
1367 
1368  for(k=0;k<kmax;k++) {
1369  ord[k]=k;
1370  }
1371 
1372  if(inp[0]>inp[1]) {
1373  ord[0]=1;
1374  ord[1]=0;
1375  }
1376 
1377  for(j=2;j<kmax;j++) {
1378  f=inp[j];
1379  l=inp[j-1];
1380 
1381 /*
1382  SUBROUTINE SORT(KMAX,INP,ORD)
1383  INTEGER KMAX,IMIN,IMAX,I,J,K,L
1384  INTEGER ORD(10000)
1385  REAL*4 INP(10000),F
1386  DO 4100 J=1,KMAX
1387  ORD(J)=J
1388  4100 CONTINUE
1389  IF (INP(1).GT.INP(2)) THEN
1390  ORD(1)=2
1391  ORD(2)=1
1392  END IF
1393  DO 4400 J=3,KMAX
1394  F=INP(J)
1395  L=ORD(J-1)
1396 */
1397 
1398  if(inp[l]<=f) goto lab4400;
1399  l=ord[0];
1400  i_min=0;
1401  if(f<=inp[l]) goto lab4250;
1402  i_max=j-1;
1403  lab4200:
1404  i=(i_min+i_max)/2;
1405  l=ord[i];
1406 
1407 /*
1408  IF (INP(L).LE.F) GO TO 4400
1409  L=ORD(1)
1410  IMIN=1
1411  IF (F.LE.INP(L)) GO TO 4250
1412  IMAX=J-1
1413  4200 I=(IMIN+IMAX)/2
1414  L=ORD(I)
1415 */
1416 
1417  if(inp[l]<f) {
1418  i_min=i;
1419  } else {
1420  i_max=i;
1421  }
1422  if(i_max>(i_min+1)) goto lab4200;
1423  i_min=i_max;
1424  lab4250:
1425  for(k=j-2;k>=i_min;k--) {
1426  ord[k+1]=ord[k];
1427  }
1428  ord[i_min]=j;
1429  lab4400:
1430  return CPL_ERROR_NONE;
1431  }
1432  return CPL_ERROR_NONE;
1433 }
1434 
1435 /*
1436  IF (INP(L).LT.F) THEN
1437  IMIN=I
1438  ELSE
1439  IMAX=I
1440  END IF
1441  IF (IMAX.GT.(IMIN+1)) GO TO 4200
1442  IMIN=IMAX
1443  4250 DO 4300 K=J-1,IMIN,-1
1444  ORD(K+1)=ORD(K)
1445  4300 CONTINUE
1446  ORD(IMIN)=J
1447  4400 CONTINUE
1448  RETURN
1449  END
1450 */
1451 
1452 /*---------------------------------------------------------------------------*/
1458 /*---------------------------------------------------------------------------*/
1459 
1460 cpl_parameterlist*
1461 uves_parameterlist_duplicate(const cpl_parameterlist* pin){
1462 
1463  cpl_parameter* p=NULL;
1464  cpl_parameterlist* pout=NULL;
1465 
1466  pout=cpl_parameterlist_new();
1467  p=cpl_parameterlist_get_first((cpl_parameterlist*)pin);
1468  while (p != NULL)
1469  {
1470  cpl_parameterlist_append(pout,p);
1471  p=cpl_parameterlist_get_next((cpl_parameterlist*)pin);
1472  }
1473  return pout;
1474 
1475 }
1492 const char*
1494 {
1495 
1496  char *t = s;
1497 
1498  if( s == NULL) {
1499  cpl_error_set(cpl_func,CPL_ERROR_NULL_INPUT);
1500  return NULL;
1501  };
1502  while (*t) {
1503  *t = toupper(*t);
1504  t++;
1505  }
1506 
1507  return s;
1508 
1509 }
1510 
1526 const char*
1528 {
1529 
1530  char *t = s;
1531 
1532  if( s == NULL) {
1533  cpl_error_set(cpl_func,CPL_ERROR_NULL_INPUT);
1534  return NULL;
1535  };
1536  while (*t) {
1537  *t = tolower(*t);
1538  t++;
1539  }
1540 
1541  return s;
1542 
1543 }
1544 
1545 
1546 
1547 
1548 /*----------------------------------------------------------------------------*/
1555 /*----------------------------------------------------------------------------*/
1556 cpl_frameset *
1557 uves_frameset_extract(const cpl_frameset *frames,
1558  const char *tag)
1559 {
1560  cpl_frameset *subset = NULL;
1561  const cpl_frame *f;
1562 
1563 
1564 
1565  assure( frames != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null frameset" );
1566  assure( tag != NULL, CPL_ERROR_ILLEGAL_INPUT, "Null tag" );
1567 
1568  subset = cpl_frameset_new();
1569 
1570  for (f = cpl_frameset_find_const(frames, tag);
1571  f != NULL;
1572  f = cpl_frameset_find_const(frames, NULL)) {
1573 
1574  cpl_frameset_insert(subset, cpl_frame_duplicate(f));
1575  }
1576 
1577  cleanup:
1578  return subset;
1579 }
1580 
1581 /*----------------------------------------------------------------------------*/
1591 /*----------------------------------------------------------------------------*/
1592 double
1593 uves_pow_int(double x, int y)
1594 {
1595  double result = 1.0;
1596 
1597  /* Invariant is: result * x ^ y */
1598 
1599 
1600  while(y != 0)
1601  {
1602  if (y % 2 == 0)
1603  {
1604  x *= x;
1605  y /= 2;
1606  }
1607  else
1608  {
1609  if (y > 0)
1610  {
1611  result *= x;
1612  y -= 1;
1613  }
1614  else
1615  {
1616  result /= x;
1617  y += 1;
1618  }
1619  }
1620  }
1621 
1622  return result;
1623 }
1624 
1625 
1626 
1627 
1628 
1629 
1630 /*----------------------------------------------------------------------------*/
1639 /*----------------------------------------------------------------------------*/
1640 cpl_error_code
1641 uves_get_version(int *major, int *minor, int *micro)
1642 {
1643  /* Macros are defined in config.h */
1644  if (major != NULL) *major = UVES_MAJOR_VERSION;
1645  if (minor != NULL) *minor = UVES_MINOR_VERSION;
1646  if (micro != NULL) *micro = UVES_MICRO_VERSION;
1647 
1648  return cpl_error_get_code();
1649 }
1650 
1651 
1652 /*----------------------------------------------------------------------------*/
1658 /*----------------------------------------------------------------------------*/
1659 int
1661 {
1662  return UVES_BINARY_VERSION;
1663 }
1664 
1665 
1666 /*----------------------------------------------------------------------------*/
1674 /*----------------------------------------------------------------------------*/
1675 const char *
1677 {
1678  return
1679  "This file is part of the ESO UVES Instrument Pipeline\n"
1680  "Copyright (C) 2004,2005,2006 European Southern Observatory\n"
1681  "\n"
1682  "This program is free software; you can redistribute it and/or modify\n"
1683  "it under the terms of the GNU General Public License as published by\n"
1684  "the Free Software Foundation; either version 2 of the License, or\n"
1685  "(at your option) any later version.\n"
1686  "\n"
1687  "This program is distributed in the hope that it will be useful,\n"
1688  "but WITHOUT ANY WARRANTY; without even the implied warranty of\n"
1689  "MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the\n"
1690  "GNU General Public License for more details.\n"
1691  "\n"
1692  "You should have received a copy of the GNU General Public License\n"
1693  "along with this program; if not, write to the Free Software\n"
1694  "Foundation, 51 Franklin St, Fifth Floor, Boston, \n"
1695  "MA 02111-1307 USA" ;
1696 
1697  /* Note that long strings are unsupported in C89 */
1698 }
1699 
1700 /*----------------------------------------------------------------------------*/
1710 /*----------------------------------------------------------------------------*/
1711 /* To change requirements, just edit these numbers */
1712 #define REQ_CPL_MAJOR 3
1713 #define REQ_CPL_MINOR 1
1714 #define REQ_CPL_MICRO 0
1715 
1716 #define REQ_QF_MAJOR 6
1717 #define REQ_QF_MINOR 2
1718 #define REQ_QF_MICRO 0
1719 
1720 void
1721 uves_check_version(void)
1722 {
1723 #ifdef CPL_VERSION_CODE
1724 #if CPL_VERSION_CODE >= CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO)
1725  uves_msg_debug("Compile time CPL version code was %d "
1726  "(version %d-%d-%d, code %d required)",
1727  CPL_VERSION_CODE, REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO,
1728  CPL_VERSION(REQ_CPL_MAJOR, REQ_CPL_MINOR, REQ_CPL_MICRO));
1729 #else
1730 #error CPL version too old
1731 #endif
1732 #else /* ifdef CPL_VERSION_CODE */
1733 #error CPL_VERSION_CODE not defined. CPL version too old
1734 #endif
1735 
1736  if (cpl_version_get_major() < REQ_CPL_MAJOR ||
1737  (cpl_version_get_major() == REQ_CPL_MAJOR &&
1738  (int) cpl_version_get_minor() < REQ_CPL_MINOR) || /* cast suppresses warning
1739  about comparing unsigned < 0 */
1740  (cpl_version_get_major() == REQ_CPL_MAJOR &&
1741  cpl_version_get_minor() == REQ_CPL_MINOR &&
1742  (int) cpl_version_get_micro() < REQ_CPL_MICRO)
1743  )
1744  {
1745  uves_msg_warning("CPL version %s (%d.%d.%d) (detected) is not supported. "
1746  "Please update to CPL version %d.%d.%d or later",
1747  cpl_version_get_version(),
1748  cpl_version_get_major(),
1749  cpl_version_get_minor(),
1750  cpl_version_get_micro(),
1751  REQ_CPL_MAJOR,
1752  REQ_CPL_MINOR,
1753  REQ_CPL_MICRO);
1754  }
1755  else
1756  {
1757  uves_msg_debug("Runtime CPL version %s (%d.%d.%d) detected (%d.%d.%d or later required)",
1758  cpl_version_get_version(),
1759  cpl_version_get_major(),
1760  cpl_version_get_minor(),
1761  cpl_version_get_micro(),
1762  REQ_CPL_MAJOR,
1763  REQ_CPL_MINOR,
1764  REQ_CPL_MICRO);
1765  }
1766 
1767  {
1768  const char *qfts_v = " ";
1769  char *suffix;
1770 
1771  long qfts_major;
1772  long qfts_minor;
1773  long qfts_micro;
1774 
1775  qfts_v = qfits_version();
1776 
1777  assure( qfts_v != NULL, CPL_ERROR_ILLEGAL_INPUT,
1778  "Error reading qfits version");
1779 
1780  /* Parse "X.[...]" */
1781  qfts_major = strtol(qfts_v, &suffix, 10);
1782  assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0',
1783  CPL_ERROR_ILLEGAL_INPUT,
1784  "Error parsing version string '%s'. "
1785  "Format 'X.Y.Z' expected", qfts_v);
1786 
1787  /* Parse "Y.[...]" */
1788  qfts_minor = strtol(suffix+1, &suffix, 10);
1789  assure( suffix != NULL && suffix[0] == '.' && suffix[1] != '\0',
1790  CPL_ERROR_ILLEGAL_INPUT,
1791  "Error parsing version string '%s'. "
1792  "Format 'X.Y.Z' expected", qfts_v);
1793 
1794  /* Parse "Z" */
1795  qfts_micro = strtol(suffix+1, &suffix, 10);
1796 
1797  /* If qfits version is earlier than required ... */
1798  if (qfts_major < REQ_QF_MAJOR ||
1799  (qfts_major == REQ_QF_MAJOR && qfts_minor < REQ_QF_MINOR) ||
1800  (qfts_major == REQ_QF_MAJOR && qfts_minor == REQ_QF_MINOR &&
1801  qfts_micro < REQ_QF_MICRO)
1802  )
1803  {
1804  uves_msg_warning("qfits version %s (detected) is not supported. "
1805  "Please update to qfits version %d.%d.%d or later",
1806  qfts_v,
1807  REQ_QF_MAJOR,
1808  REQ_QF_MINOR,
1809  REQ_QF_MICRO);
1810  }
1811  else
1812  {
1813  uves_msg_debug("qfits version %ld.%ld.%ld detected "
1814  "(%d.%d.%d or later required)",
1815  qfts_major, qfts_minor, qfts_micro,
1816  REQ_QF_MAJOR,
1817  REQ_QF_MINOR,
1818  REQ_QF_MICRO);
1819  }
1820  }
1821 
1822  cleanup:
1823  return;
1824 }
1825 
1826 /*----------------------------------------------------------------------------*/
1838 /*----------------------------------------------------------------------------*/
1839 cpl_error_code
1840 uves_end(const char *recipe_id, const cpl_frameset *frames)
1841 {
1842  cpl_frameset *products = NULL;
1843  const cpl_frame *f;
1844  int warnings = uves_msg_get_warnings();
1845 
1846  recipe_id = recipe_id; /* Suppress warning about unused variable,
1847  perhaps we the recipe_id later, so
1848  keep it in the interface. */
1849 
1850 
1851  /* Print (only) output frames */
1852 
1853  products = cpl_frameset_new();
1854  assure_mem( products );
1855 
1856  for (f = cpl_frameset_get_first_const(frames);
1857  f != NULL;
1858  f = cpl_frameset_get_next_const(frames))
1859  {
1860  if (cpl_frame_get_group(f) == CPL_FRAME_GROUP_PRODUCT)
1861  {
1862  check_nomsg(
1863  cpl_frameset_insert(products, cpl_frame_duplicate(f)));
1864  }
1865  }
1866 
1867 /* Don't do this. EsoRex should.
1868  uves_msg_low("Output frames");
1869  check( uves_print_cpl_frameset(products),
1870  "Could not print output frames");
1871 */
1872 
1873  /* Summarize warnings, if any */
1874  if( warnings > 0)
1875  {
1876  uves_msg_warning("Recipe produced %d warning%s (excluding this one)",
1878  /* Plural? */ (warnings > 1) ? "s" : "");
1879  }
1880 
1881  cleanup:
1882  uves_free_frameset(&products);
1883  return cpl_error_get_code();
1884 }
1885 
1886 /*----------------------------------------------------------------------------*/
1907 /*----------------------------------------------------------------------------*/
1908 char *
1909 uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist,
1910  const char *recipe_id, const char *short_descr)
1911 {
1912  char *recipe_string = NULL;
1913  char *stars = NULL; /* A string of stars */
1914  char *spaces1 = NULL;
1915  char *spaces2 = NULL;
1916  char *spaces3 = NULL;
1917  char *spaces4 = NULL;
1918  char *start_time = NULL;
1919 
1920  start_time = uves_sprintf("%s", uves_get_datetime_iso8601());
1921 
1922  check( uves_check_version(), "Library validation failed");
1923 
1924  /* Now read parameters and set specified message level */
1925  {
1926  const char *plotter_command;
1927  int msglevel;
1928 
1929  /* Read parameters using context = recipe_id */
1930 
1931  if (0) /* disabled */
1932  check( uves_get_parameter(parlist, NULL, "uves", "msginfolevel",
1933  CPL_TYPE_INT, &msglevel),
1934  "Could not read parameter");
1935  else
1936  {
1937  msglevel = -1; /* max verbosity */
1938  }
1939  uves_msg_set_level(msglevel);
1940  check( uves_get_parameter(parlist, NULL, "uves", "plotter",
1941  CPL_TYPE_STRING, &plotter_command), "Could not read parameter");
1942 
1943  /* Initialize plotting */
1944  check( uves_plot_initialize(plotter_command),
1945  "Could not initialize plotting");
1946  }
1947 
1948  /* Print
1949  *************************
1950  *** PACAGE_STRING ***
1951  *** Recipe: recipe_id ***
1952  *************************
1953  */
1954  recipe_string = uves_sprintf("Recipe: %s", recipe_id);
1955  {
1956  int field = uves_max_int(strlen(PACKAGE_STRING), strlen(recipe_string));
1957  int nstars = 3+1 + field + 1+3;
1958  int nspaces1, nspaces2, nspaces3, nspaces4;
1959  int i;
1960 
1961  /* ' ' padding */
1962  nspaces1 = (field - strlen(PACKAGE_STRING)) / 2;
1963  nspaces2 = field - strlen(PACKAGE_STRING) - nspaces1;
1964 
1965  nspaces3 = (field - strlen(recipe_string)) / 2;
1966  nspaces4 = field - strlen(recipe_string) - nspaces3;
1967 
1968  spaces1 = cpl_calloc(nspaces1 + 1, sizeof(char));
1969  spaces2 = cpl_calloc(nspaces2 + 1, sizeof(char));
1970  spaces3 = cpl_calloc(nspaces3 + 1, sizeof(char));
1971  spaces4 = cpl_calloc(nspaces4 + 1, sizeof(char));
1972  for (i = 0; i < nspaces1; i++) spaces1[i] = ' ';
1973  for (i = 0; i < nspaces2; i++) spaces2[i] = ' ';
1974  for (i = 0; i < nspaces3; i++) spaces3[i] = ' ';
1975  for (i = 0; i < nspaces4; i++) spaces4[i] = ' ';
1976 
1977  stars = cpl_calloc(nstars + 1, sizeof(char));
1978  for (i = 0; i < nstars; i++) stars[i] = '*';
1979 
1980  uves_msg("%s", stars);
1981  uves_msg("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
1982  uves_msg("*** %s%s%s ***", spaces3, recipe_string, spaces4);
1983  uves_msg("%s", stars);
1984  }
1985 
1986  uves_msg("This recipe %c%s", tolower(short_descr[0]), short_descr+1);
1987 
1988  if (cpl_frameset_is_empty(frames)) {
1989  uves_msg_debug("Guvf cvcryvar unf ernpurq vgf uvtu dhnyvgl qhr na npgvir "
1990  "hfre pbzzhavgl naq gur erfcbafvoyr naq vqrnyvfgvp jbex bs "
1991  "vaqvivqhny cvcryvar qrirybcref, naq qrfcvgr orvat 'onfrq ba' "
1992  "PCY juvpu vf n cvrpr bs cbyvgvpny penc");
1993  }
1994 
1995  /* Set group (RAW/CALIB) of input frames */
1996  /* This is mandatory for the later call of
1997  cpl_dfs_setup_product_header */
1998  check( uves_dfs_set_groups(frames), "Could not classify input frames");
1999 
2000  /* Print input frames */
2001  uves_msg_low("Input frames");
2002  check( uves_print_cpl_frameset(frames), "Could not print input frames" );
2003 
2004  cleanup:
2005  cpl_free(recipe_string);
2006  cpl_free(stars);
2007  cpl_free(spaces1);
2008  cpl_free(spaces2);
2009  cpl_free(spaces3);
2010  cpl_free(spaces4);
2011  return start_time;
2012 }
2013 
2014 
2015 /*----------------------------------------------------------------------------*/
2043 /*----------------------------------------------------------------------------*/
2044 cpl_image *
2045 uves_average_images(const cpl_image *image1, const cpl_image *noise1,
2046  const cpl_image *image2, const cpl_image *noise2,
2047  cpl_image **noise)
2048 {
2049  cpl_image *result = NULL;
2050  cpl_size nx, ny;
2051  int x, y;
2052 
2053  /* Check input */
2054  assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2055  assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2056  assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2057  assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2058  assure( noise != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2059 
2060  assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
2061  "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
2062  assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
2063  "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
2064 
2065  nx = cpl_image_get_size_x(image1);
2066  ny = cpl_image_get_size_y(image1);
2067 
2068  assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
2069  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2070  nx, cpl_image_get_size_x(image2));
2071  assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
2072  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2073  nx, cpl_image_get_size_x(noise1));
2074  assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
2075  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2076  nx, cpl_image_get_size_x(noise2));
2077  assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
2078  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2079  ny, cpl_image_get_size_y(image2));
2080  assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
2081  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2082  ny, cpl_image_get_size_y(noise1));
2083  assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
2084  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2085  ny, cpl_image_get_size_y(noise2));
2086 
2087  result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
2088  *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
2089 
2090  /* Do the calculation */
2091  for (y = 1; y <= ny; y++)
2092  {
2093  for (x = 1; x <= nx; x++)
2094  {
2095  double flux1, flux2;
2096  double sigma1, sigma2;
2097  int pis_rejected1, noise_rejected1;
2098  int pis_rejected2, noise_rejected2;
2099 
2100  flux1 = cpl_image_get(image1, x, y, &pis_rejected1);
2101  flux2 = cpl_image_get(image2, x, y, &pis_rejected2);
2102  sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
2103  sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);
2104 
2105  pis_rejected1 = pis_rejected1 || noise_rejected1;
2106  pis_rejected2 = pis_rejected2 || noise_rejected2;
2107 
2108  if (pis_rejected1 && pis_rejected2)
2109  {
2110  cpl_image_reject(result, x, y);
2111  cpl_image_reject(*noise, x, y);
2112  }
2113  else
2114  {
2115  /* At least one good pixel */
2116 
2117  double flux, sigma;
2118 
2119  if (pis_rejected1 && !pis_rejected2)
2120  {
2121  flux = flux2;
2122  sigma = sigma2;
2123  }
2124  else if (!pis_rejected1 && pis_rejected2)
2125  {
2126  flux = flux1;
2127  sigma = sigma1;
2128  }
2129  else
2130  {
2131  /* Both pixels are good */
2132  sigma =
2133  1 / (sigma1*sigma1) +
2134  1 / (sigma2*sigma2);
2135 
2136  flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
2137  flux /= sigma;
2138 
2139  sigma = sqrt(sigma);
2140  }
2141 
2142  cpl_image_set(result, x, y, flux);
2143  cpl_image_set(*noise, x, y, sigma);
2144  }
2145  }
2146  }
2147 
2148  cleanup:
2149  if (cpl_error_get_code() != CPL_ERROR_NONE)
2150  {
2151  uves_free_image(&result);
2152  }
2153  return result;
2154 }
2155 
2156 /*----------------------------------------------------------------------------*/
2171 /*----------------------------------------------------------------------------*/
2173 uves_initialize_image_header(const char *ctype1, const char *ctype2,
2174  const char *cunit1, const char *cunit2,
2175  const char *bunit,const double bscale,
2176  double crval1, double crval2,
2177  double crpix1, double crpix2,
2178  double cdelt1, double cdelt2)
2179 {
2180  uves_propertylist *header = NULL; /* Result */
2181 
2182  header = uves_propertylist_new();
2183 
2184  check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
2185  check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
2186  check( uves_pfits_set_cunit1(header, cunit1), "Error writing keyword");
2187  if(cunit2 != NULL) {
2188  check( uves_pfits_set_cunit2(header, cunit2), "Error writing keyword");
2189  }
2190  check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
2191  if(bscale) {
2192  check( uves_pfits_set_bscale (header, bscale ), "Error writing keyword");
2193  }
2194  check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
2195  check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
2196  check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
2197  check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
2198  check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
2199  check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
2200 
2201  cleanup:
2202  return header;
2203 }
2204 
2205 /*----------------------------------------------------------------------------*/
2223 /*----------------------------------------------------------------------------*/
2224 cpl_image *
2225 uves_define_noise(const cpl_image *image,
2226  const uves_propertylist *image_header,
2227  int ncom, enum uves_chip chip)
2228 {
2229  /*
2230  \/ __
2231  \_(__)_...
2232  */
2233 
2234  cpl_image *noise = NULL; /* Result */
2235 
2236  /* cpl_image *in_med = NULL; Median filtered input image */
2237 
2238  double ron; /* Read-out noise in ADU */
2239  double gain;
2240  int nx, ny, i;
2241  double *noise_data;
2242  const double *image_data;
2243  bool has_bnoise=false;
2244  bool has_dnoise=false;
2245  double bnoise=0;
2246  double dnoise=0;
2247  double dtime=0;
2248  double bnoise2=0;
2249  double dnoise2=0;
2250  double exptime=0;
2251  double exptime2=0;
2252  double tot_noise2=0;
2253  double var_bias_dark=0;
2254 
2255  /* Read, check input parameters */
2256  assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
2257 
2258  check( ron = uves_pfits_get_ron_adu(image_header, chip),
2259  "Could not read read-out noise");
2260 
2261  check( gain = uves_pfits_get_gain(image_header, chip),
2262  "Could not read gain factor");
2263  assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);
2264 
2265  nx = cpl_image_get_size_x(image);
2266  ny = cpl_image_get_size_y(image);
2267 
2268  /* For efficiency reasons, use pointers to image data buffers */
2269  assure(cpl_image_count_rejected(image) == 0,
2270  CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
2271  assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
2272  CPL_ERROR_UNSUPPORTED_MODE,
2273  "Input image is of type %s. double expected",
2274  uves_tostring_cpl_type(cpl_image_get_type(image)));
2275 
2276  noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
2277  assure_mem( noise );
2278 
2279  noise_data = cpl_image_get_data_double(noise);
2280 
2281  image_data = cpl_image_get_data_double_const(image);
2282 
2283 
2284  if(image_header != NULL) {
2285  has_bnoise=uves_propertylist_contains(image_header,UVES_BNOISE);
2286  has_dnoise=uves_propertylist_contains(image_header,UVES_DNOISE);
2287  }
2288 
2289  if(has_bnoise) {
2290  bnoise=uves_propertylist_get_double(image_header,UVES_BNOISE);
2291  bnoise2=bnoise*bnoise;
2292  }
2293 
2294  if(has_dnoise) {
2295  dnoise=uves_propertylist_get_double(image_header,UVES_DNOISE);
2296  dnoise2=dnoise*dnoise;
2297  dtime=uves_propertylist_get_double(image_header,UVES_DTIME);
2298  exptime=uves_pfits_get_exptime(image_header);
2299  exptime2=exptime*exptime/dtime/dtime;
2300  }
2301  var_bias_dark=bnoise2+dnoise2*exptime2;
2302  uves_msg_debug("bnoise=%g dnoise=%g sci exptime=%g dark exptime=%g",
2303  bnoise,dnoise,exptime,dtime);
2304 
2305  /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */
2306 
2307  /* This filter is disabled, as there is often structure on the scale
2308  of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
2309  structure *does* result in worse fits to the data.
2310 
2311  in_med = cpl_image_duplicate(image);
2312  assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
2313 
2314  uves_msg_low("Applying 3x3 median filter");
2315 
2316  check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
2317  image_data = cpl_image_get_data_double(in_med);
2318 
2319  uves_msg_low("Setting pixel flux uncertainty");
2320  */
2321 
2322  /* We assume median stacked input (master flat, master dark, ...) */
2323  double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
2324  double gain2=gain*gain;
2325 
2326  double quant_var = uves_max_double(0, (1 - gain2)/12.0);
2327  /* Quant. error =
2328  * sqrt((g^2-1)/12)
2329  */
2330  double flux_var_adu=0;
2331  double ron2=ron*ron;
2332  double inv_ncom_median_factor=1./(ncom * median_factor);
2333  for (i = 0; i < nx*ny; i++)
2334  {
2335 
2336  /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
2337  /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
2338  flux_var_adu = uves_max_double(image_data[i],0)*gain;
2339 
2340  /* For a number, N, of averaged or median stacked "identical" frames
2341  * (gaussian distribution assumed), the combined noise is
2342  *
2343  * sigma_N = sigma / sqrt(N*f)
2344  *
2345  * where (to a good approximation)
2346  * f ~= { 1 , N = 1
2347  * { 2/pi , N > 1
2348  *
2349  * (i.e. the resulting uncertainty is
2350  * larger than for average stacked inputs where f = 1)
2351  */
2352 
2353  /* Slow: cpl_image_set(noise, x, y, ... ); */
2354  /* Slow: noise_data[(x-1) + (y-1)*nx] =
2355  sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
2356  ((MIDAS) ? 1 : ncom * median_factor)); */
2357 
2358 
2359  tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor)+
2360  var_bias_dark;
2361 
2362  /*
2363  tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor);
2364  */
2365  noise_data[i] = sqrt(tot_noise2);
2366  }
2367 
2368  cleanup:
2369  /* uves_free_image(&in_med); */
2370  if (cpl_error_get_code() != CPL_ERROR_NONE)
2371  {
2372  uves_free_image(&noise);
2373  }
2374 
2375  return noise;
2376 }
2377 
2378 
2379 /*----------------------------------------------------------------------------*/
2389 /*----------------------------------------------------------------------------*/
2390 cpl_error_code
2391 uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
2392 {
2393  passure ( image != NULL, " ");
2394  passure ( master_bias != NULL, " ");
2395 
2396  check( cpl_image_subtract(image, master_bias),
2397  "Error subtracting bias");
2398 
2399  /* Due to different bad column correction in image/master_bias,
2400  it might happen that the image has become negative after
2401  subtracting the bias. Disallow that. */
2402 
2403 #if 0
2404  /* No, for backwards compatibility, allow negative values.
2405  * MIDAS has an inconsistent logic on this matter.
2406  * For master dark frames, the thresholding *is* applied,
2407  * but not for science frames. Therefore we have to
2408  * apply thresholding on a case-by-case base (i.e. from
2409  * the caller).
2410  */
2411  check( cpl_image_threshold(image,
2412  0, DBL_MAX, /* Interval */
2413  0, DBL_MAX), /* New values */
2414  "Error thresholding image");
2415 #endif
2416 
2417  cleanup:
2418  return cpl_error_get_code();
2419 }
2420 /*----------------------------------------------------------------------------*/
2433 /*----------------------------------------------------------------------------*/
2434 cpl_error_code
2435 uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
2436  const cpl_image *master_dark,
2437  const uves_propertylist *mdark_header)
2438 {
2439  cpl_image *normalized_mdark = NULL;
2440  double image_exptime = 0.0;
2441  double mdark_exptime = 0.0;
2442 
2443  passure ( image != NULL, " ");
2444  passure ( image_header != NULL, " ");
2445  passure ( master_dark != NULL, " ");
2446  passure ( mdark_header != NULL, " ");
2447 
2448  /* Normalize mdark to same exposure time as input image, then subtract*/
2449  check( image_exptime = uves_pfits_get_exptime(image_header),
2450  "Error reading input image exposure time");
2451  check( mdark_exptime = uves_pfits_get_exptime(mdark_header),
2452  "Error reading master dark exposure time");
2453 
2454  uves_msg("Rescaling master dark from %f s to %f s exposure time",
2455  mdark_exptime, image_exptime);
2456 
2457  check( normalized_mdark =
2458  cpl_image_multiply_scalar_create(master_dark,
2459  image_exptime / mdark_exptime),
2460  "Error normalizing master dark");
2461 
2462  check( cpl_image_subtract(image, normalized_mdark),
2463  "Error subtracting master dark");
2464 
2465  uves_msg_warning("noise rescaled master dark %g",cpl_image_get_stdev(normalized_mdark));
2466 
2467 
2468  cleanup:
2469  uves_free_image(&normalized_mdark);
2470  return cpl_error_get_code();
2471 }
2472 
2473 /*----------------------------------------------------------------------------*/
2487 /*----------------------------------------------------------------------------*/
2488 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
2489 {
2490  return (first_abs_order +
2491  (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
2492 }
2493 
2494 /*----------------------------------------------------------------------------*/
2508 /*----------------------------------------------------------------------------*/
2509 double
2510 uves_average_reject(cpl_table *t,
2511  const char *column,
2512  const char *residual2,
2513  double kappa)
2514 {
2515  double mean = 0, median, sigma2;
2516  int rejected;
2517 
2518  do {
2519  /* Robust estimation */
2520  check_nomsg(median = cpl_table_get_column_median(t, column));
2521 
2522  /* Create column
2523  residual2 = (column - median)^2 */
2524  check_nomsg(cpl_table_duplicate_column(t, residual2, t, column));
2525  check_nomsg(cpl_table_subtract_scalar(t, residual2, median));
2526  check_nomsg(cpl_table_multiply_columns(t, residual2, residual2));
2527 
2528  /* For a Gaussian distribution:
2529  * sigma ~= median(|residual|) / 0.6744
2530  * sigma^2 ~= median(residual^2) / 0.6744^2
2531  */
2532 
2533  check_nomsg(sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744));
2534 
2535  /* Reject values where
2536  residual^2 > (kappa*sigma)^2
2537  */
2538  check_nomsg( rejected = uves_erase_table_rows(t, residual2,
2539  CPL_GREATER_THAN,
2540  kappa*kappa*sigma2));
2541 
2542  check_nomsg(cpl_table_erase_column(t, residual2));
2543 
2544  } while (rejected > 0);
2545 
2546  check_nomsg(mean = cpl_table_get_column_mean(t, column));
2547 
2548  cleanup:
2549  return mean;
2550 }
2551 
2552 /*----------------------------------------------------------------------------*/
2585 /*----------------------------------------------------------------------------*/
2586 polynomial *
2588  const char *X, const char *Y, const char *sigmaY,
2589  int degree,
2590  const char *polynomial_fit, const char *residual_square,
2591  double *mean_squared_error, double kappa)
2592 {
2593  int N;
2594  int total_rejected = 0; /* Rejected in kappa sigma clipping */
2595  int rejected = 0;
2596  double mse; /* local mean squared error */
2597  double *x;
2598  double *y;
2599  double *sy;
2600  polynomial *result = NULL;
2601  cpl_vector *vx = NULL;
2602  cpl_vector *vy = NULL;
2603  cpl_vector *vsy = NULL;
2604  cpl_type type;
2605 
2606  /* Check input */
2607  assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
2608  assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
2609  assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
2610  assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
2611  assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
2612  assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
2613  "No such column: %s", sigmaY);
2614 
2615  assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
2616  CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
2617 
2618  assure( residual_square == NULL || !cpl_table_has_column(t, residual_square),
2619  CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
2620 
2621  /* Check column types */
2622  type = cpl_table_get_column_type(t, Y);
2623  assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
2624  "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
2625  type = cpl_table_get_column_type(t, X);
2626  assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
2627  "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
2628  if (sigmaY != NULL)
2629  {
2630  type = cpl_table_get_column_type(t, sigmaY);
2631  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
2632  CPL_ERROR_INVALID_TYPE,
2633  "Input column '%s' has wrong type (%s)",
2634  sigmaY, uves_tostring_cpl_type(type));
2635  }
2636 
2637  check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
2638  "Could not cast table column '%s' to double", X);
2639  check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
2640  "Could not cast table column '%s' to double", Y);
2641  if (sigmaY != NULL)
2642  {
2643  check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE),
2644  "Could not cast table column '%s' to double", sigmaY);
2645  }
2646 
2647 
2648  total_rejected = 0;
2649  rejected = 0;
2650  check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE),
2651  "Could not create column");
2652  do{
2653  check( (N = cpl_table_get_nrow(t),
2654  x = cpl_table_get_data_double(t, "_X_double"),
2655  y = cpl_table_get_data_double(t, "_Y_double")),
2656  "Could not read table data");
2657 
2658  if (sigmaY != NULL)
2659  {
2660  check( sy = cpl_table_get_data_double(t, "_sY_double"),
2661  "Could not read table data");
2662  }
2663  else
2664  {
2665  sy = NULL;
2666  }
2667 
2668  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table. "
2669  "No points to fit in poly 1d regression. At least 2 needed");
2670 
2671  assure( N > degree, CPL_ERROR_ILLEGAL_INPUT, "%d points to fit in poly 1d "
2672  "regression of degree %d. At least %d needed.",
2673  N,degree,degree+1);
2674 
2675  /* Wrap vectors */
2676  uves_unwrap_vector(&vx);
2677  uves_unwrap_vector(&vy);
2678 
2679  vx = cpl_vector_wrap(N, x);
2680  vy = cpl_vector_wrap(N, y);
2681 
2682  if (sy != NULL)
2683  {
2684  uves_unwrap_vector(&vsy);
2685  vsy = cpl_vector_wrap(N, sy);
2686  }
2687  else
2688  {
2689  vsy = NULL;
2690  }
2691 
2692  /* Fit! */
2693  uves_polynomial_delete(&result);
2694  check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse),
2695  "Could not fit polynomial");
2696 
2697  /* If requested, calculate residuals and perform kappa-sigma clipping */
2698  if (kappa > 0)
2699  {
2700  double sigma2; /* sigma squared */
2701  int i;
2702 
2703  for (i = 0; i < N; i++)
2704  {
2705  double xval, yval, yfit;
2706 
2707  check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
2708  yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
2709  yfit = uves_polynomial_evaluate_1d(result, xval),
2710 
2711  cpl_table_set_double(t, "_residual_square", i,
2712  (yfit-yval)*(yfit-yval))),
2713  "Could not evaluate polynomial");
2714  }
2715 
2716  /* For robustness, estimate sigma as (third quartile) / 0.6744
2717  * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
2718  * The third quartile is estimated as the median of the absolute residuals,
2719  * so sigma ~= median(|residual|) / 0.6744 , i.e.
2720  * sigma^2 ~= median(residual^2) / 0.6744^2
2721  */
2722  sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
2723 
2724  /* Remove points with residual^2 > kappa^2 * sigma^2 */
2725  check( rejected = uves_erase_table_rows(t, "_residual_square",
2726  CPL_GREATER_THAN, kappa*kappa*sigma2),
2727  "Could not remove outlier points");
2728 
2729  uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
2730  rejected, N, sqrt(mse));
2731 
2732  /* Update */
2733  total_rejected += rejected;
2734  N = cpl_table_get_nrow(t);
2735  }
2736 
2737 } while (rejected > 0);
2738 
2739  cpl_table_erase_column(t, "_residual_square");
2740 
2741  if (kappa > 0)
2742  {
2743  uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
2744  total_rejected,
2745  N + total_rejected,
2746  (100.0*total_rejected)/(N + total_rejected)
2747  );
2748  }
2749 
2750  if (mean_squared_error != NULL) *mean_squared_error = mse;
2751 
2752  /* Add the fitted values to table if requested */
2753  if (polynomial_fit != NULL || residual_square != NULL)
2754  {
2755  int i;
2756 
2757  check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE),
2758  "Could not create column");
2759  for (i = 0; i < N; i++){
2760  double xval;
2761  double yfit;
2762 
2763  check((
2764  xval = cpl_table_get_double(t, "_X_double", i, NULL),
2765  yfit = uves_polynomial_evaluate_1d(result, xval),
2766  cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
2767  "Could not evaluate polynomial");
2768  }
2769 
2770  /* Add residual^2 = (Polynomial fit - Y)^2 if requested */
2771  if (residual_square != NULL)
2772  {
2773  check(( cpl_table_duplicate_column(t, residual_square, /* RS := PF */
2774  t, "_polynomial_fit"),
2775  cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
2776  cpl_table_multiply_columns(t, residual_square, residual_square)),
2777  /* RS := RS^2 */
2778  "Could not calculate Residual of fit");
2779  }
2780 
2781  /* Keep the polynomial_fit column if requested */
2782  if (polynomial_fit != NULL)
2783  {
2784  cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
2785  }
2786  else
2787  {
2788  cpl_table_erase_column(t, "_polynomial_fit");
2789  }
2790  }
2791 
2792  check(( cpl_table_erase_column(t, "_X_double"),
2793  cpl_table_erase_column(t, "_Y_double")),
2794  "Could not delete temporary columns");
2795 
2796  if (sigmaY != NULL)
2797  {
2798  check( cpl_table_erase_column(t, "_sY_double"),
2799  "Could not delete temporary column");
2800  }
2801 
2802  cleanup:
2803  uves_unwrap_vector(&vx);
2804  uves_unwrap_vector(&vy);
2805  uves_unwrap_vector(&vsy);
2806  if (cpl_error_get_code() != CPL_ERROR_NONE)
2807  {
2808  uves_polynomial_delete(&result);
2809  }
2810 
2811  return result;
2812 }
2813 
2814 
2815 /*----------------------------------------------------------------------------*/
2863 /*----------------------------------------------------------------------------*/
2864 
2865 polynomial *
2867  const char *X1, const char *X2, const char *Y,
2868  const char *sigmaY,
2869  int degree1, int degree2,
2870  const char *polynomial_fit, const char *residual_square,
2871  const char *variance_fit,
2872  double *mse, double *red_chisq,
2873  polynomial **variance, double kappa,
2874  double min_reject)
2875 {
2876  int N;
2877  int rejected;
2878  int total_rejected;
2879  double *x1;
2880  double *x2;
2881  double *y;
2882  double *res;
2883  double *sy;
2884  polynomial *p = NULL; /* Result */
2885  polynomial *variance_local = NULL;
2886  cpl_vector *vx1 = NULL;
2887  cpl_vector *vx2 = NULL;
2888  cpl_bivector *vx = NULL;
2889  cpl_vector *vy = NULL;
2890  cpl_vector *vsy= NULL;
2891  cpl_type type;
2892 
2893  /* Check input */
2894  assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
2895  N = cpl_table_get_nrow(t);
2896  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "The table with column to compute regression has 0 rows!");
2897  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);
2898 
2899  assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
2900  assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
2901  assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
2902  assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
2903  CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
2904  if (sigmaY != NULL)
2905  {
2906  assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
2907  "No such column: %s", sigmaY);
2908  }
2909  if (polynomial_fit != NULL)
2910  {
2911  assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
2912  "Table already has '%s' column", polynomial_fit);
2913  }
2914  if (residual_square != NULL)
2915  {
2916  assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT,
2917  "Table already has '%s' column", residual_square);
2918  }
2919  if (variance_fit != NULL)
2920  {
2921  assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
2922  "Table already has '%s' column", variance_fit);
2923  }
2924 
2925  /* Check column types */
2926  type = cpl_table_get_column_type(t, X1);
2927  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2928  "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
2929  type = cpl_table_get_column_type(t, X2);
2930  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2931  "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
2932  type = cpl_table_get_column_type(t, Y);
2933  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2934  "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
2935  if (sigmaY != NULL)
2936  {
2937  type = cpl_table_get_column_type(t, sigmaY);
2938  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2939  "Input column '%s' has wrong type (%s)",
2940  sigmaY, uves_tostring_cpl_type(type));
2941  }
2942 
2943  /* In the case that these temporary columns already exist, a run-time error will occur */
2944  check( cpl_table_cast_column(t, X1 , "_X1_double", CPL_TYPE_DOUBLE),
2945  "Could not cast table column to double");
2946  check( cpl_table_cast_column(t, X2 , "_X2_double", CPL_TYPE_DOUBLE),
2947  "Could not cast table column to double");
2948  check( cpl_table_cast_column(t, Y , "_Y_double", CPL_TYPE_DOUBLE),
2949  "Could not cast table column to double");
2950  if (sigmaY != NULL)
2951  {
2952  check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE),
2953  "Could not cast table column to double");
2954  }
2955 
2956  total_rejected = 0;
2957  rejected = 0;
2958  check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE),
2959  "Could not create column");
2960 
2961  do {
2962  /* WARNING!!! Code duplication (see below). Be careful
2963  when updating */
2964  check(( N = cpl_table_get_nrow(t),
2965  x1 = cpl_table_get_data_double(t, "_X1_double"),
2966  x2 = cpl_table_get_data_double(t, "_X2_double"),
2967  y = cpl_table_get_data_double(t, "_Y_double"),
2968  res= cpl_table_get_data_double(t, "_residual_square")),
2969  "Could not read table data");
2970 
2971  if (sigmaY != NULL)
2972  {
2973  check (sy = cpl_table_get_data_double(t, "_sY_double"),
2974  "Could not read table data");
2975  }
2976  else
2977  {
2978  sy = NULL;
2979  }
2980 
2981  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
2982 
2983  /* Wrap vectors */
2984  uves_unwrap_vector(&vx1);
2985  uves_unwrap_vector(&vx2);
2986  uves_unwrap_vector(&vy);
2987 
2988  vx1 = cpl_vector_wrap(N, x1);
2989  vx2 = cpl_vector_wrap(N, x2);
2990  vy = cpl_vector_wrap(N, y);
2991  if (sy != NULL)
2992  {
2993  uves_unwrap_vector(&vsy);
2994  vsy = cpl_vector_wrap(N, sy);
2995  }
2996  else
2997  {
2998  vsy = NULL;
2999  }
3000 
3001  /* Wrap up the bi-vector */
3002  uves_unwrap_bivector_vectors(&vx);
3003  vx = cpl_bivector_wrap_vectors(vx1, vx2);
3004 
3005  /* Fit! */
3007  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3008  NULL, NULL, NULL),
3009  "Could not fit polynomial");
3010 
3011  /* If requested, calculate residuals and perform kappa-sigma clipping */
3012  if (kappa > 0)
3013  {
3014  double sigma2; /* sigma squared */
3015  int i;
3016 
3017  cpl_table_fill_column_window_double(t, "_residual_square", 0,
3018  cpl_table_get_nrow(t), 0.0);
3019 
3020  for (i = 0; i < N; i++)
3021  {
3022  double yval, yfit;
3023 
3024  yval = y[i];
3025  yfit = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
3026  res[i] = (yfit-y[i])*(yfit-y[i]);
3027  }
3028 
3029  /* For robustness, estimate sigma as (third quartile) / 0.6744
3030  * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
3031  * The third quartile is estimated as the median of the absolute residuals,
3032  * so sigma ~= median(|residual|) / 0.6744 , i.e.
3033  * sigma^2 ~= median(residual^2) / 0.6744^2
3034  */
3035  sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
3036 
3037 
3038  /* Remove points with residual^2 > kappa^2 * sigma^2 */
3039  check( rejected = uves_erase_table_rows(t, "_residual_square",
3040  CPL_GREATER_THAN, kappa*kappa*sigma2),
3041  "Could not remove outlier points");
3042  /* Note! All pointers to table data are now invalid! */
3043 
3044 
3045  uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
3046  rejected, N, sqrt(sigma2));
3047 
3048  /* Update */
3049  total_rejected += rejected;
3050  N = cpl_table_get_nrow(t);
3051  }
3052 
3053  /* Stop also if there are too few points left to make the fit.
3054  * Needed number of points = (degree1+1)(degree2+1) coefficients
3055  * plus one extra point for chi^2 computation. */
3056  } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
3057  N >= (degree1 + 1)*(degree2 + 1) + 1);
3058 
3059  if (kappa > 0)
3060  {
3061  uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
3062  total_rejected,
3063  N + total_rejected,
3064  (100.0*total_rejected)/(N + total_rejected)
3065  );
3066  }
3067 
3068  /* Final fit */
3069  {
3070  /* Need to convert to vector again. */
3071 
3072  /* WARNING!!! Code duplication (see above). Be careful
3073  when updating */
3074  check(( N = cpl_table_get_nrow(t),
3075  x1 = cpl_table_get_data_double(t, "_X1_double"),
3076  x2 = cpl_table_get_data_double(t, "_X2_double"),
3077  y = cpl_table_get_data_double(t, "_Y_double"),
3078  res= cpl_table_get_data_double(t, "_residual_square")),
3079  "Could not read table data");
3080 
3081  if (sigmaY != NULL)
3082  {
3083  check (sy = cpl_table_get_data_double(t, "_sY_double"),
3084  "Could not read table data");
3085  }
3086  else
3087  {
3088  sy = NULL;
3089  }
3090 
3091  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
3092 
3093  /* Wrap vectors */
3094  uves_unwrap_vector(&vx1);
3095  uves_unwrap_vector(&vx2);
3096  uves_unwrap_vector(&vy);
3097 
3098  vx1 = cpl_vector_wrap(N, x1);
3099  vx2 = cpl_vector_wrap(N, x2);
3100  vy = cpl_vector_wrap(N, y);
3101  if (sy != NULL)
3102  {
3103  uves_unwrap_vector(&vsy);
3104  vsy = cpl_vector_wrap(N, sy);
3105  }
3106  else
3107  {
3108  vsy = NULL;
3109  }
3110 
3111  /* Wrap up the bi-vector */
3112  uves_unwrap_bivector_vectors(&vx);
3113  vx = cpl_bivector_wrap_vectors(vx1, vx2);
3114  }
3115 
3117  if (variance_fit != NULL || variance != NULL)
3118  {
3119  /* If requested, also compute variance */
3120  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3121  mse, red_chisq, &variance_local),
3122  "Could not fit polynomial");
3123  }
3124  else
3125  {
3126  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3127  mse, red_chisq, NULL),
3128  "Could not fit polynomial");
3129  }
3130 
3131  cpl_table_erase_column(t, "_residual_square");
3132 
3133  /* Add the fitted values to table as requested */
3134  if (polynomial_fit != NULL || residual_square != NULL)
3135  {
3136  int i;
3137  double *pf;
3138 
3139  check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE),
3140  "Could not create column");
3141 
3142  cpl_table_fill_column_window_double(t, "_polynomial_fit", 0,
3143  cpl_table_get_nrow(t), 0.0);
3144 
3145  x1 = cpl_table_get_data_double(t, "_X1_double");
3146  x2 = cpl_table_get_data_double(t, "_X2_double");
3147  pf = cpl_table_get_data_double(t, "_polynomial_fit");
3148 
3149  for (i = 0; i < N; i++){
3150 #if 0
3151  double x1val, x2val, yfit;
3152 
3153  check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
3154  x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
3155  yfit = uves_polynomial_evaluate_2d(p, x1val, x2val),
3156 
3157  cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
3158  "Could not evaluate polynomial");
3159 
3160 #else
3161  pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
3162 #endif
3163  }
3164 
3165  /* Add residual^2 = (Polynomial fit - Y)^2 if requested */
3166  if (residual_square != NULL)
3167  {
3168  check(( cpl_table_duplicate_column(t, residual_square, /* RS := PF */
3169  t, "_polynomial_fit"),
3170  cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
3171  cpl_table_multiply_columns(t, residual_square, residual_square)),
3172  /* RS := RS^2 */
3173  "Could not calculate Residual of fit");
3174  }
3175 
3176  /* Keep the polynomial_fit column if requested */
3177  if (polynomial_fit != NULL)
3178  {
3179  cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
3180  }
3181  else
3182  {
3183  cpl_table_erase_column(t, "_polynomial_fit");
3184  }
3185  }
3186 
3187  /* Add variance of poly_fit if requested */
3188  if (variance_fit != NULL)
3189  {
3190  int i;
3191  double *vf;
3192 
3193  check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE),
3194  "Could not create column");
3195 
3196  cpl_table_fill_column_window_double(t, variance_fit, 0,
3197  cpl_table_get_nrow(t), 0.0);
3198 
3199  x1 = cpl_table_get_data_double(t, "_X1_double");
3200  x2 = cpl_table_get_data_double(t, "_X2_double");
3201  vf = cpl_table_get_data_double(t, variance_fit);
3202 
3203  for (i = 0; i < N; i++)
3204  {
3205 #if 0
3206  double x1val, x2val, yfit_variance;
3207  check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
3208  x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
3209  yfit_variance = uves_polynomial_evaluate_2d(variance_local,
3210  x1val, x2val),
3211 
3212  cpl_table_set_double(t, variance_fit, i, yfit_variance)),
3213  "Could not evaluate polynomial");
3214 #else
3215  vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
3216 #endif
3217 
3218  }
3219  }
3220 
3221 
3222  check(( cpl_table_erase_column(t, "_X1_double"),
3223  cpl_table_erase_column(t, "_X2_double"),
3224  cpl_table_erase_column(t, "_Y_double")),
3225  "Could not delete temporary columns");
3226 
3227  if (sigmaY != NULL)
3228  {
3229  check( cpl_table_erase_column(t, "_sY_double"),
3230  "Could not delete temporary column");
3231  }
3232 
3233  cleanup:
3234  uves_unwrap_bivector_vectors(&vx);
3235  uves_unwrap_vector(&vx1);
3236  uves_unwrap_vector(&vx2);
3237  uves_unwrap_vector(&vy);
3238  uves_unwrap_vector(&vsy);
3239  /* Delete 'variance_local', or return through 'variance' parameter */
3240  if (variance != NULL)
3241  {
3242  *variance = variance_local;
3243  }
3244  else
3245  {
3246  uves_polynomial_delete(&variance_local);
3247  }
3248  if (cpl_error_get_code() != CPL_ERROR_NONE)
3249  {
3251  }
3252 
3253  return p;
3254 }
3255 
3256 /*----------------------------------------------------------------------------*/
3299 /*----------------------------------------------------------------------------*/
3300 
3301 polynomial *
3303  const char *X1, const char *X2, const char *Y,
3304  const char *sigmaY,
3305  const char *polynomial_fit,
3306  const char *residual_square,
3307  const char *variance_fit,
3308  double *mean_squared_error, double *red_chisq,
3309  polynomial **variance, double kappa,
3310  int maxdeg1, int maxdeg2, double min_rms,
3311  double min_reject,
3312  bool verbose,
3313  const double *min_val,
3314  const double *max_val,
3315  int npos, double positions[][2])
3316 {
3317  int deg1 = 0; /* Current degrees */
3318  int deg2 = 0; /* Current degrees */
3319  int i;
3320 
3321  double **mse = NULL;
3322  bool adjust1 = true; /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
3323  bool adjust2 = true; /* (or held constant) */
3324  bool finished = false;
3325 
3326  const char *y_unit;
3327  cpl_table *temp = NULL;
3328  polynomial *bivariate_fit = NULL; /* Result */
3329 
3330  assure( (min_val == NULL && max_val == NULL) || positions != NULL,
3331  CPL_ERROR_NULL_INPUT,
3332  "Missing positions array");
3333 
3334  check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
3335  if (y_unit == NULL)
3336  {
3337  y_unit = "";
3338  }
3339 
3340  assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT,
3341  "Illegal max. degrees: (%d, %d)",
3342  maxdeg1, maxdeg2);
3343 
3344  mse = cpl_calloc(maxdeg1+1, sizeof(double *));
3345  assure_mem(mse);
3346  for (i = 0; i < maxdeg1+1; i++)
3347  {
3348  int j;
3349  mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
3350  assure_mem(mse);
3351 
3352  for (j = 0; j < maxdeg2+1; j++)
3353  {
3354  mse[i][j] = -1;
3355  }
3356  }
3357 
3358  temp = cpl_table_duplicate(t);
3359  assure_mem(temp);
3360 
3361  uves_polynomial_delete(&bivariate_fit);
3362  check( bivariate_fit = uves_polynomial_regression_2d(temp,
3363  X1, X2, Y, sigmaY,
3364  deg1,
3365  deg2,
3366  NULL, NULL, NULL, /* new columns */
3367  &mse[deg1][deg2], NULL, /* chi^2/N */
3368  NULL, /* variance pol.*/
3369  kappa, min_reject),
3370  "Error fitting polynomial");
3371  if (verbose)
3372  uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
3373  deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
3374  cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
3375  cpl_table_get_nrow(t));
3376  else
3377  uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
3378  deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
3379  cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
3380  cpl_table_get_nrow(t));
3381  /* Find best values of deg1, deg2 less than or equal to 8,8
3382  (the fitting algorithm is unstable after this point, anyway) */
3383  do
3384  {
3385  int new_deg1, new_deg2;
3386  double m;
3387 
3388  finished = true;
3389 
3390  adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
3391  adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
3392 
3393  /* Try the new degrees
3394 
3395  (d1+1, d2 ) (d1+2, d2)
3396  (d1, d2+1) (d1+1, d2+1)
3397  (d1, d2+2)
3398 
3399  in the following order:
3400 
3401  1 3
3402  1 2
3403  3
3404 
3405  (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
3406  */
3407  for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
3408  for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
3409  if ( (
3410  (new_deg1 == deg1+1 && new_deg2 == deg2 && adjust1) ||
3411  (new_deg1 == deg1+2 && new_deg2 == deg2 && adjust1) ||
3412  (new_deg1 == deg1 && new_deg2 == deg2+1 && adjust2) ||
3413  (new_deg1 == deg1 && new_deg2 == deg2+2 && adjust2) ||
3414  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
3415  )
3416  && mse[new_deg1][new_deg2] < 0)
3417  {
3418  int rejected = 0;
3419 
3420  uves_free_table(&temp);
3421  temp = cpl_table_duplicate(t);
3422  assure_mem(temp);
3423 
3424  uves_polynomial_delete(&bivariate_fit);
3425  bivariate_fit = uves_polynomial_regression_2d(temp,
3426  X1, X2, Y, sigmaY,
3427  new_deg1,
3428  new_deg2,
3429  NULL, NULL, NULL,
3430  &(mse[new_deg1]
3431  [new_deg2]),
3432  NULL,
3433  NULL,
3434  kappa, min_reject);
3435 
3436  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
3437  {
3438  uves_error_reset();
3439 
3440  if (verbose)
3441  uves_msg_low("(%d, %d)-degree: Singular matrix",
3442  new_deg1, new_deg2);
3443  else
3444  uves_msg_debug("(%d, %d)-degree: Singular matrix",
3445  new_deg1, new_deg2);
3446 
3447  mse[new_deg1][new_deg2] = DBL_MAX/2;
3448  }
3449  else
3450  {
3451  assure( cpl_error_get_code() == CPL_ERROR_NONE,
3452  cpl_error_get_code(),
3453  "Error fitting (%d, %d)-degree polynomial",
3454  new_deg1, new_deg2 );
3455 
3456  rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
3457 
3458  if (verbose)
3459  uves_msg_low("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
3460  new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
3461  rejected, cpl_table_get_nrow(t));
3462  else
3463  uves_msg_debug("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
3464  new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
3465  rejected, cpl_table_get_nrow(t));
3466 
3467  /* Reject if fit produced bad values */
3468  if (min_val != NULL || max_val != NULL)
3469  {
3470  for (i = 0; i < npos; i++)
3471  {
3472  double val = uves_polynomial_evaluate_2d(
3473  bivariate_fit,
3474  positions[i][0], positions[i][1]);
3475  if (min_val != NULL && val < *min_val)
3476  {
3477  uves_msg_debug("Bad fit: %f < %f",
3478  val,
3479  *min_val);
3480  mse[new_deg1][new_deg2] = DBL_MAX/2;
3481  /* A large number, even if we add a bit */
3482  }
3483  if (max_val != NULL && val > *max_val)
3484  {
3485  uves_msg_debug("Bad fit: %f > %f",
3486  val,
3487  *max_val);
3488  mse[new_deg1][new_deg2] = DBL_MAX/2;
3489  }
3490  }
3491  }
3492 
3493  /* For robustness, make sure that we don't accept a solution that
3494  rejected too many points (say, 80%)
3495  */
3496  if (rejected >= (4*cpl_table_get_nrow(t))/5)
3497  {
3498  mse[new_deg1][new_deg2] = DBL_MAX/2;
3499  }
3500 
3501  }/* if fit succeeded */
3502  }
3503 
3504  /* If fit is significantly better (say, 10% improvement in MSE) in either direction,
3505  * (in (degree,degree)-space) then move in that direction.
3506  *
3507  * First try to move one step horizontal/vertical,
3508  * otherwise try to move diagonally (i.e. increase both degrees),
3509  * otherwise move two steps horizontal/vertical
3510  *
3511  */
3512  m = mse[deg1][deg2];
3513 
3514  if (adjust1
3515  && (m - mse[deg1+1][deg2])/m > 0.1
3516  && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
3517  /* The condition is read like this:
3518  if
3519  - we are trying to move right, and
3520  - this is this is a better place than the current, and
3521  - this is better than moving down */
3522  )
3523  {
3524  deg1++;
3525  finished = false;
3526  }
3527  else if (adjust2 &&
3528  (m - mse[deg1][deg2+1])/m > 0.1
3529  && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
3530  )
3531  {
3532  deg2++;
3533  finished = false;
3534  }
3535  else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
3536  {
3537  deg1++;
3538  deg2++;
3539  finished = false;
3540  }
3541  else if (adjust1
3542  && (m - mse[deg1+2][deg2])/m > 0.1
3543  && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
3544  )
3545  {
3546  deg1 += 2;
3547  finished = false;
3548  }
3549  else if (adjust2
3550  && (m - mse[deg1][deg2+2])/m > 0.1
3551  && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
3552  {
3553  deg2 += 2;
3554  finished = false;
3555  }
3556 
3557  /* For efficiency, stop if rms reached min_rms */
3558  finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
3559 
3560  } while (!finished);
3561 
3562  uves_polynomial_delete(&bivariate_fit);
3563  check( bivariate_fit = uves_polynomial_regression_2d(t,
3564  X1, X2, Y, sigmaY,
3565  deg1,
3566  deg2,
3567  polynomial_fit, residual_square,
3568  variance_fit,
3569  mean_squared_error, red_chisq,
3570  variance, kappa, min_reject),
3571  "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
3572 
3573  if (verbose)
3574  uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2,
3575  sqrt(mse[deg1][deg2]), y_unit);
3576  else
3577  uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2,
3578  sqrt(mse[deg1][deg2]), y_unit);
3579 
3580  cleanup:
3581  if (mse != NULL)
3582  {
3583  for (i = 0; i < maxdeg1+1; i++)
3584  {
3585  if (mse[i] != NULL)
3586  {
3587  cpl_free(mse[i]);
3588  }
3589  }
3590  cpl_free(mse);
3591  }
3592  uves_free_table(&temp);
3593 
3594  return bivariate_fit;
3595 }
3596 
3597 /*----------------------------------------------------------------------------*/
3607 /*----------------------------------------------------------------------------*/
3608 const char *
3609 uves_remove_string_prefix(const char *s, const char *prefix)
3610 {
3611  const char *result = NULL;
3612  unsigned int prefix_length;
3613 
3614  assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
3615  assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
3616 
3617  prefix_length = strlen(prefix);
3618 
3619  assure( strlen(s) >= prefix_length &&
3620  strncmp(s, prefix, prefix_length) == 0,
3621  CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
3622  prefix, s);
3623 
3624  result = s + prefix_length;
3625 
3626  cleanup:
3627  return result;
3628 }
3629 
3630 
3631 /*----------------------------------------------------------------------------*/
3640 /*----------------------------------------------------------------------------*/
3641 
3642 double uves_gaussrand(void)
3643 {
3644  static double V1, V2, S;
3645  static int phase = 0;
3646  double X;
3647 
3648  if(phase == 0) {
3649  do {
3650  double U1 = (double)rand() / RAND_MAX;
3651  double U2 = (double)rand() / RAND_MAX;
3652 
3653  V1 = 2 * U1 - 1;
3654  V2 = 2 * U2 - 1;
3655  S = V1 * V1 + V2 * V2;
3656  } while(S >= 1 || S == 0);
3657 
3658  X = V1 * sqrt(-2 * log(S) / S);
3659  } else
3660  X = V2 * sqrt(-2 * log(S) / S);
3661 
3662  phase = 1 - phase;
3663 
3664  return X;
3665 }
3666 
3667 /*----------------------------------------------------------------------------*/
3678 /*----------------------------------------------------------------------------*/
3679 
3680 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x,
3681  const char *column_y, int *istart )
3682 {
3683  double result = 0;
3684  int n;
3685 
3686  const double *x, *y;
3687 
3688  check( x = cpl_table_get_data_double_const(t, column_x),
3689  "Error reading column '%s'", column_x);
3690  check( y = cpl_table_get_data_double_const(t, column_y),
3691  "Error reading column '%s'", column_y);
3692 
3693  n = cpl_table_get_nrow(t);
3694 
3695  result = uves_spline_hermite(xp, x, y, n, istart);
3696 
3697  cleanup:
3698  return result;
3699 }
3700 
3701 /*----------------------------------------------------------------------------*/
3717 /*----------------------------------------------------------------------------*/
3718 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
3719 {
3720  double yp1, yp2, yp = 0;
3721  double xpi, xpi1, l1, l2, lp1, lp2;
3722  int i;
3723 
3724  if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) ) return 0.0;
3725  if ( x[0] > x[n-1] && (xp > x[0] || xp < x[n-1]) ) return 0.0;
3726 
3727  if ( x[0] <= x[n-1] )
3728  {
3729  for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
3730  ;
3731  }
3732  else
3733  {
3734  for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
3735  ;
3736  }
3737 
3738  *istart = i;
3739  i--;
3740 
3741  lp1 = 1.0 / (x[i-1] - x[i]);
3742  lp2 = -lp1;
3743 
3744  if ( i == 1 )
3745  {
3746  yp1 = (y[1] - y[0]) / (x[1] - x[0]);
3747  }
3748  else
3749  {
3750  yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
3751  }
3752 
3753  if ( i >= n - 1 )
3754  {
3755  yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
3756  }
3757  else
3758  {
3759  yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
3760  }
3761 
3762  xpi1 = xp - x[i];
3763  xpi = xp - x[i-1];
3764  l1 = xpi1*lp1;
3765  l2 = xpi*lp2;
3766 
3767  yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 +
3768  y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 +
3769  yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
3770 
3771  return yp;
3772 }
3773 
3774 /*----------------------------------------------------------------------------*/
3788 /*----------------------------------------------------------------------------*/
3789 
3790 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
3791 {
3792  int klo, khi, k;
3793  double a, b, h, yp = 0;
3794 
3795  assure_nomsg( x != NULL, CPL_ERROR_NULL_INPUT);
3796  assure_nomsg( y != NULL, CPL_ERROR_NULL_INPUT);
3797  assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
3798  assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
3799 
3800  klo = *kstart;
3801  khi = n;
3802 
3803  if ( xp < x[1] || xp > x[n] )
3804  {
3805  return 0.0;
3806  }
3807  else if ( xp == x[1] )
3808  {
3809  return(y[1]);
3810  }
3811 
3812  for ( k = klo; k < n && xp > x[k]; k++ )
3813  ;
3814 
3815  klo = *kstart = k-1;
3816  khi = k;
3817 
3818  h = x[khi] - x[klo];
3819  assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
3820  "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
3821 
3822  a = (x[khi] - xp) / h;
3823  b = (xp - x[klo]) / h;
3824 
3825  yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
3826  (h*h) / 6.0;
3827 
3828  cleanup:
3829  return yp;
3830 }
3831 
3832 /*----------------------------------------------------------------------------*/
3842 /*----------------------------------------------------------------------------*/
3843 bool
3844 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
3845 {
3846  bool is_sorted = true; /* ... until proven false */
3847  int i;
3848  int N;
3849  double previous, current; /* column values */
3850 
3851  passure(t != NULL, " ");
3852  passure(cpl_table_has_column(t, column), "No column '%s'", column);
3853  passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
3854 
3855  N = cpl_table_get_nrow(t);
3856 
3857  if (N > 1)
3858  {
3859  previous = cpl_table_get_double(t, column, 0, NULL);
3860 
3861  for(i = 1; i < N && is_sorted; i++)
3862  {
3863  current = cpl_table_get_double(t, column, i, NULL);
3864  if (!reverse)
3865  {
3866  /* Check for ascending */
3867  is_sorted = is_sorted && ( current >= previous );
3868  }
3869  else
3870  {
3871  /* Check for descending */
3872  is_sorted = is_sorted && ( current <= previous );
3873  }
3874 
3875  previous = current;
3876  }
3877  }
3878  else
3879  {
3880  /* 0 or 1 rows. Table is sorted */
3881  }
3882 
3883  cleanup:
3884  return is_sorted;
3885 }
3886 
3887 /*----------------------------------------------------------------------------*/
3893 /*----------------------------------------------------------------------------*/
3894 cpl_table *
3896 {
3897  cpl_table *result = NULL;
3898 
3899  check((
3900  result = cpl_table_new(0),
3901  cpl_table_new_column(result, "TraceID" , CPL_TYPE_INT),
3902  cpl_table_new_column(result, "Offset" , CPL_TYPE_DOUBLE),
3903  cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
3904  "Error creating table");
3905 
3906  cleanup:
3907  return result;
3908 }
3909 
3910 /*----------------------------------------------------------------------------*/
3920 /*----------------------------------------------------------------------------*/
3921 cpl_error_code
3922 uves_ordertable_traces_add(cpl_table *traces,
3923  int fibre_ID, double fibre_offset, int fibre_mask)
3924 {
3925  int size;
3926 
3927  assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
3928 
3929  /* Write to new table row */
3930  check((
3931  size = cpl_table_get_nrow(traces),
3932  cpl_table_set_size (traces, size+1),
3933  cpl_table_set_int (traces, "TraceID" , size, fibre_ID),
3934  cpl_table_set_double(traces, "Offset" , size, fibre_offset),
3935  cpl_table_set_int (traces, "Tracemask", size, fibre_mask)),
3936  "Error updating table");
3937 
3938  cleanup:
3939  return cpl_error_get_code();
3940 }
3941 
3942 
3943 /*----------------------------------------------------------------------------*/
3949 /*----------------------------------------------------------------------------*/
3950 cpl_error_code
3952 {
3953  cpl_table* tab=NULL;
3954  uves_propertylist* head=NULL;
3955  tab=cpl_table_load(tname,1,0);
3956  head=uves_propertylist_load(tname,0);
3958  check_nomsg(uves_table_save(tab,head,NULL,tname,CPL_IO_DEFAULT));
3959 
3960  cleanup:
3961  uves_free_table(&tab);
3962  uves_free_propertylist(&head);
3963  return cpl_error_get_code();
3964 }
3965 
3966 
3967 
3968 /*----------------------------------------------------------------------------*/
3975 /*----------------------------------------------------------------------------*/
3976 cpl_error_code
3977 uves_tablenames_unify_units(const char* tname2, const char* tname1)
3978 {
3979  cpl_table* tab1=NULL;
3980  cpl_table* tab2=NULL;
3981  uves_propertylist* head2=NULL;
3982 
3983  tab1=cpl_table_load(tname1,1,0);
3984 
3985  tab2=cpl_table_load(tname2,1,0);
3986  head2=uves_propertylist_load(tname2,0);
3987 
3988  uves_table_unify_units(&tab2,&tab1);
3989  check_nomsg(uves_table_save(tab2,head2,NULL,tname2,CPL_IO_DEFAULT));
3990 
3991  cleanup:
3992  uves_free_table(&tab1);
3993  uves_free_table(&tab2);
3994  uves_free_propertylist(&head2);
3995  return cpl_error_get_code();
3996 
3997 }
3998 
3999 
4000 
4001 /*----------------------------------------------------------------------------*/
4007 /*----------------------------------------------------------------------------*/
4008 cpl_error_code
4009 uves_table_remove_units(cpl_table **table)
4010 {
4011  int ncols;
4012  const char* colname=NULL;
4013  int i=0;
4014  cpl_array *names=NULL;
4015 
4016  assure( *table != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4017  ncols = cpl_table_get_ncol(*table);
4018  names = cpl_table_get_column_names(*table);
4019  for(i=0;i<ncols;i++) {
4020  colname=cpl_array_get_string(names, i);
4021  cpl_table_set_column_unit(*table,colname,NULL);
4022  }
4023 
4024  cleanup:
4025  uves_free_array(&names);
4026 
4027  return cpl_error_get_code();
4028 }
4029 
4030 
4031 
4032 /*----------------------------------------------------------------------------*/
4039 /*----------------------------------------------------------------------------*/
4040 cpl_error_code
4041 uves_table_unify_units(cpl_table **table2, cpl_table **table1)
4042 {
4043  int ncols1;
4044  int ncols2;
4045  const char* colname=NULL;
4046  const char* unit1=NULL;
4047 
4048  int i=0;
4049  cpl_array *names=NULL;
4050 
4051  assure( table1 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4052  assure( *table2 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4053  ncols1 = cpl_table_get_ncol(*table1);
4054  ncols2 = cpl_table_get_ncol(*table2);
4055  assure( ncols1 == ncols2, CPL_ERROR_NULL_INPUT,
4056  "n columns (tab1) != n columns (tab2)");
4057 
4058  names = cpl_table_get_column_names(*table1);
4059  for(i=0;i<ncols1;i++) {
4060  colname=cpl_array_get_string(names, i);
4061  unit1=cpl_table_get_column_unit(*table1,colname);
4062  cpl_table_set_column_unit(*table2,colname,unit1);
4063  }
4064 
4065  cleanup:
4066  uves_free_array(&names);
4067 
4068  return cpl_error_get_code();
4069 }
4070 
4071 /*
4072  * modified on 2006/04/19
4073  * jmlarsen: float[5] -> const double[]
4074  * changed mapping of indices to parameters
4075  * Normalized the profile to 1 and changed meaning
4076  * of (a[3], a[2]) to (integrated flux, stdev)
4077  * Disabled debugging messages
4078  *
4079  * modified on 2005/07/29 to make dydapar a FORTRAN array
4080  * (indiced from 1 to N instead of 0 to N-1).
4081  * This allows the array to be passed to C functions expecting
4082  * FORTRAN-like arrays.
4083  *
4084  * modified on 2005/08/02 to make the function prototype ANSI
4085  * compliant (so it can be used with the levmar library).
4086  *
4087  * modified on 2005/08/16. The function now expects C-indexed
4088  * arrays as parameters (to allow proper integration). However, the
4089  * arrays are still converted to FORTRAN-indexed arrays internally.
4090  */
4091 
4102 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
4103 
4104 
4105  /* int na;*/
4106 {
4107  double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
4108  double a2i=0, m = 0, p = 0, dif =0;
4109  double sqrt5 = 2.23606797749979;
4110 
4111  *y=0.0;
4112 // a2i = 1.0/a[2];
4113  a2i = 1.0/(a[2]*sqrt5);
4114 
4115  dif=x-a[1];
4116  arg=dif*a2i;
4117  arg2=arg*arg;
4118 
4119  fac=1.0+arg2;
4120  fac2=fac*fac;
4121  fac4=fac2*fac2;
4122  fac4i = 1.0/fac4;
4123 
4124 // m = a[1]*fac4i;
4125  m = a[3]*fac4i * a2i*16/(5.0*M_PI);
4126  *y = m + a[4]*(1.0+dif*a[5]);
4127  p = 8.0*m/fac*arg*a2i;
4128 
4129  dyda[3] = m/a[3];
4130  dyda[2] = p*dif/a[2] - m/a[2];
4131 
4132 // dyda[3]=fac4i;
4133  dyda[1]=p-a[4]*a[5];
4134 // dyda[2]=p*dif*a2i;
4135  dyda[4]=1.0+dif*a[5];
4136  dyda[5]=a[4]*dif;
4137 
4138 
4139 #if 0
4140  {
4141  int i = 0, npar=5 ;
4142  printf("fmoffat_i \n");
4143  for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
4144 
4145  printf("fmoffat_i ");
4146  for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
4147  printf("\n");
4148  }
4149 #endif
4150 
4151 }
4152 
4171 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
4172 //void fmoffa_c(x,a,y, dyda)
4173 
4174 
4175 // float x,*a,*y,*dyda;
4176 /*int na;*/
4177 {
4178  int npoint = 3;
4179  double const xgl[3] = {-0.387298334621,0.,0.387298334621};
4180  double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
4181  int i=0;
4182  int j=0;
4183  int npar = 5;
4184  double xmod = 0;
4185  double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
4186  double ypar;
4187 
4188 
4189  // Convert C-indexed arrays to FORTRAN-indexed arrays
4190  a = C_TO_FORTRAN_INDEXING(a);
4191  dyda = C_TO_FORTRAN_INDEXING(dyda);
4192 
4193  *y = 0.0;
4194  for (i = 1;i<=npar;i++) dyda[i] = 0.;
4195  /* printf("fmoffat_c ");
4196  for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
4197  /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
4198  /* printf("\n");*/
4199  for (j=0; j < npoint; j++)
4200  {
4201  xmod = x+xgl[j];
4202 
4203  fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
4204 
4205  *y = *y + ypar*wgl[j];
4206 
4207  for (i = 1; i <= npar; i++)
4208  {
4209  dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
4210  }
4211 
4212  /* if (j == 2)
4213  for (i = 1;i<=npar;i++)
4214  {
4215  dyda[i] = dydapar[i];
4216  };
4217  */
4218  }
4219 
4220 #if 0
4221  printf("fmoffat_c ");
4222  for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
4223  printf("\n");
4224 #endif
4225 }
4226 
4227 /*----------------------------------------------------------------------------*/
4235 /*----------------------------------------------------------------------------*/
4236 int
4237 uves_moffat(const double x[], const double a[], double *result)
4238 {
4239  double dyda[5];
4240 
4241  fmoffa_c(x[0], a, result, dyda);
4242 
4243  return 0;
4244 }
4245 
4246 /*----------------------------------------------------------------------------*/
4254 /*----------------------------------------------------------------------------*/
4255 int
4256 uves_moffat_derivative(const double x[], const double a[], double result[])
4257 {
4258  double y;
4259 
4260  fmoffa_c(x[0], a, &y, result);
4261 
4262  return 0;
4263 }
4264 
4265 /*----------------------------------------------------------------------------*/
4285 /*----------------------------------------------------------------------------*/
4286 
4287 int
4288 uves_gauss(const double x[], const double a[], double *result)
4289 {
4290  double my = a[0];
4291  double sigma = a[1];
4292 
4293  if (sigma == 0)
4294  {
4295  /* Dirac's delta function */
4296  if (x[0] == my)
4297  {
4298  *result = DBL_MAX;
4299  }
4300  else
4301  {
4302  *result = 0;
4303  }
4304  return 0;
4305  }
4306  else
4307  {
4308  double A = a[2];
4309  double B = a[3];
4310 
4311  *result = B +
4312  A/(sqrt(2*M_PI*sigma*sigma)) *
4313  exp(- (x[0] - my)*(x[0] - my)
4314  / (2*sigma*sigma));
4315  }
4316 
4317  return 0;
4318 }
4319 
4320 /*----------------------------------------------------------------------------*/
4340 /*----------------------------------------------------------------------------*/
4341 
4342 int
4343 uves_gauss_derivative(const double x[], const double a[], double result[])
4344 {
4345  double my = a[0];
4346  double sigma = a[1];
4347  double A = a[2];
4348  /* a[3] not used */
4349 
4350  double factor;
4351 
4352  /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4353  *
4354  * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my) / s^2
4355  * = A * fac. * (x-my) / s^2
4356  * df/ds = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
4357  * = A * fac. * ((x-my)^2 / s^2 - 1) / s
4358  * df/dA = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4359  * = fac.
4360  * df/dB = 1
4361  */
4362 
4363  if (sigma == 0)
4364  {
4365  /* Derivative of Dirac's delta function */
4366  result[0] = 0;
4367  result[1] = 0;
4368  result[2] = 0;
4369  result[3] = 0;
4370  return 0;
4371  }
4372 
4373  factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
4374  / (sqrt(2*M_PI*sigma*sigma));
4375 
4376  result[0] = A * factor * (x[0]-my) / (sigma*sigma);
4377  result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
4378  result[2] = factor;
4379  result[3] = 1;
4380 
4381  return 0;
4382 }
4383 
4384 /*----------------------------------------------------------------------------*/
4405 /*----------------------------------------------------------------------------*/
4406 
4407 int
4408 uves_gauss_linear(const double x[], const double a[], double *result)
4409 {
4410  double my = a[0];
4411  double sigma = a[1];
4412 
4413  if (sigma == 0)
4414  {
4415  /* Dirac's delta function */
4416  if (x[0] == my)
4417  {
4418  *result = DBL_MAX;
4419  }
4420  else
4421  {
4422  *result = 0;
4423  }
4424  return 0;
4425  }
4426  else
4427  {
4428  double A = a[2];
4429  double B = a[3];
4430  double C = a[4];
4431 
4432  *result = B + C*(x[0] - my) +
4433  A/(sqrt(2*M_PI*sigma*sigma)) *
4434  exp(- (x[0] - my)*(x[0] - my)
4435  / (2*sigma*sigma));
4436  }
4437 
4438  return 0;
4439 }
4440 
4441 /*----------------------------------------------------------------------------*/
4464 /*----------------------------------------------------------------------------*/
4465 
4466 int
4467 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
4468 {
4469  double my = a[0];
4470  double sigma = a[1];
4471  double A = a[2];
4472  /* a[3] not used */
4473  double C = a[4];
4474 
4475  double factor;
4476 
4477  /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4478  *
4479  * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my) / s^2
4480  * = A * fac. * (x-my) / s^2 - C
4481  * df/ds = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
4482  * = A * fac. * ((x-my)^2 / s^2 - 1) / s
4483  * df/dA = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4484  * = fac.
4485  * df/dB = 1
4486  *
4487  * df/dC = x-my
4488  */
4489 
4490  if (sigma == 0)
4491  {
4492  /* Derivative of Dirac's delta function */
4493  result[0] = -C;
4494  result[1] = 0;
4495  result[2] = 0;
4496  result[3] = 0;
4497  result[4] = x[0];
4498  return 0;
4499  }
4500 
4501  factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
4502  / (sqrt(2*M_PI*sigma*sigma));
4503 
4504  result[0] = A * factor * (x[0]-my) / (sigma*sigma);
4505  result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
4506  result[2] = factor;
4507  result[3] = 1;
4508  result[4] = x[0] - my;
4509 
4510  return 0;
4511 }
4512 
4513 
4514 
4515 
4516 /*----------------------------------------------------------------------------*/
4529 /*----------------------------------------------------------------------------*/
4530 cpl_image *
4531 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
4532  const cpl_image *spectrum, const cpl_image *sky,
4533  const cpl_image *cosmic_image,
4534  const uves_extract_profile *profile,
4535  cpl_image **image_noise, uves_propertylist **image_header)
4536 {
4537  cpl_image *image = NULL;
4538 
4539  cpl_binary *bpm = NULL;
4540  bool loop_y = false;
4541 
4542  double ron = 3;
4543  double gain = 1.0; //fixme
4544  bool new_format = true;
4545 
4546  image = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
4547  assure_mem( image );
4548  if (image_noise != NULL) {
4549  *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
4550  assure_mem( *image_noise );
4551  cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
4552  }
4553 
4554  if (image_header != NULL) {
4555  *image_header = uves_propertylist_new();
4556 
4557  uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
4558  uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
4559  uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
4560  }
4561 
4562  for (uves_iterate_set_first(pos,
4563  1, pos->nx,
4564  pos->minorder, pos->maxorder,
4565  bpm,
4566  loop_y);
4567  !uves_iterate_finished(pos);
4568  uves_iterate_increment(pos)) {
4569 
4570  /* Manual loop over y */
4571  uves_extract_profile_set(profile, pos, NULL);
4572  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
4573 
4574  /* Get empirical and model profile */
4575  double flux, sky_flux;
4576  int bad;
4577  int spectrum_row = pos->order - pos->minorder + 1;
4578  double noise;
4579  double prof = uves_extract_profile_evaluate(profile, pos);
4580 
4581  if (sky != NULL)
4582  {
4583  sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
4584  }
4585  else
4586  {
4587  sky_flux = 0;
4588  }
4589 
4590  flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
4591 
4592  //fixme: check this formula
4593  noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
4594 // uves_msg_error("%f", prof);
4595  cpl_image_set(image, pos->x, pos->y,
4596  flux);
4597  if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
4598 
4599  }
4600  }
4601 
4602  if (cosmic_image != NULL) {
4603  double cr_val = 2*cpl_image_get_max(image);
4604  /* assign high pixel value to CR pixels */
4605 
4606  loop_y = true;
4607 
4608  for (uves_iterate_set_first(pos,
4609  1, pos->nx,
4610  pos->minorder, pos->maxorder,
4611  bpm,
4612  loop_y);
4613  !uves_iterate_finished(pos);
4614  uves_iterate_increment(pos)) {
4615 
4616  int is_rejected;
4617  if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
4618  cpl_image_set(image, pos->x, pos->y, cr_val);
4619  }
4620  }
4621  }
4622 
4623  cleanup:
4624  return image;
4625 }
4626 
4627 void
4628 uves_frameset_dump(cpl_frameset* set)
4629 {
4630 
4631  cpl_frame* frm=NULL;
4632  int sz=0;
4633  int i=0;
4634 
4635  cknull(set,"Null input frameset");
4636  check_nomsg(sz=cpl_frameset_get_size(set));
4637  check_nomsg(frm=cpl_frameset_get_first(set));
4638  do{
4639  uves_msg("frame %d tag %s filename %s group %d",
4640  i,
4641  cpl_frame_get_tag(frm),
4642  cpl_frame_get_filename(frm),
4643  cpl_frame_get_group(frm));
4644  i++;
4645  } while ((frm=cpl_frameset_get_next(set)) != NULL);
4646 
4647  cleanup:
4648 
4649  return ;
4650 }
4651 
4652 
4653 
4654 
4655 /*-------------------------------------------------------------------------*/
4669 /*--------------------------------------------------------------------------*/
4670 
4671 cpl_image *
4672 uves_image_smooth_x(cpl_image * inp, const int r)
4673 {
4674 
4675  /*
4676  @param xp x-value to interpolate
4677  @param x x-values
4678  @param y y-values
4679  @param n array length
4680  @param istart (input/output) initial row (set to 0 to search all row)
4681 
4682  */
4683  float* pinp=NULL;
4684  float* pout=NULL;
4685  int sx=0;
4686  int sy=0;
4687  int i=0;
4688  int j=0;
4689  int k=0;
4690 
4691  cpl_image* out=NULL;
4692 
4693  cknull(inp,"Null in put image, exit");
4694  check_nomsg(out=cpl_image_duplicate(inp));
4695  check_nomsg(sx=cpl_image_get_size_x(inp));
4696  check_nomsg(sy=cpl_image_get_size_y(inp));
4697  check_nomsg(pinp=cpl_image_get_data_float(inp));
4698  check_nomsg(pout=cpl_image_get_data_float(out));
4699  for(j=0;j<sy;j++) {
4700  for(i=r;i<sx-r;i++) {
4701  for(k=-r;k<r;k++) {
4702  pout[j*sx+i]+=pinp[j*sx+i+k];
4703  }
4704  pout[j*sx+i]/=2*r;
4705  }
4706  }
4707 
4708  cleanup:
4709 
4710  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4711  return NULL;
4712  } else {
4713  return out;
4714 
4715  }
4716 
4717 }
4718 
4719 
4720 
4721 
4722 
4723 /*-------------------------------------------------------------------------*/
4737 /*--------------------------------------------------------------------------*/
4738 
4739 cpl_image *
4740 uves_image_smooth_y(cpl_image * inp, const int r)
4741 {
4742 
4743  /*
4744  @param xp x-value to interpolate
4745  @param x x-values
4746  @param y y-values
4747  @param n array length
4748  @param istart (input/output) initial row (set to 0 to search all row)
4749 
4750  */
4751  float* pinp=NULL;
4752  float* pout=NULL;
4753  int sx=0;
4754  int sy=0;
4755  int i=0;
4756  int j=0;
4757  int k=0;
4758 
4759  cpl_image* out=NULL;
4760 
4761  cknull(inp,"Null in put image, exit");
4762  check_nomsg(out=cpl_image_duplicate(inp));
4763  check_nomsg(sx=cpl_image_get_size_x(inp));
4764  check_nomsg(sy=cpl_image_get_size_y(inp));
4765  check_nomsg(pinp=cpl_image_get_data_float(inp));
4766  check_nomsg(pout=cpl_image_get_data_float(out));
4767  for(j=r;j<sy-r;j++) {
4768  for(i=0;i<sx;i++) {
4769  for(k=-r;k<r;k++) {
4770  pout[j*sx+i]+=pinp[(j+k)*sx+i];
4771  }
4772  pout[j*sx+i]/=2*r;
4773  }
4774  }
4775 
4776  cleanup:
4777 
4778  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4779  return NULL;
4780  } else {
4781  return out;
4782 
4783  }
4784 
4785 }
4786 
4787 
4788 /*-------------------------------------------------------------------------*/
4802 /*--------------------------------------------------------------------------*/
4803 
4804 cpl_image *
4805 uves_image_smooth_mean_x(cpl_image * inp, const int r)
4806 {
4807 
4808  /*
4809  @param xp x-value to interpolate
4810  @param x x-values
4811  @param y y-values
4812  @param n array length
4813  @param istart (input/output) initial row (set to 0 to search all row)
4814 
4815  */
4816  float* pinp=NULL;
4817  float* pout=NULL;
4818  int sx=0;
4819  int sy=0;
4820  int i=0;
4821  int j=0;
4822  int k=0;
4823 
4824  cpl_image* out=NULL;
4825 
4826  cknull(inp,"Null in put image, exit");
4827  check_nomsg(out=cpl_image_duplicate(inp));
4828  check_nomsg(sx=cpl_image_get_size_x(inp));
4829  check_nomsg(sy=cpl_image_get_size_y(inp));
4830  check_nomsg(pinp=cpl_image_get_data_float(inp));
4831  check_nomsg(pout=cpl_image_get_data_float(out));
4832  for(j=0;j<sy;j++) {
4833  for(i=r;i<sx-r;i++) {
4834  for(k=-r;k<r;k++) {
4835  pout[j*sx+i]+=pinp[j*sx+i+k];
4836  }
4837  pout[j*sx+i]/=2*r;
4838  }
4839  }
4840 
4841  cleanup:
4842 
4843  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4844  return NULL;
4845  } else {
4846  return out;
4847 
4848  }
4849 
4850 }
4851 
4852 
4853 /*-------------------------------------------------------------------------*/
4867 /*--------------------------------------------------------------------------*/
4868 
4869 cpl_image *
4870 uves_image_smooth_median_x(cpl_image * inp, const int r)
4871 {
4872 
4873  /*
4874  @param xp x-value to interpolate
4875  @param x x-values
4876  @param y y-values
4877  @param n array length
4878  @param istart (input/output) initial row (set to 0 to search all row)
4879 
4880  */
4881  float* pout=NULL;
4882  int sx=0;
4883  int sy=0;
4884  int i=0;
4885  int j=0;
4886 
4887  cpl_image* out=NULL;
4888 
4889 
4890  cknull(inp,"Null in put image, exit");
4891  check_nomsg(out=cpl_image_duplicate(inp));
4892  check_nomsg(sx=cpl_image_get_size_x(inp));
4893  check_nomsg(sy=cpl_image_get_size_y(inp));
4894  check_nomsg(pout=cpl_image_get_data_float(out));
4895 
4896  for(j=1;j<sy;j++) {
4897  for(i=1+r;i<sx-r;i++) {
4898  pout[j*sx+i]=(float)cpl_image_get_median_window(inp,i,j,i+r,j);
4899  }
4900  }
4901 
4902  cleanup:
4903 
4904  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4905  return NULL;
4906  } else {
4907  return out;
4908 
4909  }
4910 
4911 }
4912 
4913 /*-------------------------------------------------------------------------*/
4926 /*--------------------------------------------------------------------------*/
4927 
4928 cpl_image *
4929 uves_image_smooth_fft(cpl_image * inp, const int fx)
4930 {
4931 
4932  int sx=0;
4933  int sy=0;
4934 
4935  cpl_image* out=NULL;
4936  cpl_image* im_re=NULL;
4937  cpl_image* im_im=NULL;
4938  cpl_image* ifft_re=NULL;
4939  cpl_image* ifft_im=NULL;
4940  cpl_image* filter=NULL;
4941 
4942  int sigma_x=fx;
4943  int sigma_y=0;
4944 
4945  cknull(inp,"Null in put image, exit");
4946  check_nomsg(im_re = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
4947  check_nomsg(im_im = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
4948 
4949  // Compute FFT
4950  check_nomsg(cpl_image_fft(im_re,im_im,CPL_FFT_DEFAULT));
4951 
4952  check_nomsg(sx=cpl_image_get_size_x(inp));
4953  check_nomsg(sy=cpl_image_get_size_y(inp));
4954  sigma_x=sx;
4955 
4956  //Generates filter image
4957  check_nomsg(filter = uves_gen_lowpass(sx,sy,sigma_x,sigma_y));
4958 
4959  //Apply filter
4960  cpl_image_multiply(im_re,filter);
4961  cpl_image_multiply(im_im,filter);
4962 
4963  uves_free_image(&filter);
4964 
4965  check_nomsg(ifft_re = cpl_image_duplicate(im_re));
4966  check_nomsg(ifft_im = cpl_image_duplicate(im_im));
4967 
4968  uves_free_image(&im_re);
4969  uves_free_image(&im_im);
4970 
4971  //Computes FFT-INVERSE
4972  check_nomsg(cpl_image_fft(ifft_re,ifft_im,CPL_FFT_INVERSE));
4973  check_nomsg(out = cpl_image_cast(ifft_re, CPL_TYPE_FLOAT));
4974 
4975  cleanup:
4976 
4977  uves_free_image(&ifft_re);
4978  uves_free_image(&ifft_im);
4979  uves_free_image(&filter);
4980  uves_free_image(&im_re);
4981  uves_free_image(&im_im);
4982 
4983  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4984  return NULL;
4985  } else {
4986  return out;
4987  }
4988 
4989 }
4990 
4991 /*-------------------------------------------------------------------------*/
5000 /*--------------------------------------------------------------------------*/
5001 cpl_vector *
5002 uves_imagelist_get_clean_mean_levels(cpl_imagelist* iml, double kappa)
5003 {
5004 
5005  cpl_image* img=NULL;
5006  int size=0;
5007  int i=0;
5008  cpl_vector* values=NULL;
5009  double* pval=NULL;
5010  double mean=0;
5011  double stdev=0;
5012 
5013  check_nomsg(size=cpl_imagelist_get_size(iml));
5014  check_nomsg(values=cpl_vector_new(size));
5015  pval=cpl_vector_get_data(values);
5016  for(i=0;i<size;i++) {
5017  img=cpl_imagelist_get(iml,i);
5018  irplib_ksigma_clip(img,1,1,
5019  cpl_image_get_size_x(img),
5020  cpl_image_get_size_y(img),
5021  5,kappa,1.e-5,&mean,&stdev);
5022  uves_msg("Ima %d mean level: %g",i+1,mean);
5023  pval[i]=mean;
5024  }
5025 
5026  cleanup:
5027 
5028  return values;
5029 }
5030 
5031 
5032 /*-------------------------------------------------------------------------*/
5041 /*--------------------------------------------------------------------------*/
5042 cpl_error_code
5043 uves_imagelist_subtract_values(cpl_imagelist** iml, cpl_vector* values)
5044 {
5045 
5046  cpl_image* img=NULL;
5047  int size=0;
5048  int i=0;
5049  double* pval=NULL;
5050 
5051  check_nomsg(size=cpl_imagelist_get_size(*iml));
5052  pval=cpl_vector_get_data(values);
5053  for(i=0;i<size;i++) {
5054  img=cpl_imagelist_get(*iml,i);
5055  cpl_image_subtract_scalar(img,pval[i]);
5056  cpl_imagelist_set(*iml,img,i);
5057  }
5058 
5059  cleanup:
5060 
5061  return cpl_error_get_code();
5062 }
5063 
5064 
5065 /*-------------------------------------------------------------------------*/
5081 /*--------------------------------------------------------------------------*/
5082 static cpl_image *
5083 uves_gen_lowpass(const int xs,
5084  const int ys,
5085  const double sigma_x,
5086  const double sigma_y)
5087 {
5088 
5089  int i= 0.0;
5090  int j= 0.0;
5091  int hlx= 0.0;
5092  int hly = 0.0;
5093  double x= 0.0;
5094  double y= 0.0;
5095  double gaussval= 0.0;
5096  double inv_sigma_x=1./sigma_x;
5097  double inv_sigma_y=1./sigma_y;
5098 
5099  float *data;
5100 
5101  cpl_image *lowpass_image=NULL;
5102 
5103 
5104  lowpass_image = cpl_image_new (xs, ys, CPL_TYPE_FLOAT);
5105  if (lowpass_image == NULL) {
5106  uves_msg_error("Cannot generate lowpass filter <%s>",
5107  cpl_error_get_message());
5108  return NULL;
5109  }
5110 
5111  hlx = xs/2;
5112  hly = ys/2;
5113 
5114  data = cpl_image_get_data_float(lowpass_image);
5115 
5116 /* Given an image with pixels 0<=i<N, 0<=j<M then the convolution image
5117  has the following properties:
5118 
5119  ima[0][0] = 1
5120  ima[i][0] = ima[N-i][0] = exp (-0.5 * (i/sig_i)^2) 1<=i<N/2
5121  ima[0][j] = ima[0][M-j] = exp (-0.5 * (j/sig_j)^2) 1<=j<M/2
5122  ima[i][j] = ima[N-i][j] = ima[i][M-j] = ima[N-i][M-j]
5123  = exp (-0.5 * ((i/sig_i)^2 + (j/sig_j)^2))
5124 */
5125 
5126  data[0] = 1.0;
5127 
5128  /* first row */
5129  for (i=1 ; i<=hlx ; i++) {
5130  x = i * inv_sigma_x;
5131  gaussval = exp(-0.5*x*x);
5132  data[i] = gaussval;
5133  data[xs-i] = gaussval;
5134  }
5135 
5136  for (j=1; j<=hly ; j++) {
5137  y = j * inv_sigma_y;
5138  /* first column */
5139  data[j*xs] = exp(-0.5*y*y);
5140  data[(ys-j)*xs] = exp(-0.5*y*y);
5141 
5142  for (i=1 ; i<=hlx ; i++) {
5143  /* Use internal symetries */
5144  x = i * inv_sigma_x;
5145  gaussval = exp (-0.5*(x*x+y*y));
5146  data[j*xs+i] = gaussval;
5147  data[(j+1)*xs-i] = gaussval;
5148  data[(ys-j)*xs+i] = gaussval;
5149  data[(ys+1-j)*xs-i] = gaussval;
5150 
5151  }
5152  }
5153 
5154  /* FIXME: for the moment, reset errno which is coming from exp()
5155  in first for-loop at i=348. This is causing cfitsio to
5156  fail when loading an extension image (bug in cfitsio too).
5157  */
5158  if(errno != 0)
5159  errno = 0;
5160 
5161  return lowpass_image;
5162 }
5163 /*-------------------------------------------------------------------------*/
5171 /*--------------------------------------------------------------------------*/
5172 cpl_image*
5173 uves_image_mflat_detect_blemishes(const cpl_image* flat,
5174  const uves_propertylist* head)
5175 {
5176 
5177  cpl_image* result=NULL;
5178  cpl_image* diff=NULL;
5179  cpl_image* flat_smooth=NULL;
5180  cpl_array* val=NULL;
5181  cpl_matrix* mx=NULL;
5182 
5183  int binx=0;
5184  int biny=0;
5185  int sx=0;
5186  int sy=0;
5187  int size=0;
5188  int i=0;
5189  int j=0;
5190  int k=0;
5191  int niter=3;
5192  int filter_width_x=7;
5193  int filter_width_y=7;
5194 
5195  double mean=0;
5196  double stdev=0;
5197  double stdev_x_4=0;
5198 
5199  double med_flat=0;
5200 
5201  double* pres=NULL;
5202  const double* pima=NULL;
5203  double* pval=NULL;
5204  double* pdif=NULL;
5205  int npixs=0;
5206 
5207  /* check input is valid */
5208  passure( flat !=NULL , "NULL input flat ");
5209  passure( head !=NULL , "NULL input head ");
5210 
5211  /* get image and bin sizes */
5212  sx=cpl_image_get_size_x(flat);
5213  sy=cpl_image_get_size_y(flat);
5214  npixs=sx*sy;
5215 
5216  binx=uves_pfits_get_binx(head);
5217  biny=uves_pfits_get_biny(head);
5218 
5219  /* set proper x/y filter width. Start values are 3 */
5220  if (binx>1) filter_width_x=5;
5221  if (biny>1) filter_width_y=5;
5222 
5223 
5224  /* create residuals image from smoothed flat */
5225  check_nomsg(mx=cpl_matrix_new(filter_width_x,filter_width_y));
5226 
5227  for(j=0; j< filter_width_y; j++){
5228  for(i=0; i< filter_width_x; i++){
5229  cpl_matrix_set( mx, i,j,1.0);
5230  }
5231  }
5232 
5233  check_nomsg(diff=cpl_image_duplicate(flat));
5234 
5235  check_nomsg(flat_smooth=uves_image_filter_median(flat,mx));
5236  /*
5237  check_nomsg(cpl_image_save(flat_smooth,"flat_smooth.fits",
5238  CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
5239  */
5240  check_nomsg(cpl_image_subtract(diff,flat_smooth));
5241  /*
5242  check_nomsg(cpl_image_save(diff,"diff.fits",
5243  CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
5244  */
5245  /* compute median of flat */
5246  check_nomsg(med_flat=cpl_image_get_median(flat));
5247 
5248  /* prepare array of flat pixel values greater than the median */
5249  val=cpl_array_new(npixs,CPL_TYPE_DOUBLE);
5250  check_nomsg(cpl_array_fill_window_double(val,0,npixs,0));
5251  check_nomsg(pval=cpl_array_get_data_double(val));
5252  check_nomsg(pima=cpl_image_get_data_double_const(flat));
5253  check_nomsg(pdif=cpl_image_get_data_double(diff));
5254  k=0;
5255  for(i=0;i<npixs;i++) {
5256  if(pima[i]>med_flat) {
5257  pval[k]=pdif[i];
5258  k++;
5259  }
5260  }
5261 
5262  check_nomsg(cpl_array_set_size(val,k));
5263 
5264  /* computes 4 sigma clip mean of values */
5265  check_nomsg(mean=cpl_array_get_mean(val));
5266  check_nomsg(stdev=cpl_array_get_stdev(val));
5267  stdev_x_4=stdev*4.;
5268  check_nomsg(size=cpl_array_get_size(val));
5269 
5270  for(i=0;i<niter;i++) {
5271  for(k=0;k<size;k++) {
5272  if(fabs(pval[k]-mean)>stdev_x_4) {
5273  cpl_array_set_invalid(val,k);
5274  }
5275  }
5276  mean=cpl_array_get_mean(val);
5277  stdev=cpl_array_get_stdev(val);
5278  stdev_x_4=stdev*4.;
5279  }
5280 
5281  /* compute absolute value of difference image */
5282  result=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
5283  pres=cpl_image_get_data_double(result);
5284  for(i=0;i<npixs;i++) {
5285  if(fabs(pdif[i])<stdev_x_4) {
5286  pres[i]=1.;
5287  }
5288  }
5289 
5290  /* save result to debug */
5291  /*
5292  check_nomsg(cpl_image_save(result,"blemish.fits",CPL_BPP_IEEE_FLOAT,NULL,
5293  CPL_IO_DEFAULT));
5294  */
5295 
5296  cleanup:
5297  uves_free_array(&val);
5298  uves_free_image(&diff);
5299  uves_free_image(&flat_smooth);
5300  uves_free_matrix(&mx);
5301  return result;
5302 }
5303 
5304