UVES Pipeline Reference Manual  5.4.6
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_exptime(image_header),
2453  "Error reading input image exposure time");
2454  check( mdark_exptime = uves_pfits_get_exptime(mdark_header),
2455  "Error reading master dark exposure time");
2456 
2457  uves_msg("Rescaling master dark from %f s to %f s exposure time",
2458  mdark_exptime, image_exptime);
2459 
2460  check( normalized_mdark =
2461  cpl_image_multiply_scalar_create(master_dark,
2462  image_exptime / mdark_exptime),
2463  "Error normalizing master dark");
2464 
2465  check( cpl_image_subtract(image, normalized_mdark),
2466  "Error subtracting master dark");
2467 
2468  uves_msg_warning("noise rescaled master dark %g",cpl_image_get_stdev(normalized_mdark));
2469 
2470 
2471  cleanup:
2472  uves_free_image(&normalized_mdark);
2473  return cpl_error_get_code();
2474 }
2475 
2476 /*----------------------------------------------------------------------------*/
2490 /*----------------------------------------------------------------------------*/
2491 int uves_absolute_order(int first_abs_order, int last_abs_order, int relative_order)
2492 {
2493  return (first_abs_order +
2494  (relative_order-1)*((last_abs_order > first_abs_order) ? 1 : -1));
2495 }
2496 
2497 /*----------------------------------------------------------------------------*/
2511 /*----------------------------------------------------------------------------*/
2512 double
2513 uves_average_reject(cpl_table *t,
2514  const char *column,
2515  const char *residual2,
2516  double kappa)
2517 {
2518  double mean = 0, median, sigma2;
2519  int rejected;
2520 
2521  do {
2522  /* Robust estimation */
2523  check_nomsg(median = cpl_table_get_column_median(t, column));
2524 
2525  /* Create column
2526  residual2 = (column - median)^2 */
2527  check_nomsg(cpl_table_duplicate_column(t, residual2, t, column));
2528  check_nomsg(cpl_table_subtract_scalar(t, residual2, median));
2529  check_nomsg(cpl_table_multiply_columns(t, residual2, residual2));
2530 
2531  /* For a Gaussian distribution:
2532  * sigma ~= median(|residual|) / 0.6744
2533  * sigma^2 ~= median(residual^2) / 0.6744^2
2534  */
2535 
2536  check_nomsg(sigma2 = cpl_table_get_column_median(t, residual2) / (0.6744 * 0.6744));
2537 
2538  /* Reject values where
2539  residual^2 > (kappa*sigma)^2
2540  */
2541  check_nomsg( rejected = uves_erase_table_rows(t, residual2,
2542  CPL_GREATER_THAN,
2543  kappa*kappa*sigma2));
2544 
2545  check_nomsg(cpl_table_erase_column(t, residual2));
2546 
2547  } while (rejected > 0);
2548 
2549  check_nomsg(mean = cpl_table_get_column_mean(t, column));
2550 
2551  cleanup:
2552  return mean;
2553 }
2554 
2555 /*----------------------------------------------------------------------------*/
2588 /*----------------------------------------------------------------------------*/
2589 polynomial *
2591  const char *X, const char *Y, const char *sigmaY,
2592  int degree,
2593  const char *polynomial_fit, const char *residual_square,
2594  double *mean_squared_error, double kappa)
2595 {
2596  int N;
2597  int total_rejected = 0; /* Rejected in kappa sigma clipping */
2598  int rejected = 0;
2599  double mse; /* local mean squared error */
2600  double *x;
2601  double *y;
2602  double *sy;
2603  polynomial *result = NULL;
2604  cpl_vector *vx = NULL;
2605  cpl_vector *vy = NULL;
2606  cpl_vector *vsy = NULL;
2607  cpl_type type;
2608 
2609  /* Check input */
2610  assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
2611  assure( X != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
2612  assure( Y != NULL, CPL_ERROR_NULL_INPUT, "Null column name");
2613  assure( cpl_table_has_column(t, X), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X);
2614  assure( cpl_table_has_column(t, Y), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
2615  assure( sigmaY == NULL || cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
2616  "No such column: %s", sigmaY);
2617 
2618  assure( polynomial_fit == NULL || !cpl_table_has_column(t, polynomial_fit),
2619  CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", polynomial_fit);
2620 
2621  assure( residual_square == NULL || !cpl_table_has_column(t, residual_square),
2622  CPL_ERROR_ILLEGAL_INPUT, "Column '%s' already present", residual_square);
2623 
2624  /* Check column types */
2625  type = cpl_table_get_column_type(t, Y);
2626  assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
2627  "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
2628  type = cpl_table_get_column_type(t, X);
2629  assure( type == CPL_TYPE_DOUBLE || type == CPL_TYPE_INT, CPL_ERROR_INVALID_TYPE,
2630  "Input column '%s' has wrong type (%s)", X, uves_tostring_cpl_type(type));
2631  if (sigmaY != NULL)
2632  {
2633  type = cpl_table_get_column_type(t, sigmaY);
2634  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE,
2635  CPL_ERROR_INVALID_TYPE,
2636  "Input column '%s' has wrong type (%s)",
2637  sigmaY, uves_tostring_cpl_type(type));
2638  }
2639 
2640  check( cpl_table_cast_column(t, X, "_X_double", CPL_TYPE_DOUBLE),
2641  "Could not cast table column '%s' to double", X);
2642  check( cpl_table_cast_column(t, Y, "_Y_double", CPL_TYPE_DOUBLE),
2643  "Could not cast table column '%s' to double", Y);
2644  if (sigmaY != NULL)
2645  {
2646  check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE),
2647  "Could not cast table column '%s' to double", sigmaY);
2648  }
2649 
2650 
2651  total_rejected = 0;
2652  rejected = 0;
2653  check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE),
2654  "Could not create column");
2655  do{
2656  check( (N = cpl_table_get_nrow(t),
2657  x = cpl_table_get_data_double(t, "_X_double"),
2658  y = cpl_table_get_data_double(t, "_Y_double")),
2659  "Could not read table data");
2660 
2661  if (sigmaY != NULL)
2662  {
2663  check( sy = cpl_table_get_data_double(t, "_sY_double"),
2664  "Could not read table data");
2665  }
2666  else
2667  {
2668  sy = NULL;
2669  }
2670 
2671  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table. "
2672  "No points to fit in poly 1d regression. At least 2 needed");
2673 
2674  assure( N > degree, CPL_ERROR_ILLEGAL_INPUT, "%d points to fit in poly 1d "
2675  "regression of degree %d. At least %d needed.",
2676  N,degree,degree+1);
2677 
2678  /* Wrap vectors */
2679  uves_unwrap_vector(&vx);
2680  uves_unwrap_vector(&vy);
2681 
2682  vx = cpl_vector_wrap(N, x);
2683  vy = cpl_vector_wrap(N, y);
2684 
2685  if (sy != NULL)
2686  {
2687  uves_unwrap_vector(&vsy);
2688  vsy = cpl_vector_wrap(N, sy);
2689  }
2690  else
2691  {
2692  vsy = NULL;
2693  }
2694 
2695  /* Fit! */
2696  uves_polynomial_delete(&result);
2697  check( result = uves_polynomial_fit_1d(vx, vy, vsy, degree, &mse),
2698  "Could not fit polynomial");
2699 
2700  /* If requested, calculate residuals and perform kappa-sigma clipping */
2701  if (kappa > 0)
2702  {
2703  double sigma2; /* sigma squared */
2704  int i;
2705 
2706  for (i = 0; i < N; i++)
2707  {
2708  double xval, yval, yfit;
2709 
2710  check(( xval = cpl_table_get_double(t, "_X_double", i, NULL),
2711  yval = cpl_table_get_double(t, "_Y_double" ,i, NULL),
2712  yfit = uves_polynomial_evaluate_1d(result, xval),
2713 
2714  cpl_table_set_double(t, "_residual_square", i,
2715  (yfit-yval)*(yfit-yval))),
2716  "Could not evaluate polynomial");
2717  }
2718 
2719  /* For robustness, estimate sigma as (third quartile) / 0.6744
2720  * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
2721  * The third quartile is estimated as the median of the absolute residuals,
2722  * so sigma ~= median(|residual|) / 0.6744 , i.e.
2723  * sigma^2 ~= median(residual^2) / 0.6744^2
2724  */
2725  sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
2726 
2727  /* Remove points with residual^2 > kappa^2 * sigma^2 */
2728  check( rejected = uves_erase_table_rows(t, "_residual_square",
2729  CPL_GREATER_THAN, kappa*kappa*sigma2),
2730  "Could not remove outlier points");
2731 
2732  uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
2733  rejected, N, sqrt(mse));
2734 
2735  /* Update */
2736  total_rejected += rejected;
2737  N = cpl_table_get_nrow(t);
2738  }
2739 
2740 } while (rejected > 0);
2741 
2742  cpl_table_erase_column(t, "_residual_square");
2743 
2744  if (kappa > 0)
2745  {
2746  uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
2747  total_rejected,
2748  N + total_rejected,
2749  (100.0*total_rejected)/(N + total_rejected)
2750  );
2751  }
2752 
2753  if (mean_squared_error != NULL) *mean_squared_error = mse;
2754 
2755  /* Add the fitted values to table if requested */
2756  if (polynomial_fit != NULL || residual_square != NULL)
2757  {
2758  int i;
2759 
2760  check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE),
2761  "Could not create column");
2762  for (i = 0; i < N; i++){
2763  double xval;
2764  double yfit;
2765 
2766  check((
2767  xval = cpl_table_get_double(t, "_X_double", i, NULL),
2768  yfit = uves_polynomial_evaluate_1d(result, xval),
2769  cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
2770  "Could not evaluate polynomial");
2771  }
2772 
2773  /* Add residual^2 = (Polynomial fit - Y)^2 if requested */
2774  if (residual_square != NULL)
2775  {
2776  check(( cpl_table_duplicate_column(t, residual_square, /* RS := PF */
2777  t, "_polynomial_fit"),
2778  cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
2779  cpl_table_multiply_columns(t, residual_square, residual_square)),
2780  /* RS := RS^2 */
2781  "Could not calculate Residual of fit");
2782  }
2783 
2784  /* Keep the polynomial_fit column if requested */
2785  if (polynomial_fit != NULL)
2786  {
2787  cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
2788  }
2789  else
2790  {
2791  cpl_table_erase_column(t, "_polynomial_fit");
2792  }
2793  }
2794 
2795  check(( cpl_table_erase_column(t, "_X_double"),
2796  cpl_table_erase_column(t, "_Y_double")),
2797  "Could not delete temporary columns");
2798 
2799  if (sigmaY != NULL)
2800  {
2801  check( cpl_table_erase_column(t, "_sY_double"),
2802  "Could not delete temporary column");
2803  }
2804 
2805  cleanup:
2806  uves_unwrap_vector(&vx);
2807  uves_unwrap_vector(&vy);
2808  uves_unwrap_vector(&vsy);
2809  if (cpl_error_get_code() != CPL_ERROR_NONE)
2810  {
2811  uves_polynomial_delete(&result);
2812  }
2813 
2814  return result;
2815 }
2816 
2817 
2818 /*----------------------------------------------------------------------------*/
2866 /*----------------------------------------------------------------------------*/
2867 
2868 polynomial *
2870  const char *X1, const char *X2, const char *Y,
2871  const char *sigmaY,
2872  int degree1, int degree2,
2873  const char *polynomial_fit, const char *residual_square,
2874  const char *variance_fit,
2875  double *mse, double *red_chisq,
2876  polynomial **variance, double kappa,
2877  double min_reject)
2878 {
2879  int N;
2880  int rejected;
2881  int total_rejected;
2882  double *x1;
2883  double *x2;
2884  double *y;
2885  double *res;
2886  double *sy;
2887  polynomial *p = NULL; /* Result */
2888  polynomial *variance_local = NULL;
2889  cpl_vector *vx1 = NULL;
2890  cpl_vector *vx2 = NULL;
2891  cpl_bivector *vx = NULL;
2892  cpl_vector *vy = NULL;
2893  cpl_vector *vsy= NULL;
2894  cpl_type type;
2895 
2896  /* Check input */
2897  assure( t != NULL, CPL_ERROR_NULL_INPUT, "Null table");
2898  N = cpl_table_get_nrow(t);
2899  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "The table with column to compute regression has 0 rows!");
2900  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);
2901 
2902  assure( cpl_table_has_column(t, X1), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X1);
2903  assure( cpl_table_has_column(t, X2), CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", X2);
2904  assure( cpl_table_has_column(t, Y) , CPL_ERROR_ILLEGAL_INPUT, "No such column: %s", Y);
2905  assure( (variance == NULL && variance_fit == NULL) || sigmaY != NULL,
2906  CPL_ERROR_INCOMPATIBLE_INPUT, "Cannot calculate variances without sigmaY");
2907  if (sigmaY != NULL)
2908  {
2909  assure( cpl_table_has_column(t, sigmaY) , CPL_ERROR_ILLEGAL_INPUT,
2910  "No such column: %s", sigmaY);
2911  }
2912  if (polynomial_fit != NULL)
2913  {
2914  assure( !cpl_table_has_column(t, polynomial_fit) , CPL_ERROR_ILLEGAL_INPUT,
2915  "Table already has '%s' column", polynomial_fit);
2916  }
2917  if (residual_square != NULL)
2918  {
2919  assure( !cpl_table_has_column(t, residual_square), CPL_ERROR_ILLEGAL_INPUT,
2920  "Table already has '%s' column", residual_square);
2921  }
2922  if (variance_fit != NULL)
2923  {
2924  assure( !cpl_table_has_column(t, variance_fit) , CPL_ERROR_ILLEGAL_INPUT,
2925  "Table already has '%s' column", variance_fit);
2926  }
2927 
2928  /* Check column types */
2929  type = cpl_table_get_column_type(t, X1);
2930  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2931  "Input column '%s' has wrong type (%s)", X1, uves_tostring_cpl_type(type));
2932  type = cpl_table_get_column_type(t, X2);
2933  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2934  "Input column '%s' has wrong type (%s)", X2, uves_tostring_cpl_type(type));
2935  type = cpl_table_get_column_type(t, Y);
2936  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2937  "Input column '%s' has wrong type (%s)", Y, uves_tostring_cpl_type(type));
2938  if (sigmaY != NULL)
2939  {
2940  type = cpl_table_get_column_type(t, sigmaY);
2941  assure( type == CPL_TYPE_INT || type == CPL_TYPE_DOUBLE, CPL_ERROR_INVALID_TYPE,
2942  "Input column '%s' has wrong type (%s)",
2943  sigmaY, uves_tostring_cpl_type(type));
2944  }
2945 
2946  /* In the case that these temporary columns already exist, a run-time error will occur */
2947  check( cpl_table_cast_column(t, X1 , "_X1_double", CPL_TYPE_DOUBLE),
2948  "Could not cast table column to double");
2949  check( cpl_table_cast_column(t, X2 , "_X2_double", CPL_TYPE_DOUBLE),
2950  "Could not cast table column to double");
2951  check( cpl_table_cast_column(t, Y , "_Y_double", CPL_TYPE_DOUBLE),
2952  "Could not cast table column to double");
2953  if (sigmaY != NULL)
2954  {
2955  check( cpl_table_cast_column(t, sigmaY, "_sY_double", CPL_TYPE_DOUBLE),
2956  "Could not cast table column to double");
2957  }
2958 
2959  total_rejected = 0;
2960  rejected = 0;
2961  check( cpl_table_new_column(t, "_residual_square", CPL_TYPE_DOUBLE),
2962  "Could not create column");
2963 
2964  do {
2965  /* WARNING!!! Code duplication (see below). Be careful
2966  when updating */
2967  check(( N = cpl_table_get_nrow(t),
2968  x1 = cpl_table_get_data_double(t, "_X1_double"),
2969  x2 = cpl_table_get_data_double(t, "_X2_double"),
2970  y = cpl_table_get_data_double(t, "_Y_double"),
2971  res= cpl_table_get_data_double(t, "_residual_square")),
2972  "Could not read table data");
2973 
2974  if (sigmaY != NULL)
2975  {
2976  check (sy = cpl_table_get_data_double(t, "_sY_double"),
2977  "Could not read table data");
2978  }
2979  else
2980  {
2981  sy = NULL;
2982  }
2983 
2984  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
2985 
2986  /* Wrap vectors */
2987  uves_unwrap_vector(&vx1);
2988  uves_unwrap_vector(&vx2);
2989  uves_unwrap_vector(&vy);
2990 
2991  vx1 = cpl_vector_wrap(N, x1);
2992  vx2 = cpl_vector_wrap(N, x2);
2993  vy = cpl_vector_wrap(N, y);
2994  if (sy != NULL)
2995  {
2996  uves_unwrap_vector(&vsy);
2997  vsy = cpl_vector_wrap(N, sy);
2998  }
2999  else
3000  {
3001  vsy = NULL;
3002  }
3003 
3004  /* Wrap up the bi-vector */
3005  uves_unwrap_bivector_vectors(&vx);
3006  vx = cpl_bivector_wrap_vectors(vx1, vx2);
3007 
3008  /* Fit! */
3010  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3011  NULL, NULL, NULL),
3012  "Could not fit polynomial");
3013 
3014  /* If requested, calculate residuals and perform kappa-sigma clipping */
3015  if (kappa > 0)
3016  {
3017  double sigma2; /* sigma squared */
3018  int i;
3019 
3020  cpl_table_fill_column_window_double(t, "_residual_square", 0,
3021  cpl_table_get_nrow(t), 0.0);
3022 
3023  for (i = 0; i < N; i++)
3024  {
3025  double yval, yfit;
3026 
3027  yval = y[i];
3028  yfit = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
3029  res[i] = (yfit-y[i])*(yfit-y[i]);
3030  }
3031 
3032  /* For robustness, estimate sigma as (third quartile) / 0.6744
3033  * (68% is within 1 sigma, 50% is within 3rd quartile, so sigma is > 3rd quartile)
3034  * The third quartile is estimated as the median of the absolute residuals,
3035  * so sigma ~= median(|residual|) / 0.6744 , i.e.
3036  * sigma^2 ~= median(residual^2) / 0.6744^2
3037  */
3038  sigma2 = cpl_table_get_column_median(t, "_residual_square") / (0.6744 * 0.6744);
3039 
3040 
3041  /* Remove points with residual^2 > kappa^2 * sigma^2 */
3042  check( rejected = uves_erase_table_rows(t, "_residual_square",
3043  CPL_GREATER_THAN, kappa*kappa*sigma2),
3044  "Could not remove outlier points");
3045  /* Note! All pointers to table data are now invalid! */
3046 
3047 
3048  uves_msg_debug("%d of %d points rejected in kappa-sigma clipping. rms=%f",
3049  rejected, N, sqrt(sigma2));
3050 
3051  /* Update */
3052  total_rejected += rejected;
3053  N = cpl_table_get_nrow(t);
3054  }
3055 
3056  /* Stop also if there are too few points left to make the fit.
3057  * Needed number of points = (degree1+1)(degree2+1) coefficients
3058  * plus one extra point for chi^2 computation. */
3059  } while (rejected > 0 && rejected > min_reject*(N+rejected) &&
3060  N >= (degree1 + 1)*(degree2 + 1) + 1);
3061 
3062  if (kappa > 0)
3063  {
3064  uves_msg_debug("%d of %d points (%f %%) rejected in kappa-sigma clipping",
3065  total_rejected,
3066  N + total_rejected,
3067  (100.0*total_rejected)/(N + total_rejected)
3068  );
3069  }
3070 
3071  /* Final fit */
3072  {
3073  /* Need to convert to vector again. */
3074 
3075  /* WARNING!!! Code duplication (see above). Be careful
3076  when updating */
3077  check(( N = cpl_table_get_nrow(t),
3078  x1 = cpl_table_get_data_double(t, "_X1_double"),
3079  x2 = cpl_table_get_data_double(t, "_X2_double"),
3080  y = cpl_table_get_data_double(t, "_Y_double"),
3081  res= cpl_table_get_data_double(t, "_residual_square")),
3082  "Could not read table data");
3083 
3084  if (sigmaY != NULL)
3085  {
3086  check (sy = cpl_table_get_data_double(t, "_sY_double"),
3087  "Could not read table data");
3088  }
3089  else
3090  {
3091  sy = NULL;
3092  }
3093 
3094  assure( N > 0, CPL_ERROR_ILLEGAL_INPUT, "Empty table");
3095 
3096  /* Wrap vectors */
3097  uves_unwrap_vector(&vx1);
3098  uves_unwrap_vector(&vx2);
3099  uves_unwrap_vector(&vy);
3100 
3101  vx1 = cpl_vector_wrap(N, x1);
3102  vx2 = cpl_vector_wrap(N, x2);
3103  vy = cpl_vector_wrap(N, y);
3104  if (sy != NULL)
3105  {
3106  uves_unwrap_vector(&vsy);
3107  vsy = cpl_vector_wrap(N, sy);
3108  }
3109  else
3110  {
3111  vsy = NULL;
3112  }
3113 
3114  /* Wrap up the bi-vector */
3115  uves_unwrap_bivector_vectors(&vx);
3116  vx = cpl_bivector_wrap_vectors(vx1, vx2);
3117  }
3118 
3120  if (variance_fit != NULL || variance != NULL)
3121  {
3122  /* If requested, also compute variance */
3123  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3124  mse, red_chisq, &variance_local),
3125  "Could not fit polynomial");
3126  }
3127  else
3128  {
3129  check( p = uves_polynomial_fit_2d(vx, vy, vsy, degree1, degree2,
3130  mse, red_chisq, NULL),
3131  "Could not fit polynomial");
3132  }
3133 
3134  cpl_table_erase_column(t, "_residual_square");
3135 
3136  /* Add the fitted values to table as requested */
3137  if (polynomial_fit != NULL || residual_square != NULL)
3138  {
3139  int i;
3140  double *pf;
3141 
3142  check( cpl_table_new_column(t, "_polynomial_fit", CPL_TYPE_DOUBLE),
3143  "Could not create column");
3144 
3145  cpl_table_fill_column_window_double(t, "_polynomial_fit", 0,
3146  cpl_table_get_nrow(t), 0.0);
3147 
3148  x1 = cpl_table_get_data_double(t, "_X1_double");
3149  x2 = cpl_table_get_data_double(t, "_X2_double");
3150  pf = cpl_table_get_data_double(t, "_polynomial_fit");
3151 
3152  for (i = 0; i < N; i++){
3153 #if 0
3154  double x1val, x2val, yfit;
3155 
3156  check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
3157  x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
3158  yfit = uves_polynomial_evaluate_2d(p, x1val, x2val),
3159 
3160  cpl_table_set_double(t, "_polynomial_fit", i, yfit)),
3161  "Could not evaluate polynomial");
3162 
3163 #else
3164  pf[i] = uves_polynomial_evaluate_2d(p, x1[i], x2[i]);
3165 #endif
3166  }
3167 
3168  /* Add residual^2 = (Polynomial fit - Y)^2 if requested */
3169  if (residual_square != NULL)
3170  {
3171  check(( cpl_table_duplicate_column(t, residual_square, /* RS := PF */
3172  t, "_polynomial_fit"),
3173  cpl_table_subtract_columns(t, residual_square, Y), /* RS := RS - Y */
3174  cpl_table_multiply_columns(t, residual_square, residual_square)),
3175  /* RS := RS^2 */
3176  "Could not calculate Residual of fit");
3177  }
3178 
3179  /* Keep the polynomial_fit column if requested */
3180  if (polynomial_fit != NULL)
3181  {
3182  cpl_table_name_column(t, "_polynomial_fit", polynomial_fit);
3183  }
3184  else
3185  {
3186  cpl_table_erase_column(t, "_polynomial_fit");
3187  }
3188  }
3189 
3190  /* Add variance of poly_fit if requested */
3191  if (variance_fit != NULL)
3192  {
3193  int i;
3194  double *vf;
3195 
3196  check( cpl_table_new_column(t, variance_fit, CPL_TYPE_DOUBLE),
3197  "Could not create column");
3198 
3199  cpl_table_fill_column_window_double(t, variance_fit, 0,
3200  cpl_table_get_nrow(t), 0.0);
3201 
3202  x1 = cpl_table_get_data_double(t, "_X1_double");
3203  x2 = cpl_table_get_data_double(t, "_X2_double");
3204  vf = cpl_table_get_data_double(t, variance_fit);
3205 
3206  for (i = 0; i < N; i++)
3207  {
3208 #if 0
3209  double x1val, x2val, yfit_variance;
3210  check(( x1val = cpl_table_get_double(t, "_X1_double", i, NULL),
3211  x2val = cpl_table_get_double(t, "_X2_double", i, NULL),
3212  yfit_variance = uves_polynomial_evaluate_2d(variance_local,
3213  x1val, x2val),
3214 
3215  cpl_table_set_double(t, variance_fit, i, yfit_variance)),
3216  "Could not evaluate polynomial");
3217 #else
3218  vf[i] = uves_polynomial_evaluate_2d(variance_local, x1[i], x2[i]);
3219 #endif
3220 
3221  }
3222  }
3223 
3224 
3225  check(( cpl_table_erase_column(t, "_X1_double"),
3226  cpl_table_erase_column(t, "_X2_double"),
3227  cpl_table_erase_column(t, "_Y_double")),
3228  "Could not delete temporary columns");
3229 
3230  if (sigmaY != NULL)
3231  {
3232  check( cpl_table_erase_column(t, "_sY_double"),
3233  "Could not delete temporary column");
3234  }
3235 
3236  cleanup:
3237  uves_unwrap_bivector_vectors(&vx);
3238  uves_unwrap_vector(&vx1);
3239  uves_unwrap_vector(&vx2);
3240  uves_unwrap_vector(&vy);
3241  uves_unwrap_vector(&vsy);
3242  /* Delete 'variance_local', or return through 'variance' parameter */
3243  if (variance != NULL)
3244  {
3245  *variance = variance_local;
3246  }
3247  else
3248  {
3249  uves_polynomial_delete(&variance_local);
3250  }
3251  if (cpl_error_get_code() != CPL_ERROR_NONE)
3252  {
3254  }
3255 
3256  return p;
3257 }
3258 
3259 /*----------------------------------------------------------------------------*/
3302 /*----------------------------------------------------------------------------*/
3303 
3304 polynomial *
3306  const char *X1, const char *X2, const char *Y,
3307  const char *sigmaY,
3308  const char *polynomial_fit,
3309  const char *residual_square,
3310  const char *variance_fit,
3311  double *mean_squared_error, double *red_chisq,
3312  polynomial **variance, double kappa,
3313  int maxdeg1, int maxdeg2, double min_rms,
3314  double min_reject,
3315  bool verbose,
3316  const double *min_val,
3317  const double *max_val,
3318  int npos, double positions[][2])
3319 {
3320  int deg1 = 0; /* Current degrees */
3321  int deg2 = 0; /* Current degrees */
3322  int i;
3323 
3324  double **mse = NULL;
3325  bool adjust1 = true; /* Flags indicating if DEFPOL1/DEFPOL2 should be adjusted */
3326  bool adjust2 = true; /* (or held constant) */
3327  bool finished = false;
3328 
3329  const char *y_unit;
3330  cpl_table *temp = NULL;
3331  polynomial *bivariate_fit = NULL; /* Result */
3332 
3333  assure( (min_val == NULL && max_val == NULL) || positions != NULL,
3334  CPL_ERROR_NULL_INPUT,
3335  "Missing positions array");
3336 
3337  check_nomsg( y_unit = cpl_table_get_column_unit(t, Y));
3338  if (y_unit == NULL)
3339  {
3340  y_unit = "";
3341  }
3342 
3343  assure(maxdeg1 >= 1 && maxdeg2 >= 1, CPL_ERROR_ILLEGAL_INPUT,
3344  "Illegal max. degrees: (%d, %d)",
3345  maxdeg1, maxdeg2);
3346 
3347  mse = cpl_calloc(maxdeg1+1, sizeof(double *));
3348  assure_mem(mse);
3349  for (i = 0; i < maxdeg1+1; i++)
3350  {
3351  int j;
3352  mse[i] = cpl_calloc(maxdeg2+1, sizeof(double));
3353  assure_mem(mse);
3354 
3355  for (j = 0; j < maxdeg2+1; j++)
3356  {
3357  mse[i][j] = -1;
3358  }
3359  }
3360 
3361  temp = cpl_table_duplicate(t);
3362  assure_mem(temp);
3363 
3364  uves_polynomial_delete(&bivariate_fit);
3365  check( bivariate_fit = uves_polynomial_regression_2d(temp,
3366  X1, X2, Y, sigmaY,
3367  deg1,
3368  deg2,
3369  NULL, NULL, NULL, /* new columns */
3370  &mse[deg1][deg2], NULL, /* chi^2/N */
3371  NULL, /* variance pol.*/
3372  kappa, min_reject),
3373  "Error fitting polynomial");
3374  if (verbose)
3375  uves_msg_low("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
3376  deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
3377  cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
3378  cpl_table_get_nrow(t));
3379  else
3380  uves_msg_debug("(%d, %d)-degree: RMS = %.3g %s (%" CPL_SIZE_FORMAT "/%" CPL_SIZE_FORMAT " outliers)",
3381  deg1, deg2, sqrt(mse[deg1][deg2]), y_unit,
3382  cpl_table_get_nrow(t) - cpl_table_get_nrow(temp),
3383  cpl_table_get_nrow(t));
3384  /* Find best values of deg1, deg2 less than or equal to 8,8
3385  (the fitting algorithm is unstable after this point, anyway) */
3386  do
3387  {
3388  int new_deg1, new_deg2;
3389  double m;
3390 
3391  finished = true;
3392 
3393  adjust1 = adjust1 && (deg1 + 2 <= maxdeg1);
3394  adjust2 = adjust2 && (deg2 + 2 <= maxdeg2);
3395 
3396  /* Try the new degrees
3397 
3398  (d1+1, d2 ) (d1+2, d2)
3399  (d1, d2+1) (d1+1, d2+1)
3400  (d1, d2+2)
3401 
3402  in the following order:
3403 
3404  1 3
3405  1 2
3406  3
3407 
3408  (i.e. only move to '3' if positions '1' and '2' were no better, etc.)
3409  */
3410  for (new_deg1 = deg1; new_deg1 <= deg1+2; new_deg1++)
3411  for (new_deg2 = deg2; new_deg2 <= deg2+2; new_deg2++)
3412  if ( (
3413  (new_deg1 == deg1+1 && new_deg2 == deg2 && adjust1) ||
3414  (new_deg1 == deg1+2 && new_deg2 == deg2 && adjust1) ||
3415  (new_deg1 == deg1 && new_deg2 == deg2+1 && adjust2) ||
3416  (new_deg1 == deg1 && new_deg2 == deg2+2 && adjust2) ||
3417  (new_deg1 == deg1+1 && new_deg2 == deg2+1 && adjust1 && adjust2)
3418  )
3419  && mse[new_deg1][new_deg2] < 0)
3420  {
3421  int rejected = 0;
3422 
3423  uves_free_table(&temp);
3424  temp = cpl_table_duplicate(t);
3425  assure_mem(temp);
3426 
3427  uves_polynomial_delete(&bivariate_fit);
3428  bivariate_fit = uves_polynomial_regression_2d(temp,
3429  X1, X2, Y, sigmaY,
3430  new_deg1,
3431  new_deg2,
3432  NULL, NULL, NULL,
3433  &(mse[new_deg1]
3434  [new_deg2]),
3435  NULL,
3436  NULL,
3437  kappa, min_reject);
3438 
3439  if (cpl_error_get_code() == CPL_ERROR_SINGULAR_MATRIX)
3440  {
3441  uves_error_reset();
3442 
3443  if (verbose)
3444  uves_msg_low("(%d, %d)-degree: Singular matrix",
3445  new_deg1, new_deg2);
3446  else
3447  uves_msg_debug("(%d, %d)-degree: Singular matrix",
3448  new_deg1, new_deg2);
3449 
3450  mse[new_deg1][new_deg2] = DBL_MAX/2;
3451  }
3452  else
3453  {
3454  assure( cpl_error_get_code() == CPL_ERROR_NONE,
3455  cpl_error_get_code(),
3456  "Error fitting (%d, %d)-degree polynomial",
3457  new_deg1, new_deg2 );
3458 
3459  rejected = cpl_table_get_nrow(t) - cpl_table_get_nrow(temp);
3460 
3461  if (verbose)
3462  uves_msg_low("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
3463  new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
3464  rejected, cpl_table_get_nrow(t));
3465  else
3466  uves_msg_debug("(%d,%d)-degree: RMS = %.3g %s (%d/%" CPL_SIZE_FORMAT " outliers)",
3467  new_deg1, new_deg2, sqrt(mse[new_deg1][new_deg2]), y_unit,
3468  rejected, cpl_table_get_nrow(t));
3469 
3470  /* Reject if fit produced bad values */
3471  if (min_val != NULL || max_val != NULL)
3472  {
3473  for (i = 0; i < npos; i++)
3474  {
3475  double val = uves_polynomial_evaluate_2d(
3476  bivariate_fit,
3477  positions[i][0], positions[i][1]);
3478  if (min_val != NULL && val < *min_val)
3479  {
3480  uves_msg_debug("Bad fit: %f < %f",
3481  val,
3482  *min_val);
3483  mse[new_deg1][new_deg2] = DBL_MAX/2;
3484  /* A large number, even if we add a bit */
3485  }
3486  if (max_val != NULL && val > *max_val)
3487  {
3488  uves_msg_debug("Bad fit: %f > %f",
3489  val,
3490  *max_val);
3491  mse[new_deg1][new_deg2] = DBL_MAX/2;
3492  }
3493  }
3494  }
3495 
3496  /* For robustness, make sure that we don't accept a solution that
3497  rejected too many points (say, 80%)
3498  */
3499  if (rejected >= (4*cpl_table_get_nrow(t))/5)
3500  {
3501  mse[new_deg1][new_deg2] = DBL_MAX/2;
3502  }
3503 
3504  }/* if fit succeeded */
3505  }
3506 
3507  /* If fit is significantly better (say, 10% improvement in MSE) in either direction,
3508  * (in (degree,degree)-space) then move in that direction.
3509  *
3510  * First try to move one step horizontal/vertical,
3511  * otherwise try to move diagonally (i.e. increase both degrees),
3512  * otherwise move two steps horizontal/vertical
3513  *
3514  */
3515  m = mse[deg1][deg2];
3516 
3517  if (adjust1
3518  && (m - mse[deg1+1][deg2])/m > 0.1
3519  && (!adjust2 || mse[deg1+1][deg2] <= mse[deg1][deg2+1])
3520  /* The condition is read like this:
3521  if
3522  - we are trying to move right, and
3523  - this is this is a better place than the current, and
3524  - this is better than moving down */
3525  )
3526  {
3527  deg1++;
3528  finished = false;
3529  }
3530  else if (adjust2 &&
3531  (m - mse[deg1][deg2+1])/m > 0.1
3532  && (!adjust1 || mse[deg1+1][deg2] > mse[deg1][deg2+1])
3533  )
3534  {
3535  deg2++;
3536  finished = false;
3537  }
3538  else if (adjust1 && adjust2 && (m - mse[deg1+1][deg2+1])/m > 0.1)
3539  {
3540  deg1++;
3541  deg2++;
3542  finished = false;
3543  }
3544  else if (adjust1
3545  && (m - mse[deg1+2][deg2])/m > 0.1
3546  && (!adjust2 || mse[deg1+2][deg2] <= mse[deg1][deg2+2])
3547  )
3548  {
3549  deg1 += 2;
3550  finished = false;
3551  }
3552  else if (adjust2
3553  && (m - mse[deg1][deg2+2])/m > 0.1
3554  && (!adjust1 || mse[deg1+2][deg2] < mse[deg1][deg2+2]))
3555  {
3556  deg2 += 2;
3557  finished = false;
3558  }
3559 
3560  /* For efficiency, stop if rms reached min_rms */
3561  finished = finished || (sqrt(mse[deg1][deg2]) < min_rms);
3562 
3563  } while (!finished);
3564 
3565  uves_polynomial_delete(&bivariate_fit);
3566  check( bivariate_fit = uves_polynomial_regression_2d(t,
3567  X1, X2, Y, sigmaY,
3568  deg1,
3569  deg2,
3570  polynomial_fit, residual_square,
3571  variance_fit,
3572  mean_squared_error, red_chisq,
3573  variance, kappa, min_reject),
3574  "Error fitting (%d, %d)-degree polynomial", deg1, deg2);
3575 
3576  if (verbose)
3577  uves_msg_low("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2,
3578  sqrt(mse[deg1][deg2]), y_unit);
3579  else
3580  uves_msg_debug("Using degree (%d, %d), RMS = %.3g %s", deg1, deg2,
3581  sqrt(mse[deg1][deg2]), y_unit);
3582 
3583  cleanup:
3584  if (mse != NULL)
3585  {
3586  for (i = 0; i < maxdeg1+1; i++)
3587  {
3588  if (mse[i] != NULL)
3589  {
3590  cpl_free(mse[i]);
3591  }
3592  }
3593  cpl_free(mse);
3594  }
3595  uves_free_table(&temp);
3596 
3597  return bivariate_fit;
3598 }
3599 
3600 /*----------------------------------------------------------------------------*/
3610 /*----------------------------------------------------------------------------*/
3611 const char *
3612 uves_remove_string_prefix(const char *s, const char *prefix)
3613 {
3614  const char *result = NULL;
3615  unsigned int prefix_length;
3616 
3617  assure( s != NULL, CPL_ERROR_NULL_INPUT, "Null string");
3618  assure( prefix != NULL, CPL_ERROR_NULL_INPUT, "Null string");
3619 
3620  prefix_length = strlen(prefix);
3621 
3622  assure( strlen(s) >= prefix_length &&
3623  strncmp(s, prefix, prefix_length) == 0,
3624  CPL_ERROR_INCOMPATIBLE_INPUT, "'%s' is not a prefix of '%s'",
3625  prefix, s);
3626 
3627  result = s + prefix_length;
3628 
3629  cleanup:
3630  return result;
3631 }
3632 
3633 
3634 /*----------------------------------------------------------------------------*/
3643 /*----------------------------------------------------------------------------*/
3644 
3645 double uves_gaussrand(void)
3646 {
3647  static double V1, V2, S;
3648  static int phase = 0;
3649  double X;
3650 
3651  if(phase == 0) {
3652  do {
3653  double U1 = (double)rand() / RAND_MAX;
3654  double U2 = (double)rand() / RAND_MAX;
3655 
3656  V1 = 2 * U1 - 1;
3657  V2 = 2 * U2 - 1;
3658  S = V1 * V1 + V2 * V2;
3659  } while(S >= 1 || S == 0);
3660 
3661  X = V1 * sqrt(-2 * log(S) / S);
3662  } else
3663  X = V2 * sqrt(-2 * log(S) / S);
3664 
3665  phase = 1 - phase;
3666 
3667  return X;
3668 }
3669 
3670 /*----------------------------------------------------------------------------*/
3681 /*----------------------------------------------------------------------------*/
3682 
3683 double uves_spline_hermite_table( double xp, const cpl_table *t, const char *column_x,
3684  const char *column_y, int *istart )
3685 {
3686  double result = 0;
3687  int n;
3688 
3689  const double *x, *y;
3690 
3691  check( x = cpl_table_get_data_double_const(t, column_x),
3692  "Error reading column '%s'", column_x);
3693  check( y = cpl_table_get_data_double_const(t, column_y),
3694  "Error reading column '%s'", column_y);
3695 
3696  n = cpl_table_get_nrow(t);
3697 
3698  result = uves_spline_hermite(xp, x, y, n, istart);
3699 
3700  cleanup:
3701  return result;
3702 }
3703 
3704 /*----------------------------------------------------------------------------*/
3720 /*----------------------------------------------------------------------------*/
3721 double uves_spline_hermite( double xp, const double *x, const double *y, int n, int *istart )
3722 {
3723  double yp1, yp2, yp = 0;
3724  double xpi, xpi1, l1, l2, lp1, lp2;
3725  int i;
3726 
3727  if ( x[0] <= x[n-1] && (xp < x[0] || xp > x[n-1]) ) return 0.0;
3728  if ( x[0] > x[n-1] && (xp > x[0] || xp < x[n-1]) ) return 0.0;
3729 
3730  if ( x[0] <= x[n-1] )
3731  {
3732  for ( i = (*istart)+1; i <= n && xp >= x[i-1]; i++ )
3733  ;
3734  }
3735  else
3736  {
3737  for ( i = (*istart)+1; i <= n && xp <= x[i-1]; i++ )
3738  ;
3739  }
3740 
3741  *istart = i;
3742  i--;
3743 
3744  lp1 = 1.0 / (x[i-1] - x[i]);
3745  lp2 = -lp1;
3746 
3747  if ( i == 1 )
3748  {
3749  yp1 = (y[1] - y[0]) / (x[1] - x[0]);
3750  }
3751  else
3752  {
3753  yp1 = (y[i] - y[i-2]) / (x[i] - x[i-2]);
3754  }
3755 
3756  if ( i >= n - 1 )
3757  {
3758  yp2 = (y[n-1] - y[n-2]) / (x[n-1] - x[n-2]);
3759  }
3760  else
3761  {
3762  yp2 = (y[i+1] - y[i-1]) / (x[i+1] - x[i-1]);
3763  }
3764 
3765  xpi1 = xp - x[i];
3766  xpi = xp - x[i-1];
3767  l1 = xpi1*lp1;
3768  l2 = xpi*lp2;
3769 
3770  yp = y[i-1]*(1 - 2.0*lp1*xpi)*l1*l1 +
3771  y[i]*(1 - 2.0*lp2*xpi1)*l2*l2 +
3772  yp1*xpi*l1*l1 + yp2*xpi1*l2*l2;
3773 
3774  return yp;
3775 }
3776 
3777 /*----------------------------------------------------------------------------*/
3791 /*----------------------------------------------------------------------------*/
3792 
3793 double uves_spline_cubic( double xp, double *x, float *y, float *y2, int n, int *kstart )
3794 {
3795  int klo, khi, k;
3796  double a, b, h, yp = 0;
3797 
3798  assure_nomsg( x != NULL, CPL_ERROR_NULL_INPUT);
3799  assure_nomsg( y != NULL, CPL_ERROR_NULL_INPUT);
3800  assure_nomsg( y2 != NULL, CPL_ERROR_NULL_INPUT);
3801  assure_nomsg( kstart != NULL, CPL_ERROR_NULL_INPUT);
3802 
3803  klo = *kstart;
3804  khi = n;
3805 
3806  if ( xp < x[1] || xp > x[n] )
3807  {
3808  return 0.0;
3809  }
3810  else if ( xp == x[1] )
3811  {
3812  return(y[1]);
3813  }
3814 
3815  for ( k = klo; k < n && xp > x[k]; k++ )
3816  ;
3817 
3818  klo = *kstart = k-1;
3819  khi = k;
3820 
3821  h = x[khi] - x[klo];
3822  assure( h != 0.0, CPL_ERROR_DIVISION_BY_ZERO,
3823  "Empty x-value range: xlo = %e ; xhi = %e", x[khi], x[klo]);
3824 
3825  a = (x[khi] - xp) / h;
3826  b = (xp - x[klo]) / h;
3827 
3828  yp = a*y[klo] + b*y[khi] + ((a*a*a - a)*y2[klo] + (b*b*b - b)*y2[khi])*
3829  (h*h) / 6.0;
3830 
3831  cleanup:
3832  return yp;
3833 }
3834 
3835 /*----------------------------------------------------------------------------*/
3845 /*----------------------------------------------------------------------------*/
3846 bool
3847 uves_table_is_sorted_double(const cpl_table *t, const char *column, const bool reverse)
3848 {
3849  bool is_sorted = true; /* ... until proven false */
3850  int i;
3851  int N;
3852  double previous, current; /* column values */
3853 
3854  passure(t != NULL, " ");
3855  passure(cpl_table_has_column(t, column), "No column '%s'", column);
3856  passure(cpl_table_get_column_type(t, column) == CPL_TYPE_DOUBLE, " ");
3857 
3858  N = cpl_table_get_nrow(t);
3859 
3860  if (N > 1)
3861  {
3862  previous = cpl_table_get_double(t, column, 0, NULL);
3863 
3864  for(i = 1; i < N && is_sorted; i++)
3865  {
3866  current = cpl_table_get_double(t, column, i, NULL);
3867  if (!reverse)
3868  {
3869  /* Check for ascending */
3870  is_sorted = is_sorted && ( current >= previous );
3871  }
3872  else
3873  {
3874  /* Check for descending */
3875  is_sorted = is_sorted && ( current <= previous );
3876  }
3877 
3878  previous = current;
3879  }
3880  }
3881  else
3882  {
3883  /* 0 or 1 rows. Table is sorted */
3884  }
3885 
3886  cleanup:
3887  return is_sorted;
3888 }
3889 
3890 /*----------------------------------------------------------------------------*/
3896 /*----------------------------------------------------------------------------*/
3897 cpl_table *
3899 {
3900  cpl_table *result = NULL;
3901 
3902  check((
3903  result = cpl_table_new(0),
3904  cpl_table_new_column(result, "TraceID" , CPL_TYPE_INT),
3905  cpl_table_new_column(result, "Offset" , CPL_TYPE_DOUBLE),
3906  cpl_table_new_column(result, "Tracemask", CPL_TYPE_INT)),
3907  "Error creating table");
3908 
3909  cleanup:
3910  return result;
3911 }
3912 
3913 /*----------------------------------------------------------------------------*/
3923 /*----------------------------------------------------------------------------*/
3924 cpl_error_code
3925 uves_ordertable_traces_add(cpl_table *traces,
3926  int fibre_ID, double fibre_offset, int fibre_mask)
3927 {
3928  int size;
3929 
3930  assure( traces != NULL, CPL_ERROR_NULL_INPUT, "Null table!");
3931 
3932  /* Write to new table row */
3933  check((
3934  size = cpl_table_get_nrow(traces),
3935  cpl_table_set_size (traces, size+1),
3936  cpl_table_set_int (traces, "TraceID" , size, fibre_ID),
3937  cpl_table_set_double(traces, "Offset" , size, fibre_offset),
3938  cpl_table_set_int (traces, "Tracemask", size, fibre_mask)),
3939  "Error updating table");
3940 
3941  cleanup:
3942  return cpl_error_get_code();
3943 }
3944 
3945 
3946 /*----------------------------------------------------------------------------*/
3952 /*----------------------------------------------------------------------------*/
3953 cpl_error_code
3955 {
3956  cpl_table* tab=NULL;
3957  uves_propertylist* head=NULL;
3958  tab=cpl_table_load(tname,1,0);
3959  head=uves_propertylist_load(tname,0);
3961  check_nomsg(uves_table_save(tab,head,NULL,tname,CPL_IO_DEFAULT));
3962 
3963  cleanup:
3964  uves_free_table(&tab);
3965  uves_free_propertylist(&head);
3966  return cpl_error_get_code();
3967 }
3968 
3969 
3970 
3971 /*----------------------------------------------------------------------------*/
3978 /*----------------------------------------------------------------------------*/
3979 cpl_error_code
3980 uves_tablenames_unify_units(const char* tname2, const char* tname1)
3981 {
3982  cpl_table* tab1=NULL;
3983  cpl_table* tab2=NULL;
3984  uves_propertylist* head2=NULL;
3985 
3986  tab1=cpl_table_load(tname1,1,0);
3987 
3988  tab2=cpl_table_load(tname2,1,0);
3989  head2=uves_propertylist_load(tname2,0);
3990 
3991  uves_table_unify_units(&tab2,&tab1);
3992  check_nomsg(uves_table_save(tab2,head2,NULL,tname2,CPL_IO_DEFAULT));
3993 
3994  cleanup:
3995  uves_free_table(&tab1);
3996  uves_free_table(&tab2);
3997  uves_free_propertylist(&head2);
3998  return cpl_error_get_code();
3999 
4000 }
4001 
4002 
4003 
4004 /*----------------------------------------------------------------------------*/
4010 /*----------------------------------------------------------------------------*/
4011 cpl_error_code
4012 uves_table_remove_units(cpl_table **table)
4013 {
4014  int ncols;
4015  const char* colname=NULL;
4016  int i=0;
4017  cpl_array *names=NULL;
4018 
4019  assure( *table != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4020  ncols = cpl_table_get_ncol(*table);
4021  names = cpl_table_get_column_names(*table);
4022  for(i=0;i<ncols;i++) {
4023  colname=cpl_array_get_string(names, i);
4024  cpl_table_set_column_unit(*table,colname,NULL);
4025  }
4026 
4027  cleanup:
4028  uves_free_array(&names);
4029 
4030  return cpl_error_get_code();
4031 }
4032 
4033 
4034 
4035 /*----------------------------------------------------------------------------*/
4042 /*----------------------------------------------------------------------------*/
4043 cpl_error_code
4044 uves_table_unify_units(cpl_table **table2, cpl_table **table1)
4045 {
4046  int ncols1;
4047  int ncols2;
4048  const char* colname=NULL;
4049  const char* unit1=NULL;
4050 
4051  int i=0;
4052  cpl_array *names=NULL;
4053 
4054  assure( table1 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4055  assure( *table2 != NULL, CPL_ERROR_NULL_INPUT, "Null input table!");
4056  ncols1 = cpl_table_get_ncol(*table1);
4057  ncols2 = cpl_table_get_ncol(*table2);
4058  assure( ncols1 == ncols2, CPL_ERROR_NULL_INPUT,
4059  "n columns (tab1) != n columns (tab2)");
4060 
4061  names = cpl_table_get_column_names(*table1);
4062  for(i=0;i<ncols1;i++) {
4063  colname=cpl_array_get_string(names, i);
4064  unit1=cpl_table_get_column_unit(*table1,colname);
4065  cpl_table_set_column_unit(*table2,colname,unit1);
4066  }
4067 
4068  cleanup:
4069  uves_free_array(&names);
4070 
4071  return cpl_error_get_code();
4072 }
4073 
4074 /*
4075  * modified on 2006/04/19
4076  * jmlarsen: float[5] -> const double[]
4077  * changed mapping of indices to parameters
4078  * Normalized the profile to 1 and changed meaning
4079  * of (a[3], a[2]) to (integrated flux, stdev)
4080  * Disabled debugging messages
4081  *
4082  * modified on 2005/07/29 to make dydapar a FORTRAN array
4083  * (indiced from 1 to N instead of 0 to N-1).
4084  * This allows the array to be passed to C functions expecting
4085  * FORTRAN-like arrays.
4086  *
4087  * modified on 2005/08/02 to make the function prototype ANSI
4088  * compliant (so it can be used with the levmar library).
4089  *
4090  * modified on 2005/08/16. The function now expects C-indexed
4091  * arrays as parameters (to allow proper integration). However, the
4092  * arrays are still converted to FORTRAN-indexed arrays internally.
4093  */
4094 
4105 static void fmoffa_i(float x,const double a[],double *y,double dyda[])
4106 
4107 
4108  /* int na;*/
4109 {
4110  double fac=0, fac2=0, fac4= 0, fac4i=0, arg=0, arg2=0;
4111  double a2i=0, m = 0, p = 0, dif =0;
4112  double sqrt5 = 2.23606797749979;
4113 
4114  *y=0.0;
4115 // a2i = 1.0/a[2];
4116  a2i = 1.0/(a[2]*sqrt5);
4117 
4118  dif=x-a[1];
4119  arg=dif*a2i;
4120  arg2=arg*arg;
4121 
4122  fac=1.0+arg2;
4123  fac2=fac*fac;
4124  fac4=fac2*fac2;
4125  fac4i = 1.0/fac4;
4126 
4127 // m = a[1]*fac4i;
4128  m = a[3]*fac4i * a2i*16/(5.0*M_PI);
4129  *y = m + a[4]*(1.0+dif*a[5]);
4130  p = 8.0*m/fac*arg*a2i;
4131 
4132  dyda[3] = m/a[3];
4133  dyda[2] = p*dif/a[2] - m/a[2];
4134 
4135 // dyda[3]=fac4i;
4136  dyda[1]=p-a[4]*a[5];
4137 // dyda[2]=p*dif*a2i;
4138  dyda[4]=1.0+dif*a[5];
4139  dyda[5]=a[4]*dif;
4140 
4141 
4142 #if 0
4143  {
4144  int i = 0, npar=5 ;
4145  printf("fmoffat_i \n");
4146  for (i = 1;i<=npar;i++) printf("a[%1i] %f :\n",i,a[i]);
4147 
4148  printf("fmoffat_i ");
4149  for (i = 1;i<=npar;i++) printf("%i %f :",i,dyda[i]);
4150  printf("\n");
4151  }
4152 #endif
4153 
4154 }
4155 
4174 static void fmoffa_c(float x,const double a[],double *y,double dyda[])/*,na)*/
4175 //void fmoffa_c(x,a,y, dyda)
4176 
4177 
4178 // float x,*a,*y,*dyda;
4179 /*int na;*/
4180 {
4181  int npoint = 3;
4182  double const xgl[3] = {-0.387298334621,0.,0.387298334621};
4183  double const wgl[3] = {.2777777777778,0.444444444444,0.2777777777778};
4184  int i=0;
4185  int j=0;
4186  int npar = 5;
4187  double xmod = 0;
4188  double dydapar[5]; /* = {0.,0.,0.,0.,0.,};*/
4189  double ypar;
4190 
4191 
4192  // Convert C-indexed arrays to FORTRAN-indexed arrays
4193  a = C_TO_FORTRAN_INDEXING(a);
4194  dyda = C_TO_FORTRAN_INDEXING(dyda);
4195 
4196  *y = 0.0;
4197  for (i = 1;i<=npar;i++) dyda[i] = 0.;
4198  /* printf("fmoffat_c ");
4199  for (i = 1;i<=npar;i++) printf("%i %f :",i,a[i]);*/
4200  /*for (i = 0;i<3;i++) printf("%i %f %f:",i,xgl[i],wgl[i]);*/
4201  /* printf("\n");*/
4202  for (j=0; j < npoint; j++)
4203  {
4204  xmod = x+xgl[j];
4205 
4206  fmoffa_i(xmod,a,&ypar,&dydapar[-1]);
4207 
4208  *y = *y + ypar*wgl[j];
4209 
4210  for (i = 1; i <= npar; i++)
4211  {
4212  dyda[i] = dyda[i] + dydapar[i-1]*wgl[j] ;
4213  }
4214 
4215  /* if (j == 2)
4216  for (i = 1;i<=npar;i++)
4217  {
4218  dyda[i] = dydapar[i];
4219  };
4220  */
4221  }
4222 
4223 #if 0
4224  printf("fmoffat_c ");
4225  for (i = 1;i<=npar;i++) printf("%i %f %f: \n",i,a[i],dyda[i]);
4226  printf("\n");
4227 #endif
4228 }
4229 
4230 /*----------------------------------------------------------------------------*/
4238 /*----------------------------------------------------------------------------*/
4239 int
4240 uves_moffat(const double x[], const double a[], double *result)
4241 {
4242  double dyda[5];
4243 
4244  fmoffa_c(x[0], a, result, dyda);
4245 
4246  return 0;
4247 }
4248 
4249 /*----------------------------------------------------------------------------*/
4257 /*----------------------------------------------------------------------------*/
4258 int
4259 uves_moffat_derivative(const double x[], const double a[], double result[])
4260 {
4261  double y;
4262 
4263  fmoffa_c(x[0], a, &y, result);
4264 
4265  return 0;
4266 }
4267 
4268 /*----------------------------------------------------------------------------*/
4288 /*----------------------------------------------------------------------------*/
4289 
4290 int
4291 uves_gauss(const double x[], const double a[], double *result)
4292 {
4293  double my = a[0];
4294  double sigma = a[1];
4295 
4296  if (sigma == 0)
4297  {
4298  /* Dirac's delta function */
4299  if (x[0] == my)
4300  {
4301  *result = DBL_MAX;
4302  }
4303  else
4304  {
4305  *result = 0;
4306  }
4307  return 0;
4308  }
4309  else
4310  {
4311  double A = a[2];
4312  double B = a[3];
4313 
4314  *result = B +
4315  A/(sqrt(2*M_PI*sigma*sigma)) *
4316  exp(- (x[0] - my)*(x[0] - my)
4317  / (2*sigma*sigma));
4318  }
4319 
4320  return 0;
4321 }
4322 
4323 /*----------------------------------------------------------------------------*/
4343 /*----------------------------------------------------------------------------*/
4344 
4345 int
4346 uves_gauss_derivative(const double x[], const double a[], double result[])
4347 {
4348  double my = a[0];
4349  double sigma = a[1];
4350  double A = a[2];
4351  /* a[3] not used */
4352 
4353  double factor;
4354 
4355  /* f(x) = B + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4356  *
4357  * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my) / s^2
4358  * = A * fac. * (x-my) / s^2
4359  * df/ds = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
4360  * = A * fac. * ((x-my)^2 / s^2 - 1) / s
4361  * df/dA = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4362  * = fac.
4363  * df/dB = 1
4364  */
4365 
4366  if (sigma == 0)
4367  {
4368  /* Derivative of Dirac's delta function */
4369  result[0] = 0;
4370  result[1] = 0;
4371  result[2] = 0;
4372  result[3] = 0;
4373  return 0;
4374  }
4375 
4376  factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
4377  / (sqrt(2*M_PI*sigma*sigma));
4378 
4379  result[0] = A * factor * (x[0]-my) / (sigma*sigma);
4380  result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
4381  result[2] = factor;
4382  result[3] = 1;
4383 
4384  return 0;
4385 }
4386 
4387 /*----------------------------------------------------------------------------*/
4408 /*----------------------------------------------------------------------------*/
4409 
4410 int
4411 uves_gauss_linear(const double x[], const double a[], double *result)
4412 {
4413  double my = a[0];
4414  double sigma = a[1];
4415 
4416  if (sigma == 0)
4417  {
4418  /* Dirac's delta function */
4419  if (x[0] == my)
4420  {
4421  *result = DBL_MAX;
4422  }
4423  else
4424  {
4425  *result = 0;
4426  }
4427  return 0;
4428  }
4429  else
4430  {
4431  double A = a[2];
4432  double B = a[3];
4433  double C = a[4];
4434 
4435  *result = B + C*(x[0] - my) +
4436  A/(sqrt(2*M_PI*sigma*sigma)) *
4437  exp(- (x[0] - my)*(x[0] - my)
4438  / (2*sigma*sigma));
4439  }
4440 
4441  return 0;
4442 }
4443 
4444 /*----------------------------------------------------------------------------*/
4467 /*----------------------------------------------------------------------------*/
4468 
4469 int
4470 uves_gauss_linear_derivative(const double x[], const double a[], double result[])
4471 {
4472  double my = a[0];
4473  double sigma = a[1];
4474  double A = a[2];
4475  /* a[3] not used */
4476  double C = a[4];
4477 
4478  double factor;
4479 
4480  /* f(x) = B + C(x-my) + A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4481  *
4482  * df/d(my) = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * (x-my) / s^2
4483  * = A * fac. * (x-my) / s^2 - C
4484  * df/ds = A/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2) * ((x-my)^2/s^3 - 1/s)
4485  * = A * fac. * ((x-my)^2 / s^2 - 1) / s
4486  * df/dA = 1/sqrt(2 pi s^2) exp(-(x-my)^2/2s^2)
4487  * = fac.
4488  * df/dB = 1
4489  *
4490  * df/dC = x-my
4491  */
4492 
4493  if (sigma == 0)
4494  {
4495  /* Derivative of Dirac's delta function */
4496  result[0] = -C;
4497  result[1] = 0;
4498  result[2] = 0;
4499  result[3] = 0;
4500  result[4] = x[0];
4501  return 0;
4502  }
4503 
4504  factor = exp( -(x[0] - my)*(x[0] - my)/(2*sigma*sigma) )
4505  / (sqrt(2*M_PI*sigma*sigma));
4506 
4507  result[0] = A * factor * (x[0]-my) / (sigma*sigma);
4508  result[1] = A * factor * ((x[0]-my)*(x[0]-my) / (sigma*sigma) - 1) / sigma;
4509  result[2] = factor;
4510  result[3] = 1;
4511  result[4] = x[0] - my;
4512 
4513  return 0;
4514 }
4515 
4516 
4517 
4518 
4519 /*----------------------------------------------------------------------------*/
4532 /*----------------------------------------------------------------------------*/
4533 cpl_image *
4534 uves_create_image(uves_iterate_position *pos, enum uves_chip chip,
4535  const cpl_image *spectrum, const cpl_image *sky,
4536  const cpl_image *cosmic_image,
4537  const uves_extract_profile *profile,
4538  cpl_image **image_noise, uves_propertylist **image_header)
4539 {
4540  cpl_image *image = NULL;
4541 
4542  cpl_binary *bpm = NULL;
4543  bool loop_y = false;
4544 
4545  double ron = 3;
4546  double gain = 1.0; //fixme
4547  bool new_format = true;
4548 
4549  image = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
4550  assure_mem( image );
4551  if (image_noise != NULL) {
4552  *image_noise = cpl_image_new(pos->nx, pos->ny, CPL_TYPE_DOUBLE);
4553  assure_mem( *image_noise );
4554  cpl_image_add_scalar(*image_noise, 0.01); /* To avoid non-positive values */
4555  }
4556 
4557  if (image_header != NULL) {
4558  *image_header = uves_propertylist_new();
4559 
4560  uves_propertylist_append_double(*image_header, UVES_MJDOBS, 60000);
4561  uves_propertylist_append_double(*image_header, UVES_RON(new_format, chip), ron);
4562  uves_propertylist_append_double(*image_header, UVES_GAIN(new_format, chip), gain);
4563  }
4564 
4565  for (uves_iterate_set_first(pos,
4566  1, pos->nx,
4567  pos->minorder, pos->maxorder,
4568  bpm,
4569  loop_y);
4570  !uves_iterate_finished(pos);
4571  uves_iterate_increment(pos)) {
4572 
4573  /* Manual loop over y */
4574  uves_extract_profile_set(profile, pos, NULL);
4575  for (pos->y = pos->ylow; pos->y <= pos->yhigh; pos->y++) {
4576 
4577  /* Get empirical and model profile */
4578  double flux, sky_flux;
4579  int bad;
4580  int spectrum_row = pos->order - pos->minorder + 1;
4581  double noise;
4582  double prof = uves_extract_profile_evaluate(profile, pos);
4583 
4584  if (sky != NULL)
4585  {
4586  sky_flux = cpl_image_get(sky, pos->x, spectrum_row, &bad)/pos->sg.length;
4587  }
4588  else
4589  {
4590  sky_flux = 0;
4591  }
4592 
4593  flux = cpl_image_get(spectrum, pos->x, spectrum_row, &bad) * prof + sky_flux;
4594 
4595  //fixme: check this formula
4596  noise = sqrt(gain)*sqrt(ron*ron/(gain*gain) + sky_flux/gain + flux/gain);
4597 // uves_msg_error("%f", prof);
4598  cpl_image_set(image, pos->x, pos->y,
4599  flux);
4600  if (image_noise != NULL) cpl_image_set(*image_noise, pos->x, pos->y, noise);
4601 
4602  }
4603  }
4604 
4605  if (cosmic_image != NULL) {
4606  double cr_val = 2*cpl_image_get_max(image);
4607  /* assign high pixel value to CR pixels */
4608 
4609  loop_y = true;
4610 
4611  for (uves_iterate_set_first(pos,
4612  1, pos->nx,
4613  pos->minorder, pos->maxorder,
4614  bpm,
4615  loop_y);
4616  !uves_iterate_finished(pos);
4617  uves_iterate_increment(pos)) {
4618 
4619  int is_rejected;
4620  if (cpl_image_get(cosmic_image, pos->x, pos->y, &is_rejected) > 0) {
4621  cpl_image_set(image, pos->x, pos->y, cr_val);
4622  }
4623  }
4624  }
4625 
4626  cleanup:
4627  return image;
4628 }
4629 
4630 void
4631 uves_frameset_dump(cpl_frameset* set)
4632 {
4633 
4634  cpl_frame* frm=NULL;
4635  int sz=0;
4636  int i=0;
4637 
4638  cknull(set,"Null input frameset");
4639  check_nomsg(sz=cpl_frameset_get_size(set));
4640  for(i=0;i<sz;i++) {
4641  frm=cpl_frameset_get_frame(set,i);
4642  uves_msg("frame %d tag %s filename %s group %d",
4643  i,
4644  cpl_frame_get_tag(frm),
4645  cpl_frame_get_filename(frm),
4646  cpl_frame_get_group(frm));
4647 
4648  }
4649 
4650  cleanup:
4651 
4652  return ;
4653 }
4654 
4655 
4656 
4657 
4658 /*-------------------------------------------------------------------------*/
4672 /*--------------------------------------------------------------------------*/
4673 
4674 cpl_image *
4675 uves_image_smooth_x(cpl_image * inp, const int r)
4676 {
4677 
4678  /*
4679  @param xp x-value to interpolate
4680  @param x x-values
4681  @param y y-values
4682  @param n array length
4683  @param istart (input/output) initial row (set to 0 to search all row)
4684 
4685  */
4686  float* pinp=NULL;
4687  float* pout=NULL;
4688  int sx=0;
4689  int sy=0;
4690  int i=0;
4691  int j=0;
4692  int k=0;
4693 
4694  cpl_image* out=NULL;
4695 
4696  cknull(inp,"Null in put image, exit");
4697  check_nomsg(out=cpl_image_duplicate(inp));
4698  check_nomsg(sx=cpl_image_get_size_x(inp));
4699  check_nomsg(sy=cpl_image_get_size_y(inp));
4700  check_nomsg(pinp=cpl_image_get_data_float(inp));
4701  check_nomsg(pout=cpl_image_get_data_float(out));
4702  for(j=0;j<sy;j++) {
4703  for(i=r;i<sx-r;i++) {
4704  for(k=-r;k<r;k++) {
4705  pout[j*sx+i]+=pinp[j*sx+i+k];
4706  }
4707  pout[j*sx+i]/=2*r;
4708  }
4709  }
4710 
4711  cleanup:
4712 
4713  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4714  return NULL;
4715  } else {
4716  return out;
4717 
4718  }
4719 
4720 }
4721 
4722 
4723 
4724 
4725 
4726 /*-------------------------------------------------------------------------*/
4740 /*--------------------------------------------------------------------------*/
4741 
4742 cpl_image *
4743 uves_image_smooth_y(cpl_image * inp, const int r)
4744 {
4745 
4746  /*
4747  @param xp x-value to interpolate
4748  @param x x-values
4749  @param y y-values
4750  @param n array length
4751  @param istart (input/output) initial row (set to 0 to search all row)
4752 
4753  */
4754  float* pinp=NULL;
4755  float* pout=NULL;
4756  int sx=0;
4757  int sy=0;
4758  int i=0;
4759  int j=0;
4760  int k=0;
4761 
4762  cpl_image* out=NULL;
4763 
4764  cknull(inp,"Null in put image, exit");
4765  check_nomsg(out=cpl_image_duplicate(inp));
4766  check_nomsg(sx=cpl_image_get_size_x(inp));
4767  check_nomsg(sy=cpl_image_get_size_y(inp));
4768  check_nomsg(pinp=cpl_image_get_data_float(inp));
4769  check_nomsg(pout=cpl_image_get_data_float(out));
4770  for(j=r;j<sy-r;j++) {
4771  for(i=0;i<sx;i++) {
4772  for(k=-r;k<r;k++) {
4773  pout[j*sx+i]+=pinp[(j+k)*sx+i];
4774  }
4775  pout[j*sx+i]/=2*r;
4776  }
4777  }
4778 
4779  cleanup:
4780 
4781  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4782  return NULL;
4783  } else {
4784  return out;
4785 
4786  }
4787 
4788 }
4789 
4790 
4791 /*-------------------------------------------------------------------------*/
4805 /*--------------------------------------------------------------------------*/
4806 
4807 cpl_image *
4808 uves_image_smooth_mean_x(cpl_image * inp, const int r)
4809 {
4810 
4811  /*
4812  @param xp x-value to interpolate
4813  @param x x-values
4814  @param y y-values
4815  @param n array length
4816  @param istart (input/output) initial row (set to 0 to search all row)
4817 
4818  */
4819  float* pinp=NULL;
4820  float* pout=NULL;
4821  int sx=0;
4822  int sy=0;
4823  int i=0;
4824  int j=0;
4825  int k=0;
4826 
4827  cpl_image* out=NULL;
4828 
4829  cknull(inp,"Null in put image, exit");
4830  check_nomsg(out=cpl_image_duplicate(inp));
4831  check_nomsg(sx=cpl_image_get_size_x(inp));
4832  check_nomsg(sy=cpl_image_get_size_y(inp));
4833  check_nomsg(pinp=cpl_image_get_data_float(inp));
4834  check_nomsg(pout=cpl_image_get_data_float(out));
4835  for(j=0;j<sy;j++) {
4836  for(i=r;i<sx-r;i++) {
4837  for(k=-r;k<r;k++) {
4838  pout[j*sx+i]+=pinp[j*sx+i+k];
4839  }
4840  pout[j*sx+i]/=2*r;
4841  }
4842  }
4843 
4844  cleanup:
4845 
4846  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4847  return NULL;
4848  } else {
4849  return out;
4850 
4851  }
4852 
4853 }
4854 
4855 
4856 /*-------------------------------------------------------------------------*/
4870 /*--------------------------------------------------------------------------*/
4871 
4872 cpl_image *
4873 uves_image_smooth_median_x(cpl_image * inp, const int r)
4874 {
4875 
4876  /*
4877  @param xp x-value to interpolate
4878  @param x x-values
4879  @param y y-values
4880  @param n array length
4881  @param istart (input/output) initial row (set to 0 to search all row)
4882 
4883  */
4884  float* pout=NULL;
4885  int sx=0;
4886  int sy=0;
4887  int i=0;
4888  int j=0;
4889 
4890  cpl_image* out=NULL;
4891 
4892 
4893  cknull(inp,"Null in put image, exit");
4894  check_nomsg(out=cpl_image_duplicate(inp));
4895  check_nomsg(sx=cpl_image_get_size_x(inp));
4896  check_nomsg(sy=cpl_image_get_size_y(inp));
4897  check_nomsg(pout=cpl_image_get_data_float(out));
4898 
4899  for(j=1;j<sy;j++) {
4900  for(i=1+r;i<sx-r;i++) {
4901  pout[j*sx+i]=(float)cpl_image_get_median_window(inp,i,j,i+r,j);
4902  }
4903  }
4904 
4905  cleanup:
4906 
4907  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4908  return NULL;
4909  } else {
4910  return out;
4911 
4912  }
4913 
4914 }
4915 
4916 /*-------------------------------------------------------------------------*/
4929 /*--------------------------------------------------------------------------*/
4930 
4931 cpl_image *
4932 uves_image_smooth_fft(cpl_image * inp, const int fx)
4933 {
4934 
4935  int sx=0;
4936  int sy=0;
4937 
4938  cpl_image* out=NULL;
4939  cpl_image* im_re=NULL;
4940  cpl_image* im_im=NULL;
4941  cpl_image* ifft_re=NULL;
4942  cpl_image* ifft_im=NULL;
4943  cpl_image* filter=NULL;
4944 
4945  int sigma_x=fx;
4946  int sigma_y=0;
4947 
4948  cknull(inp,"Null in put image, exit");
4949  check_nomsg(im_re = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
4950  check_nomsg(im_im = cpl_image_cast(inp, CPL_TYPE_DOUBLE));
4951 
4952  // Compute FFT
4953  check_nomsg(cpl_image_fft(im_re,im_im,CPL_FFT_DEFAULT));
4954 
4955  check_nomsg(sx=cpl_image_get_size_x(inp));
4956  check_nomsg(sy=cpl_image_get_size_y(inp));
4957  sigma_x=sx;
4958 
4959  //Generates filter image
4960  check_nomsg(filter = uves_gen_lowpass(sx,sy,sigma_x,sigma_y));
4961 
4962  //Apply filter
4963  cpl_image_multiply(im_re,filter);
4964  cpl_image_multiply(im_im,filter);
4965 
4966  uves_free_image(&filter);
4967 
4968  check_nomsg(ifft_re = cpl_image_duplicate(im_re));
4969  check_nomsg(ifft_im = cpl_image_duplicate(im_im));
4970 
4971  uves_free_image(&im_re);
4972  uves_free_image(&im_im);
4973 
4974  //Computes FFT-INVERSE
4975  check_nomsg(cpl_image_fft(ifft_re,ifft_im,CPL_FFT_INVERSE));
4976  check_nomsg(out = cpl_image_cast(ifft_re, CPL_TYPE_FLOAT));
4977 
4978  cleanup:
4979 
4980  uves_free_image(&ifft_re);
4981  uves_free_image(&ifft_im);
4982  uves_free_image(&filter);
4983  uves_free_image(&im_re);
4984  uves_free_image(&im_im);
4985 
4986  if(cpl_error_get_code() != CPL_ERROR_NONE) {
4987  return NULL;
4988  } else {
4989  return out;
4990  }
4991 
4992 }
4993 
4994 /*-------------------------------------------------------------------------*/
5003 /*--------------------------------------------------------------------------*/
5004 cpl_vector *
5005 uves_imagelist_get_clean_mean_levels(cpl_imagelist* iml, double kappa)
5006 {
5007 
5008  cpl_image* img=NULL;
5009  int size=0;
5010  int i=0;
5011  cpl_vector* values=NULL;
5012  double* pval=NULL;
5013  double mean=0;
5014  double stdev=0;
5015 
5016  check_nomsg(size=cpl_imagelist_get_size(iml));
5017  check_nomsg(values=cpl_vector_new(size));
5018  pval=cpl_vector_get_data(values);
5019  for(i=0;i<size;i++) {
5020  img=cpl_imagelist_get(iml,i);
5021  irplib_ksigma_clip(img,1,1,
5022  cpl_image_get_size_x(img),
5023  cpl_image_get_size_y(img),
5024  5,kappa,1.e-5,&mean,&stdev);
5025  uves_msg("Ima %d mean level: %g",i+1,mean);
5026  pval[i]=mean;
5027  }
5028 
5029  cleanup:
5030 
5031  return values;
5032 }
5033 
5034 
5035 /*-------------------------------------------------------------------------*/
5044 /*--------------------------------------------------------------------------*/
5045 cpl_error_code
5046 uves_imagelist_subtract_values(cpl_imagelist** iml, cpl_vector* values)
5047 {
5048 
5049  cpl_image* img=NULL;
5050  int size=0;
5051  int i=0;
5052  double* pval=NULL;
5053 
5054  check_nomsg(size=cpl_imagelist_get_size(*iml));
5055  pval=cpl_vector_get_data(values);
5056  for(i=0;i<size;i++) {
5057  img=cpl_imagelist_get(*iml,i);
5058  cpl_image_subtract_scalar(img,pval[i]);
5059  cpl_imagelist_set(*iml,img,i);
5060  }
5061 
5062  cleanup:
5063 
5064  return cpl_error_get_code();
5065 }
5066 
5067 
5068 /*-------------------------------------------------------------------------*/
5084 /*--------------------------------------------------------------------------*/
5085 static cpl_image *
5086 uves_gen_lowpass(const int xs,
5087  const int ys,
5088  const double sigma_x,
5089  const double sigma_y)
5090 {
5091 
5092  int i= 0.0;
5093  int j= 0.0;
5094  int hlx= 0.0;
5095  int hly = 0.0;
5096  double x= 0.0;
5097  double y= 0.0;
5098  double gaussval= 0.0;
5099  double inv_sigma_x=1./sigma_x;
5100  double inv_sigma_y=1./sigma_y;
5101 
5102  float *data;
5103 
5104  cpl_image *lowpass_image=NULL;
5105 
5106 
5107  lowpass_image = cpl_image_new (xs, ys, CPL_TYPE_FLOAT);
5108  if (lowpass_image == NULL) {
5109  uves_msg_error("Cannot generate lowpass filter <%s>",
5110  cpl_error_get_message());
5111  return NULL;
5112  }
5113 
5114  hlx = xs/2;
5115  hly = ys/2;
5116 
5117  data = cpl_image_get_data_float(lowpass_image);
5118 
5119 /* Given an image with pixels 0<=i<N, 0<=j<M then the convolution image
5120  has the following properties:
5121 
5122  ima[0][0] = 1
5123  ima[i][0] = ima[N-i][0] = exp (-0.5 * (i/sig_i)^2) 1<=i<N/2
5124  ima[0][j] = ima[0][M-j] = exp (-0.5 * (j/sig_j)^2) 1<=j<M/2
5125  ima[i][j] = ima[N-i][j] = ima[i][M-j] = ima[N-i][M-j]
5126  = exp (-0.5 * ((i/sig_i)^2 + (j/sig_j)^2))
5127 */
5128 
5129  data[0] = 1.0;
5130 
5131  /* first row */
5132  for (i=1 ; i<=hlx ; i++) {
5133  x = i * inv_sigma_x;
5134  gaussval = exp(-0.5*x*x);
5135  data[i] = gaussval;
5136  data[xs-i] = gaussval;
5137  }
5138 
5139  for (j=1; j<=hly ; j++) {
5140  y = j * inv_sigma_y;
5141  /* first column */
5142  data[j*xs] = exp(-0.5*y*y);
5143  data[(ys-j)*xs] = exp(-0.5*y*y);
5144 
5145  for (i=1 ; i<=hlx ; i++) {
5146  /* Use internal symetries */
5147  x = i * inv_sigma_x;
5148  gaussval = exp (-0.5*(x*x+y*y));
5149  data[j*xs+i] = gaussval;
5150  data[(j+1)*xs-i] = gaussval;
5151  data[(ys-j)*xs+i] = gaussval;
5152  data[(ys+1-j)*xs-i] = gaussval;
5153 
5154  }
5155  }
5156 
5157  /* FIXME: for the moment, reset errno which is coming from exp()
5158  in first for-loop at i=348. This is causing cfitsio to
5159  fail when loading an extension image (bug in cfitsio too).
5160  */
5161  if(errno != 0)
5162  errno = 0;
5163 
5164  return lowpass_image;
5165 }
5166 /*-------------------------------------------------------------------------*/
5174 /*--------------------------------------------------------------------------*/
5175 cpl_image*
5176 uves_image_mflat_detect_blemishes(const cpl_image* flat,
5177  const uves_propertylist* head)
5178 {
5179 
5180  cpl_image* result=NULL;
5181  cpl_image* diff=NULL;
5182  cpl_image* flat_smooth=NULL;
5183  cpl_array* val=NULL;
5184  cpl_matrix* mx=NULL;
5185 
5186  int binx=0;
5187  int biny=0;
5188  int sx=0;
5189  int sy=0;
5190  int size=0;
5191  int i=0;
5192  int j=0;
5193  int k=0;
5194  int niter=3;
5195  int filter_width_x=7;
5196  int filter_width_y=7;
5197 
5198  double mean=0;
5199  double stdev=0;
5200  double stdev_x_4=0;
5201 
5202  double med_flat=0;
5203 
5204  double* pres=NULL;
5205  const double* pima=NULL;
5206  double* pval=NULL;
5207  double* pdif=NULL;
5208  int npixs=0;
5209 
5210  /* check input is valid */
5211  passure( flat !=NULL , "NULL input flat ");
5212  passure( head !=NULL , "NULL input head ");
5213 
5214  /* get image and bin sizes */
5215  sx=cpl_image_get_size_x(flat);
5216  sy=cpl_image_get_size_y(flat);
5217  npixs=sx*sy;
5218 
5219  binx=uves_pfits_get_binx(head);
5220  biny=uves_pfits_get_biny(head);
5221 
5222  /* set proper x/y filter width. Start values are 3 */
5223  if (binx>1) filter_width_x=5;
5224  if (biny>1) filter_width_y=5;
5225 
5226 
5227  /* create residuals image from smoothed flat */
5228  check_nomsg(mx=cpl_matrix_new(filter_width_x,filter_width_y));
5229 
5230  for(j=0; j< filter_width_y; j++){
5231  for(i=0; i< filter_width_x; i++){
5232  cpl_matrix_set( mx, i,j,1.0);
5233  }
5234  }
5235 
5236  check_nomsg(diff=cpl_image_duplicate(flat));
5237 
5238  check_nomsg(flat_smooth=uves_image_filter_median(flat,mx));
5239  /*
5240  check_nomsg(cpl_image_save(flat_smooth,"flat_smooth.fits",
5241  CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
5242  */
5243  check_nomsg(cpl_image_subtract(diff,flat_smooth));
5244  /*
5245  check_nomsg(cpl_image_save(diff,"diff.fits",
5246  CPL_BPP_IEEE_FLOAT,NULL,CPL_IO_DEFAULT));
5247  */
5248  /* compute median of flat */
5249  check_nomsg(med_flat=cpl_image_get_median(flat));
5250 
5251  /* prepare array of flat pixel values greater than the median */
5252  val=cpl_array_new(npixs,CPL_TYPE_DOUBLE);
5253  check_nomsg(cpl_array_fill_window_double(val,0,npixs,0));
5254  check_nomsg(pval=cpl_array_get_data_double(val));
5255  check_nomsg(pima=cpl_image_get_data_double_const(flat));
5256  check_nomsg(pdif=cpl_image_get_data_double(diff));
5257  k=0;
5258  for(i=0;i<npixs;i++) {
5259  if(pima[i]>med_flat) {
5260  pval[k]=pdif[i];
5261  k++;
5262  }
5263  }
5264 
5265  check_nomsg(cpl_array_set_size(val,k));
5266 
5267  /* computes 4 sigma clip mean of values */
5268  check_nomsg(mean=cpl_array_get_mean(val));
5269  check_nomsg(stdev=cpl_array_get_stdev(val));
5270  stdev_x_4=stdev*4.;
5271  check_nomsg(size=cpl_array_get_size(val));
5272 
5273  for(i=0;i<niter;i++) {
5274  for(k=0;k<size;k++) {
5275  if(fabs(pval[k]-mean)>stdev_x_4) {
5276  cpl_array_set_invalid(val,k);
5277  }
5278  }
5279  mean=cpl_array_get_mean(val);
5280  stdev=cpl_array_get_stdev(val);
5281  stdev_x_4=stdev*4.;
5282  }
5283 
5284  /* compute absolute value of difference image */
5285  result=cpl_image_new(sx,sy,CPL_TYPE_DOUBLE);
5286  pres=cpl_image_get_data_double(result);
5287  for(i=0;i<npixs;i++) {
5288  if(fabs(pdif[i])<stdev_x_4) {
5289  pres[i]=1.;
5290  }
5291  }
5292 
5293  /* save result to debug */
5294  /*
5295  check_nomsg(cpl_image_save(result,"blemish.fits",CPL_BPP_IEEE_FLOAT,NULL,
5296  CPL_IO_DEFAULT));
5297  */
5298 
5299  cleanup:
5300  uves_free_array(&val);
5301  uves_free_image(&diff);
5302  uves_free_image(&flat_smooth);
5303  uves_free_matrix(&mx);
5304  return result;
5305 }
5306 
5307 
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.
#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:3847
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:202
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:309
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:2491
#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:4105
int uves_gauss_linear(const double x[], const double a[], double *result)
Evaluate a gaussian with linear background.
Definition: uves_utils.c:4411
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:3898
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:3954
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:4346
double uves_average_reject(cpl_table *t, const char *column, const char *residual2, double kappa)
Get average with iterative rejection.
Definition: uves_utils.c:2513
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:5176
cpl_error_code uves_table_unify_units(cpl_table **table2, cpl_table **table1)
Unify column units of table2 to table1.
Definition: uves_utils.c:4044
cpl_error_code uves_tablenames_unify_units(const char *tname2, const char *tname1)
Unify column units in tables.
Definition: uves_utils.c:3980
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:5086
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:3645
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:3683
#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:4291
int uves_moffat(const double x[], const double a[], double *result)
Evaluate a Moffat.
Definition: uves_utils.c:4240
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:2869
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:4470
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:3305
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:5005
const char * uves_remove_string_prefix(const char *s, const char *prefix)
Remove named prefix from string.
Definition: uves_utils.c:3612
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:4534
cpl_error_code uves_table_remove_units(cpl_table **table)
Remove column units from a table.
Definition: uves_utils.c:4012
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:4259
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:3925
#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:2590
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:4174
#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:3721
#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:5046
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:3793
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.