UVES Pipeline Reference Manual  5.4.6
flames_corvel.c
1 /*
2  * This file is part of the ESO UVES Pipeline
3  * Copyright (C) 2004,2005 European Southern Observatory
4  *
5  * This program 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  flames_corvel:
22  Purpose:
23  to cross correlate in velocity space a wavelength calibrated spectra with a
24  reference mask to get eventual velocity shift of one with respect to the
25  other.
26 
27  This code implements the Geneva alghorithm as for HARPS. Information and
28  reference alghorithms where provided from Claudio Melo, ESO-Paranal.
29  ============================================================================
30 */
31 
32 /*
33  ----------------------------------------------------------------------------
34  INCLUDES
35  ----------------------------------------------------------------------------
36 */
37 
38 #ifdef HAVE_CONFIG_H
39 # include <config.h>
40 #endif
41 #include <flames_lfit.h>
42 #include <flames_midas_def.h> /* MIDAS environment interface functions */
43 #include <flames_corvel.h> /* FLAMES-UVES functions */
44 #include <flames_newmatrix.h> /* FLAMES-UVES functions for array manipolation */
45 #include <uves_utils.h> /* M_PI */
46 #include <uves_msg.h>
47 #include <stdio.h>
48 #include <math.h>
49 #include <stdlib.h>
50 #include <irplib_utils.h>
51 #include <string.h>
52 
53 /*
54  ----------------------------------------------------------------------------
55  LOCAL DEFINITIONS
56  ----------------------------------------------------------------------------
57 */
58 #define MAX_LEN 512
59 #define MAX_DIM 2
60 #define MAX_ORD 4
61 #define MAX_PIX 10000
62 #define MAX_DEG 4
63 #define FLAMES_SPEED_OF_LIGHT 299792.458 //is defined also in uves_utils.h
64 
65 /*
66 static void
67 fpoly(double x,double p[],int np);
68 */
69 
70 /*
71 static void
72 get_mask(char* tpl_name,double in_msk_wgt_min, double in_msk_hole_wid,
73  char* log_opt, double** msk_hole_width, double** msk_hole_center,
74  double** msk_hole_wgt);
75 */
76 
77 static void
78 do_cor_vel(double* wcal_sol,float** sp_flux,
79  double* rv_ccf,double* msk_hole_siz, double* msk_hole_cen,
80  double* msk_hole_wgt, double bar_v,double bar_v_max,
81  int fit_type,int in_ima_nrow,
82  int in_msk_nrow,int rv_ccf_size, double* ccf,double* ccf_max,
83  double* pix_passed_ord,int* tot_line,double* ll_range_ord,
84  int in_ima_id);
85 
86 static void
87 fit_ccf(double* rv_ccf,double* ccf_nor,int type,double* ccf_res,
88  double* ccf_fit);
89 
90 
91 
92 
93 
94 /* void fgauss(double x,double g[],int ng); */
95 /*
96 static double
97 fgauss(double x,double a[],double y,double dyda[],int na);
98 */
99 
100 static void
101 gaussian_fit(const double * xfit, const double * yfit,int size,
102  double * norm, double * xcen, double * sig_x,
103  double * fwhm_x);
104 static void
105 correl_bin(int sp_flux_sz, float** sp_flux,double* sp_ll,double* sp_dll,
106  int *in_msk_nrow,double* msk_blu,double* msk_red,
107  double* msk_w, int* i_blue_masques,int* i_red_masques,
108  double* intensity_s,double* pix,double* ll_range);
109 
110 static int
111 hunt(double* xx, int n, double x, int jlo);
112 
113 
114 static void
115 do_ccf_f(double* mask_ll,double* mask_d,double* mask_w,double* sp_ll,
116  float** sp_flux,double* sp_dll,double* rv_ccf,double* ccf_o,
117  double* pix_passed_ord,double* wcal_range_ord,int in_msk_nrow,
118  int in_ima_ncol, int rv_ccf_size, int in_ima_id);
119 
120 
121 
138 int flames_corvel(const char *IN_A,
139  const char *IN_B,
140  const int IN_N,
141  const char *OU_A,
142  const char *OU_B,
143  const char *OU_C,
144  const double rv_ccf_min,
145  const double rv_ccf_max,
146  const double rv_ccf_step)
147 {
148 
149 
150 
151  char in_ima[MAX_LEN]; /* char array for input ima */
152  char ou_ima[MAX_LEN]; /* char array for output ima */
153  char ou_tab[MAX_LEN]; /* char array for output ima */
154  char in_msk[MAX_LEN]; /* char array for input mask */
155 
156  /* MIDAS stuff */
157  int midas_unit = 0;
158  int midas_null = 0;
159  int midas_nval = 0;
160  int midas_status = 0;
161 
162  /* tmp variable used in MIDAS env calls */
163  int in_ima_id =0;
164  int ou_ima_id =0;
165  int in_msk_id =0;
166  int in_ima_naxis =0;
167  int ou_ima_naxis =1;
168  int ou_ima_npix[2] ={0,0};
169  double ou_ima_start[2] ={0.,0.};
170  double ou_ima_step[2] ={0.,0.};
171 
172  float cuts[4]={0.,0.,0.,0.};
173  int tid=0;
174  int ccf_pos_col=0;
175  int ccf_nrm_col=0;
176  int ccf_out_col=0;
177 
178  int in_ima_npix[MAX_DIM];
179  int in_msk_ncol=0;
180  int in_msk_nrow=0;
181  char ident[73];
182  char cunit[3][16];
183 
184 
185  /* Other useful variables */
186  int in_ima_nx = 0; /* No of columns */
187  int in_ima_ny = 0; /* No of rows */
188  int in_ima_ord=0; /* order number of input image */
189 
190  float ** m_in_ima=NULL; /* input image array */
191 
192  double* in_ima_wcal_sol=NULL;
193 
194  double* msk_hole_sta=NULL;
195  double* msk_hole_end=NULL;
196  double* msk_hole_cen=NULL;
197  double* msk_hole_siz=NULL;
198  double* msk_hole_wgt=NULL;
199 
200  double* msk_hole_cen_selw=NULL;
201  double* msk_hole_siz_selw=NULL;
202  double* msk_hole_wgt_selw=NULL;
203 
204 
205  double in_msk_wgt_min=0.9; /*1 */
206  double in_msk_hole_wid=0.; /*0 */
207  double tmp_double=0;
208  double in_ima_wstart =0.;
209  double in_ima_wstep =0.;
210 
211 
212  double* rv_ccf=NULL;
213  int rv_ccf_size=0;
214  //double rv_ccf_par[3] ={0.,0.,0.};
215 
216  int wstart_id=0;
217  int wend_id=0;
218  int weight_id=0;
219 
220  int i=0;
221  int counter=0;
222 
223  double tmp_dbl=0;
224 
225  double ccf_max=0;
226  double ccf_avg=0;
227 
228  double* ccf_nrm=NULL;
229  double pix_passed_ord=0;
230 
231  int tot_line=0;
232  double ll_range_ord=0;
233  double* ccf_res=NULL;
234  double* ccf_fit=NULL;
235  double* ccf_o=NULL;
236  char wstart_key[80];
237 
238  /* Program's Id */
239  SCSPRO("flames_corvel");
240 
241 
242  memset(ident, '\0', 73);
243  memset(cunit[0], '\0', 48);
244  strncpy(cunit[1], "PIXEL ", 16);
245  strncpy(cunit[2], "PIXEL ", 16);
246  /* ================================================================ */
247  /* GET INPUT DATA */
248  /* ================================================================ */
249  /* get input ima name */
250 
251  in_ima_ord=IN_N;
252  if((midas_status = SCKGETC(IN_A,1,MAX_LEN,&midas_nval,in_ima)) !=0) {
253  uves_msg_warning("Error reading char keyword %s",IN_A);
254  return flames_midas_error(MAREMMA);
255  }
256 
257  //sprintf(in_ima,IN_A);
258  /* get input ima order number */
259  //midas_status = SCKRDI(IN_N,1,1,&midas_nval,&in_ima_ord,
260  // &midas_unit, &midas_null);
261 
262  /* ================================================================ */
263  /* Read 2D extracted input spectra */
264  /* ================================================================ */
265  /* get input ima frame */
266 
267 
268  if( (midas_status = SCFOPN(in_ima,D_R4_FORMAT,0,F_IMA_TYPE,&in_ima_id))!=0) {
269  uves_msg_warning("Error opening input image %s",IN_A);
270  return flames_midas_error(MAREMMA);
271  }
272 
273  /* get input ima dimension */
274  if((midas_status = SCDRDI(in_ima_id,"NAXIS",1,1,&midas_nval,
275  &in_ima_naxis,&midas_unit,&midas_null)) !=0)
276  {
277  uves_msg_warning("Error reading NAXIS from image %s",IN_A);
278  return flames_midas_error(MAREMMA);
279  }
280  /* get input ima no of columns and rows */
281 
282  if((midas_status = SCDRDI(in_ima_id,"NPIX",1,in_ima_naxis,&midas_nval,
283  in_ima_npix,&midas_unit,&midas_null))!=0) {
284  uves_msg_warning("Error reading NPIX from image %s",IN_A);
285  return flames_midas_error(MAREMMA);
286  }
287 
288 
289 
290  if (in_ima_naxis > 1) {
291  in_ima_nx = in_ima_npix[0];
292  in_ima_ny = in_ima_npix[1];
293  }
294  else {
295  in_ima_nx = in_ima_npix[0];
296  in_ima_ny = 1; /* input image is one extracted order */
297  }
298 
299  /* Prepare memory area to hold input image */
300  m_in_ima = matrix(0, in_ima_ny-1, 0, in_ima_nx-1);
301 
302  memset(&m_in_ima[0][0], '\0', in_ima_nx*in_ima_ny*sizeof(float));
303 
304  /* get input ima in prepared area */
305  if((midas_status = SCFGET(in_ima_id,1,in_ima_nx*in_ima_ny,&midas_nval,
306  (char *)&m_in_ima[0][0])) != 0) {
307  uves_msg_warning("Error mapping image %s",IN_A);
308  return flames_midas_error(MAREMMA);
309 
310  }
311 
312  /* ================================================================ */
313  /* PREPARE WCAL SOLUTION */
314  /* ================================================================ */
315  /* get WSTART and WSTEP values to calculate array of wcal pix values
316  in_ima_wcal_sol stores the wavelength calibration solution */
317 
318 
319  sprintf(wstart_key,"%s%d","WSTART",in_ima_ord);
320  if((midas_status = SCDRDD(in_ima_id,wstart_key,1,1,
321  &midas_nval,&tmp_double,
322  &midas_unit,&midas_null)) != 0) {
323  uves_msg_warning("Error reading %s from input image %s",wstart_key,IN_A);
324  return flames_midas_error(MAREMMA);
325  }
326 
327 
328 
329  in_ima_wstart=(float)tmp_double;
330 
331 
332  if((midas_status = SCDRDD(in_ima_id,"CDELT1",1,1,&midas_nval,&tmp_double,
333  &midas_unit,&midas_null))!=0) {
334  uves_msg_warning("Error reading CDELT1 from input image %s",IN_A);
335  return flames_midas_error(MAREMMA);
336  }
337 
338 
339  in_ima_wstep=(float)tmp_double;
340  in_ima_wcal_sol=dvector(0,in_ima_nx);
341 
342 
343  for (i=0; i< in_ima_nx; i++){
344  in_ima_wcal_sol[i]=(double)(in_ima_wstart+in_ima_wstep*i);
345  }
346  /* get input mask table name */
347  if((midas_status = SCKGETC(IN_B,1,MAX_LEN,&midas_nval,in_msk))!=0) {
348  uves_msg_warning("Error reading input table %s",IN_B);
349  return flames_midas_error(MAREMMA);
350  }
351 
352  /* ================================================================ */
353  /* GET INPUT MASK */
354  /* ================================================================ */
355  /* ================================================================ */
356  /*
357  The input mask is as follows.
358  First column tells you where the hole begins,
359  The second one where the hole ends and the third is the weight of each hole
360  (this last value is important for the stellar case where one may want to
361  give more importance to stellar lines of a given type)
362  We get from the input mask the following parameters:
363  1) the minimum weight of the holes of the mask used in the CCF
364  2) the width of the holes
365  3) the weight of the holes
366 
367  After this operation the parameters which counts are:
368  msk_hole_siz_selw[i]
369  msk_hole_cen_selw[i]
370  msk_hole_wgt_selw[i]
371 
372  in_msk_wgt_min=1;
373  in_msk_hole_wid=1.;
374  strcpy(log_opt," ");
375 
376  get_mask(in_msk,in_msk_wgt_min,in_msk_hole_wid,log_opt,
377  &msk_hole_width,&msk_hole_center,&msk_hole_wgt);
378  */
379  /* ================================================================ */
380  /* get input mask table frame */
381 
382 
383  if((midas_status = TCTOPN(in_msk,F_I_MODE,&in_msk_id))!=0) {
384  uves_msg_warning("Error reading input mask %s",in_msk);
385  return flames_midas_error(MAREMMA);
386  }
387 
388 
389  TCIGET (in_msk_id, &in_msk_ncol, &in_msk_nrow);
390  /* get input mask table column id */
391  if((midas_status = TCCSER(in_msk_id,"WSTART",&wstart_id))!=0) {
392  uves_msg_warning("Error reading WSTART from input mask %s",in_msk);
393  return flames_midas_error(MAREMMA);
394  }
395 
396  /* get input mask table column id */
397  if((midas_status = TCCSER(in_msk_id,"WEND",&wend_id))!=0) {
398  uves_msg_warning("Error reading WEND from input mask %s",in_msk);
399  return flames_midas_error(MAREMMA);
400  }
401 
402  /* get input mask table column id */
403  if((midas_status = TCCSER(in_msk_id,"WEIGHT",&weight_id))!=0) {
404  uves_msg_warning("Error reading WEIGHT from input mask %s",in_msk);
405  return flames_midas_error(MAREMMA);
406  }
407 
408  /* Defines and initializes all necessary vectors */
409  msk_hole_sta=dvector(0,in_msk_nrow);
410  msk_hole_end=dvector(0,in_msk_nrow);
411  msk_hole_siz=dvector(0,in_msk_nrow);
412  msk_hole_wgt=dvector(0,in_msk_nrow);
413  msk_hole_cen=dvector(0,in_msk_nrow);
414 
415  /* selected values...*/
416  msk_hole_siz_selw=dvector(0,in_msk_nrow);
417  msk_hole_wgt_selw=dvector(0,in_msk_nrow);
418  msk_hole_cen_selw=dvector(0,in_msk_nrow);
419 
420 
421  for(i=1;i<in_msk_nrow;i++) {
422  TCERDD(in_msk_id,i,wstart_id,&tmp_dbl,&midas_null);
423  msk_hole_sta[i-1]=tmp_dbl;
424  TCERDD(in_msk_id,i,wend_id,&tmp_dbl,&midas_null);
425  msk_hole_end[i-1]=tmp_dbl;
426  TCERDD(in_msk_id,i,weight_id,&tmp_dbl,&midas_null);
427  msk_hole_wgt[i-1]=tmp_dbl;
428  msk_hole_siz[i-1]=msk_hole_end[i-1]-msk_hole_sta[i-1];
429  msk_hole_cen[i-1]=msk_hole_sta[i-1]+msk_hole_siz[i-1]*0.5;
430  /*
431  uves_msg_debug("sta=%f end=%f wgt=%f siz=%f cen=%f",
432  msk_hole_sta[i-1],
433  msk_hole_end[i-1],
434  msk_hole_wgt[i-1],
435  msk_hole_siz[i-1],
436  msk_hole_cen[i-1]);
437  */
438  }
439  TCTCLO(in_msk_id);
440  /*ADAPTED*****/
441  /*
442  If a fixed width is given as input parameter in_msk_hole_wid then
443  is calculated msk_hole_siz
444  in_msk_hole_wid is the fixed width given in km/s
445  In our case in_msk_hole_wid=0 and the following if is not entered
446  */
447 
448  if (in_msk_hole_wid > 0) {
449 
450  for(i=1;i<in_msk_nrow;i++) {
451  msk_hole_siz[i-1]=
452  in_msk_hole_wid*msk_hole_siz[i-1]/FLAMES_SPEED_OF_LIGHT;
453  }
454 
455  }
456 
457 
458  /* selects mask on in_msk_wgt_min of force weight=1
459  in our case in_msk_wgt_min =1 and the following if is not entered
460  is executed instead the else part
461  */
462  if (in_msk_wgt_min < 1) {
463  /* If a lower limit of the weight of the holes is specified as input
464  parameter in_msk_wgt_min, then selects values of
465  wsize,wcenter,weight
466  If no condition is given keep the vectors intact
467  */
468  counter=0;
469  for(i=1;i<in_msk_nrow;i++) {
470  if (msk_hole_wgt[counter] > in_msk_wgt_min) {
471  msk_hole_siz_selw[counter] = msk_hole_siz[i];
472  msk_hole_cen_selw[counter] = msk_hole_cen[i];
473  msk_hole_wgt_selw[counter] = msk_hole_wgt[i];
474  counter++;
475  }
476  }
477  }
478  else {
479  for(i=1;i<in_msk_nrow;i++) {
480  if (msk_hole_wgt[i] > in_msk_wgt_min) {
481  msk_hole_siz_selw[i] = msk_hole_siz[i];
482  msk_hole_cen_selw[i] = msk_hole_cen[i];
483  msk_hole_wgt_selw[i] = msk_hole_wgt[i];
484  }
485  }
486  }
487 
488 
489  /* ================================================================ */
490  /* END GET INPUT MASK */
491  /* ================================================================ */
492  /* ================================================================ */
493  /* COMPUTE CCF */
494  /* ================================================================ */
495  /* we allocate memory and define the vector to be used to evaluate CCF */
496  /* this vector defines the points at which the CCF is computed */
497  //midas_status = SCKRDD(IN_C,1,3,&midas_nval,rv_ccf_par,
498  // &midas_unit, &midas_null);
499 
500  rv_ccf_size=(int)((rv_ccf_max-rv_ccf_min)/rv_ccf_step+1);
501  rv_ccf=dvector(0,rv_ccf_size);
502  ccf_o=dvector(0,rv_ccf_size);
503 
504 
505  rv_ccf[0]=rv_ccf_min;
506  for(i=1;i<rv_ccf_size;i++){
507  rv_ccf[i]=rv_ccf[i-1]+rv_ccf_step;
508  }
509  /*
510  =======================================================================
511  Do correlation. Values calculated by this subriutine are:
512  ccf: ccf matrix containing the ccf for each order (ccf_i)
513 
514  ccf_max: vector containing the highest value of each ccf_i,
515 
516  pix_passed_all: number of pixels of the input spectrum used for the
517  computation of each ccf_i,
518  pix_passed_ord is the currespondent order value
519 
520  tot_line: number of holes used in the computation of each ccf_i,
521 
522  ll_range_all: wavelength interval of each order the input spectrum
523  used in the computation of each ccf_i
524  ll_range_ord is the correspondent order value
525  =======================================================================
526  */
527 
528 
529  do_cor_vel(in_ima_wcal_sol, /* wave calibration solution */
530  m_in_ima, /* extracted spectrum */
531  rv_ccf, /* points at which the CCF is computed */
532  msk_hole_siz_selw, /* hole size selected on weight criteria */
533  msk_hole_cen_selw, /* hole center selected on weight criteria */
534  msk_hole_wgt_selw, /* hole weight selected on weight criteria */
535  0, /* barv :Baricentric Velocity Corr */
536  0, /* barv_max :Its maximum */
537  0, /* fit_type (Gaussian): 0/1 emis/absorb */
538  in_ima_nx, /* X sise of input spectra */
539  in_msk_nrow, /* size of input mask */
540  rv_ccf_size, /* size of CCF */
541  ccf_o, /* out: ccf for each order (ccf_i) */
542  &ccf_max, /* out: max(ccf) for each order (ccf_i) */
543  &pix_passed_ord, /* out: each order in sp's no of pix to
544  get ccf_i */
545  &tot_line, /* out: no of holes used to get ccf_i */
546  &ll_range_ord, /* out: each order's wav interval to get ccf_i */
547  in_ima_id); /* input ima id (to write descriptors) */
548 
549 
550  /* Sum the individual ccf_i for each bin and normalize the final ccf */
551 
552  SCFCLO(in_ima_id); //not needed anymore
553  ccf_nrm=dvector(0,rv_ccf_size);
554  for(i=0;i<rv_ccf_size;i++){
555  ccf_avg +=ccf_o[i];
556  if(!irplib_isinf(ccf_o[i])) {
557  if(ccf_o[i] > ccf_max) {
558  ccf_max=ccf_o[i];
559  }
560  }
561  }
562 
563 
564  /* Creating a new table for offline plotting of peaks */
565  SCKGETC(OU_A,1,MAX_LEN,&midas_nval,ou_tab);
566  /* jmlarsen: use F_O_MODE for new table
567  old code: TCTINI(ou_tab,F_IO_MODE,rv_ccf_size,&tid);*/
568  TCTINI(ou_tab,F_O_MODE,rv_ccf_size,&tid);
569 
570  /* Creating a new column */
571  TCCINI(tid, D_R8_FORMAT, 1, "F8.4", " ", "ccf_pos", &ccf_pos_col);
572  TCCINI(tid, D_R8_FORMAT, 1, "F8.4", " ", "ccf_nrm", &ccf_nrm_col);
573  TCCINI(tid, D_R8_FORMAT, 1, "F8.4", " ", "ccf_out", &ccf_out_col);
574 
575  /* Writing table values */
576  /*
577  if (abs(ccf_max) >= FEPSILON) {
578  for(i=0;i<rv_ccf_size;i++){
579  ccf_nrm[i]=ccf_o[i]/ccf_max;
580  TCEWRD(tid, i+1, ccf_pos_col, &rv_ccf[i]);
581  TCEWRD(tid, i+1, ccf_nrm_col, &ccf_nrm[i]);
582  TCEWRD(tid, i+1, ccf_out_col, &ccf_o[i]);
583  }
584  } else {
585  for(i=0;i<rv_ccf_size;i++){
586  ccf_nrm[i]=0.;
587  TCEWRD(tid, i+1, ccf_pos_col, &rv_ccf[i]);
588  TCEWRD(tid, i+1, ccf_nrm_col, &ccf_nrm[i]);
589  TCEWRD(tid, i+1, ccf_out_col, &ccf_o[i]);
590  }
591  }
592  */
593 
594  for(i=0;i<rv_ccf_size;i++){
595  ccf_nrm[i]=ccf_o[i]/ccf_max;
596  TCEWRD(tid, i+1, ccf_pos_col, &rv_ccf[i]);
597  TCEWRD(tid, i+1, ccf_nrm_col, &ccf_nrm[i]);
598  TCEWRD(tid, i+1, ccf_out_col, &ccf_o[i]);
599  }
600 
601  SCDWRD(tid,"CCF_MAX",&ccf_max,1,1,&midas_unit);
602  SCDWRD(tid,"WAV_RNG",&ll_range_ord,1,1,&midas_unit);
603  SCDWRD(tid,"PIX_TOT",&pix_passed_ord,1,1,&midas_unit);
604  SCDWRI(tid,"LIN_TOT",&tot_line,1,1,&midas_unit);
605 
606  TCTCLO(tid);
607 
608 
609  /* TO BE IMPLEMENTED */
610  /* Gaussian Fit of the normalized CCF */
611  /*
612  one fit normalized_ccf as a function of rv_ccf using as fit type an
613  emission Gaussian. Output of the fit are the Gaussian fit coefficients
614  ccf_res and ccf_fit is the fitted Gaussian computed on the rv_ccf
615  velocity bins
616  */
617 
618  /* ccf_res[0]=ccf_res[0]/(1.-ccf_res[3]); */
619  fit_ccf(rv_ccf,ccf_nrm,1,ccf_res,ccf_fit);
620 
621 
622 
623  /* dump results in ouput image*/
624 
625  ou_ima_npix[0]=rv_ccf_size;
626  ou_ima_npix[1]=1;
627  ou_ima_start[0]=rv_ccf[0];
628  ou_ima_start[1]=ccf_nrm[0];
629  ou_ima_step[0]=ccf_max;
630  ou_ima_step[1]=1;
631  cuts[0] = 0;
632  cuts[1] = 0;
633  cuts[2] = 0;
634  cuts[3] = 1;
635 
636 
637  SCKGETC(OU_B,1,MAX_LEN,&midas_nval,ou_ima);
638 
639  SCFCRE(ou_ima,D_R8_FORMAT,F_O_MODE,F_IMA_TYPE,rv_ccf_size,&ou_ima_id);
640  SCDWRC(ou_ima_id,"IDENT", 1, ident, 1, 72, &midas_unit);
641  SCDWRI(ou_ima_id,"NAXIS",&ou_ima_naxis,1,1,&midas_unit);
642  SCDWRI(ou_ima_id,"NPIX",ou_ima_npix,1,2,&midas_unit);
643  SCDWRD(ou_ima_id,"START",ou_ima_start, 1, 2, &midas_unit);
644  SCDWRD(ou_ima_id,"STEP", ou_ima_step, 1, 2, &midas_unit);
645  SCDWRC(ou_ima_id,"CUNIT", 1, cunit[0], 1, 48, &midas_unit);
646  SCDWRR(ou_ima_id,"LHCUTS", cuts, 1, 4, &midas_unit);
647  SCFPUT(ou_ima_id,1,rv_ccf_size,(char *)ccf_o);
648  SCDWRD(ou_ima_id,"CCF_MAX",&ccf_max,1,1,&midas_unit);
649  SCDWRD(ou_ima_id,"WAV_RNG",&ll_range_ord,1,1,&midas_unit);
650  SCDWRD(ou_ima_id,"PIX_TOT",&pix_passed_ord,1,1,&midas_unit);
651  SCDWRI(ou_ima_id,"LIN_TOT",&tot_line,1,1,&midas_unit);
652  SCFCLO(ou_ima_id);
653 
654  cuts[3] = ccf_max;
655  SCKGETC(OU_C,1,MAX_LEN,&midas_nval,ou_ima);
656  SCFCRE(ou_ima,D_R8_FORMAT,F_O_MODE,F_IMA_TYPE,rv_ccf_size,&ou_ima_id);
657 
658  SCDWRC(ou_ima_id,"IDENT", 1, ident, 1, 72, &midas_unit);
659  SCDWRI(ou_ima_id,"NAXIS",&ou_ima_naxis,1,1,&midas_unit);
660  SCDWRI(ou_ima_id,"NPIX",ou_ima_npix,1,2,&midas_unit);
661  SCDWRD(ou_ima_id,"START",ou_ima_start, 1, 2, &midas_unit);
662  SCDWRD(ou_ima_id,"STEP", ou_ima_step, 1, 2, &midas_unit);
663  SCDWRC(ou_ima_id,"CUNIT", 1, cunit[0], 1, 48, &midas_unit);
664  SCDWRR(ou_ima_id,"LHCUTS", cuts, 1, 4, &midas_unit);
665  SCFPUT(ou_ima_id,1,rv_ccf_size,(char *)ccf_nrm);
666  SCDWRD(ou_ima_id,"CCF_MAX",&ccf_max,1,1,&midas_unit);
667  SCDWRD(ou_ima_id,"WAV_RNG",&ll_range_ord,1,1,&midas_unit);
668  SCDWRD(ou_ima_id,"PIX_TOT",&pix_passed_ord,1,1,&midas_unit);
669  SCDWRI(ou_ima_id,"LIN_TOT",&tot_line,1,1,&midas_unit);
670  SCFCLO(ou_ima_id);
671  /* free allocated memory */
672  /* free_matrix(m_in_ima,0,in_ima_ny-1,0,in_ima_nx-1); */
673  free_dvector(msk_hole_sta,0,in_msk_nrow);
674  free_dvector(msk_hole_end,0,in_msk_nrow);
675  free_dvector(msk_hole_siz,0,in_msk_nrow);
676  free_dvector(msk_hole_wgt,0,in_msk_nrow);
677  free_dvector(msk_hole_cen,0,in_msk_nrow);
678  free_dvector(msk_hole_siz_selw,0,in_msk_nrow);
679  free_dvector(msk_hole_wgt_selw,0,in_msk_nrow);
680  free_dvector(msk_hole_cen_selw,0,in_msk_nrow);
681  free_dvector(rv_ccf,0,rv_ccf_size);
682  free_dvector(ccf_nrm,0,rv_ccf_size);
683  free_dvector(in_ima_wcal_sol,0,in_ima_nx);
684  free_dvector(ccf_o,0,rv_ccf_size);
685 
686 
687  SCSEPI();
688  return 0;
689 
690 }
691 
692 void
693 do_cor_vel(double* wcal_sol,float** sp_flux,double* rv_ccf,
694  double* msk_hole_siz,double* msk_hole_cen,
695  double* msk_hole_wgt,double bar_v,double bar_v_max,
696  int fit_type,int in_ima_ncol,int in_msk_nrow,
697  int rv_ccf_size,
698  double* ccf_o, /* matrix with ccf_i */
699  double* ccf_max, /* vector with max(ccf_i) */
700  double* pix_passed_ord, /* no of in spct pixels used to get ccf_i */
701  int* tot_line, /* no of holes used to get ccf_i */
702  double* wcal_range_ord, /* wave range of each order in spct used to get ccf_i */
703  int in_ima_id)
704 {
705 
706  /* Local variables */
707  double* dw_map=NULL;
708  double* ccf_all=NULL;
709  double* ccf_all_fit=NULL;
710  double* msk_hole_cen_selr=NULL;
711  double* msk_hole_siz_selr=NULL;
712  double* msk_hole_wgt_selr=NULL;
713 
714  double* ccf_o_results=NULL;
715  /* double* ccf_o_fit=NULL; */
716  /* ccf_o_fit is commented out as not really used */
717  double* rv_ccf_cor=NULL;
718 
719  double wcal_min=0;
720  double wcal_max=0;
721  double d_secular_red=0;
722  double d_secular_blu=0;
723 
724  int i=0;
725  int sel_no=0;
726 
727  /* Local Functions */
728 
729 /*
730  ==========================================================================
731  Subroutine body
732  ==========================================================================
733 */
734 
735 /* The following 2 lines has de facto no effect as bar_v and bar__max are 0 */
736  d_secular_red=bar_v_max-bar_v;
737  d_secular_blu=bar_v_max-bar_v;
738 
739 
740  dw_map=dvector(0,in_ima_ncol);
741  ccf_all=dvector(0,rv_ccf_size);
742  ccf_all_fit=dvector(0,rv_ccf_size);
743  rv_ccf_cor=dvector(0,rv_ccf_size);
744  /* ccf_o_fit=dvector(0,in_ima_ncol); */
745  /* ccf_o_fit is commented out as not really used*/
746  ccf_o_results=dvector(0,4);
747 
748 
749  msk_hole_cen_selr=dvector(0,in_msk_nrow);
750  msk_hole_siz_selr=dvector(0,in_msk_nrow);
751  msk_hole_wgt_selr=dvector(0,in_msk_nrow);
752  /* defines delta_lambda vector as delta_lambda=lambda(i+1)-lambda(i) */
753  for(i=0;i<in_ima_ncol-1;i++){
754  dw_map[i]=wcal_sol[i+1]-wcal_sol[i];
755  }
756  /* Not relevant for the ThAr correlation.
757  This computes the minimum and the maximum wavelengths given the velocity
758  point extremes in which the CCF is going to be computed
759  (rv_ccf[0] is the first velocity bin and rv_ccf[-1] is the last) and the
760  max BAR_V velocity (baricentric velocity) possible
761  */
762 
763 
764  /* Here should start a loop over orders: we do not do it as we assume
765  to have in input the spectra relative to each order */
766 
767  /* The following two lines are not relevant in case of ThAr spectra */
768  /* They are to compute the min and max wavelength being given the velocity
769  point extremes in which the CCF is going to be computed and the max
770  baricentric velocity possible */
771 
772  wcal_min=wcal_sol[0]-(rv_ccf[0]-bar_v-d_secular_blu)*
773  wcal_sol[0]/FLAMES_SPEED_OF_LIGHT;
774 
775  wcal_max=wcal_sol[in_ima_ncol-1]-(rv_ccf[rv_ccf_size-1]-bar_v+d_secular_red)*
776  wcal_sol[in_ima_ncol-1]/FLAMES_SPEED_OF_LIGHT;
777 
778 
779 /*
780 >From the python version:
781 
782 ll_max=ll_map[order,-1]-(RV_CCF[-1]-berv+D_secular_red)*ll_map[order,-1]/speed_of_light
783 */
784  /* Filter wcenter,wsize,weight to include holes whose center is within the
785  limits wcal_min and wcal_max
786  */
787 
788  for(i=0;i<in_msk_nrow;i++){
789  if((msk_hole_cen[i]>wcal_min) && (msk_hole_cen[i]<wcal_max)) {
790  msk_hole_cen_selr[sel_no]=msk_hole_cen[i];
791  msk_hole_siz_selr[sel_no]=msk_hole_siz[i];
792  msk_hole_wgt_selr[sel_no]=msk_hole_wgt[i];
793  sel_no++;
794  }
795  }
796  *tot_line=sel_no;
797 
798  if(sel_no) {
799  /* If at least one is left after filtering the mask */
800  *wcal_range_ord=0.;
801  /* we get the velocity bins were the CCF is going to be computed
802  corrected for bar_v */
803  for(i=0;i<rv_ccf_size;i++){
804  rv_ccf_cor[i]=rv_ccf[i]-bar_v;
805  }
806 
807  /* computes the ccf on the order order.
808 
809  The input arguments are:
810  msk_hole_cen_selr, centers of each hole selected on wave range criteria
811  msk_hole_siz_selr, widths of each hole selected on wave range criteria
812  msk_hole_wgt_selr, weights of each hole selected on wave range criteria
813  wcal_sol, the vector containing the correspondence pixel to
814  lambda for the order order
815  sp_flux[order] is the vector containing the intensity of each pixel
816  for the order order
817  dw_map is the delta lambda between consecutive pixels
818  rv_ccf-bar_v is the velocity bin where the CCF is going to be
819  computed corrected for the BAR_V.
820 
821  OUTPUT arguments are:
822  ccf_o, the ccf of the order order,
823  pix_passed tells you how many pixels have participated in the ccf,
824  wcal_range is the length (in Angstroms) of the region covered by the
825  holes which participated in the CCF
826  (i.e., the sum of the vector wcal_msk_size_selr);
827 
828  */
829 
830  do_ccf_f(msk_hole_cen_selr, msk_hole_siz_selr, msk_hole_wgt_selr,
831  wcal_sol, sp_flux, dw_map, rv_ccf_cor, ccf_o, pix_passed_ord,
832  wcal_range_ord, sel_no, in_ima_ncol, rv_ccf_size, in_ima_id);
833 
834  }
835  else {
836  /* there is no mas holes in the wavelength interval wcal_min, wcal_max
837  then everything is set to zero */
838  printf("No hole between wcal_min=%f and wcal_max=%f all set to 0. \n",
839  wcal_min,wcal_max);
840  for(i=0;i<rv_ccf_size;i++){
841  /* rv_ccf[i]=0.; */
842  ccf_o[i]=rv_ccf[i]*0.;
843  /* ccf_o_fit[i]=ccf_o[i]; */
844  /* ccf_o_fit is commented out as not really used */
845  }
846  *pix_passed_ord=0.;
847  *wcal_range_ord=0.;
848 
849  ccf_o_results[0]=0.;
850  ccf_o_results[1]=0.;
851  ccf_o_results[2]=0.;
852  ccf_o_results[3]=0.;
853 
854  }
855 
856 
857  /* write results on output table */
858 
859  /* Free memory */
860  free_dvector(rv_ccf_cor,0,rv_ccf_size);
861  free_dvector(dw_map,0,in_ima_ncol);
862  /* free_dvector(ccf_o_fit,0,in_ima_ncol); */
863  /* ccf_o_fit is commented out as not really used */
864  free_dvector(ccf_o_results,0,4);
865 
866 
867  free_dvector(ccf_all,0,rv_ccf_size);
868  free_dvector(ccf_all_fit,0,rv_ccf_size);
869 
870  free_dvector(msk_hole_cen_selr,0,in_msk_nrow);
871  free_dvector(msk_hole_siz_selr,0,in_msk_nrow);
872  free_dvector(msk_hole_wgt_selr,0,in_msk_nrow);
873 
874  return;
875 
876 } /* end function do_corvel */
877 
878 
879 void
880 do_ccf_f(double* mask_ll,double* mask_d,double* mask_w,double* sp_ll,
881  float** sp_flux,double* sp_dll,double* rv_ccf,double* ccf_o,
882  double* pix_tot,double* ll_range_tot,int in_msk_nrow,
883  int in_ima_ncol, int rv_ccf_size, int in_ima_id)
884 {
885 
886  /* This routine should evaluate and return:
887  ccf_o[rv_ccf_size]-the resulting CCF for a given order (not normalized)
888  pix_passed-a double scalar
889  ll_range-a double scalar
890  */
891  /* iter for v */
892 
893  /* at rest the mask holes are centered on the vector mask_ll.
894  at a velocity rv, they will be centered on
895  mask_ll+rv*mask_ll/FLAMES_SPEED_OF_LIGHT
896  The blue edge of the holes (Mask_blue) is then this new center minus
897  half of the size of the hole. The same is valid for the red edge of
898  the hole.
899 
900  */
901 
902  /* local variable definition-initializzation */
903 
904  double** covar;
905  double** alpha;
906 
907  double* msk_blu=NULL;
908  double* msk_red=NULL;
909  double* sp_ll_prime=NULL;
910  double* sfit=NULL;
911  double* xfit=NULL;
912  double* yfit=NULL;
913  double* aa=NULL;
914  double* erraa=NULL;
915 
916 
917  int* i_blu_masques=NULL;
918  int* i_red_masques=NULL;
919  int* ia=NULL;
920 
921  double intensity_s=0;
922  double pix=0;
923  double ll_range=0;
924  double norm=0;
925  double cen=0;
926  double sig=0;
927  double fwhm=0;
928  double rv=0;
929 
930  int i=0;
931  int j=0;
932  int first_hole;
933  int midas_unit = 0;
934  int sp_ll_sz = in_ima_ncol;
935  int guess=0;
936  int ndeg=6;
937 
938  /* Function prototype */
939 
940 
941  xfit=dvector(1,rv_ccf_size);
942  yfit=dvector(1,rv_ccf_size);
943  sfit=dvector(1,rv_ccf_size);
944 
945  covar = dmatrix(1,ndeg,1,ndeg);
946  alpha = dmatrix(1,ndeg,1,ndeg);
947 
948  aa=dvector(1,ndeg);
949  erraa=dvector(1,ndeg);
950  ia=ivector(1,ndeg);
951  sp_ll_prime=dvector(0,in_ima_ncol);
952  msk_blu = dvector(0,in_msk_nrow);
953  msk_red = dvector(0,in_msk_nrow);
954  i_blu_masques = ivector(0,in_msk_nrow);
955  i_red_masques = ivector(0,in_msk_nrow);
956 
957  for(i=0;i<rv_ccf_size;i++) {
958  rv=rv_ccf[i];
959  sfit[i]=1.0;
960  }
961 
962  for(i=0;i<rv_ccf_size;i++) {
963  rv=rv_ccf[i];
964  /*
965  we define the 1st derivative: sp_ll_prime[j]=sp_ll[j]+sp_dll[j]*0.5;
966  j is a counter variable of values up to sp_ll_sz equal to the No of
967  extracted spectra definition points
968  */
969  for(j=0; j<sp_ll_sz; j++) {
970  sp_ll_prime[j]=sp_ll[j]+sp_dll[j]*0.5;
971  }
972  for(j=0;j<in_msk_nrow;j++) {
973  /* shift the mask holes for a velocity RV[i] */
974  msk_blu[j]=mask_ll[j]+rv*mask_ll[j]/FLAMES_SPEED_OF_LIGHT-0.5*mask_d[j];
975  msk_red[j]=mask_ll[j]+rv*mask_ll[j]/FLAMES_SPEED_OF_LIGHT+0.5*mask_d[j];
976 
977  /*
978  The idea is to know where (i.e. in which pixel) a given hole will start
979  because we won't want to scan through the vector wave to find the pixel
980  i where lambda(i-1) < mask_start <lambda(i). The command search_sorted
981  does it (see below).
982  It returns the position where the element mask_blue will fit in the
983  vector lamda+delta_lambda/2.
984  This is done for the blue edge of the mask and for the red edge.
985  The +1 in the end is because phython vectors starts at 0 and F77 at 1.
986  */
987 
988  }
989  /*
990  Look for the first and the last holes available for the crooss-correlation
991  assuming the spectrum has a dimension nspec and sp_ll(nspec) and
992  flux(nspec) are the wavelength and spectral flux vectors
993 
994  Then finds the first hole such as
995  wave[0]<=mask_blu[first_hole] && mask_red[first_hole-1]<wave[0]
996  find last_hole such as
997  wave[nspec]>=mask_red[first_hole] && mask_red[first_hole+1]>wave[nspec]
998 
999  This search is done using
1000  find_pos_d(vector,len(vector),x,i,j,guess)
1001  which returns the index of the element in the vector such as
1002  vector[i]<=x<vector[i+1]
1003  The search is carried out between the elements:
1004  vector[i] and vector[j]
1005  and using "guess" and first "guess" for the position of "x" within "vector"
1006 
1007  (see NR F77 chapter 3.4)
1008  */
1009 
1010  first_hole=hunt(msk_blu-1, in_msk_nrow, sp_ll[0],0);
1011  guess=first_hole;
1012 
1013  for(j=0;j<in_msk_nrow;j++) {
1014  //for(j=0;j<3;j++) {
1015 
1016  i_blu_masques[j]=hunt(sp_ll_prime-1,sp_ll_sz,msk_blu[j],0)+1;
1017 
1018  guess=i_blu_masques[j];
1019  i_red_masques[j]=hunt(sp_ll_prime-1,sp_ll_sz,msk_red[j],guess)+1;
1020  guess=i_red_masques[j];
1021  //uves_msg_debug("masques: %d %d",i_blu_masques[j],i_red_masques[j]);
1022 
1023  }
1024  correl_bin(sp_ll_sz,sp_flux,sp_ll,sp_dll,
1025  &in_msk_nrow,msk_blu,msk_red,mask_w,i_blu_masques,
1026  i_red_masques,&intensity_s,&pix,&ll_range);
1027 
1028  ccf_o[i]=intensity_s;
1029 
1030  }
1031  *pix_tot+=pix;
1032  *ll_range_tot+=ll_range;
1033  for(i=0;i<rv_ccf_size;i++) {
1034  j=i+1;
1035  xfit[j]=rv_ccf[i];
1036  yfit[j]=ccf_o[i];
1037  sfit[j]=1;
1038  }
1039 
1040  aa[1]=300;
1041  aa[2]=0;
1042  aa[3]=1;
1043  aa[4]=1.;
1044 
1045 
1046  ia[1]=1;
1047  ia[2]=1;
1048  ia[3]=1;
1049  ia[4]=0;
1050 
1051  /*
1052  lfit(xfit,yfit,sfit,rv_ccf_size,aa,ia,3,covar,&chisq,fgauss);
1053  non_lfit(xfit,yfit,sfit,rv_ccf_size,aa,ndeg,ia,4,fgauss,erraa,&chisq);
1054  alambda=-1.0;
1055  mrqmin(xfit,yfit,sfit,rv_ccf_size,aa,ndeg,ia,mfit,covar,alpha,&chisq,
1056  fgauss,&alambda);
1057  */
1058 
1059 
1060  gaussian_fit(rv_ccf,ccf_o,rv_ccf_size,&norm,&cen,&sig,&fwhm);
1061 
1062  /* write output in descriptor */
1063  uves_msg_debug("Position max corvel=%f",cen);
1064  SCDWRD(in_ima_id,"CORVEL_MAX",&cen,1,1,&midas_unit);
1065 
1066 
1067 
1068  /* Free allocated memory */
1069  free_dmatrix(covar,1,ndeg,1,ndeg);
1070  free_dmatrix(alpha,1,ndeg,1,ndeg);
1071 
1072  free_dvector(aa,1,ndeg);
1073  free_dvector(erraa,1,ndeg);
1074  free_ivector(ia,1,ndeg);
1075 
1076  free_dvector(xfit,1,rv_ccf_size);
1077  free_dvector(yfit,1,rv_ccf_size);
1078  free_dvector(sfit,1,rv_ccf_size);
1079 
1080  free_dvector(msk_blu,0,in_msk_nrow);
1081  free_dvector(msk_red,0,in_msk_nrow);
1082  free_ivector(i_blu_masques,0,in_msk_nrow);
1083  free_ivector(i_red_masques,0,in_msk_nrow);
1084 
1085  free_dvector(sp_ll_prime,0,in_ima_ncol);
1086 
1087 } /* end function do_ccf_f */
1088 
1089 void
1090 correl_bin(int nx, /* in: dimension of flux (is it necessary?) */
1091  float** flux, /* in: Spectral flux (dim nx) */
1092  double *ll, /* in: wavelength (dim nx) */
1093  double *dll, /* in: Delta(lambda) D_ll (dim nx) */
1094  int *nbr_trou, /* in: Number of holes read from the mask file */
1095  double *ll_s, /* in: Mask hole start wavelength (dim nbr_trou) */
1096  double *ll_e, /* in: Mask hole end wavelength (dim nbr_trou) */
1097  double *ll_wei, /* in: Mask hole weight wavelength (dim nbr_trou) */
1098  int *i_start, /* in: see python code (page 9 line 76-77) */
1099  int *i_end, /* in: see python code (page 9 line 76-77) */
1100  double *out_ccf, /* out: Value of the CCF for a given velocity
1101  point */
1102  double *pix, /* out: number of pixelx used in the
1103  computation of the CCF */
1104  double *llrange) /* out: wavelenght interval covered by the
1105  pixels used in computation of the CCF */
1106 {
1107 
1108  /* pointers */
1109 
1110  float *pflux=NULL;
1111  double *pll=NULL;
1112  double *pdll=NULL;
1113  double *pll_s=NULL;
1114  double *pll_e=NULL;
1115  double *pll_wei=NULL;
1116  int *pi_start=NULL;
1117  int *pi_end=NULL;
1118  int trou=0;
1119  int i=0;
1120 
1121  pflux = *flux;
1122  pll = ll;
1123  pdll = dll;
1124  pll_s = ll_s;
1125  pll_e = ll_e;
1126  pll_wei = ll_wei;
1127  pi_start = i_start;
1128  pi_end = i_end;
1129 
1130 
1131  /*local param */
1132 
1133 
1134  *out_ccf=0.0;
1135  *pix=0.0;
1136  *llrange=0.0;
1137 
1138 
1139  for (trou=0;trou < *nbr_trou;trou++) {
1140 
1141  if (pi_start[trou] == pi_end[trou]) {
1142  *out_ccf=*out_ccf+(pll_e[trou]-pll_s[trou])/pdll[pi_start[trou]]*
1143  pflux[pi_start[trou]]*(pll_wei[trou]);
1144 
1145  *pix=*pix+(pll_e[trou]-pll_s[trou])*pll_wei[trou]/
1146  pdll[pi_start[trou]];
1147 
1148  *llrange=*llrange+(pll_e[trou]-pll_s[trou])*pll_wei[trou];
1149 
1150  } else if (pi_start[trou]+1 == pi_end[trou]) {
1151 
1152  *out_ccf=*out_ccf+
1153  ((pll[pi_start[trou]]+pdll[pi_start[trou]]*.5-pll_s[trou])*
1154  pflux[pi_start[trou]]/pdll[pi_start[trou]]+
1155  (pll_e[trou]-(pll[pi_start[trou]]+pdll[pi_start[trou]]*.5))*
1156  pflux[pi_end[trou]]/pdll[pi_start[trou]])*pll_wei[trou];
1157 
1158  *pix=*pix+((pll[pi_start[trou]]+pdll[pi_start[trou]]*.5-
1159  pll_s[trou])/pdll[pi_start[trou]]+
1160  (pll_e[trou]-(pll[pi_start[trou]]+pdll[pi_start[trou]]*.5))/
1161  pdll[pi_end[trou]])*pll_wei[trou];
1162 
1163 
1164  *llrange=*llrange+((pll[pi_start[trou]]+pdll[pi_start[trou]]*.5-
1165  pll_s[trou])+
1166  (pll_e[trou]-(pll[pi_start[trou]]+pdll[pi_start[trou]]*.5)))*
1167  pll_wei[trou];
1168 
1169 
1170  } else {
1171 
1172  *out_ccf=*out_ccf+((pll[pi_start[trou]]+pdll[pi_start[trou]]*0.5-
1173  pll_s[trou])*pflux[pi_start[trou]]/pdll[pi_start[trou]]+
1174  (pll_e[trou]-(pll[pi_end[trou]]-pdll[pi_end[trou]]*.5))*
1175  pflux[pi_end[trou]]/pdll[pi_end[trou]])*pll_wei[trou];
1176 
1177  *pix=*pix+
1178  ((pll[pi_start[trou]]+pdll[pi_start[trou]]*0.5-pll_s[trou])/
1179  pdll[pi_start[trou]]+
1180  (pll_e[trou]-(pll[pi_end[trou]]-pdll[pi_end[trou]]*.5))/
1181  pdll[pi_end[trou]])*pll_wei[trou];
1182 
1183  *llrange=*llrange+
1184  ((pll[pi_start[trou]]+pdll[pi_start[trou]]*0.5-pll_s[trou])+
1185  (pll_e[trou]-(pll[pi_end[trou]]-pdll[pi_end[trou]]*.5)))
1186  *pll_wei[trou];
1187 
1188  for (i=pi_start[trou]+1;i<=pi_end[trou]-1;i++) {
1189 
1190  *out_ccf=*out_ccf+pflux[i]*pll_wei[trou];
1191  *pix=*pix+pll_wei[trou];
1192  *llrange=*llrange+pdll[i]*pll_wei[trou];
1193  }
1194  }
1195  }
1196 } /* end function correl_bin */
1197 
1198 
1199 void
1200 fit_ccf(double* rv_ccf,double* ccf_nor,int type,double* ccf_res,
1201  double* ccf_fit)
1202 {
1203  /* Gaussian Fit either in emission or in absorbtion depending on the flag,
1204  emission for the ThAr
1205  It first computes a single fit in order to find the first guess
1206  parameters. Then it does the fit again now putting more weight on the
1207  core of the Gaussian. It returns the fit coefficients and the fitted
1208  function.
1209 
1210 */
1211 
1212 } /* end function fit_ccf */
1213 
1214 
1215 
1216 
1217 
1218 int
1219 hunt(double* xx, int n, double x, int jlo) {
1220 
1221  int jm, jhi, inc;
1222  int ascnd;
1223 
1224  ascnd=(xx[n] >= xx[1]);
1225  if (jlo <= 0 || jlo >n) {
1226  jlo=0;
1227  jhi=n+1;
1228  } else {
1229  inc=1;
1230  if ((x>=xx[jlo]) == ascnd) {
1231  if (jlo == n) return jlo-1;
1232  jhi=jlo+1;
1233  while ((x>=xx[jhi]) == ascnd) {
1234  jlo=jhi;
1235  inc +=inc;
1236  jhi=jlo+inc;
1237  if (jhi>n) {
1238  jhi=n+1;
1239  break;
1240  }
1241  }
1242  } else {
1243  if (jlo==1) {
1244  jlo=0;
1245  return jlo-1;
1246  }
1247  jhi=jlo--;
1248  while ((x<xx[jlo])==ascnd) {
1249  jhi=jlo;
1250  inc *=2;
1251  if (inc >= jhi) {
1252  jlo=0;
1253  break;
1254  }
1255  else jlo=jhi-inc;
1256  }
1257  }
1258  }
1259  while ((jhi-jlo) != 1) {
1260  jm=(jhi+jlo) >> 1;
1261  if ( (x >= xx[jm]) ==ascnd)
1262  jlo=jm;
1263  else
1264  jhi=jm;
1265  }
1266  if (x == xx[n]) jlo=n-1;
1267  if (x == xx[1]) jlo=1;
1268 
1269  return jlo-1;
1270 } /* end function hunt */
1271 
1272 
1273 /*
1274 void fgauss(double x,double g[],int ng)
1275 {
1276  int i=0;
1277  double arg=0.0;
1278  double ex=0.0;
1279  double fac=0.0;
1280  arg=(x-g[2])/g[3];
1281  ex=exp(-arg*arg);
1282  fac=g[4]+g[1]*ex*2.0*arg;
1283  return fac;
1284 }
1285 */
1286 
1287 
1288  /*
1289 static double
1290 fgauss(double x,double a[],double y,double dyda[],int na)
1291 {
1292  double arg=0.0;
1293  double ex=0.0;
1294  double fac=0.0;
1295 
1296  arg=(x-a[2])/a[3];
1297  ex=exp(-arg*arg);
1298  fac=a[4]+a[1]*ex*2.0*arg;
1299  y = a[4]+fac;
1300 
1301  dyda[1]=ex;
1302  dyda[2]=fac/a[2];
1303  dyda[3]=fac*arg/a[2];
1304  dyda[4]=0;
1305  return fac;
1306 }
1307  */
1308 
1309 /*
1310 static void
1311 fpoly(double x,double p[],int np)
1312 {
1313  int j=0;
1314  p[1]=1;
1315  for (j=2; j<=np;j++) p[j]=p[j-1]*x;
1316 }
1317 */
1318 
1319 
1320 static void
1321 gaussian_fit(const double * x,
1322  const double * y,
1323  int size,
1324  double * norm,
1325  double * xcen,
1326  double * sig_x,
1327  double * fwhm_x)
1328 {
1329  double u0, ux, uxx;
1330  double max_val ;
1331  int i;
1332 
1333  /* Check entries */
1334  /* Extraction zone */
1335 
1336  /* Extract the image zone to fit */
1337  /* Check if there are enough good pixels */
1338  /* Convert the image to double */
1339  /* Compute xcen */
1340  u0 = ux = 0.0 ;
1341  for (i=0 ; i<size ; i++) {
1342  u0 += y[i] ;
1343  ux += x[i] * y[i] ;
1344  }
1345  /* Compute sig_x */
1346  uxx = 0.0 ;
1347  for (i=0 ; i<size ; i++) {
1348  uxx += (x[i]-(ux/u0)) * (x[i]-(ux/u0)) * y[i] ;
1349  }
1350  if (sig_x) *sig_x = sqrt(fabs(uxx/u0)) ;
1351  if (fwhm_x) *fwhm_x = 2 * sqrt(2 * log(2.0)) * sqrt(fabs(uxx/u0)) ;
1352 
1353  max_val=y[0];
1354  for (i=1 ; i<size ; i++) {
1355  if(y[i] > max_val) max_val=y[i];
1356  }
1357  /* Compute norm */
1358  if (norm) *norm = max_val*2*M_PI*sqrt(fabs(uxx/u0)) ;
1359 
1360  /* Shift xcen and ycen to coordinates in the input big image */
1361  if (xcen) *xcen = ux/u0;
1362 
1363 }
#define uves_msg_warning(...)
Print an warning message.
Definition: uves_msg.h:87
#define uves_msg_debug(...)
Print a debug message.
Definition: uves_msg.h:97