UVES Pipeline Reference Manual  5.5.5b1
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  int i=0;
1856  int nfrm=0;
1857  nfrm=cpl_frameset_get_size(frames);
1858  for (i=0;i<nfrm;i++)
1859  {
1860  f=cpl_frameset_get_frame_const(frames,i);
1861  if (cpl_frame_get_group(f) == CPL_FRAME_GROUP_PRODUCT)
1862  {
1863  check_nomsg(
1864  cpl_frameset_insert(products, cpl_frame_duplicate(f)));
1865  }
1866  }
1867 
1868 /* Don't do this. EsoRex should.
1869  uves_msg_low("Output frames");
1870  check( uves_print_cpl_frameset(products),
1871  "Could not print output frames");
1872 */
1873 
1874  /* Summarize warnings, if any */
1875  if( warnings > 0)
1876  {
1877  uves_msg_warning("Recipe produced %d warning%s (excluding this one)",
1879  /* Plural? */ (warnings > 1) ? "s" : "");
1880  }
1881 
1882  cleanup:
1883  uves_free_frameset(&products);
1884  return cpl_error_get_code();
1885 }
1886 
1887 /*----------------------------------------------------------------------------*/
1908 /*----------------------------------------------------------------------------*/
1909 char *
1910 uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist,
1911  const char *recipe_id, const char *short_descr)
1912 {
1913  char *recipe_string = NULL;
1914  char *stars = NULL; /* A string of stars */
1915  char *spaces1 = NULL;
1916  char *spaces2 = NULL;
1917  char *spaces3 = NULL;
1918  char *spaces4 = NULL;
1919  char *start_time = NULL;
1920 
1921  start_time = uves_sprintf("%s", uves_get_datetime_iso8601());
1922 
1923  check( uves_check_version(), "Library validation failed");
1924 
1925  /* Now read parameters and set specified message level */
1926  {
1927  const char *plotter_command;
1928  int msglevel;
1929 
1930  /* Read parameters using context = recipe_id */
1931 
1932  if (0) /* disabled */
1933  check( uves_get_parameter(parlist, NULL, "uves", "msginfolevel",
1934  CPL_TYPE_INT, &msglevel),
1935  "Could not read parameter");
1936  else
1937  {
1938  msglevel = -1; /* max verbosity */
1939  }
1940  uves_msg_set_level(msglevel);
1941  check( uves_get_parameter(parlist, NULL, "uves", "plotter",
1942  CPL_TYPE_STRING, &plotter_command), "Could not read parameter");
1943 
1944  /* Initialize plotting */
1945  check( uves_plot_initialize(plotter_command),
1946  "Could not initialize plotting");
1947  }
1948 
1949  /* Print
1950  *************************
1951  *** PACAGE_STRING ***
1952  *** Recipe: recipe_id ***
1953  *************************
1954  */
1955  recipe_string = uves_sprintf("Recipe: %s", recipe_id);
1956  {
1957  int field = uves_max_int(strlen(PACKAGE_STRING), strlen(recipe_string));
1958  int nstars = 3+1 + field + 1+3;
1959  int nspaces1, nspaces2, nspaces3, nspaces4;
1960  int i;
1961 
1962  /* ' ' padding */
1963  nspaces1 = (field - strlen(PACKAGE_STRING)) / 2;
1964  nspaces2 = field - strlen(PACKAGE_STRING) - nspaces1;
1965 
1966  nspaces3 = (field - strlen(recipe_string)) / 2;
1967  nspaces4 = field - strlen(recipe_string) - nspaces3;
1968 
1969  spaces1 = cpl_calloc(nspaces1 + 1, sizeof(char));
1970  spaces2 = cpl_calloc(nspaces2 + 1, sizeof(char));
1971  spaces3 = cpl_calloc(nspaces3 + 1, sizeof(char));
1972  spaces4 = cpl_calloc(nspaces4 + 1, sizeof(char));
1973  for (i = 0; i < nspaces1; i++) spaces1[i] = ' ';
1974  for (i = 0; i < nspaces2; i++) spaces2[i] = ' ';
1975  for (i = 0; i < nspaces3; i++) spaces3[i] = ' ';
1976  for (i = 0; i < nspaces4; i++) spaces4[i] = ' ';
1977 
1978  stars = cpl_calloc(nstars + 1, sizeof(char));
1979  for (i = 0; i < nstars; i++) stars[i] = '*';
1980 
1981  uves_msg("%s", stars);
1982  uves_msg("*** %s%s%s ***", spaces1, PACKAGE_STRING, spaces2);
1983  uves_msg("*** %s%s%s ***", spaces3, recipe_string, spaces4);
1984  uves_msg("%s", stars);
1985  }
1986 
1987  uves_msg("This recipe %c%s", tolower(short_descr[0]), short_descr+1);
1988 
1989  if (cpl_frameset_is_empty(frames)) {
1990  uves_msg_debug("Guvf cvcryvar unf ernpurq vgf uvtu dhnyvgl qhr na npgvir "
1991  "hfre pbzzhavgl naq gur erfcbafvoyr naq vqrnyvfgvp jbex bs "
1992  "vaqvivqhny cvcryvar qrirybcref, naq qrfcvgr orvat 'onfrq ba' "
1993  "PCY juvpu vf n cvrpr bs cbyvgvpny penc");
1994  }
1995 
1996  /* Set group (RAW/CALIB) of input frames */
1997  /* This is mandatory for the later call of
1998  cpl_dfs_setup_product_header */
1999  check( uves_dfs_set_groups(frames), "Could not classify input frames");
2000 
2001  /* Print input frames */
2002  uves_msg_low("Input frames");
2003  check( uves_print_cpl_frameset(frames), "Could not print input frames" );
2004 
2005  cleanup:
2006  cpl_free(recipe_string);
2007  cpl_free(stars);
2008  cpl_free(spaces1);
2009  cpl_free(spaces2);
2010  cpl_free(spaces3);
2011  cpl_free(spaces4);
2012  return start_time;
2013 }
2014 
2015 
2016 /*----------------------------------------------------------------------------*/
2044 /*----------------------------------------------------------------------------*/
2045 cpl_image *
2046 uves_average_images(const cpl_image *image1, const cpl_image *noise1,
2047  const cpl_image *image2, const cpl_image *noise2,
2048  cpl_image **noise)
2049 {
2050  cpl_image *result = NULL;
2051  cpl_size nx, ny;
2052  int x, y;
2053 
2054  /* Check input */
2055  assure( image1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2056  assure( image2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2057  assure( noise1 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2058  assure( noise2 != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2059  assure( noise != NULL, CPL_ERROR_NULL_INPUT, "Null image");
2060 
2061  assure( cpl_image_get_min(noise1) > 0, CPL_ERROR_ILLEGAL_INPUT,
2062  "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise1));
2063  assure( cpl_image_get_min(noise2) > 0, CPL_ERROR_ILLEGAL_INPUT,
2064  "Noise must be everywhere positive, minimum = %e", cpl_image_get_min(noise2));
2065 
2066  nx = cpl_image_get_size_x(image1);
2067  ny = cpl_image_get_size_y(image1);
2068 
2069  assure( nx == cpl_image_get_size_x(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
2070  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2071  nx, cpl_image_get_size_x(image2));
2072  assure( nx == cpl_image_get_size_x(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
2073  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2074  nx, cpl_image_get_size_x(noise1));
2075  assure( nx == cpl_image_get_size_x(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
2076  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2077  nx, cpl_image_get_size_x(noise2));
2078  assure( ny == cpl_image_get_size_y(image2), CPL_ERROR_INCOMPATIBLE_INPUT,
2079  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2080  ny, cpl_image_get_size_y(image2));
2081  assure( ny == cpl_image_get_size_y(noise1), CPL_ERROR_INCOMPATIBLE_INPUT,
2082  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2083  ny, cpl_image_get_size_y(noise1));
2084  assure( ny == cpl_image_get_size_y(noise2), CPL_ERROR_INCOMPATIBLE_INPUT,
2085  "Size mismatch %" CPL_SIZE_FORMAT " != %" CPL_SIZE_FORMAT "",
2086  ny, cpl_image_get_size_y(noise2));
2087 
2088  result = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
2089  *noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
2090 
2091  /* Do the calculation */
2092  for (y = 1; y <= ny; y++)
2093  {
2094  for (x = 1; x <= nx; x++)
2095  {
2096  double flux1, flux2;
2097  double sigma1, sigma2;
2098  int pis_rejected1, noise_rejected1;
2099  int pis_rejected2, noise_rejected2;
2100 
2101  flux1 = cpl_image_get(image1, x, y, &pis_rejected1);
2102  flux2 = cpl_image_get(image2, x, y, &pis_rejected2);
2103  sigma1 = cpl_image_get(noise1, x, y, &noise_rejected1);
2104  sigma2 = cpl_image_get(noise2, x, y, &noise_rejected2);
2105 
2106  pis_rejected1 = pis_rejected1 || noise_rejected1;
2107  pis_rejected2 = pis_rejected2 || noise_rejected2;
2108 
2109  if (pis_rejected1 && pis_rejected2)
2110  {
2111  cpl_image_reject(result, x, y);
2112  cpl_image_reject(*noise, x, y);
2113  }
2114  else
2115  {
2116  /* At least one good pixel */
2117 
2118  double flux, sigma;
2119 
2120  if (pis_rejected1 && !pis_rejected2)
2121  {
2122  flux = flux2;
2123  sigma = sigma2;
2124  }
2125  else if (!pis_rejected1 && pis_rejected2)
2126  {
2127  flux = flux1;
2128  sigma = sigma1;
2129  }
2130  else
2131  {
2132  /* Both pixels are good */
2133  sigma =
2134  1 / (sigma1*sigma1) +
2135  1 / (sigma2*sigma2);
2136 
2137  flux = flux1/(sigma1*sigma1) + flux2/(sigma2*sigma2);
2138  flux /= sigma;
2139 
2140  sigma = sqrt(sigma);
2141  }
2142 
2143  cpl_image_set(result, x, y, flux);
2144  cpl_image_set(*noise, x, y, sigma);
2145  }
2146  }
2147  }
2148 
2149  cleanup:
2150  if (cpl_error_get_code() != CPL_ERROR_NONE)
2151  {
2152  uves_free_image(&result);
2153  }
2154  return result;
2155 }
2156 
2157 /*----------------------------------------------------------------------------*/
2172 /*----------------------------------------------------------------------------*/
2174 uves_initialize_image_header(const char *ctype1, const char *ctype2,
2175  const char *cunit1, const char *cunit2,
2176  const char *bunit,const double bscale,
2177  double crval1, double crval2,
2178  double crpix1, double crpix2,
2179  double cdelt1, double cdelt2)
2180 {
2181  uves_propertylist *header = NULL; /* Result */
2182 
2183  header = uves_propertylist_new();
2184 
2185  check( uves_pfits_set_ctype1(header, ctype1), "Error writing keyword");
2186  check( uves_pfits_set_ctype2(header, ctype2), "Error writing keyword");
2187  check( uves_pfits_set_cunit1(header, cunit1), "Error writing keyword");
2188  if(cunit2 != NULL) {
2189  check( uves_pfits_set_cunit2(header, cunit2), "Error writing keyword");
2190  }
2191  check( uves_pfits_set_bunit (header, bunit ), "Error writing keyword");
2192  if(bscale) {
2193  check( uves_pfits_set_bscale (header, bscale ), "Error writing keyword");
2194  }
2195  check( uves_pfits_set_crval1(header, crval1), "Error writing keyword");
2196  check( uves_pfits_set_crval2(header, crval2), "Error writing keyword");
2197  check( uves_pfits_set_crpix1(header, crpix1), "Error writing keyword");
2198  check( uves_pfits_set_crpix2(header, crpix2), "Error writing keyword");
2199  check( uves_pfits_set_cdelt1(header, cdelt1), "Error writing keyword");
2200  check( uves_pfits_set_cdelt2(header, cdelt2), "Error writing keyword");
2201 
2202  cleanup:
2203  return header;
2204 }
2205 
2206 /*----------------------------------------------------------------------------*/
2224 /*----------------------------------------------------------------------------*/
2225 cpl_image *
2226 uves_define_noise(const cpl_image *image,
2227  const uves_propertylist *image_header,
2228  int ncom, enum uves_chip chip)
2229 {
2230  /*
2231  \/ __
2232  \_(__)_...
2233  */
2234 
2235  cpl_image *noise = NULL; /* Result */
2236 
2237  /* cpl_image *in_med = NULL; Median filtered input image */
2238 
2239  double ron; /* Read-out noise in ADU */
2240  double gain;
2241  int nx, ny, i;
2242  double *noise_data;
2243  const double *image_data;
2244  bool has_bnoise=false;
2245  bool has_dnoise=false;
2246  double bnoise=0;
2247  double dnoise=0;
2248  double dtime=0;
2249  double bnoise2=0;
2250  double dnoise2=0;
2251  double exptime=0;
2252  double exptime2=0;
2253  double tot_noise2=0;
2254  double var_bias_dark=0;
2255 
2256  /* Read, check input parameters */
2257  assure( ncom >= 1, CPL_ERROR_ILLEGAL_INPUT, "Number of combined frames = %d", ncom);
2258 
2259  check( ron = uves_pfits_get_ron_adu(image_header, chip),
2260  "Could not read read-out noise");
2261 
2262  check( gain = uves_pfits_get_gain(image_header, chip),
2263  "Could not read gain factor");
2264  assure( gain > 0, CPL_ERROR_ILLEGAL_INPUT, "Non-positive gain: %e", gain);
2265 
2266  nx = cpl_image_get_size_x(image);
2267  ny = cpl_image_get_size_y(image);
2268 
2269  /* For efficiency reasons, use pointers to image data buffers */
2270  /* The following check is too strict. It can be avoided to solve PIPE-4893
2271  assure(cpl_image_count_rejected(image) == 0,
2272  CPL_ERROR_UNSUPPORTED_MODE, "Input image contains bad pixels");
2273  */
2274  assure(cpl_image_get_type(image) == CPL_TYPE_DOUBLE,
2275  CPL_ERROR_UNSUPPORTED_MODE,
2276  "Input image is of type %s. double expected",
2277  uves_tostring_cpl_type(cpl_image_get_type(image)));
2278 
2279  noise = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
2280  assure_mem( noise );
2281 
2282  noise_data = cpl_image_get_data_double(noise);
2283 
2284  image_data = cpl_image_get_data_double_const(image);
2285 
2286 
2287  if(image_header != NULL) {
2288  has_bnoise=uves_propertylist_contains(image_header,UVES_BNOISE);
2289  has_dnoise=uves_propertylist_contains(image_header,UVES_DNOISE);
2290  }
2291 
2292  if(has_bnoise) {
2293  bnoise=uves_propertylist_get_double(image_header,UVES_BNOISE);
2294  bnoise2=bnoise*bnoise;
2295  }
2296 
2297  if(has_dnoise) {
2298  dnoise=uves_propertylist_get_double(image_header,UVES_DNOISE);
2299  dnoise2=dnoise*dnoise;
2300  dtime=uves_propertylist_get_double(image_header,UVES_DTIME);
2301  exptime=uves_pfits_get_exptime(image_header);
2302  exptime2=exptime*exptime/dtime/dtime;
2303  }
2304  var_bias_dark=bnoise2+dnoise2*exptime2;
2305  uves_msg_debug("bnoise=%g dnoise=%g sci exptime=%g dark exptime=%g",
2306  bnoise,dnoise,exptime,dtime);
2307 
2308  /* Apply 3x3 median filter to get rid of isolated hot/cold pixels */
2309 
2310  /* This filter is disabled, as there is often structure on the scale
2311  of 1 pixel (e.g. UVES_ORDER_FLAT frames). Smoothing out this
2312  structure *does* result in worse fits to the data.
2313 
2314  in_med = cpl_image_duplicate(image);
2315  assure( in_med != NULL, CPL_ERROR_ILLEGAL_OUTPUT, "Image duplication failed");
2316 
2317  uves_msg_low("Applying 3x3 median filter");
2318 
2319  check( uves_filter_image_median(&in_med, 1, 1), "Could not filter image");
2320  image_data = cpl_image_get_data_double(in_med);
2321 
2322  uves_msg_low("Setting pixel flux uncertainty");
2323  */
2324 
2325  /* We assume median stacked input (master flat, master dark, ...) */
2326  double median_factor = (ncom > 1) ? 2.0/M_PI : 1.0;
2327  double gain2=gain*gain;
2328 
2329  double quant_var = uves_max_double(0, (1 - gain2)/12.0);
2330  /* Quant. error =
2331  * sqrt((g^2-1)/12)
2332  */
2333  double flux_var_adu=0;
2334  double ron2=ron*ron;
2335  double inv_ncom_median_factor=1./(ncom * median_factor);
2336  for (i = 0; i < nx*ny; i++)
2337  {
2338 
2339  /* Slow: flux = cpl_image_get(image, x, y, &pis_rejected); */
2340  /* Slow: flux = image_data[(x-1) + (y-1) * nx]; */
2341  flux_var_adu = uves_max_double(image_data[i],0)*gain;
2342 
2343  /* For a number, N, of averaged or median stacked "identical" frames
2344  * (gaussian distribution assumed), the combined noise is
2345  *
2346  * sigma_N = sigma / sqrt(N*f)
2347  *
2348  * where (to a good approximation)
2349  * f ~= { 1 , N = 1
2350  * { 2/pi , N > 1
2351  *
2352  * (i.e. the resulting uncertainty is
2353  * larger than for average stacked inputs where f = 1)
2354  */
2355 
2356  /* Slow: cpl_image_set(noise, x, y, ... ); */
2357  /* Slow: noise_data[(x-1) + (y-1)*nx] =
2358  sqrt((ron*ron + quant_var + sigma_adu*sigma_adu) /
2359  ((MIDAS) ? 1 : ncom * median_factor)); */
2360 
2361 
2362  tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor)+
2363  var_bias_dark;
2364 
2365  /*
2366  tot_noise2=(( ron2 + quant_var + flux_var_adu )*inv_ncom_median_factor);
2367  */
2368  noise_data[i] = sqrt(tot_noise2);
2369  }
2370 
2371  cleanup:
2372  /* uves_free_image(&in_med); */
2373  if (cpl_error_get_code() != CPL_ERROR_NONE)
2374  {
2375  uves_free_image(&noise);
2376  }
2377 
2378  return noise;
2379 }
2380 
2381 
2382 /*----------------------------------------------------------------------------*/
2392 /*----------------------------------------------------------------------------*/
2393 cpl_error_code
2394 uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
2395 {
2396  passure ( image != NULL, " ");
2397  passure ( master_bias != NULL, " ");
2398 
2399  check( cpl_image_subtract(image, master_bias),
2400  "Error subtracting bias");
2401 
2402  /* Due to different bad column correction in image/master_bias,
2403  it might happen that the image has become negative after
2404  subtracting the bias. Disallow that. */
2405 
2406 #if 0
2407  /* No, for backwards compatibility, allow negative values.
2408  * MIDAS has an inconsistent logic on this matter.
2409  * For master dark frames, the thresholding *is* applied,
2410  * but not for science frames. Therefore we have to
2411  * apply thresholding on a case-by-case base (i.e. from
2412  * the caller).
2413  */
2414  check( cpl_image_threshold(image,
2415  0, DBL_MAX, /* Interval */
2416  0, DBL_MAX), /* New values */
2417  "Error thresholding image");
2418 #endif
2419 
2420  cleanup:
2421  return cpl_error_get_code();
2422 }
2423 /*----------------------------------------------------------------------------*/
2436 /*----------------------------------------------------------------------------*/
2437 cpl_error_code
2438 uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header,
2439  const cpl_image *master_dark,
2440  const uves_propertylist *mdark_header)
2441 {
2442  cpl_image *normalized_mdark = NULL;
2443  double image_exptime = 0.0;
2444  double mdark_exptime = 0.0;
2445 
2446  passure ( image != NULL, " ");
2447  passure ( image_header != NULL, " ");
2448  passure ( master_dark != NULL, " ");
2449  passure ( mdark_header != NULL, " ");
2450 
2451  /* Normalize mdark to same exposure time as input image, then subtract*/
2452  check( image_exptime = uves_pfits_get_uit(image_header),
2453  "Error reading input image exposure time");
2454 
2455  check( mdark_exptime = uves_pfits_get_uit(mdark_header),
2456  "Error reading master dark exposure time");
2457 
2458  uves_msg("Rescaling master dark from %f s to %f s exposure time",
2459  mdark_exptime, image_exptime);
2460 
2461  check( normalized_mdark =
2462  cpl_image_multiply_scalar_create(master_dark,
2463  image_exptime / mdark_exptime),
2464  "Error normalizing master dark");
2465 
2466  check( cpl_image_subtract(image, normalized_mdark),
2467  "Error subtracting master dark");
2468 
2469  uves_msg_warning("noise rescaled master dark %g",cpl_image_get_stdev(normalized_mdark));
2470 
2471 
2472  cleanup:
2473  uves_free_image(&normalized_mdark);
2474  return cpl_error_get_code();
2475 }
2476 
2477 /*----------------------------------------------------------------------------*/
2491 /*----------------------------------------------------------------------------*/
2492 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
2493 {
2494  return (first_abs_order +
2495  (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
2496 }
2497 
2498 /*----------------------------------------------------------------------------*/
2512 /*----------------------------------------------------------------------------*/
2513 double
2514 uves_average_reject(cpl_table *t,
2515  const char *column,
2516  const char *residual2,
2517  double kappa)
2518 {
2519  double mean = 0, median, sigma2;
2520  int rejected;
2521 
2522  do {
2523  /* Robust estimation */
2524  check_nomsg(median = cpl_table_get_column_median(t, column));
2525 
2526  /* Create column
2527  residual2 = (column - median)^2 */
2528  check_nomsg(cpl_table_duplicate_column(t, residual2, t, column));
2529  check_nomsg(cpl_table_subtract_scalar(t, residual2, median));
2530  check_nomsg(cpl_table_multiply_columns(t, residual2, residual2));
2531 
2532  /* For a Gaussian distribution:
2533  * sigma ~= median(|residual|) / 0.6744
2534  * sigma^2 ~= median(residual^2) / 0.6744^2
2535  */
2536 
2537  check_nomsg(sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744));
2538 
2539  /* Reject values where
2540  residual^2 > (kappa*sigma)^2
2541  */
2542  check_nomsg( rejected = uves_erase_table_rows(t, residual2,
2543  CPL_GREATER_THAN,
2544  kappa*kappa*sigma2));
2545 
2546  check_nomsg(cpl_table_erase_column(t, residual2));
2547 
2548  } while (rejected > 0);
2549 
2550  check_nomsg(mean = cpl_table_get_column_mean(t, column));
2551 
2552  cleanup:
2553  return mean;
2554 }
2555 
2556 /*----------------------------------------------------------------------------*/
2589 /*----------------------------------------------------------------------------*/
2590 polynomial *
2592  const char *X, const char *Y, const char *sigmaY,
2593  int degree,
2594  const char *polynomial_fit, const char *residual_square,
2595  double *mean_squared_error, double kappa)
2596 {
2597  int N;
2598  int total_rejected = 0; /* Rejected in kappa sigma clipping */
2599  int rejected = 0;
2600  double mse; /* local mean squared error */
2601  double *x;
2602  double *y;
2603  double *sy;
2604  polynomial *result = NULL;
2605  cpl_vector *vx = NULL;
2606  cpl_vector *vy = NULL;
2607  cpl_vector *vsy = NULL;
2608  cpl_type type;
2609 
2610  /* Check input */
2611  assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
2612  assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
2613  assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
2614  assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
2615  assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
2616  assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
2617  "No such column: %s", sigmaY);
2618 
2619  assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
2620  CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
2621 
2622  assure( residual_square == NULL || !cpl_table_has_column(t, residual_square),
2623  CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
2624 
2625  /* Check column types */
2626  type = cpl_table_get_column_type(t, Y);
2627  assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
2628  "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
2629  type = cpl_table_get_column_type(t, X);
2630  assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
2631  "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
2632  if (sigmaY != NULL)
2633  {
2634  type = cpl_table_get_column_type(t, sigmaY);
2635  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
2636  CPL_ERROR_INVALID_TYPE,
2637  "Input column '%s' has wrong type (%s)",
2638  sigmaY, uves_tostring_cpl_type(type));
2639  }
2640 
2641  check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
2642  "Could not cast table column '%s' to double", X);
2643  check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
2644  "Could not cast table column '%s' to double", Y);
2645  if (sigmaY != NULL)
2646  {
2647  check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE),
2648  "Could not cast table column '%s' to double", sigmaY);
2649  }
2650 
2651 
2652  total_rejected = 0;
2653  rejected = 0;
2654  check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE),
2655  "Could not create column");
2656  do{
2657  check( (N = cpl_table_get_nrow(t),
2658  x = cpl_table_get_data_double(t, "_X_double"),
2659  y = cpl_table_get_data_double(t, "_Y_double")),
2660  "Could not read table data");
2661 
2662  if (sigmaY != NULL)
2663  {
2664  check( sy = cpl_table_get_data_double(t, "_sY_double"),
2665  "Could not read table data");
2666  }
2667  else
2668  {
2669  sy = NULL;
2670  }
2671 
2672  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table. "
2673  "No points to fit in poly 1d regression. At least 2 needed");
2674 
2675  assure( N > degree, CPL_ERROR_ILLEGAL_INPUT, "%d points to fit in poly 1d "
2676  "regression of degree %d. At least %d needed.",
2677  N,degree,degree+1);
2678 
2679  /* Wrap vectors */
2680  uves_unwrap_vector(&vx);
2681  uves_unwrap_vector(&vy);
2682 
2683  vx = cpl_vector_wrap(N, x);
2684  vy = cpl_vector_wrap(N, y);
2685 
2686  if (sy != NULL)
2687  {
2688  uves_unwrap_vector(&vsy);
2689  vsy = cpl_vector_wrap(N, sy);
2690  }
2691  else
2692  {
2693  vsy = NULL;
2694  }
2695 
2696  /* Fit! */
2697  uves_polynomial_delete(&result);
2698  check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse),
2699  "Could not fit polynomial");
2700 
2701  /* If requested, calculate residuals and perform kappa-sigma clipping */
2702  if (kappa > 0)
2703  {
2704  double sigma2; /* sigma squared */
2705  int i;
2706 
2707  for (i = 0; i < N; i++)
2708  {
2709  double xval, yval, yfit;
2710 
2711  check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
2712  yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
2713  yfit = uves_polynomial_evaluate_1d(result, xval),
2714 
2715  cpl_table_set_double(t, "_residual_square", i,
2716  (yfit-yval)*(yfit-yval))),
2717  "Could not evaluate polynomial");
2718  }
2719 
2720  /* For robustness, estimate sigma as (third quartile) / 0.6744
2721  * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
2722  * The third quartile is estimated as the median of the absolute residuals,
2723  * so sigma ~= median(|residual|) / 0.6744 , i.e.
2724  * sigma^2 ~= median(residual^2) / 0.6744^2
2725  */
2726  sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
2727 
2728  /* Remove points with residual^2 > kappa^2 * sigma^2 */
2729  check( rejected = uves_erase_table_rows(t, "_residual_square",
2730  CPL_GREATER_THAN, kappa*kappa*sigma2),
2731  "Could not remove outlier points");
2732 
2733  uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
2734  rejected, N, sqrt(mse));
2735 
2736  /* Update */
2737  total_rejected += rejected;
2738  N = cpl_table_get_nrow(t);
2739  }
2740 
2741 } while (rejected > 0);
2742 
2743  cpl_table_erase_column(t, "_residual_square");
2744 
2745  if (kappa > 0)
2746  {
2747  uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
2748  total_rejected,
2749  N + total_rejected,
2750  (100.0*total_rejected)/(N + total_rejected)
2751  );
2752  }
2753 
2754  if (mean_squared_error != NULL) *mean_squared_error = mse;
2755 
2756  /* Add the fitted values to table if requested */
2757  if (polynomial_fit != NULL || residual_square != NULL)
2758  {
2759  int i;
2760 
2761  check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE),
2762  "Could not create column");
2763  for (i = 0; i < N; i++){
2764  double xval;
2765  double yfit;
2766 
2767  check((
2768  xval = cpl_table_get_double(t, "_X_double", i, NULL),
2769  yfit = uves_polynomial_evaluate_1d(result, xval),
2770  cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
2771  "Could not evaluate polynomial");
2772  }
2773 
2774  /* Add residual^2 = (Polynomial fit - Y)^2 if requested */
2775  if (residual_square != NULL)
2776  {
2777  check(( cpl_table_duplicate_column(t, residual_square, /* RS := PF */
2778  t, "_polynomial_fit"),
2779  cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
2780  cpl_table_multiply_columns(t, residual_square, residual_square)),
2781  /* RS := RS^2 */
2782  "Could not calculate Residual of fit");
2783  }
2784 
2785  /* Keep the polynomial_fit column if requested */
2786  if (polynomial_fit != NULL)
2787  {
2788  cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
2789  }
2790  else
2791  {
2792  cpl_table_erase_column(t, "_polynomial_fit");
2793  }
2794  }
2795 
2796  check(( cpl_table_erase_column(t, "_X_double"),
2797  cpl_table_erase_column(t, "_Y_double")),
2798  "Could not delete temporary columns");
2799 
2800  if (sigmaY != NULL)
2801  {
2802  check( cpl_table_erase_column(t, "_sY_double"),
2803  "Could not delete temporary column");
2804  }
2805 
2806  cleanup:
2807  uves_unwrap_vector(&vx);
2808  uves_unwrap_vector(&vy);
2809  uves_unwrap_vector(&vsy);
2810  if (cpl_error_get_code() != CPL_ERROR_NONE)
2811  {
2812  uves_polynomial_delete(&result);
2813  }
2814 
2815  return result;
2816 }
2817 
2818 
2819 /*----------------------------------------------------------------------------*/
2867 /*----------------------------------------------------------------------------*/
2868 
2869 polynomial *
2871  const char *X1, const char *X2, const char *Y,
2872  const char *sigmaY,
2873  int degree1, int degree2,
2874  const char *polynomial_fit, const char *residual_square,
2875  const char *variance_fit,
2876  double *mse, double *red_chisq,
2877  polynomial **variance, double kappa,
2878  double min_reject)
2879 {
2880  int N;
2881  int rejected;
2882  int total_rejected;
2883  double *x1;
2884  double *x2;
2885  double *y;
2886  double *res;
2887  double *sy;
2888  polynomial *p = NULL; /* Result */
2889  polynomial *variance_local = NULL;
2890  cpl_vector *vx1 = NULL;
2891  cpl_vector *vx2 = NULL;
2892  cpl_bivector *vx = NULL;
2893  cpl_vector *vy = NULL;
2894  cpl_vector *vsy= NULL;
2895  cpl_type type;
2896 
2897  /* Check input */
2898  assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
2899  N = cpl_table_get_nrow(t);
2900  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "The table with column to compute regression has 0 rows!");
2901  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);
2902 
2903  assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
2904  assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
2905  assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
2906  assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
2907  CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
2908  if (sigmaY != NULL)
2909  {
2910  assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
2911  "No such column: %s", sigmaY);
2912  }
2913  if (polynomial_fit != NULL)
2914  {
2915  assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
2916  "Table already has '%s' column", polynomial_fit);
2917  }
2918  if (residual_square != NULL)
2919  {
2920  assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT,
2921  "Table already has '%s' column", residual_square);
2922  }
2923  if (variance_fit != NULL)
2924  {
2925  assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
2926  "Table already has '%s' column", variance_fit);
2927  }
2928 
2929  /* Check column types */
2930  type = cpl_table_get_column_type(t, X1);
2931  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2932  "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
2933  type = cpl_table_get_column_type(t, X2);
2934  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2935  "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
2936  type = cpl_table_get_column_type(t, Y);
2937  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2938  "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
2939  if (sigmaY != NULL)
2940  {
2941  type = cpl_table_get_column_type(t, sigmaY);
2942  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2943  "Input column '%s' has wrong type (%s)",
2944  sigmaY, uves_tostring_cpl_type(type));
2945  }
2946 
2947  /* In the case that these temporary columns already exist, a run-time error will occur */
2948  check( cpl_table_cast_column(t, X1 , "_X1_double", CPL_TYPE_DOUBLE),
2949  "Could not cast table column to double");
2950  check( cpl_table_cast_column(t, X2 , "_X2_double", CPL_TYPE_DOUBLE),
2951  "Could not cast table column to double");
2952  check( cpl_table_cast_column(t, Y , "_Y_double", CPL_TYPE_DOUBLE),
2953  "Could not cast table column to double");
2954  if (sigmaY != NULL)
2955  {
2956  check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE),
2957  "Could not cast table column to double");
2958  }
2959 
2960  total_rejected = 0;
2961  rejected = 0;
2962  check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE),
2963  "Could not create column");
2964 
2965  do {
2966  /* WARNING!!! Code duplication (see below). Be careful
2967  when updating */
2968  check(( N = cpl_table_get_nrow(t),
2969  x1 = cpl_table_get_data_double(t, "_X1_double"),
2970  x2 = cpl_table_get_data_double(t, "_X2_double"),
2971  y = cpl_table_get_data_double(t, "_Y_double"),
2972  res= cpl_table_get_data_double(t, "_residual_square")),
2973  "Could not read table data");
2974 
2975  if (sigmaY != NULL)
2976  {
2977  check (sy = cpl_table_get_data_double(t, "_sY_double"),
2978  "Could not read table data");
2979  }
2980  else
2981  {
2982  sy = NULL;
2983  }
2984 
2985  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
2986 
2987  /* Wrap vectors */
2988  uves_unwrap_vector(&vx1);
2989  uves_unwrap_vector(&vx2);
2990  uves_unwrap_vector(&vy);
2991 
2992  vx1 = cpl_vector_wrap(N, x1);
2993  vx2 = cpl_vector_wrap(N, x2);
2994  vy = cpl_vector_wrap(N, y);
2995  if (sy != NULL)
2996  {
2997  uves_unwrap_vector(&vsy);
2998  vsy = cpl_vector_wrap(N, sy);
2999  }
3000  else
3001  {
3002  vsy = NULL;
3003  }
3004 
3005  /* Wrap up the bi-vector */
3006  uves_unwrap_bivector_vectors(&vx);
3007  vx = cpl_bivector_wrap_vectors(vx1, vx2);
3008 
3009  /* Fit! */
3011  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3012  NULL, NULL, NULL),
3013  "Could not fit polynomial");
3014 
3015  /* If requested, calculate residuals and perform kappa-sigma clipping */
3016  if (kappa > 0)
3017  {
3018  double sigma2; /* sigma squared */
3019  int i;
3020 
3021  cpl_table_fill_column_window_double(t, "_residual_square", 0,
3022  cpl_table_get_nrow(t), 0.0);
3023 
3024  for (i = 0; i < N; i++)
3025  {
3026  double yval, yfit;
3027 
3028  yval = y[i];
3029  yfit = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
3030  res[i] = (yfit-y[i])*(yfit-y[i]);
3031  }
3032 
3033  /* For robustness, estimate sigma as (third quartile) / 0.6744
3034  * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
3035  * The third quartile is estimated as the median of the absolute residuals,
3036  * so sigma ~= median(|residual|) / 0.6744 , i.e.
3037  * sigma^2 ~= median(residual^2) / 0.6744^2
3038  */
3039  sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
3040 
3041 
3042  /* Remove points with residual^2 > kappa^2 * sigma^2 */
3043  check( rejected = uves_erase_table_rows(t, "_residual_square",
3044  CPL_GREATER_THAN, kappa*kappa*sigma2),
3045  "Could not remove outlier points");
3046  /* Note! All pointers to table data are now invalid! */
3047 
3048 
3049  uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
3050  rejected, N, sqrt(sigma2));
3051 
3052  /* Update */
3053  total_rejected += rejected;
3054  N = cpl_table_get_nrow(t);
3055  }
3056 
3057  /* Stop also if there are too few points left to make the fit.
3058  * Needed number of points = (degree1+1)(degree2+1) coefficients
3059  * plus one extra point for chi^2 computation. */
3060  } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
3061  N >= (degree1 + 1)*(degree2 + 1) + 1);
3062 
3063  if (kappa > 0)
3064  {
3065  uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
3066  total_rejected,
3067  N + total_rejected,
3068  (100.0*total_rejected)/(N + total_rejected)
3069  );
3070  }
3071 
3072  /* Final fit */
3073  {
3074  /* Need to convert to vector again. */
3075 
3076  /* WARNING!!! Code duplication (see above). Be careful
3077  when updating */
3078  check(( N = cpl_table_get_nrow(t),
3079  x1 = cpl_table_get_data_double(t, "_X1_double"),
3080  x2 = cpl_table_get_data_double(t, "_X2_double"),
3081  y = cpl_table_get_data_double(t, "_Y_double"),
3082  res= cpl_table_get_data_double(t, "_residual_square")),
3083  "Could not read table data");
3084 
3085  if (sigmaY != NULL)
3086  {
3087  check (sy = cpl_table_get_data_double(t, "_sY_double"),
3088  "Could not read table data");
3089  }
3090  else
3091  {
3092  sy = NULL;
3093  }
3094 
3095  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
3096 
3097  /* Wrap vectors */
3098  uves_unwrap_vector(&vx1);
3099  uves_unwrap_vector(&vx2);
3100  uves_unwrap_vector(&vy);
3101 
3102  vx1 = cpl_vector_wrap(N, x1);
3103  vx2 = cpl_vector_wrap(N, x2);
3104  vy = cpl_vector_wrap(N, y);
3105  if (sy != NULL)
3106  {
3107  uves_unwrap_vector(&vsy);
3108  vsy = cpl_vector_wrap(N, sy);
3109  }
3110  else
3111  {
3112  vsy = NULL;
3113  }
3114 
3115  /* Wrap up the bi-vector */
3116  uves_unwrap_bivector_vectors(&vx);
3117  vx = cpl_bivector_wrap_vectors(vx1, vx2);
3118  }
3119 
3121  if (variance_fit != NULL || variance != NULL)
3122  {
3123  /* If requested, also compute variance */
3124  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3125  mse, red_chisq, &variance_local),
3126  "Could not fit polynomial");
3127  }
3128  else
3129  {
3130  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3131  mse, red_chisq, NULL),
3132  "Could not fit polynomial");
3133  }
3134 
3135  cpl_table_erase_column(t, "_residual_square");
3136 
3137  /* Add the fitted values to table as requested */
3138  if (polynomial_fit != NULL || residual_square != NULL)
3139  {
3140  int i;
3141  double *pf;
3142 
3143  check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE),
3144  "Could not create column");
3145 
3146  cpl_table_fill_column_window_double(t, "_polynomial_fit", 0,
3147  cpl_table_get_nrow(t), 0.0);
3148 
3149  x1 = cpl_table_get_data_double(t, "_X1_double");
3150  x2 = cpl_table_get_data_double(t, "_X2_double");
3151  pf = cpl_table_get_data_double(t, "_polynomial_fit");
3152 
3153  for (i = 0; i < N; i++){
3154 #if 0
3155  double x1val, x2val, yfit;
3156 
3157  check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
3158  x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
3159  yfit = uves_polynomial_evaluate_2d(p, x1val, x2val),
3160 
3161  cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
3162  "Could not evaluate polynomial");
3163 
3164 #else
3165  pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
3166 #endif
3167  }
3168 
3169  /* Add residual^2 = (Polynomial fit - Y)^2 if requested */
3170  if (residual_square != NULL)
3171  {
3172  check(( cpl_table_duplicate_column(t, residual_square, /* RS := PF */
3173  t, "_polynomial_fit"),
3174  cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
3175  cpl_table_multiply_columns(t, residual_square, residual_square)),
3176  /* RS := RS^2 */
3177  "Could not calculate Residual of fit");
3178  }
3179 
3180  /* Keep the polynomial_fit column if requested */
3181  if (polynomial_fit != NULL)
3182  {
3183  cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
3184  }
3185  else
3186  {
3187  cpl_table_erase_column(t, "_polynomial_fit");
3188  }
3189  }
3190 
3191  /* Add variance of poly_fit if requested */
3192  if (variance_fit != NULL)
3193  {
3194  int i;
3195  double *vf;
3196 
3197  check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE),
3198  "Could not create column");
3199 
3200  cpl_table_fill_column_window_double(t, variance_fit, 0,
3201  cpl_table_get_nrow(t), 0.0);
3202 
3203  x1 = cpl_table_get_data_double(t, "_X1_double");
3204  x2 = cpl_table_get_data_double(t, "_X2_double");
3205  vf = cpl_table_get_data_double(t, variance_fit);
3206 
3207  for (i = 0; i < N; i++)
3208  {
3209 #if 0
3210  double x1val, x2val, yfit_variance;
3211  check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
3212  x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
3213  yfit_variance = uves_polynomial_evaluate_2d(variance_local,
3214  x1val, x2val),
3215 
3216  cpl_table_set_double(t, variance_fit, i, yfit_variance)),
3217  "Could not evaluate polynomial");
3218 #else
3219  vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
3220 #endif
3221 
3222  }
3223  }
3224 
3225 
3226  check(( cpl_table_erase_column(t, "_X1_double"),
3227  cpl_table_erase_column(t, "_X2_double"),
3228  cpl_table_erase_column(t, "_Y_double")),
3229  "Could not delete temporary columns");
3230 
3231  if (sigmaY != NULL)
3232  {
3233  check( cpl_table_erase_column(t, "_sY_double"),
3234  "Could not delete temporary column");
3235  }
3236 
3237  cleanup:
3238  uves_unwrap_bivector_vectors(&vx);
3239  uves_unwrap_vector(&vx1);
3240  uves_unwrap_vector(&vx2);
3241  uves_unwrap_vector(&vy);
3242  uves_unwrap_vector(&vsy);
3243  /* Delete 'variance_local', or return through 'variance' parameter */
3244  if (variance != NULL)
3245  {
3246  *variance = variance_local;
3247  }
3248  else
3249  {
3250  uves_polynomial_delete(&variance_local);
3251  }
3252  if (cpl_error_get_code() != CPL_ERROR_NONE)
3253  {
3255  }
3256 
3257  return p;
3258 }
3259 
3260 /*----------------------------------------------------------------------------*/
3303 /*----------------------------------------------------------------------------*/
3304 
3305 polynomial *
3307  const char *X1, const char *X2, const char *Y,
3308  const char *sigmaY,
3309  const char *polynomial_fit,
3310  const char *residual_square,
3311  const char *variance_fit,
3312  double *mean_squared_error, double *red_chisq,
3313  polynomial **variance, double kappa,
3314  int maxdeg1, int maxdeg2, double min_rms,
3315  double min_reject,
3316  bool verbose,
3317  const double *min_val,
3318  const double *max_val,
3319  int npos, double positions[][2])
3320 {
3321  int deg1 = 0; /* Current degrees */
3322  int deg2 = 0; /* Current degrees */
3323  int i;
3324 
3325  double **mse = NULL;
3326  bool adjust1 = true; /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
3327  bool adjust2 = true; /* (or held constant) */
3328  bool finished = false;
3329 
3330  const char *y_unit;
3331  cpl_table *temp = NULL;
3332  polynomial *bivariate_fit = NULL; /* Result */
3333 
3334  assure( (min_val == NULL && max_val == NULL) || positions != NULL,
3335  CPL_ERROR_NULL_INPUT,
3336  "Missing positions array");
3337 
3338  check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
3339  if (y_unit == NULL)
3340  {
3341  y_unit = "";
3342  }
3343 
3344  assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT,
3345  "Illegal max. degrees: (%d, %d)",
3346  maxdeg1, maxdeg2);
3347 
3348  mse = cpl_calloc(maxdeg1+1, sizeof(double *));
3349  assure_mem(mse);
3350  for (i = 0; i < maxdeg1+1; i++)
3351  {
3352  int j;
3353  mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
3354  assure_mem(mse);
3355 
3356  for (j = 0; j < maxdeg2+1; j++)
3357  {
3358  mse[i][j] = -1;
3359  }
3360  }
3361 
3362  temp = cpl_table_duplicate(t);
3363  assure_mem(temp);
3364 
3365  uves_polynomial_delete(&bivariate_fit);
3366  check( bivariate_fit = uves_polynomial_regression_2d(temp,
3367  X1, X2, Y, sigmaY,
3368  deg1,
3369  deg2,
3370  NULL, NULL, NULL, /* new columns */
3371  &mse[deg1][deg2], NULL, /* chi^2/N */
3372  NULL, /* variance pol.*/
3373  kappa, min_reject),
3374  "Error fitting polynomial");
3375  if (verbose)
3376  uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
3377  deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
3378  cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
3379  cpl_table_get_nrow(t));
3380  else
3381  uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
3382  deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
3383  cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
3384  cpl_table_get_nrow(t));
3385  /* Find best values of deg1, deg2 less than or equal to 8,8
3386  (the fitting algorithm is unstable after this point, anyway) */
3387  do
3388  {
3389  int new_deg1, new_deg2;
3390  double m;
3391 
3392  finished = true;
3393 
3394  adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
3395  adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
3396 
3397  /* Try the new degrees
3398 
3399  (d1+1, d2 ) (d1+2, d2)
3400  (d1, d2+1) (d1+1, d2+1)
3401  (d1, d2+2)
3402 
3403  in the following order:
3404 
3405  1 3
3406  1 2
3407  3
3408 
3409  (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
3410  */
3411  for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
3412  for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
3413  if ( (
3414  (new_deg1 == deg1+1 && new_deg2 == deg2 && adjust1) ||
3415  (new_deg1 == deg1+2 && new_deg2 == deg2 && adjust1) ||
3416  (new_deg1 == deg1 && new_deg2 == deg2+1 && adjust2) ||
3417  (new_deg1 == deg1 && new_deg2 == deg2+2 && adjust2) ||
3418  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
3419  )
3420  && mse[new_deg1][new_deg2] < 0)
3421  {
3422  int rejected = 0;
3423 
3424  uves_free_table(&temp);
3425  temp = cpl_table_duplicate(t);
3426  assure_mem(temp);
3427 
3428  uves_polynomial_delete(&bivariate_fit);
3429  bivariate_fit = uves_polynomial_regression_2d(temp,
3430  X1, X2, Y, sigmaY,
3431  new_deg1,
3432  new_deg2,
3433  NULL, NULL, NULL,
3434  &(mse[new_deg1]
3435  [new_deg2]),
3436  NULL,
3437  NULL,
3438  kappa, min_reject);
3439 
3440  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
3441  {
3442  uves_error_reset();
3443 
3444  if (verbose)
3445  uves_msg_low("(%d, %d)-degree: Singular matrix",
3446  new_deg1, new_deg2);
3447  else
3448  uves_msg_debug("(%d, %d)-degree: Singular matrix",
3449  new_deg1, new_deg2);
3450 
3451  mse[new_deg1][new_deg2] = DBL_MAX/2;
3452  }
3453  else
3454  {
3455  assure( cpl_error_get_code() == CPL_ERROR_NONE,
3456  cpl_error_get_code(),
3457  "Error fitting (%d, %d)-degree polynomial",
3458  new_deg1, new_deg2 );
3459 
3460  rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
3461 
3462  if (verbose)
3463  uves_msg_low("(%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  else
3467  uves_msg_debug("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
3468  new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
3469  rejected, cpl_table_get_nrow(t));
3470 
3471  /* Reject if fit produced bad values */
3472  if (min_val != NULL || max_val != NULL)
3473  {
3474  for (i = 0; i < npos; i++)
3475  {
3476  double val = uves_polynomial_evaluate_2d(
3477  bivariate_fit,
3478  positions[i][0], positions[i][1]);
3479  if (min_val != NULL && val < *min_val)
3480  {
3481  uves_msg_debug("Bad fit: %f < %f",
3482  val,
3483  *min_val);
3484  mse[new_deg1][new_deg2] = DBL_MAX/2;
3485  /* A large number, even if we add a bit */
3486  }
3487  if (max_val != NULL && val > *max_val)
3488  {
3489  uves_msg_debug("Bad fit: %f > %f",
3490  val,
3491  *max_val);
3492  mse[new_deg1][new_deg2] = DBL_MAX/2;
3493  }
3494  }
3495  }
3496 
3497  /* For robustness, make sure that we don't accept a solution that
3498  rejected too many points (say, 80%)
3499  */
3500  if (rejected >= (4*cpl_table_get_nrow(t))/5)
3501  {
3502  mse[new_deg1][new_deg2] = DBL_MAX/2;
3503  }
3504 
3505  }/* if fit succeeded */
3506  }
3507 
3508  /* If fit is significantly better (say, 10% improvement in MSE) in either direction,
3509  * (in (degree,degree)-space) then move in that direction.
3510  *
3511  * First try to move one step horizontal/vertical,
3512  * otherwise try to move diagonally (i.e. increase both degrees),
3513  * otherwise move two steps horizontal/vertical
3514  *
3515  */
3516  m = mse[deg1][deg2];
3517 
3518  if (adjust1
3519  && (m - mse[deg1+1][deg2])/m > 0.1
3520  && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
3521  /* The condition is read like this:
3522  if
3523  - we are trying to move right, and
3524  - this is this is a better place than the current, and
3525  - this is better than moving down */
3526  )
3527  {
3528  deg1++;
3529  finished = false;
3530  }
3531  else if (adjust2 &&
3532  (m - mse[deg1][deg2+1])/m > 0.1
3533  && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
3534  )
3535  {
3536  deg2++;
3537  finished = false;
3538  }
3539  else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
3540  {
3541  deg1++;
3542  deg2++;
3543  finished = false;
3544  }
3545  else if (adjust1
3546  && (m - mse[deg1+2][deg2])/m > 0.1
3547  && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
3548  )
3549  {
3550  deg1 += 2;
3551  finished = false;
3552  }
3553  else if (adjust2
3554  && (m - mse[deg1][deg2+2])/m > 0.1
3555  && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
3556  {
3557  deg2 += 2;
3558  finished = false;
3559  }
3560 
3561  /* For efficiency, stop if rms reached min_rms */
3562  finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
3563 
3564  } while (!finished);
3565 
3566  uves_polynomial_delete(&bivariate_fit);
3567  check( bivariate_fit = uves_polynomial_regression_2d(t,
3568  X1, X2, Y, sigmaY,
3569  deg1,
3570  deg2,
3571  polynomial_fit, residual_square,
3572  variance_fit,
3573  mean_squared_error, red_chisq,
3574  variance, kappa, min_reject),
3575  "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
3576 
3577  if (verbose)
3578  uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2,
3579  sqrt(mse[deg1][deg2]), y_unit);
3580  else
3581  uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2,
3582  sqrt(mse[deg1][deg2]), y_unit);
3583 
3584  cleanup:
3585  if (mse != NULL)
3586  {
3587  for (i = 0; i < maxdeg1+1; i++)
3588  {
3589  if (mse[i] != NULL)
3590  {
3591  cpl_free(mse[i]);
3592  }
3593  }
3594  cpl_free(mse);
3595  }
3596  uves_free_table(&temp);
3597 
3598  return bivariate_fit;
3599 }
3600 
3601 /*----------------------------------------------------------------------------*/
3611 /*----------------------------------------------------------------------------*/
3612 const char *
3613 uves_remove_string_prefix(const char *s, const char *prefix)
3614 {
3615  const char *result = NULL;
3616  unsigned int prefix_length;
3617 
3618  assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
3619  assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
3620 
3621  prefix_length = strlen(prefix);
3622 
3623  assure( strlen(s) >= prefix_length &&
3624  strncmp(s, prefix, prefix_length) == 0,
3625  CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
3626  prefix, s);
3627 
3628  result = s + prefix_length;
3629 
3630  cleanup:
3631  return result;
3632 }
3633 
3634 
3635 /*----------------------------------------------------------------------------*/
3644 /*----------------------------------------------------------------------------*/
3645 
3646 double uves_gaussrand(void)
3647 {
3648  static double V1, V2, S;
3649  static int phase = 0;
3650  double X;
3651 
3652  if(phase == 0) {
3653  do {
3654  double U1 = (double)rand() / RAND_MAX;
3655  double U2 = (double)rand() / RAND_MAX;
3656 
3657  V1 = 2 * U1 - 1;
3658  V2 = 2 * U2 - 1;
3659  S = V1 * V1 + V2 * V2;
3660  } while(S >= 1 || S == 0);
3661 
3662  X = V1 * sqrt(-2 * log(S) / S);
3663  } else
3664  X = V2 * sqrt(-2 * log(S) / S);
3665 
3666  phase = 1 - phase;
3667 
3668  return X;
3669 }
3670 
3671 /*----------------------------------------------------------------------------*/
3682 /*----------------------------------------------------------------------------*/
3683 
3684 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x,
3685  const char *column_y, int *istart )
3686 {
3687  double result = 0;
3688  int n;
3689 
3690  const double *x, *y;
3691 
3692  check( x = cpl_table_get_data_double_const(t, column_x),
3693  "Error reading column '%s'", column_x);
3694  check( y = cpl_table_get_data_double_const(t, column_y),
3695  "Error reading column '%s'", column_y);
3696 
3697  n = cpl_table_get_nrow(t);
3698 
3699  result = uves_spline_hermite(xp, x, y, n, istart);
3700 
3701  cleanup:
3702  return result;
3703 }
3704 
3705 /*----------------------------------------------------------------------------*/
3721 /*----------------------------------------------------------------------------*/
3722 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
3723 {
3724  double yp1, yp2, yp = 0;
3725  double xpi, xpi1, l1, l2, lp1, lp2;
3726  int i;
3727 
3728  if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) ) return 0.0;
3729  if ( x[0] > x[n-1] && (xp > x[0] || xp < x[n-1]) ) return 0.0;
3730 
3731  if ( x[0] <= x[n-1] )
3732  {
3733  for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
3734  ;
3735  }
3736  else
3737  {
3738  for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
3739  ;
3740  }
3741 
3742  *istart = i;
3743  i--;
3744 
3745  lp1 = 1.0 / (x[i-1] - x[i]);
3746  lp2 = -lp1;
3747 
3748  if ( i == 1 )
3749  {
3750  yp1 = (y[1] - y[0]) / (x[1] - x[0]);
3751  }
3752  else
3753  {
3754  yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
3755  }
3756 
3757  if ( i >= n - 1 )
3758  {
3759  yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
3760  }
3761  else
3762  {
3763  yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
3764  }
3765 
3766  xpi1 = xp - x[i];
3767  xpi = xp - x[i-1];
3768  l1 = xpi1*lp1;
3769  l2 = xpi*lp2;
3770 
3771  yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 +
3772  y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 +
3773  yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
3774 
3775  return yp;
3776 }
3777 
3778 /*----------------------------------------------------------------------------*/
3792 /*----------------------------------------------------------------------------*/
3793 
3794 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
3795 {
3796  int klo, khi, k;
3797  double a, b, h, yp = 0;
3798 
3799  assure_nomsg( x != NULL, CPL_ERROR_NULL_INPUT);
3800  assure_nomsg( y != NULL, CPL_ERROR_NULL_INPUT);
3801  assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
3802  assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
3803 
3804  klo = *kstart;
3805  khi = n;
3806 
3807  if ( xp < x[1] || xp > x[n] )
3808  {
3809  return 0.0;
3810  }
3811  else if ( xp == x[1] )
3812  {
3813  return(y[1]);
3814  }
3815 
3816  for ( k = klo; k < n && xp > x[k]; k++ )
3817  ;
3818 
3819  klo = *kstart = k-1;
3820  khi = k;
3821 
3822  h = x[khi] - x[klo];
3823  assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
3824  "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
3825 
3826  a = (x[khi] - xp) / h;
3827  b = (xp - x[klo]) / h;
3828 
3829  yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
3830  (h*h) / 6.0;
3831 
3832  cleanup:
3833  return yp;
3834 }
3835 
3836 /*----------------------------------------------------------------------------*/
3846 /*----------------------------------------------------------------------------*/
3847 bool
3848 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
3849 {
3850  bool is_sorted = true; /* ... until proven false */
3851  int i;
3852  int N;
3853  double previous, current; /* column values */
3854 
3855  passure(t != NULL, " ");
3856  passure(cpl_table_has_column(t, column), "No column '%s'", column);
3857  passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
3858 
3859  N = cpl_table_get_nrow(t);
3860 
3861  if (N > 1)
3862  {
3863  previous = cpl_table_get_double(t, column, 0, NULL);
3864 
3865  for(i = 1; i < N && is_sorted; i++)
3866  {
3867  current = cpl_table_get_double(t, column, i, NULL);
3868  if (!reverse)
3869  {
3870  /* Check for ascending */
3871  is_sorted = is_sorted && ( current >= previous );
3872  }
3873  else
3874  {
3875  /* Check for descending */
3876  is_sorted = is_sorted && ( current <= previous );
3877  }
3878 
3879  previous = current;
3880  }
3881  }
3882  else
3883  {
3884  /* 0 or 1 rows. Table is sorted */
3885  }
3886 
3887  cleanup:
3888  return is_sorted;
3889 }
3890 
3891 /*----------------------------------------------------------------------------*/
3897 /*----------------------------------------------------------------------------*/
3898 cpl_table *
3900 {
3901  cpl_table *result = NULL;
3902 
3903  check((
3904  result = cpl_table_new(0),
3905  cpl_table_new_column(result, "TraceID" , CPL_TYPE_INT),
3906  cpl_table_new_column(result, "Offset" , CPL_TYPE_DOUBLE),
3907  cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
3908  "Error creating table");
3909 
3910  cleanup:
3911  return result;
3912 }
3913 
3914 /*----------------------------------------------------------------------------*/
3924 /*----------------------------------------------------------------------------*/
3925 cpl_error_code
3926 uves_ordertable_traces_add(cpl_table *traces,
3927  int fibre_ID, double fibre_offset, int fibre_mask)
3928 {
3929  int size;
3930 
3931  assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
3932 
3933  /* Write to new table row */
3934  check((
3935  size = cpl_table_get_nrow(traces),
3936  cpl_table_set_size (traces, size+1),
3937  cpl_table_set_int (traces, "TraceID" , size, fibre_ID),
3938  cpl_table_set_double(traces, "Offset" , size, fibre_offset),
3939  cpl_table_set_int (traces, "Tracemask", size, fibre_mask)),
3940  "Error updating table");
3941 
3942  cleanup:
3943  return cpl_error_get_code();
3944 }
3945 
3946 
3947 /*----------------------------------------------------------------------------*/
3953 /*----------------------------------------------------------------------------*/
3954 cpl_error_code
3956 {
3957  cpl_table* tab=NULL;
3958  uves_propertylist* head=NULL;
3959  tab=cpl_table_load(tname,1,0);
3960  head=uves_propertylist_load(tname,0);
3962  check_nomsg(uves_table_save(tab,head,NULL,tname,CPL_IO_DEFAULT));
3963 
3964  cleanup:
3965  uves_free_table(&tab);
3966  uves_free_propertylist(&head);
3967  return cpl_error_get_code();
3968 }
3969 
3970 
3971 
3972 /*----------------------------------------------------------------------------*/
3979 /*----------------------------------------------------------------------------*/
3980 cpl_error_code
3981 uves_tablenames_unify_units(const char* tname2, const char* tname1)
3982 {
3983  cpl_table* tab1=NULL;
3984  cpl_table* tab2=NULL;
3985  uves_propertylist* head2=NULL;
3986 
3987  tab1=cpl_table_load(tname1,1,0);
3988 
3989  tab2=cpl_table_load(tname2,1,0);
3990  head2=uves_propertylist_load(tname2,0);
3991 
3992  uves_table_unify_units(&tab2,&tab1);
3993  check_nomsg(uves_table_save(tab2,head2,NULL,tname2,CPL_IO_DEFAULT));
3994 
3995  cleanup:
3996  uves_free_table(&tab1);
3997  uves_free_table(&tab2);
3998  uves_free_propertylist(&head2);
3999  return cpl_error_get_code();
4000 
4001 }
4002 
4003 
4004 
4005 /*----------------------------------------------------------------------------*/
4011 /*----------------------------------------------------------------------------*/
4012 cpl_error_code
4013 uves_table_remove_units(cpl_table **table)
4014 {
4015  int ncols;
4016  const char* colname=NULL;
4017  int i=0;
4018  cpl_array *names=NULL;
4019 
4020  assure( *table != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4021  ncols = cpl_table_get_ncol(*table);
4022  names = cpl_table_get_column_names(*table);
4023  for(i=0;i<ncols;i++) {
4024  colname=cpl_array_get_string(names, i);
4025  cpl_table_set_column_unit(*table,colname,NULL);
4026  }
4027 
4028  cleanup:
4029  uves_free_array(&names);
4030 
4031  return cpl_error_get_code();
4032 }
4033 
4034 
4035 
4036 /*----------------------------------------------------------------------------*/
4043 /*----------------------------------------------------------------------------*/
4044 cpl_error_code
4045 uves_table_unify_units(cpl_table **table2, cpl_table **table1)
4046 {
4047  int ncols1;
4048  int ncols2;
4049  const char* colname=NULL;
4050  const char* unit1=NULL;
4051 
4052  int i=0;
4053  cpl_array *names=NULL;
4054 
4055  assure( table1 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4056  assure( *table2 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4057  ncols1 = cpl_table_get_ncol(*table1);
4058  ncols2 = cpl_table_get_ncol(*table2);
4059  assure( ncols1 == ncols2, CPL_ERROR_NULL_INPUT,
4060  "n columns (tab1) != n columns (tab2)");
4061 
4062  names = cpl_table_get_column_names(*table1);
4063  for(i=0;i<ncols1;i++) {
4064  colname=cpl_array_get_string(names, i);
4065  unit1=cpl_table_get_column_unit(*table1,colname);
4066  cpl_table_set_column_unit(*table2,colname,unit1);
4067  }
4068 
4069  cleanup:
4070  uves_free_array(&names);
4071 
4072  return cpl_error_get_code();
4073 }
4074 
4075 /*
4076  * modified on 2006/04/19
4077  * jmlarsen: float[5] -> const double[]
4078  * changed mapping of indices to parameters
4079  * Normalized the profile to 1 and changed meaning
4080  * of (a[3], a[2]) to (integrated flux, stdev)
4081  * Disabled debugging messages
4082  *
4083  * modified on 2005/07/29 to make dydapar a FORTRAN array
4084  * (indiced from 1 to N instead of 0 to N-1).
4085  * This allows the array to be passed to C functions expecting
4086  * FORTRAN-like arrays.
4087  *
4088  * modified on 2005/08/02 to make the function prototype ANSI
4089  * compliant (so it can be used with the levmar library).
4090  *
4091  * modified on 2005/08/16. The function now expects C-indexed
4092  * arrays as parameters (to allow proper integration). However, the
4093  * arrays are still converted to FORTRAN-indexed arrays internally.
4094  */
4095 
4106 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
4107 
4108 
4109  /* int na;*/
4110 {
4111  double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
4112  double a2i=0, m = 0, p = 0, dif =0;
4113  double sqrt5 = 2.23606797749979;
4114 
4115  *y=0.0;
4116 // a2i = 1.0/a[2];
4117  a2i = 1.0/(a[2]*sqrt5);
4118 
4119  dif=x-a[1];
4120  arg=dif*a2i;
4121  arg2=arg*arg;
4122 
4123  fac=1.0+arg2;
4124  fac2=fac*fac;
4125  fac4=fac2*fac2;
4126  fac4i = 1.0/fac4;
4127 
4128 // m = a[1]*fac4i;
4129  m = a[3]*fac4i * a2i*16/(5.0*M_PI);
4130  *y = m + a[4]*(1.0+dif*a[5]);
4131  p = 8.0*m/fac*arg*a2i;
4132 
4133  dyda[3] = m/a[3];
4134  dyda[2] = p*dif/a[2] - m/a[2];
4135 
4136 // dyda[3]=fac4i;
4137  dyda[1]=p-a[4]*a[5];
4138 // dyda[2]=p*dif*a2i;
4139  dyda[4]=1.0+dif*a[5];
4140  dyda[5]=a[4]*dif;
4141 
4142 
4143 #if 0
4144  {
4145  int i = 0, npar=5 ;
4146  printf("fmoffat_i \n");
4147  for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
4148 
4149  printf("fmoffat_i ");
4150  for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
4151  printf("\n");
4152  }
4153 #endif
4154 
4155 }
4156 
4175 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
4176 //void fmoffa_c(x,a,y, dyda)
4177 
4178 
4179 // float x,*a,*y,*dyda;
4180 /*int na;*/
4181 {
4182  int npoint = 3;
4183  double const xgl[3] = {-0.387298334621,0.,0.387298334621};
4184  double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
4185  int i=0;
4186  int j=0;
4187  int npar = 5;
4188  double xmod = 0;
4189  double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
4190  double ypar;
4191 
4192 
4193  // Convert C-indexed arrays to FORTRAN-indexed arrays
4194  a = C_TO_FORTRAN_INDEXING(a);
4195  dyda = C_TO_FORTRAN_INDEXING(dyda);
4196 
4197  *y = 0.0;
4198  for (i = 1;i<=npar;i++) dyda[i] = 0.;
4199  /* printf("fmoffat_c ");
4200  for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
4201  /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
4202  /* printf("\n");*/
4203  for (j=0; j < npoint; j++)
4204  {
4205  xmod = x+xgl[j];
4206 
4207  fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
4208 
4209  *y = *y + ypar*wgl[j];
4210 
4211  for (i = 1; i <= npar; i++)
4212  {
4213  dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
4214  }
4215 
4216  /* if (j == 2)
4217  for (i = 1;i<=npar;i++)
4218  {
4219  dyda[i] = dydapar[i];
4220  };
4221  */
4222  }
4223 
4224 #if 0
4225  printf("fmoffat_c ");
4226  for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
4227  printf("\n");
4228 #endif
4229 }
4230 
4231 /*----------------------------------------------------------------------------*/
4239 /*----------------------------------------------------------------------------*/
4240 int
4241 uves_moffat(const double x[], const double a[], double *result)
4242 {
4243  double dyda[5];
4244 
4245  fmoffa_c(x[0], a, result, dyda);
4246 
4247  return 0;
4248 }
4249 
4250 /*----------------------------------------------------------------------------*/
4258 /*----------------------------------------------------------------------------*/
4259 int
4260 uves_moffat_derivative(const double x[], const double a[], double result[])
4261 {
4262  double y;
4263 
4264  fmoffa_c(x[0], a, &y, result);
4265 
4266  return 0;
4267 }
4268 
4269 /*----------------------------------------------------------------------------*/
4289 /*----------------------------------------------------------------------------*/
4290 
4291 int
4292 uves_gauss(const double x[], const double a[], double *result)
4293 {
4294  double my = a[0];
4295  double sigma = a[1];
4296 
4297  if (sigma == 0)
4298  {
4299  /* Dirac's delta function */
4300  if (x[0] == my)
4301  {
4302  *result = DBL_MAX;
4303  }
4304  else
4305  {
4306  *result = 0;
4307  }
4308  return 0;
4309  }
4310  else
4311  {
4312  double A = a[2];
4313  double B = a[3];
4314 
4315  *result = B +
4316  A/(sqrt(2*M_PI*sigma*sigma)) *
4317  exp(- (x[0] - my)*(x[0] - my)
4318  / (2*sigma*sigma));
4319  }
4320 
4321  return 0;
4322 }
4323 
4324 /*----------------------------------------------------------------------------*/
4344 /*----------------------------------------------------------------------------*/
4345 
4346 int
4347 uves_gauss_derivative(const double x[], const double a[], double result[])
4348 {
4349  double my = a[0];
4350  double sigma = a[1];
4351  double A = a[2];
4352  /* a[3] not used */
4353 
4354  double factor;
4355 
4356  /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4357  *
4358  * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my) / s^2
4359  * = A * fac. * (x-my) / s^2
4360  * df/ds = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
4361  * = A * fac. * ((x-my)^2 / s^2 - 1) / s
4362  * df/dA = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4363  * = fac.
4364  * df/dB = 1
4365  */
4366 
4367  if (sigma == 0)
4368  {
4369  /* Derivative of Dirac's delta function */
4370  result[0] = 0;
4371  result[1] = 0;
4372  result[2] = 0;
4373  result[3] = 0;
4374  return 0;
4375  }
4376 
4377  factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
4378  / (sqrt(2*M_PI*sigma*sigma));
4379 
4380  result[0] = A * factor * (x[0]-my) / (sigma*sigma);
4381  result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
4382  result[2] = factor;
4383  result[3] = 1;
4384 
4385  return 0;
4386 }
4387 
4388 /*----------------------------------------------------------------------------*/
4409 /*----------------------------------------------------------------------------*/
4410 
4411 int
4412 uves_gauss_linear(const double x[], const double a[], double *result)
4413 {
4414  double my = a[0];
4415  double sigma = a[1];
4416 
4417  if (sigma == 0)
4418  {
4419  /* Dirac's delta function */
4420  if (x[0] == my)
4421  {
4422  *result = DBL_MAX;
4423  }
4424  else
4425  {
4426  *result = 0;
4427  }
4428  return 0;
4429  }
4430  else
4431  {
4432  double A = a[2];
4433  double B = a[3];
4434  double C = a[4];
4435 
4436  *result = B + C*(x[0] - my) +
4437  A/(sqrt(2*M_PI*sigma*sigma)) *
4438  exp(- (x[0] - my)*(x[0] - my)
4439  / (2*sigma*sigma));
4440  }
4441 
4442  return 0;
4443 }
4444 
4445 /*----------------------------------------------------------------------------*/
4468 /*----------------------------------------------------------------------------*/
4469 
4470 int
4471 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
4472 {
4473  double my = a[0];
4474  double sigma = a[1];
4475  double A = a[2];
4476  /* a[3] not used */
4477  double C = a[4];
4478 
4479  double factor;
4480 
4481  /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4482  *
4483  * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my) / s^2
4484  * = A * fac. * (x-my) / s^2 - C
4485  * df/ds = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
4486  * = A * fac. * ((x-my)^2 / s^2 - 1) / s
4487  * df/dA = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4488  * = fac.
4489  * df/dB = 1
4490  *
4491  * df/dC = x-my
4492  */
4493 
4494  if (sigma == 0)
4495  {
4496  /* Derivative of Dirac's delta function */
4497  result[0] = -C;
4498  result[1] = 0;
4499  result[2] = 0;
4500  result[3] = 0;
4501  result[4] = x[0];
4502  return 0;
4503  }
4504 
4505  factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
4506  / (sqrt(2*M_PI*sigma*sigma));
4507 
4508  result[0] = A * factor * (x[0]-my) / (sigma*sigma);
4509  result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
4510  result[2] = factor;
4511  result[3] = 1;
4512  result[4] = x[0] - my;
4513 
4514  return 0;
4515 }
4516 
4517 
4518 
4519 
4520 /*----------------------------------------------------------------------------*/
4533 /*----------------------------------------------------------------------------*/
4534 cpl_image *
4535 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
4536  const cpl_image *spectrum, const cpl_image *sky,
4537  const cpl_image *cosmic_image,
4538  const uves_extract_profile *profile,
4539  cpl_image **image_noise, uves_propertylist **image_header)
4540 {
4541  cpl_image *image = NULL;
4542 
4543  cpl_binary *bpm = NULL;
4544  bool loop_y = false;
4545 
4546  double ron = 3;
4547  double gain = 1.0; //fixme
4548  bool new_format = true;
4549 
4550  image = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
4551  assure_mem( image );
4552  if (image_noise != NULL) {
4553  *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
4554  assure_mem( *image_noise );
4555  cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
4556  }
4557 
4558  if (image_header != NULL) {
4559  *image_header = uves_propertylist_new();
4560 
4561  uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
4562  uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
4563  uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
4564  }
4565 
4566  for (uves_iterate_set_first(pos,
4567  1, pos->nx,
4568  pos->minorder, pos->maxorder,
4569  bpm,
4570  loop_y);
4571  !uves_iterate_finished(pos);
4572  uves_iterate_increment(pos)) {
4573 
4574  /* Manual loop over y */
4575  uves_extract_profile_set(profile, pos, NULL);
4576  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
4577 
4578  /* Get empirical and model profile */
4579  double flux, sky_flux;
4580  int bad;
4581  int spectrum_row = pos->order - pos->minorder + 1;
4582  double noise;
4583  double prof = uves_extract_profile_evaluate(profile, pos);
4584 
4585  if (sky != NULL)
4586  {
4587  sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
4588  }
4589  else
4590  {
4591  sky_flux = 0;
4592  }
4593 
4594  flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
4595 
4596  //fixme: check this formula
4597  noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
4598 // uves_msg_error("%f", prof);
4599  cpl_image_set(image, pos->x, pos->y,
4600  flux);
4601  if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
4602 
4603  }
4604  }
4605 
4606  if (cosmic_image != NULL) {
4607  double cr_val = 2*cpl_image_get_max(image);
4608  /* assign high pixel value to CR pixels */
4609 
4610  loop_y = true;
4611 
4612  for (uves_iterate_set_first(pos,
4613  1, pos->nx,
4614  pos->minorder, pos->maxorder,
4615  bpm,
4616  loop_y);
4617  !uves_iterate_finished(pos);
4618  uves_iterate_increment(pos)) {
4619 
4620  int is_rejected;
4621  if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
4622  cpl_image_set(image, pos->x, pos->y, cr_val);
4623  }
4624  }
4625  }
4626 
4627  cleanup:
4628  return image;
4629 }
4630 
4631 void
4632 uves_frameset_dump(cpl_frameset* set)
4633 {
4634 
4635  cpl_frame* frm=NULL;
4636  int sz=0;
4637  int i=0;
4638 
4639  cknull(set,"Null input frameset");
4640  check_nomsg(sz=cpl_frameset_get_size(set));
4641  for(i=0;i<sz;i++) {
4642  frm=cpl_frameset_get_frame(set,i);
4643  uves_msg("frame %d tag %s filename %s group %d",
4644  i,
4645  cpl_frame_get_tag(frm),
4646  cpl_frame_get_filename(frm),
4647  cpl_frame_get_group(frm));
4648 
4649  }
4650 
4651  cleanup:
4652 
4653  return ;
4654 }
4655 
4656 
4657 
4658 
4659 /*-------------------------------------------------------------------------*/
4673 /*--------------------------------------------------------------------------*/
4674 
4675 cpl_image *
4676 uves_image_smooth_x(cpl_image * inp, const int r)
4677 {
4678 
4679  /*
4680  @param xp x-value to interpolate
4681  @param x x-values
4682  @param y y-values
4683  @param n array length
4684  @param istart (input/output) initial row (set to 0 to search all row)
4685 
4686  */
4687  float* pinp=NULL;
4688  float* pout=NULL;
4689  int sx=0;
4690  int sy=0;
4691  int i=0;
4692  int j=0;
4693  int k=0;
4694 
4695  cpl_image* out=NULL;
4696 
4697  cknull(inp,"Null in put image, exit");
4698  check_nomsg(out=cpl_image_duplicate(inp));
4699  check_nomsg(sx=cpl_image_get_size_x(inp));
4700  check_nomsg(sy=cpl_image_get_size_y(inp));
4701  check_nomsg(pinp=cpl_image_get_data_float(inp));
4702  check_nomsg(pout=cpl_image_get_data_float(out));
4703  for(j=0;j<sy;j++) {
4704  for(i=r;i<sx-r;i++) {
4705  for(k=-r;k<r;k++) {
4706  pout[j*sx+i]+=pinp[j*sx+i+k];
4707  }
4708  pout[j*sx+i]/=2*r;
4709  }
4710  }
4711 
4712  cleanup:
4713 
4714  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4715  return NULL;
4716  } else {
4717  return out;
4718 
4719  }
4720 
4721 }
4722 
4723 
4724 
4725 
4726 
4727 /*-------------------------------------------------------------------------*/
4741 /*--------------------------------------------------------------------------*/
4742 
4743 cpl_image *
4744 uves_image_smooth_y(cpl_image * inp, const int r)
4745 {
4746 
4747  /*
4748  @param xp x-value to interpolate
4749  @param x x-values
4750  @param y y-values
4751  @param n array length
4752  @param istart (input/output) initial row (set to 0 to search all row)
4753 
4754  */
4755  float* pinp=NULL;
4756  float* pout=NULL;
4757  int sx=0;
4758  int sy=0;
4759  int i=0;
4760  int j=0;
4761  int k=0;
4762 
4763  cpl_image* out=NULL;
4764 
4765  cknull(inp,"Null in put image, exit");
4766  check_nomsg(out=cpl_image_duplicate(inp));
4767  check_nomsg(sx=cpl_image_get_size_x(inp));
4768  check_nomsg(sy=cpl_image_get_size_y(inp));
4769  check_nomsg(pinp=cpl_image_get_data_float(inp));
4770  check_nomsg(pout=cpl_image_get_data_float(out));
4771  for(j=r;j<sy-r;j++) {
4772  for(i=0;i<sx;i++) {
4773  for(k=-r;k<r;k++) {
4774  pout[j*sx+i]+=pinp[(j+k)*sx+i];
4775  }
4776  pout[j*sx+i]/=2*r;
4777  }
4778  }
4779 
4780  cleanup:
4781 
4782  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4783  return NULL;
4784  } else {
4785  return out;
4786 
4787  }
4788 
4789 }
4790 
4791 
4792 /*-------------------------------------------------------------------------*/
4806 /*--------------------------------------------------------------------------*/
4807 
4808 cpl_image *
4809 uves_image_smooth_mean_x(cpl_image * inp, const int r)
4810 {
4811 
4812  /*
4813  @param xp x-value to interpolate
4814  @param x x-values
4815  @param y y-values
4816  @param n array length
4817  @param istart (input/output) initial row (set to 0 to search all row)
4818 
4819  */
4820  float* pinp=NULL;
4821  float* pout=NULL;
4822  int sx=0;
4823  int sy=0;
4824  int i=0;
4825  int j=0;
4826  int k=0;
4827 
4828  cpl_image* out=NULL;
4829 
4830  cknull(inp,"Null in put image, exit");
4831  check_nomsg(out=cpl_image_duplicate(inp));
4832  check_nomsg(sx=cpl_image_get_size_x(inp));
4833  check_nomsg(sy=cpl_image_get_size_y(inp));
4834  check_nomsg(pinp=cpl_image_get_data_float(inp));
4835  check_nomsg(pout=cpl_image_get_data_float(out));
4836  for(j=0;j<sy;j++) {
4837  for(i=r;i<sx-r;i++) {
4838  for(k=-r;k<r;k++) {
4839  pout[j*sx+i]+=pinp[j*sx+i+k];
4840  }
4841  pout[j*sx+i]/=2*r;
4842  }
4843  }
4844 
4845  cleanup:
4846 
4847  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4848  return NULL;
4849  } else {
4850  return out;
4851 
4852  }
4853 
4854 }
4855 
4856 
4857 /*-------------------------------------------------------------------------*/
4871 /*--------------------------------------------------------------------------*/
4872 
4873 cpl_image *
4874 uves_image_smooth_median_x(cpl_image * inp, const int r)
4875 {
4876 
4877  /*
4878  @param xp x-value to interpolate
4879  @param x x-values
4880  @param y y-values
4881  @param n array length
4882  @param istart (input/output) initial row (set to 0 to search all row)
4883 
4884  */
4885  float* pout=NULL;
4886  int sx=0;
4887  int sy=0;
4888  int i=0;
4889  int j=0;
4890 
4891  cpl_image* out=NULL;
4892 
4893 
4894  cknull(inp,"Null in put image, exit");
4895  check_nomsg(out=cpl_image_duplicate(inp));
4896  check_nomsg(sx=cpl_image_get_size_x(inp));
4897  check_nomsg(sy=cpl_image_get_size_y(inp));
4898  check_nomsg(pout=cpl_image_get_data_float(out));
4899 
4900  for(j=1;j<sy;j++) {
4901  for(i=1+r;i<sx-r;i++) {
4902  pout[j*sx+i]=(float)cpl_image_get_median_window(inp,i,j,i+r,j);
4903  }
4904  }
4905 
4906  cleanup:
4907 
4908  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4909  return NULL;
4910  } else {
4911  return out;
4912 
4913  }
4914 
4915 }
4916 
4917 /*-------------------------------------------------------------------------*/
4930 /*--------------------------------------------------------------------------*/
4931 
4932 cpl_image *
4933 uves_image_smooth_fft(cpl_image * inp, const int fx)
4934 {
4935 
4936  int sx=0;
4937  int sy=0;
4938 
4939  cpl_image* out=NULL;
4940  cpl_image* im_re=NULL;
4941  cpl_image* im_im=NULL;
4942  cpl_image* ifft_re=NULL;
4943  cpl_image* ifft_im=NULL;
4944  cpl_image* filter=NULL;
4945 
4946  int sigma_x=fx;
4947  int sigma_y=0;
4948 
4949  cknull(inp,"Null in put image, exit");
4950  check_nomsg(im_re = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
4951  check_nomsg(im_im = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
4952 
4953  // Compute FFT
4954  check_nomsg(cpl_image_fft(im_re,im_im,CPL_FFT_DEFAULT));
4955 
4956  check_nomsg(sx=cpl_image_get_size_x(inp));
4957  check_nomsg(sy=cpl_image_get_size_y(inp));
4958  sigma_x=sx;
4959 
4960  //Generates filter image
4961  check_nomsg(filter = uves_gen_lowpass(sx,sy,sigma_x,sigma_y));
4962 
4963  //Apply filter
4964  cpl_image_multiply(im_re,filter);
4965  cpl_image_multiply(im_im,filter);
4966 
4967  uves_free_image(&filter);
4968 
4969  check_nomsg(ifft_re = cpl_image_duplicate(im_re));
4970  check_nomsg(ifft_im = cpl_image_duplicate(im_im));
4971 
4972  uves_free_image(&im_re);
4973  uves_free_image(&im_im);
4974 
4975  //Computes FFT-INVERSE
4976  check_nomsg(cpl_image_fft(ifft_re,ifft_im,CPL_FFT_INVERSE));
4977  check_nomsg(out = cpl_image_cast(ifft_re, CPL_TYPE_FLOAT));
4978 
4979  cleanup:
4980 
4981  uves_free_image(&ifft_re);
4982  uves_free_image(&ifft_im);
4983  uves_free_image(&filter);
4984  uves_free_image(&im_re);
4985  uves_free_image(&im_im);
4986 
4987  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4988  return NULL;
4989  } else {
4990  return out;
4991  }
4992 
4993 }
4994 
4995 /*-------------------------------------------------------------------------*/
5004 /*--------------------------------------------------------------------------*/
5005 cpl_vector *
5006 uves_imagelist_get_clean_mean_levels(cpl_imagelist* iml, double kappa)
5007 {
5008 
5009  cpl_image* img=NULL;
5010  int size=0;
5011  int i=0;
5012  cpl_vector* values=NULL;
5013  double* pval=NULL;
5014  double mean=0;
5015  double stdev=0;
5016 
5017  check_nomsg(size=cpl_imagelist_get_size(iml));
5018  check_nomsg(values=cpl_vector_new(size));
5019  pval=cpl_vector_get_data(values);
5020  for(i=0;i<size;i++) {
5021  img=cpl_imagelist_get(iml,i);
5022  irplib_ksigma_clip(img,1,1,
5023  cpl_image_get_size_x(img),
5024  cpl_image_get_size_y(img),
5025  5,kappa,1.e-5,&mean,&stdev);
5026  uves_msg("Ima %d mean level: %g",i+1,mean);
5027  pval[i]=mean;
5028  }
5029 
5030  cleanup:
5031 
5032  return values;
5033 }
5034 
5035 
5036 /*-------------------------------------------------------------------------*/
5045 /*--------------------------------------------------------------------------*/
5046 cpl_error_code
5047 uves_imagelist_subtract_values(cpl_imagelist** iml, cpl_vector* values)
5048 {
5049 
5050  cpl_image* img=NULL;
5051  int size=0;
5052  int i=0;
5053  double* pval=NULL;
5054 
5055  check_nomsg(size=cpl_imagelist_get_size(*iml));
5056  pval=cpl_vector_get_data(values);
5057  for(i=0;i<size;i++) {
5058  img=cpl_imagelist_get(*iml,i);
5059  cpl_image_subtract_scalar(img,pval[i]);
5060  cpl_imagelist_set(*iml,img,i);
5061  }
5062 
5063  cleanup:
5064 
5065  return cpl_error_get_code();
5066 }
5067 
5068 
5069 /*-------------------------------------------------------------------------*/
5085 /*--------------------------------------------------------------------------*/
5086 static cpl_image *
5087 uves_gen_lowpass(const int xs,
5088  const int ys,
5089  const double sigma_x,
5090  const double sigma_y)
5091 {
5092 
5093  int i= 0.0;
5094  int j= 0.0;
5095  int hlx= 0.0;
5096  int hly = 0.0;
5097  double x= 0.0;
5098  double y= 0.0;
5099  double gaussval= 0.0;
5100  double inv_sigma_x=1./sigma_x;
5101  double inv_sigma_y=1./sigma_y;
5102 
5103  float *data;
5104 
5105  cpl_image *lowpass_image=NULL;
5106 
5107 
5108  lowpass_image = cpl_image_new (xs, ys, CPL_TYPE_FLOAT);
5109  if (lowpass_image == NULL) {
5110  uves_msg_error("Cannot generate lowpass filter <%s>",
5111  cpl_error_get_message());
5112  return NULL;
5113  }
5114 
5115  hlx = xs/2;
5116  hly = ys/2;
5117 
5118  data = cpl_image_get_data_float(lowpass_image);
5119 
5120 /* Given an image with pixels 0<=i<N, 0<=j<M then the convolution image
5121  has the following properties:
5122 
5123  ima[0][0] = 1
5124  ima[i][0] = ima[N-i][0] = exp (-0.5 * (i/sig_i)^2) 1<=i<N/2
5125  ima[0][j] = ima[0][M-j] = exp (-0.5 * (j/sig_j)^2) 1<=j<M/2
5126  ima[i][j] = ima[N-i][j] = ima[i][M-j] = ima[N-i][M-j]
5127  = exp (-0.5 * ((i/sig_i)^2 + (j/sig_j)^2))
5128 */
5129 
5130  data[0] = 1.0;
5131 
5132  /* first row */
5133  for (i=1 ; i<=hlx ; i++) {
5134  x = i * inv_sigma_x;
5135  gaussval = exp(-0.5*x*x);
5136  data[i] = gaussval;
5137  data[xs-i] = gaussval;
5138  }
5139 
5140  for (j=1; j<=hly ; j++) {
5141  y = j * inv_sigma_y;
5142  /* first column */
5143  data[j*xs] = exp(-0.5*y*y);
5144  data[(ys-j)*xs] = exp(-0.5*y*y);
5145 
5146  for (i=1 ; i<=hlx ; i++) {
5147  /* Use internal symetries */
5148  x = i * inv_sigma_x;
5149  gaussval = exp (-0.5*(x*x+y*y));
5150  data[j*xs+i] = gaussval;
5151  data[(j+1)*xs-i] = gaussval;
5152  data[(ys-j)*xs+i] = gaussval;
5153  data[(ys+1-j)*xs-i] = gaussval;
5154 
5155  }
5156  }
5157 
5158  /* FIXME: for the moment, reset errno which is coming from exp()
5159  in first for-loop at i=348. This is causing cfitsio to
5160  fail when loading an extension image (bug in cfitsio too).
5161  */
5162  if(errno != 0)
5163  errno = 0;
5164 
5165  return lowpass_image;
5166 }
5167 /*-------------------------------------------------------------------------*/
5175 /*--------------------------------------------------------------------------*/
5176 cpl_image*
5177 uves_image_mflat_detect_blemishes(const cpl_image* flat,
5178  const uves_propertylist* head)
5179 {
5180 
5181  cpl_image* result=NULL;
5182  cpl_image* diff=NULL;
5183  cpl_image* flat_smooth=NULL;
5184  cpl_array* val=NULL;
5185  cpl_matrix* mx=NULL;
5186 
5187  int binx=0;
5188  int biny=0;
5189  int sx=0;
5190  int sy=0;
5191  int size=0;
5192  int i=0;
5193  int j=0;
5194  int k=0;
5195  int niter=3;
5196  int filter_width_x=7;
5197  int filter_width_y=7;
5198 
5199  double mean=0;
5200  double stdev=0;
5201  double stdev_x_4=0;
5202 
5203  double med_flat=0;
5204 
5205  double* pres=NULL;
5206  const double* pima=NULL;
5207  double* pval=NULL;
5208  double* pdif=NULL;
5209  int npixs=0;
5210 
5211  /* check input is valid */
5212  passure( flat !=NULL , "NULL input flat ");
5213  passure( head !=NULL , "NULL input head ");
5214 
5215  /* get image and bin sizes */
5216  sx=cpl_image_get_size_x(flat);
5217  sy=cpl_image_get_size_y(flat);
5218  npixs=sx*sy;
5219 
5220  binx=uves_pfits_get_binx(head);
5221  biny=uves_pfits_get_biny(head);
5222 
5223  /* set proper x/y filter width. Start values are 3 */
5224  if (binx>1) filter_width_x=5;
5225  if (biny>1) filter_width_y=5;
5226 
5227 
5228  /* create residuals image from smoothed flat */
5229  check_nomsg(mx=cpl_matrix_new(filter_width_x,filter_width_y));
5230 
5231  for(j=0; j< filter_width_y; j++){
5232  for(i=0; i< filter_width_x; i++){
5233  cpl_matrix_set( mx, i,j,1.0);
5234  }
5235  }
5236 
5237  check_nomsg(diff=cpl_image_duplicate(flat));
5238 
5239  check_nomsg(flat_smooth=uves_image_filter_median(flat,mx));
5240  /*
5241  check_nomsg(cpl_image_save(flat_smooth,"flat_smooth.fits",
5242  CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
5243  */
5244  check_nomsg(cpl_image_subtract(diff,flat_smooth));
5245  /*
5246  check_nomsg(cpl_image_save(diff,"diff.fits",
5247  CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
5248  */
5249  /* compute median of flat */
5250  check_nomsg(med_flat=cpl_image_get_median(flat));
5251 
5252  /* prepare array of flat pixel values greater than the median */
5253  val=cpl_array_new(npixs,CPL_TYPE_DOUBLE);
5254  check_nomsg(cpl_array_fill_window_double(val,0,npixs,0));
5255  check_nomsg(pval=cpl_array_get_data_double(val));
5256  check_nomsg(pima=cpl_image_get_data_double_const(flat));
5257  check_nomsg(pdif=cpl_image_get_data_double(diff));
5258  k=0;
5259  for(i=0;i<npixs;i++) {
5260  if(pima[i]>med_flat) {
5261  pval[k]=pdif[i];
5262  k++;
5263  }
5264  }
5265 
5266  check_nomsg(cpl_array_set_size(val,k));
5267 
5268  /* computes 4 sigma clip mean of values */
5269  check_nomsg(mean=cpl_array_get_mean(val));
5270  check_nomsg(stdev=cpl_array_get_stdev(val));
5271  stdev_x_4=stdev*4.;
5272  check_nomsg(size=cpl_array_get_size(val));
5273 
5274  for(i=0;i<niter;i++) {
5275  for(k=0;k<size;k++) {
5276  if(fabs(pval[k]-mean)>stdev_x_4) {
5277  cpl_array_set_invalid(val,k);
5278  }
5279  }
5280  mean=cpl_array_get_mean(val);
5281  stdev=cpl_array_get_stdev(val);
5282  stdev_x_4=stdev*4.;
5283  }
5284 
5285  /* compute absolute value of difference image */
5286  result=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
5287  pres=cpl_image_get_data_double(result);
5288  for(i=0;i<npixs;i++) {
5289  if(fabs(pdif[i])<stdev_x_4) {
5290  pres[i]=1.;
5291  }
5292  }
5293 
5294  /* save result to debug */
5295  /*
5296  check_nomsg(cpl_image_save(result,"blemish.fits",CPL_BPP_IEEE_FLOAT,NULL,
5297  CPL_IO_DEFAULT));
5298  */
5299 
5300  cleanup:
5301  uves_free_array(&val);
5302  uves_free_image(&diff);
5303  uves_free_image(&flat_smooth);
5304  uves_free_matrix(&mx);
5305  return result;
5306 }
5307 
5308 
const char * uves_string_tolower(char *s)
Convert all uppercase characters in a string into lowercase characters.
Definition: uves_utils.c:1527
polynomial * uves_polynomial_fit_1d(const cpl_vector *x_pos, const cpl_vector *values, const cpl_vector *sigmas, int poly_deg, double *mse)
Fit a 1d function with a polynomial.
double uves_pfits_get_uit(const uves_propertylist *plist)
Find out the user integration time.
Definition: uves_pfits.c:2100
#define uves_msg_error(...)
Print an error message.
Definition: uves_msg.h:64
cpl_error_code uves_pfits_set_crpix2(uves_propertylist *plist, double crpix2)
Write the crpix2 keyword.
Definition: uves_pfits.c:2882
cpl_error_code uves_filter_image_median(cpl_image **image, int xwindow, int ywindow, bool extrapolate_border)
Median filter.
void uves_polynomial_delete(polynomial **p)
Delete a polynomial.
char * uves_get_datetime_iso8601(void)
Returns the current date and time as a static string.
Definition: uves_time.c:118
#define uves_msg_warning(...)
Print an warning message.
Definition: uves_msg.h:87
bool uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
Determine if a table is sorted.
Definition: uves_utils.c:3848
cpl_image * uves_get_wave_map(cpl_image *ima_sci, const char *context, const cpl_parameterlist *parameters, const cpl_table *ordertable, const cpl_table *linetable, const polynomial *order_locations, const polynomial *dispersion_relation, const int first_abs_order, const int last_abs_order, const int slit_size)
Generates wave map.
Definition: uves_utils.c:452
void uves_msg_set_level(int olevel)
Set output level.
Definition: uves_msg.c:159
bool uves_iterate_finished(const uves_iterate_position *p)
Finished iterating?
cpl_error_code uves_pfits_set_ctype1(uves_propertylist *plist, const char *ctype1)
Write the ctype1 keyword.
Definition: uves_pfits.c:2756
cpl_error_code uves_rcosmic(cpl_image *ima, cpl_image **flt, cpl_image **out, cpl_image **msk, const double sky, const double ron, const double gain, const int ns, const double rc)
Remove cosmic ray events on single ccd exposure and replace them by interpolation on neighbourhood pi...
Definition: uves_utils.c:162
int uves_msg_get_warnings(void)
Get number of warnings printed so far.
Definition: uves_msg.c:266
cpl_error_code uves_pfits_set_cdelt1(uves_propertylist *plist, double cdelt1)
Write the cdelt1 keyword.
Definition: uves_pfits.c:2899
double uves_propertylist_get_double(const uves_propertylist *self, const char *name)
Get the double value of the given property list entry.
static double uves_ksigma_vector(cpl_vector *values, double klow, double khigh, int kiter)
Perform kappa-sigma clip.
Definition: uves_utils.c:277
cpl_image * uves_define_noise(const cpl_image *image, const uves_propertylist *image_header, int ncom, enum uves_chip chip)
Create noise image.
Definition: uves_utils.c:2226
cpl_image * uves_flat_create_normalized_master(cpl_imagelist *flats, const cpl_table *ordertable, const polynomial *order_locations, const cpl_vector *gain_vals, double *fnoise)
Stack images using k-sigma clipping.
Definition: uves_utils.c:702
double uves_pfits_get_gain(const uves_propertylist *plist, enum uves_chip chip)
Find out the gain.
Definition: uves_pfits.c:887
int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
Get the absolute order number.
Definition: uves_utils.c:2492
#define check_nomsg(CMD)
Definition: uves_error.h:204
const char * uves_get_license(void)
Get the pipeline copyright and license.
Definition: uves_utils.c:1676
static void fmoffa_i(float x, const double a[], double *y, double dyda[])
This subroutine gives the value of the Moffat (beta=4)+ linear functions at pixel of coordinates x es...
Definition: uves_utils.c:4106
int uves_gauss_linear(const double x[], const double a[], double *result)
Evaluate a gaussian with linear background.
Definition: uves_utils.c:4412
double uves_pow_int(double x, int y)
Calculate x to the y'th.
Definition: uves_utils.c:1593
cpl_table * uves_ordertable_traces_new(void)
Create the table that describes fibre traces.
Definition: uves_utils.c:3899
cpl_error_code uves_pfits_set_crval1(uves_propertylist *plist, double crval1)
Write the crval1 keyword.
Definition: uves_pfits.c:2829
cpl_image * uves_flat_create_normalized_master2(cpl_imagelist *flats, const cpl_table *ordertable, const polynomial *order_locations, const cpl_image *mflat)
Stack images using k-sigma clipping.
Definition: uves_utils.c:551
cpl_error_code uves_tablename_remove_units(const char *tname)
Remove column units from a table.
Definition: uves_utils.c:3955
cpl_error_code uves_subtract_bias(cpl_image *image, const cpl_image *master_bias)
Subtract bias.
Definition: uves_utils.c:2394
cpl_error_code uves_pfits_set_cunit2(uves_propertylist *plist, const char *cunit2)
Write the cunit2 keyword.
Definition: uves_pfits.c:2811
#define passure(BOOL,...)
Definition: uves_error.h:207
void uves_iterate_set_first(uves_iterate_position *p, int xmin, int xmax, int ordermin, int ordermax, const cpl_binary *bpm, bool loop_y)
Initialize iteration.
int uves_gauss_derivative(const double x[], const double a[], double result[])
Evaluate the derivatives of a gaussian.
Definition: uves_utils.c:4347
double uves_average_reject(cpl_table *t, const char *column, const char *residual2, double kappa)
Get average with iterative rejection.
Definition: uves_utils.c:2514
cpl_image * uves_image_mflat_detect_blemishes(const cpl_image *flat, const uves_propertylist *head)
Flag blemishes in a flat image.
Definition: uves_utils.c:5177
cpl_error_code uves_table_unify_units(cpl_table **table2, cpl_table **table1)
Unify column units of table2 to table1.
Definition: uves_utils.c:4045
cpl_error_code uves_tablenames_unify_units(const char *tname2, const char *tname1)
Unify column units in tables.
Definition: uves_utils.c:3981
cpl_error_code uves_subtract_dark(cpl_image *image, const uves_propertylist *image_header, const cpl_image *master_dark, const uves_propertylist *mdark_header)
Subtract dark.
Definition: uves_utils.c:2438
uves_propertylist * uves_initialize_image_header(const char *ctype1, const char *ctype2, const char *cunit1, const char *cunit2, const char *bunit, const double bscale, double crval1, double crval2, double crpix1, double crpix2, double cdelt1, double cdelt2)
Initialize image header.
Definition: uves_utils.c:2174
static cpl_image * uves_gen_lowpass(const int xs, const int ys, const double sigma_x, const double sigma_y)
Generate a low pass filter for FFT convolution .
Definition: uves_utils.c:5087
cpl_error_code uves_pfits_set_bscale(uves_propertylist *plist, const double bscale)
Write the bscale keyword.
Definition: uves_pfits.c:2678
uves_propertylist * uves_propertylist_new(void)
Create an empty property list.
double uves_gaussrand(void)
Pseudo-random gaussian distributed number.
Definition: uves_utils.c:3646
int uves_pfits_get_binx(const uves_propertylist *plist)
Find out the x binning factor.
Definition: uves_pfits.c:1176
double uves_spline_hermite_table(double xp, const cpl_table *t, const char *column_x, const char *column_y, int *istart)
Spline interpolation based on Hermite polynomials.
Definition: uves_utils.c:3684
#define uves_msg(...)
Print a message on 'info' or 'debug' level.
Definition: uves_msg.h:119
int uves_gauss(const double x[], const double a[], double *result)
Evaluate a gaussian.
Definition: uves_utils.c:4292
int uves_moffat(const double x[], const double a[], double *result)
Evaluate a Moffat.
Definition: uves_utils.c:4241
uves_propertylist * uves_propertylist_load(const char *name, int position)
Create a property list from a file.
cpl_error_code uves_pfits_set_ctype2(uves_propertylist *plist, const char *ctype2)
Write the ctype2 keyword.
Definition: uves_pfits.c:2773
static cpl_error_code uves_cosrout(cpl_image *ima, cpl_image **msk, const double ron, const double gain, const int ns, const double sky, const double rc, cpl_image **flt, cpl_image **out)
Remove cosmic ray events on single ccd exposure and replace them by interpolation on neighbourhood pi...
Definition: uves_utils.c:846
polynomial * uves_polynomial_regression_2d(cpl_table *t, const char *X1, const char *X2, const char *Y, const char *sigmaY, int degree1, int degree2, const char *polynomial_fit, const char *residual_square, const char *variance_fit, double *mse, double *red_chisq, polynomial **variance, double kappa, double min_reject)
Fit a 2d polynomial to three table columns.
Definition: uves_utils.c:2870
cpl_error_code uves_pfits_set_crpix1(uves_propertylist *plist, double crpix1)
Write the crpix1 keyword.
Definition: uves_pfits.c:2864
int uves_pfits_get_biny(const uves_propertylist *plist)
Find out the y binning factor.
Definition: uves_pfits.c:1194
int uves_gauss_linear_derivative(const double x[], const double a[], double result[])
Evaluate the derivatives of a gaussian with linear background.
Definition: uves_utils.c:4471
polynomial * uves_polynomial_regression_2d_autodegree(cpl_table *t, const char *X1, const char *X2, const char *Y, const char *sigmaY, const char *polynomial_fit, const char *residual_square, const char *variance_fit, double *mean_squared_error, double *red_chisq, polynomial **variance, double kappa, int maxdeg1, int maxdeg2, double min_rms, double min_reject, bool verbose, const double *min_val, const double *max_val, int npos, double positions[][2])
Fit a 2d polynomial to three table columns.
Definition: uves_utils.c:3306
cpl_vector * uves_imagelist_get_clean_mean_levels(cpl_imagelist *iml, double kappa)
Computes kappa-sigma clean mean (free bad pixels) for each input image of the input imagelist...
Definition: uves_utils.c:5006
const char * uves_remove_string_prefix(const char *s, const char *prefix)
Remove named prefix from string.
Definition: uves_utils.c:3613
double uves_pfits_get_exptime(const uves_propertylist *plist)
Find out the exposure time in seconds.
Definition: uves_pfits.c:922
#define assure_mem(PTR)
Definition: uves_error.h:181
cpl_image * uves_create_image(uves_iterate_position *pos, enum uves_chip chip, const cpl_image *spectrum, const cpl_image *sky, const cpl_image *cosmic_image, const uves_extract_profile *profile, cpl_image **image_noise, uves_propertylist **image_header)
Reconstruct echelle image from spectrum.
Definition: uves_utils.c:4535
cpl_error_code uves_table_remove_units(cpl_table **table)
Remove column units from a table.
Definition: uves_utils.c:4013
double uves_polynomial_evaluate_2d(const polynomial *p, double x1, double x2)
Evaluate a 2d polynomial.
double uves_polynomial_evaluate_1d(const polynomial *p, double x)
Evaluate a 1d polynomial.
cpl_image * uves_average_images(const cpl_image *image1, const cpl_image *noise1, const cpl_image *image2, const cpl_image *noise2, cpl_image **noise)
Optimally average images.
Definition: uves_utils.c:2046
cpl_error_code uves_pfits_set_cdelt2(uves_propertylist *plist, double cdelt2)
Write the cdelt2 keyword.
Definition: uves_pfits.c:2935
char * uves_initialize(cpl_frameset *frames, const cpl_parameterlist *parlist, const char *recipe_id, const char *short_descr)
Recipe initialization.
Definition: uves_utils.c:1910
int uves_moffat_derivative(const double x[], const double a[], double result[])
Evaluate Moffat derivative.
Definition: uves_utils.c:4260
cpl_error_code uves_ordertable_traces_add(cpl_table *traces, int fibre_ID, double fibre_offset, int fibre_mask)
Add a trace.
Definition: uves_utils.c:3926
#define REQ_CPL_MAJOR
Check compile time and runtime library versions.
Definition: uves_utils.c:1712
polynomial * uves_polynomial_regression_1d(cpl_table *t, const char *X, const char *Y, const char *sigmaY, int degree, const char *polynomial_fit, const char *residual_square, double *mean_squared_error, double kappa)
Fit a 1d polynomial to two table columns.
Definition: uves_utils.c:2591
const char * uves_tostring_cpl_type(cpl_type t)
Convert a CPL type to a string.
Definition: uves_dump.c:378
cpl_image * uves_ksigma_stack(const cpl_imagelist *imlist, double klow, double khigh, int kiter)
Stack images using k-sigma clipping.
Definition: uves_utils.c:356
#define uves_error_reset()
Definition: uves_error.h:215
#define uves_msg_low(...)
Print a message on a lower message level.
Definition: uves_msg.h:105
cpl_error_code uves_end(const char *recipe_id, const cpl_frameset *frames)
Recipe termination.
Definition: uves_utils.c:1840
cpl_error_code uves_pfits_set_cunit1(uves_propertylist *plist, const char *cunit1)
Write the cunit1 keyword.
Definition: uves_pfits.c:2793
static void fmoffa_c(float x, const double a[], double *y, double dyda[])
Moffat profile.
Definition: uves_utils.c:4175
#define uves_msg_debug(...)
Print a debug message.
Definition: uves_msg.h:97
#define assure_nomsg(BOOL, CODE)
Definition: uves_error.h:177
cpl_error_code uves_get_version(int *major, int *minor, int *micro)
Get UVES library version number.
Definition: uves_utils.c:1641
cpl_error_code uves_pfits_set_bunit(uves_propertylist *plist, const char *bunit)
Write the bunit keyword.
Definition: uves_pfits.c:2660
const char * uves_string_toupper(char *s)
Convert all lowercase characters in a string into uppercase characters.
Definition: uves_utils.c:1493
int uves_propertylist_contains(const uves_propertylist *self, const char *name)
Check whether a property is present in a property list.
double uves_spline_hermite(double xp, const double *x, const double *y, int n, int *istart)
Spline interpolation based on Hermite polynomials.
Definition: uves_utils.c:3722
#define check(CMD,...)
Definition: uves_error.h:198
cpl_parameterlist * uves_parameterlist_duplicate(const cpl_parameterlist *pin)
Extract frames with given tag from frameset.
Definition: uves_utils.c:1461
int uves_get_version_binary(void)
Get UVES library binary version number.
Definition: uves_utils.c:1660
void uves_iterate_increment(uves_iterate_position *p)
Get next position.
double uves_pfits_get_ron_adu(const uves_propertylist *plist, enum uves_chip chip)
Find out the readout noise in ADU.
Definition: uves_pfits.c:740
cpl_error_code uves_print_cpl_frameset(const cpl_frameset *frames)
Print a frame set.
Definition: uves_dump.c:235
cpl_error_code uves_imagelist_subtract_values(cpl_imagelist **iml, cpl_vector *values)
Subtract from input imagelist values specified in input vector.
Definition: uves_utils.c:5047
cpl_error_code uves_pfits_set_crval2(uves_propertylist *plist, double crval2)
Write the crval2 keyword.
Definition: uves_pfits.c:2847
double uves_spline_cubic(double xp, double *x, float *y, float *y2, int n, int *kstart)
Natural cubic-spline interpolation.
Definition: uves_utils.c:3794
cpl_frameset * uves_frameset_extract(const cpl_frameset *frames, const char *tag)
Extract frames with given tag from frameset.
Definition: uves_utils.c:1557
polynomial * uves_polynomial_fit_2d(const cpl_bivector *xy_pos, const cpl_vector *values, const cpl_vector *sigmas, int poly_deg1, int poly_deg2, double *mse, double *red_chisq, polynomial **variance)
Fit a 2d surface with a polynomial in x and y.