flames_corvel.c

00001 /* 
00002  * This file is part of the ESO UVES Pipeline
00003  * Copyright (C) 2004,2005 European Southern Observatory
00004  *
00005  * This program is free software; you can redistribute it and/or modify
00006  * it under the terms of the GNU General Public License as published by
00007  * the Free Software Foundation; either version 2 of the License, or
00008  * (at your option) any later version.
00009  *
00010  * This program is distributed in the hope that it will be useful,
00011  * but WITHOUT ANY WARRANTY; without even the implied warranty of
00012  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00013  * GNU General Public License for more details.
00014  *
00015  * You should have received a copy of the GNU General Public License
00016  * along with this program; if not, write to the Free Software
00017  * Foundation, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA
00018  */
00019 /*
00020   ============================================================================
00021   flames_corvel:
00022   Purpose: 
00023   to cross correlate in velocity space a wavelength calibrated spectra with a 
00024   reference mask to get eventual velocity shift of one with respect to the 
00025   other.
00026 
00027   This code implements the Geneva alghorithm as for HARPS. Information and 
00028   reference alghorithms where provided from Claudio Melo, ESO-Paranal.
00029   ============================================================================
00030 */
00031 
00032 /* 
00033   ----------------------------------------------------------------------------
00034   INCLUDES
00035   ----------------------------------------------------------------------------
00036 */ 
00037 
00038 #ifdef HAVE_CONFIG_H
00039 #  include <config.h>
00040 #endif
00041 #include <flames_lfit.h>
00042 #include <flames_midas_def.h>   /* MIDAS environment interface functions */
00043 #include <flames_corvel.h>        /* FLAMES-UVES functions */
00044 #include <flames_newmatrix.h>   /* FLAMES-UVES functions for array manipolation */
00045 #include <uves_utils.h>         /* M_PI */
00046 #include <uves_msg.h>        
00047 #include <stdio.h> 
00048 #include <math.h> 
00049 #include <stdlib.h> 
00050 #include <irplib_utils.h>
00051 #include <string.h>
00052 
00053 /* 
00054   ----------------------------------------------------------------------------
00055   LOCAL DEFINITIONS
00056   ----------------------------------------------------------------------------
00057 */ 
00058 #define MAX_LEN 80
00059 #define MAX_DIM 2
00060 #define MAX_ORD 4
00061 #define MAX_PIX 10000
00062 #define MAX_DEG 4
00063 #define FLAMES_SPEED_OF_LIGHT 299792.458 //is defined also in uves_utils.h
00064 
00065 /*
00066 static void 
00067 fpoly(double x,double p[],int np);
00068 */
00069 
00070 /*
00071 static void 
00072 get_mask(char*  tpl_name,double in_msk_wgt_min, double in_msk_hole_wid, 
00073          char* log_opt, double** msk_hole_width, double** msk_hole_center,
00074          double** msk_hole_wgt);
00075 */
00076 
00077 static void 
00078 do_cor_vel(double* wcal_sol,float** sp_flux,
00079            double* rv_ccf,double* msk_hole_siz, double* msk_hole_cen,
00080            double* msk_hole_wgt, double bar_v,double bar_v_max,
00081            int fit_type,int in_ima_nrow,
00082            int in_msk_nrow,int rv_ccf_size, double* ccf,double* ccf_max,
00083            double* pix_passed_ord,int* tot_line,double* ll_range_ord,
00084            int in_ima_id);
00085 
00086 static void 
00087 fit_ccf(double* rv_ccf,double* ccf_nor,int type,double* ccf_res,
00088         double* ccf_fit);
00089 
00090 
00091 
00092 
00093 
00094 /* void fgauss(double x,double g[],int ng); */
00095 /*
00096 static double 
00097 fgauss(double x,double a[],double y,double dyda[],int na);
00098 */
00099 
00100 static void 
00101 gaussian_fit(const double *   xfit, const double * yfit,int size,
00102                     double * norm, double * xcen, double * sig_x,
00103                     double * fwhm_x); 
00104 static void 
00105 correl_bin(int sp_flux_sz, float** sp_flux,double* sp_ll,double* sp_dll,
00106                   int *in_msk_nrow,double* msk_blu,double* msk_red,
00107                   double* msk_w, int* i_blue_masques,int* i_red_masques,
00108                   double* intensity_s,double* pix,double* ll_range);
00109     
00110 static int 
00111 hunt(double* xx, int n, double x, int jlo);
00112 
00113 
00114 static void 
00115 do_ccf_f(double* mask_ll,double* mask_d,double* mask_w,double* sp_ll,
00116          float** sp_flux,double* sp_dll,double* rv_ccf,double* ccf_o,
00117          double* pix_passed_ord,double* wcal_range_ord,int in_msk_nrow, 
00118          int in_ima_ncol, int rv_ccf_size, int in_ima_id);
00119 
00120 
00121 
00138 int flames_corvel(const char *IN_A,
00139                   const char *IN_B,
00140                   const int  IN_N,
00141                   const char *OU_A,
00142                   const char *OU_B,
00143                   const char *OU_C,
00144                   const double rv_ccf_min,
00145                   const double rv_ccf_max,
00146                   const double rv_ccf_step)
00147 {
00148 
00149 
00150 
00151   char in_ima[MAX_LEN];   /* char array for input ima */
00152   char ou_ima[MAX_LEN];   /* char array for output ima */
00153   char ou_tab[MAX_LEN];   /* char array for output ima */
00154   char in_msk[MAX_LEN];   /* char array for input mask */
00155 
00156   /* MIDAS stuff */
00157   int midas_unit = 0;
00158   int midas_null = 0;
00159   int midas_nval = 0;
00160   int midas_status = 0;
00161 
00162   /* tmp variable used in MIDAS env calls */
00163   int in_ima_id =0;
00164   int ou_ima_id =0;
00165   int in_msk_id =0;
00166   int in_ima_naxis =0;
00167   int ou_ima_naxis =1;
00168   int ou_ima_npix[2] ={0,0};
00169   double ou_ima_start[2] ={0.,0.};
00170   double ou_ima_step[2] ={0.,0.};
00171 
00172   float cuts[4]={0.,0.,0.,0.};
00173   int tid=0;
00174   int ccf_pos_col=0;
00175   int ccf_nrm_col=0;
00176   int ccf_out_col=0;
00177   
00178   int in_ima_npix[MAX_DIM];
00179   int in_msk_ncol=0; 
00180   int in_msk_nrow=0;  
00181   char ident[73];
00182   char cunit[3][16];
00183 
00184 
00185   /* Other useful variables */
00186   int in_ima_nx = 0;      /* No of columns */
00187   int in_ima_ny = 0;      /* No of rows */
00188   int in_ima_ord=0;       /* order number of input image */
00189   
00190   float ** m_in_ima=NULL;     /* input image array */
00191 
00192   double* in_ima_wcal_sol=NULL;
00193 
00194   double* msk_hole_sta=NULL;
00195   double* msk_hole_end=NULL;
00196   double* msk_hole_cen=NULL;
00197   double* msk_hole_siz=NULL;
00198   double* msk_hole_wgt=NULL;
00199 
00200   double* msk_hole_cen_selw=NULL;
00201   double* msk_hole_siz_selw=NULL;
00202   double* msk_hole_wgt_selw=NULL;
00203   
00204 
00205   double in_msk_wgt_min=0.9;  /*1 */
00206   double in_msk_hole_wid=0.; /*0 */
00207   double tmp_double=0;
00208   double in_ima_wstart =0.;
00209   double in_ima_wstep  =0.;
00210 
00211 
00212   double* rv_ccf=NULL;
00213   int rv_ccf_size=0;
00214   //double rv_ccf_par[3] ={0.,0.,0.};
00215 
00216   int    wstart_id=0;
00217   int    wend_id=0;
00218   int    weight_id=0;
00219 
00220   int i=0;
00221   int counter=0;
00222 
00223   double  tmp_dbl=0;
00224 
00225   double ccf_max=0;
00226   double ccf_avg=0;
00227 
00228   double* ccf_nrm=NULL;
00229   double pix_passed_ord=0;
00230 
00231   int tot_line=0;
00232   double ll_range_ord=0;
00233   double* ccf_res=NULL;
00234   double* ccf_fit=NULL;
00235   double* ccf_o=NULL;
00236   char wstart_key[80];
00237 
00238   /* Program's Id */
00239   SCSPRO("flames_corvel");
00240 
00241  
00242   memset(ident, '\0', 73);
00243   memset(cunit[0], '\0', 48);
00244   strncpy(cunit[1], "PIXEL           ", 16);
00245   strncpy(cunit[2], "PIXEL           ", 16);
00246   /* ================================================================ */
00247   /* GET INPUT DATA                                                   */
00248   /* ================================================================ */
00249   /* get input ima name */
00250 
00251   in_ima_ord=IN_N;
00252   if((midas_status = SCKGETC(IN_A,1,MAX_LEN,&midas_nval,in_ima)) !=0) {
00253      uves_msg_warning("Error reading char keyword %s",IN_A);
00254      return flames_midas_error(MAREMMA);
00255   }
00256 
00257   //sprintf(in_ima,IN_A);
00258   /* get input ima order number */
00259   //midas_status = SCKRDI(IN_N,1,1,&midas_nval,&in_ima_ord, 
00260   //          &midas_unit, &midas_null);
00261 
00262   /* ================================================================ */
00263   /* Read 2D extracted input spectra */
00264   /* ================================================================ */
00265   /* get input ima frame */
00266 
00267   
00268   if( (midas_status = SCFOPN(in_ima,D_R4_FORMAT,0,F_IMA_TYPE,&in_ima_id))!=0) {
00269      uves_msg_warning("Error opening input image %s",IN_A);
00270      return flames_midas_error(MAREMMA);
00271   }
00272 
00273   /* get input ima dimension */
00274   if((midas_status = SCDRDI(in_ima_id,"NAXIS",1,1,&midas_nval,
00275                             &in_ima_naxis,&midas_unit,&midas_null)) !=0)
00276   {
00277      uves_msg_warning("Error reading NAXIS from image %s",IN_A);
00278      return flames_midas_error(MAREMMA);
00279   } 
00280   /* get input ima no of columns and rows */
00281 
00282   if((midas_status = SCDRDI(in_ima_id,"NPIX",1,in_ima_naxis,&midas_nval,
00283                             in_ima_npix,&midas_unit,&midas_null))!=0) {
00284      uves_msg_warning("Error reading NPIX from image %s",IN_A);
00285      return flames_midas_error(MAREMMA);
00286   }
00287 
00288 
00289 
00290   if (in_ima_naxis > 1) {
00291      in_ima_nx = in_ima_npix[0];
00292      in_ima_ny = in_ima_npix[1];
00293   }
00294   else {
00295      in_ima_nx = in_ima_npix[0];
00296      in_ima_ny = 1;            /* input image is one extracted order */
00297   }
00298 
00299   /* Prepare memory area to hold input image */
00300   m_in_ima = matrix(0, in_ima_ny-1, 0, in_ima_nx-1);
00301  
00302   memset(&m_in_ima[0][0], '\0', in_ima_nx*in_ima_ny*sizeof(float));
00303 
00304   /* get input ima in prepared area */
00305   if((midas_status = SCFGET(in_ima_id,1,in_ima_nx*in_ima_ny,&midas_nval, 
00306                             (char *)&m_in_ima[0][0])) != 0) {
00307     uves_msg_warning("Error mapping image %s",IN_A);
00308      return flames_midas_error(MAREMMA);
00309 
00310   }
00311 
00312   /* ================================================================ */
00313   /* PREPARE WCAL SOLUTION                                            */
00314   /* ================================================================ */
00315   /* get WSTART and WSTEP values to calculate array of wcal pix values
00316      in_ima_wcal_sol stores the wavelength calibration solution */
00317 
00318 
00319   sprintf(wstart_key,"%s%d","WSTART",in_ima_ord);
00320   if((midas_status = SCDRDD(in_ima_id,wstart_key,1,1,
00321                         &midas_nval,&tmp_double,
00322                             &midas_unit,&midas_null)) != 0) {
00323      uves_msg_warning("Error reading %s from input image %s",wstart_key,IN_A);
00324      return flames_midas_error(MAREMMA);
00325   }
00326 
00327   
00328  
00329   in_ima_wstart=(float)tmp_double;
00330 
00331  
00332   if((midas_status = SCDRDD(in_ima_id,"CDELT1",1,1,&midas_nval,&tmp_double,
00333                             &midas_unit,&midas_null))!=0) {
00334      uves_msg_warning("Error reading CDELT1 from input image %s",IN_A);
00335      return flames_midas_error(MAREMMA);
00336   }
00337  
00338   
00339   in_ima_wstep=(float)tmp_double;
00340   in_ima_wcal_sol=dvector(0,in_ima_nx);
00341 
00342 
00343   for (i=0; i< in_ima_nx; i++){
00344     in_ima_wcal_sol[i]=(double)(in_ima_wstart+in_ima_wstep*i);
00345   }
00346   /* get input mask table name */
00347   if((midas_status = SCKGETC(IN_B,1,MAX_LEN,&midas_nval,in_msk))!=0) {
00348      uves_msg_warning("Error reading input table %s",IN_B);
00349      return flames_midas_error(MAREMMA);
00350   }
00351 
00352   /* ================================================================ */
00353   /* GET INPUT MASK                                                   */
00354   /* ================================================================ */
00355   /* ================================================================ */
00356   /*  
00357    The input mask is as follows. 
00358    First column tells you where the hole begins, 
00359    The second one where the hole ends and the third is the weight of each hole
00360    (this last value is important for the stellar case where one may want to 
00361     give more importance to stellar lines of a given type)
00362    We get from the input mask the following parameters:
00363    1) the minimum weight of the holes of the mask used in the CCF 
00364    2) the width of the holes 
00365    3) the weight of the holes 
00366 
00367    After this operation the parameters which counts are:
00368        msk_hole_siz_selw[i] 
00369        msk_hole_cen_selw[i]  
00370        msk_hole_wgt_selw[i]  
00371 
00372    in_msk_wgt_min=1;
00373    in_msk_hole_wid=1.;
00374    strcpy(log_opt," ");
00375 
00376    get_mask(in_msk,in_msk_wgt_min,in_msk_hole_wid,log_opt,
00377            &msk_hole_width,&msk_hole_center,&msk_hole_wgt);
00378   */
00379   /* ================================================================ */
00380   /* get input mask table frame */
00381 
00382 
00383   if((midas_status = TCTOPN(in_msk,F_I_MODE,&in_msk_id))!=0) {
00384      uves_msg_warning("Error reading input mask %s",in_msk);
00385      return flames_midas_error(MAREMMA);
00386   }
00387 
00388 
00389   TCIGET (in_msk_id, &in_msk_ncol, &in_msk_nrow);
00390   /* get input mask table column id */
00391   if((midas_status = TCCSER(in_msk_id,"WSTART",&wstart_id))!=0) {
00392     uves_msg_warning("Error reading WSTART from input mask %s",in_msk);
00393     return flames_midas_error(MAREMMA);
00394   }
00395 
00396   /* get input mask table column id */
00397   if((midas_status = TCCSER(in_msk_id,"WEND",&wend_id))!=0) {
00398     uves_msg_warning("Error reading WEND from input mask %s",in_msk);
00399     return flames_midas_error(MAREMMA);
00400   }
00401 
00402   /* get input mask table column id */
00403   if((midas_status = TCCSER(in_msk_id,"WEIGHT",&weight_id))!=0) {
00404     uves_msg_warning("Error reading WEIGHT from input mask %s",in_msk);
00405     return flames_midas_error(MAREMMA);
00406   }
00407 
00408   /* Defines and initializes all necessary vectors */
00409   msk_hole_sta=dvector(0,in_msk_nrow);  
00410   msk_hole_end=dvector(0,in_msk_nrow);    
00411   msk_hole_siz=dvector(0,in_msk_nrow);
00412   msk_hole_wgt=dvector(0,in_msk_nrow);
00413   msk_hole_cen=dvector(0,in_msk_nrow);
00414 
00415   /* selected values...*/
00416   msk_hole_siz_selw=dvector(0,in_msk_nrow);
00417   msk_hole_wgt_selw=dvector(0,in_msk_nrow);
00418   msk_hole_cen_selw=dvector(0,in_msk_nrow);
00419 
00420 
00421   for(i=1;i<in_msk_nrow;i++) {
00422      TCERDD(in_msk_id,i,wstart_id,&tmp_dbl,&midas_null); 
00423      msk_hole_sta[i-1]=tmp_dbl;
00424      TCERDD(in_msk_id,i,wend_id,&tmp_dbl,&midas_null);
00425      msk_hole_end[i-1]=tmp_dbl;
00426      TCERDD(in_msk_id,i,weight_id,&tmp_dbl,&midas_null);
00427      msk_hole_wgt[i-1]=tmp_dbl;
00428      msk_hole_siz[i-1]=msk_hole_end[i-1]-msk_hole_sta[i-1];
00429      msk_hole_cen[i-1]=msk_hole_sta[i-1]+msk_hole_siz[i-1]*0.5;
00430      /*
00431      uves_msg_debug("sta=%f end=%f wgt=%f siz=%f cen=%f",
00432               msk_hole_sta[i-1],
00433               msk_hole_end[i-1],
00434               msk_hole_wgt[i-1],
00435               msk_hole_siz[i-1],
00436               msk_hole_cen[i-1]);
00437      */
00438   }
00439   TCTCLO(in_msk_id);
00440   /*ADAPTED*****/
00441   /* 
00442      If a fixed width is given as input parameter in_msk_hole_wid then
00443      is calculated msk_hole_siz
00444      in_msk_hole_wid is the fixed width given in km/s
00445      In our case in_msk_hole_wid=0 and the following if is not entered
00446   */
00447   
00448   if (in_msk_hole_wid > 0) {
00449 
00450      for(i=1;i<in_msk_nrow;i++) {
00451         msk_hole_siz[i-1]=
00452            in_msk_hole_wid*msk_hole_siz[i-1]/FLAMES_SPEED_OF_LIGHT;
00453      }
00454 
00455   }
00456 
00457 
00458   /* selects mask on in_msk_wgt_min of force weight=1
00459      in our case in_msk_wgt_min =1 and the following if is not entered
00460      is executed instead the else part
00461   */
00462   if (in_msk_wgt_min < 1) {
00463     /* If a lower limit of the weight of the holes is specified as input 
00464        parameter in_msk_wgt_min, then selects values of 
00465        wsize,wcenter,weight
00466        If no condition is given keep the vectors intact
00467     */
00468      counter=0;
00469      for(i=1;i<in_msk_nrow;i++) {
00470        if (msk_hole_wgt[counter] > in_msk_wgt_min) {
00471           msk_hole_siz_selw[counter] = msk_hole_siz[i];  
00472           msk_hole_cen_selw[counter] = msk_hole_cen[i];  
00473           msk_hole_wgt_selw[counter] = msk_hole_wgt[i]; 
00474           counter++; 
00475        }
00476      }
00477   }
00478   else {
00479      for(i=1;i<in_msk_nrow;i++) {
00480        if (msk_hole_wgt[i] > in_msk_wgt_min) {
00481           msk_hole_siz_selw[i] = msk_hole_siz[i];  
00482           msk_hole_cen_selw[i] = msk_hole_cen[i];  
00483           msk_hole_wgt_selw[i] = msk_hole_wgt[i]; 
00484        }
00485      }
00486   }
00487 
00488  
00489   /* ================================================================ */
00490   /* END GET INPUT MASK                                               */
00491   /* ================================================================ */
00492   /* ================================================================ */
00493   /* COMPUTE CCF                                                      */
00494   /* ================================================================ */
00495   /* we allocate memory and define the vector to be used to evaluate CCF */
00496   /* this vector defines the points at which the CCF is computed */
00497   //midas_status = SCKRDD(IN_C,1,3,&midas_nval,rv_ccf_par, 
00498   //        &midas_unit, &midas_null);
00499 
00500   rv_ccf_size=(int)((rv_ccf_max-rv_ccf_min)/rv_ccf_step+1);
00501   rv_ccf=dvector(0,rv_ccf_size);
00502   ccf_o=dvector(0,rv_ccf_size);
00503 
00504  
00505   rv_ccf[0]=rv_ccf_min;
00506   for(i=1;i<rv_ccf_size;i++){
00507     rv_ccf[i]=rv_ccf[i-1]+rv_ccf_step;
00508   }
00509   /* 
00510      ======================================================================= 
00511      Do correlation. Values calculated by this subriutine are:
00512        ccf:            ccf matrix containing the ccf for each order (ccf_i)
00513 
00514        ccf_max:        vector containing the highest value of each ccf_i, 
00515 
00516        pix_passed_all: number of pixels of the input spectrum used for the
00517                        computation of each ccf_i,
00518        pix_passed_ord is the currespondent order value
00519 
00520        tot_line:       number of holes used in the computation of each ccf_i, 
00521 
00522        ll_range_all:   wavelength interval of each order the input spectrum 
00523                        used in the computation of each ccf_i
00524        ll_range_ord is the correspondent order value
00525      ======================================================================= 
00526    */
00527 
00528 
00529   do_cor_vel(in_ima_wcal_sol,   /* wave calibration solution */
00530          m_in_ima,          /* extracted spectrum */
00531          rv_ccf,            /* points at which the CCF is computed */
00532          msk_hole_siz_selw, /* hole size   selected on weight criteria */
00533          msk_hole_cen_selw, /* hole center selected on weight criteria */
00534          msk_hole_wgt_selw, /* hole weight selected on weight criteria */
00535              0,                 /* barv     :Baricentric Velocity Corr */
00536              0,                 /* barv_max :Its maximum               */
00537              0,                 /* fit_type (Gaussian): 0/1 emis/absorb */
00538              in_ima_nx,         /* X sise of input spectra */
00539              in_msk_nrow,       /* size of input mask */
00540          rv_ccf_size,       /* size of CCF */
00541          ccf_o,               /* out: ccf for each order (ccf_i) */     
00542              &ccf_max,          /* out: max(ccf) for each order (ccf_i) */
00543              &pix_passed_ord,   /* out: each order in sp's no of pix to 
00544                                              get ccf_i */
00545          &tot_line,         /* out: no of holes used to get ccf_i */
00546          &ll_range_ord,     /* out: each order's wav interval to get ccf_i */
00547              in_ima_id);        /* input ima id (to write descriptors) */
00548 
00549  
00550   /* Sum the individual ccf_i for each bin and normalize the final ccf */
00551 
00552   SCFCLO(in_ima_id); //not needed anymore
00553   ccf_nrm=dvector(0,rv_ccf_size);
00554   for(i=0;i<rv_ccf_size;i++){
00555      ccf_avg +=ccf_o[i];
00556      if(!irplib_isinf(ccf_o[i])) {
00557         if(ccf_o[i] > ccf_max) {
00558            ccf_max=ccf_o[i];
00559         }
00560      }
00561   }
00562  
00563 
00564   /* Creating a new table for offline plotting of peaks */
00565   SCKGETC(OU_A,1,MAX_LEN,&midas_nval,ou_tab);
00566   /* jmlarsen: use F_O_MODE for new table
00567      old code: TCTINI(ou_tab,F_IO_MODE,rv_ccf_size,&tid);*/
00568   TCTINI(ou_tab,F_O_MODE,rv_ccf_size,&tid);
00569   
00570   /* Creating a new column */
00571   TCCINI(tid, D_R8_FORMAT, 1, "F8.4", " ", "ccf_pos", &ccf_pos_col);
00572   TCCINI(tid, D_R8_FORMAT, 1, "F8.4", " ", "ccf_nrm", &ccf_nrm_col);
00573   TCCINI(tid, D_R8_FORMAT, 1, "F8.4", " ", "ccf_out", &ccf_out_col);
00574 
00575   /* Writing table values */
00576   /*
00577   if (abs(ccf_max) >= FEPSILON) { 
00578      for(i=0;i<rv_ccf_size;i++){
00579         ccf_nrm[i]=ccf_o[i]/ccf_max;
00580         TCEWRD(tid, i+1, ccf_pos_col, &rv_ccf[i]);
00581         TCEWRD(tid, i+1, ccf_nrm_col, &ccf_nrm[i]);
00582         TCEWRD(tid, i+1, ccf_out_col, &ccf_o[i]);
00583      }
00584   } else {
00585      for(i=0;i<rv_ccf_size;i++){
00586         ccf_nrm[i]=0.;
00587         TCEWRD(tid, i+1, ccf_pos_col, &rv_ccf[i]);
00588         TCEWRD(tid, i+1, ccf_nrm_col, &ccf_nrm[i]);
00589         TCEWRD(tid, i+1, ccf_out_col, &ccf_o[i]);
00590      }
00591   }
00592   */
00593  
00594      for(i=0;i<rv_ccf_size;i++){
00595         ccf_nrm[i]=ccf_o[i]/ccf_max;
00596         TCEWRD(tid, i+1, ccf_pos_col, &rv_ccf[i]);
00597         TCEWRD(tid, i+1, ccf_nrm_col, &ccf_nrm[i]);
00598         TCEWRD(tid, i+1, ccf_out_col, &ccf_o[i]);
00599      }
00600 
00601   SCDWRD(tid,"CCF_MAX",&ccf_max,1,1,&midas_unit); 
00602   SCDWRD(tid,"WAV_RNG",&ll_range_ord,1,1,&midas_unit); 
00603   SCDWRD(tid,"PIX_TOT",&pix_passed_ord,1,1,&midas_unit); 
00604   SCDWRI(tid,"LIN_TOT",&tot_line,1,1,&midas_unit); 
00605 
00606   TCTCLO(tid);
00607  
00608  
00609   /* TO BE IMPLEMENTED */
00610   /* Gaussian Fit of the normalized CCF */
00611   /* 
00612      one fit normalized_ccf as a function of rv_ccf using as fit type an
00613      emission Gaussian. Output of the fit are the Gaussian fit coefficients 
00614      ccf_res and ccf_fit is the fitted Gaussian computed on the rv_ccf 
00615      velocity bins
00616   */
00617 
00618   /* ccf_res[0]=ccf_res[0]/(1.-ccf_res[3]); */
00619   fit_ccf(rv_ccf,ccf_nrm,1,ccf_res,ccf_fit);
00620 
00621 
00622  
00623   /* dump results in ouput image*/
00624 
00625   ou_ima_npix[0]=rv_ccf_size;
00626   ou_ima_npix[1]=1;
00627   ou_ima_start[0]=rv_ccf[0];
00628   ou_ima_start[1]=ccf_nrm[0];
00629   ou_ima_step[0]=ccf_max;
00630   ou_ima_step[1]=1;
00631   cuts[0] = 0;
00632   cuts[1] = 0;
00633   cuts[2] = 0;
00634   cuts[3] = 1;
00635  
00636  
00637   SCKGETC(OU_B,1,MAX_LEN,&midas_nval,ou_ima);
00638 
00639   SCFCRE(ou_ima,D_R8_FORMAT,F_O_MODE,F_IMA_TYPE,rv_ccf_size,&ou_ima_id);
00640   SCDWRC(ou_ima_id,"IDENT", 1, ident, 1, 72, &midas_unit);
00641   SCDWRI(ou_ima_id,"NAXIS",&ou_ima_naxis,1,1,&midas_unit); 
00642   SCDWRI(ou_ima_id,"NPIX",ou_ima_npix,1,2,&midas_unit); 
00643   SCDWRD(ou_ima_id,"START",ou_ima_start, 1, 2, &midas_unit);
00644   SCDWRD(ou_ima_id,"STEP", ou_ima_step, 1, 2, &midas_unit);
00645   SCDWRC(ou_ima_id,"CUNIT", 1, cunit[0], 1, 48, &midas_unit);
00646   SCDWRR(ou_ima_id,"LHCUTS", cuts, 1, 4, &midas_unit);
00647   SCFPUT(ou_ima_id,1,rv_ccf_size,(char *)ccf_o);
00648   SCDWRD(ou_ima_id,"CCF_MAX",&ccf_max,1,1,&midas_unit); 
00649   SCDWRD(ou_ima_id,"WAV_RNG",&ll_range_ord,1,1,&midas_unit); 
00650   SCDWRD(ou_ima_id,"PIX_TOT",&pix_passed_ord,1,1,&midas_unit); 
00651   SCDWRI(ou_ima_id,"LIN_TOT",&tot_line,1,1,&midas_unit); 
00652   SCFCLO(ou_ima_id);
00653 
00654   cuts[3] = ccf_max;
00655   SCKGETC(OU_C,1,MAX_LEN,&midas_nval,ou_ima);
00656   SCFCRE(ou_ima,D_R8_FORMAT,F_O_MODE,F_IMA_TYPE,rv_ccf_size,&ou_ima_id);
00657   
00658   SCDWRC(ou_ima_id,"IDENT", 1, ident, 1, 72, &midas_unit);
00659   SCDWRI(ou_ima_id,"NAXIS",&ou_ima_naxis,1,1,&midas_unit); 
00660   SCDWRI(ou_ima_id,"NPIX",ou_ima_npix,1,2,&midas_unit); 
00661   SCDWRD(ou_ima_id,"START",ou_ima_start, 1, 2, &midas_unit);
00662   SCDWRD(ou_ima_id,"STEP", ou_ima_step, 1, 2, &midas_unit);
00663   SCDWRC(ou_ima_id,"CUNIT", 1, cunit[0], 1, 48, &midas_unit);
00664   SCDWRR(ou_ima_id,"LHCUTS", cuts, 1, 4, &midas_unit);
00665   SCFPUT(ou_ima_id,1,rv_ccf_size,(char *)ccf_nrm);
00666   SCDWRD(ou_ima_id,"CCF_MAX",&ccf_max,1,1,&midas_unit); 
00667   SCDWRD(ou_ima_id,"WAV_RNG",&ll_range_ord,1,1,&midas_unit); 
00668   SCDWRD(ou_ima_id,"PIX_TOT",&pix_passed_ord,1,1,&midas_unit); 
00669   SCDWRI(ou_ima_id,"LIN_TOT",&tot_line,1,1,&midas_unit); 
00670   SCFCLO(ou_ima_id);
00671   /* free allocated memory */
00672   /* free_matrix(m_in_ima,0,in_ima_ny-1,0,in_ima_nx-1); */
00673   free_dvector(msk_hole_sta,0,in_msk_nrow);
00674   free_dvector(msk_hole_end,0,in_msk_nrow);
00675   free_dvector(msk_hole_siz,0,in_msk_nrow);
00676   free_dvector(msk_hole_wgt,0,in_msk_nrow);
00677   free_dvector(msk_hole_cen,0,in_msk_nrow);
00678   free_dvector(msk_hole_siz_selw,0,in_msk_nrow);
00679   free_dvector(msk_hole_wgt_selw,0,in_msk_nrow);
00680   free_dvector(msk_hole_cen_selw,0,in_msk_nrow);
00681   free_dvector(rv_ccf,0,rv_ccf_size);
00682   free_dvector(ccf_nrm,0,rv_ccf_size);
00683   free_dvector(in_ima_wcal_sol,0,in_ima_nx);
00684   free_dvector(ccf_o,0,rv_ccf_size);
00685 
00686 
00687   SCSEPI();
00688   return 0;
00689 
00690 }
00691 
00692 void
00693 do_cor_vel(double* wcal_sol,float** sp_flux,double* rv_ccf,
00694            double* msk_hole_siz,double* msk_hole_cen,
00695            double* msk_hole_wgt,double bar_v,double bar_v_max,
00696            int fit_type,int in_ima_ncol,int in_msk_nrow,
00697            int rv_ccf_size,
00698        double* ccf_o,            /* matrix with ccf_i */
00699        double* ccf_max,        /* vector with max(ccf_i) */
00700        double* pix_passed_ord, /* no of in spct pixels used to get ccf_i */
00701        int*    tot_line,       /* no of holes used to get ccf_i */
00702        double* wcal_range_ord, /* wave range of each order in spct used to get ccf_i */
00703            int in_ima_id)
00704 {
00705 
00706   /* Local variables */
00707   double* dw_map=NULL;
00708   double* ccf_all=NULL;
00709   double* ccf_all_fit=NULL;
00710   double* msk_hole_cen_selr=NULL;
00711   double* msk_hole_siz_selr=NULL;
00712   double* msk_hole_wgt_selr=NULL;
00713 
00714   double* ccf_o_results=NULL;
00715   /* double* ccf_o_fit=NULL; */
00716   /* ccf_o_fit is commented out as not really used */
00717   double* rv_ccf_cor=NULL;
00718 
00719   double wcal_min=0;
00720   double wcal_max=0;
00721   double d_secular_red=0;
00722   double d_secular_blu=0;
00723 
00724   int i=0;
00725   int sel_no=0;
00726 
00727   /* Local Functions */
00728 
00729 /* 
00730    ==========================================================================
00731    Subroutine body 
00732    ==========================================================================
00733 */
00734 
00735 /* The following 2 lines has de facto no effect as bar_v and bar__max are 0 */
00736   d_secular_red=bar_v_max-bar_v;
00737   d_secular_blu=bar_v_max-bar_v;
00738 
00739 
00740   dw_map=dvector(0,in_ima_ncol);
00741   ccf_all=dvector(0,rv_ccf_size);
00742   ccf_all_fit=dvector(0,rv_ccf_size);
00743   rv_ccf_cor=dvector(0,rv_ccf_size);
00744   /* ccf_o_fit=dvector(0,in_ima_ncol); */
00745   /* ccf_o_fit is commented out as not really used*/
00746   ccf_o_results=dvector(0,4);
00747 
00748 
00749   msk_hole_cen_selr=dvector(0,in_msk_nrow);
00750   msk_hole_siz_selr=dvector(0,in_msk_nrow);
00751   msk_hole_wgt_selr=dvector(0,in_msk_nrow);
00752   /* defines delta_lambda vector as delta_lambda=lambda(i+1)-lambda(i) */
00753   for(i=0;i<in_ima_ncol-1;i++){
00754     dw_map[i]=wcal_sol[i+1]-wcal_sol[i];
00755   }
00756   /* Not relevant for the ThAr correlation.
00757      This computes the minimum and the maximum wavelengths given the velocity
00758      point extremes in which the CCF is going to be computed
00759      (rv_ccf[0] is the first velocity bin and rv_ccf[-1] is the last) and the
00760      max BAR_V velocity (baricentric velocity) possible
00761   */
00762 
00763   
00764   /* Here should start a loop over orders: we do not do it as we assume
00765      to have in input the spectra relative to each order */
00766 
00767   /* The following two lines are not relevant in case of ThAr spectra */
00768   /* They are to compute the min and max wavelength being given the velocity
00769      point extremes in which the CCF is going to be computed and the max
00770      baricentric velocity possible */
00771 
00772   wcal_min=wcal_sol[0]-(rv_ccf[0]-bar_v-d_secular_blu)*
00773            wcal_sol[0]/FLAMES_SPEED_OF_LIGHT; 
00774 
00775   wcal_max=wcal_sol[in_ima_ncol-1]-(rv_ccf[rv_ccf_size-1]-bar_v+d_secular_red)*           
00776            wcal_sol[in_ima_ncol-1]/FLAMES_SPEED_OF_LIGHT;
00777 
00778 
00779 /*
00780 >From the python version:
00781 
00782 ll_max=ll_map[order,-1]-(RV_CCF[-1]-berv+D_secular_red)*ll_map[order,-1]/speed_of_light
00783 */ 
00784   /* Filter wcenter,wsize,weight to include holes whose center is within the
00785      limits wcal_min and wcal_max
00786   */
00787 
00788   for(i=0;i<in_msk_nrow;i++){
00789     if((msk_hole_cen[i]>wcal_min) && (msk_hole_cen[i]<wcal_max)) {
00790       msk_hole_cen_selr[sel_no]=msk_hole_cen[i];
00791       msk_hole_siz_selr[sel_no]=msk_hole_siz[i];
00792       msk_hole_wgt_selr[sel_no]=msk_hole_wgt[i];
00793       sel_no++;
00794     }
00795   }
00796   *tot_line=sel_no;
00797 
00798   if(sel_no) {
00799     /* If at least one is left after filtering the mask */
00800     *wcal_range_ord=0.;
00801   /* we get the velocity bins were the CCF is going to be computed 
00802      corrected for bar_v */
00803     for(i=0;i<rv_ccf_size;i++){
00804         rv_ccf_cor[i]=rv_ccf[i]-bar_v; 
00805     }
00806 
00807     /* computes the ccf on the order order. 
00808 
00809        The input arguments are:
00810        msk_hole_cen_selr, centers of each hole selected on wave range criteria
00811        msk_hole_siz_selr, widths  of each hole selected on wave range criteria
00812        msk_hole_wgt_selr, weights of each hole selected on wave range criteria
00813        wcal_sol, the vector containing the correspondence pixel to 
00814                  lambda for the order order
00815        sp_flux[order] is the vector containing the intensity of each pixel
00816                   for the order order
00817        dw_map is the delta lambda between consecutive pixels
00818        rv_ccf-bar_v is the velocity bin where the CCF is going to be 
00819                     computed corrected for the BAR_V.
00820 
00821        OUTPUT arguments are:
00822        ccf_o, the ccf of the order order,
00823        pix_passed tells you how many pixels have participated in the ccf,
00824        wcal_range is the length (in Angstroms) of the region covered by the
00825                   holes which participated in the CCF 
00826                   (i.e., the sum of the vector wcal_msk_size_selr);
00827 
00828     */
00829  
00830   do_ccf_f(msk_hole_cen_selr, msk_hole_siz_selr, msk_hole_wgt_selr,  
00831        wcal_sol, sp_flux, dw_map, rv_ccf_cor, ccf_o, pix_passed_ord,
00832            wcal_range_ord, sel_no, in_ima_ncol, rv_ccf_size, in_ima_id);
00833 
00834   }
00835   else {
00836     /* there is no mas holes in the wavelength interval wcal_min, wcal_max
00837        then everything is set to zero */
00838     printf("No hole between wcal_min=%f and wcal_max=%f all set to 0. \n",
00839             wcal_min,wcal_max);
00840      for(i=0;i<rv_ccf_size;i++){
00841        /* rv_ccf[i]=0.; */
00842          ccf_o[i]=rv_ccf[i]*0.;
00843          /* ccf_o_fit[i]=ccf_o[i]; */
00844          /* ccf_o_fit is commented out as not really used */
00845      }
00846      *pix_passed_ord=0.;
00847      *wcal_range_ord=0.;
00848 
00849     ccf_o_results[0]=0.;
00850     ccf_o_results[1]=0.;
00851     ccf_o_results[2]=0.;
00852     ccf_o_results[3]=0.;
00853 
00854   }
00855  
00856 
00857   /* write results on output table */
00858 
00859   /* Free memory */
00860   free_dvector(rv_ccf_cor,0,rv_ccf_size);
00861   free_dvector(dw_map,0,in_ima_ncol);
00862   /* free_dvector(ccf_o_fit,0,in_ima_ncol); */
00863   /* ccf_o_fit is commented out as not really used */
00864   free_dvector(ccf_o_results,0,4);
00865 
00866 
00867   free_dvector(ccf_all,0,rv_ccf_size);
00868   free_dvector(ccf_all_fit,0,rv_ccf_size);
00869 
00870   free_dvector(msk_hole_cen_selr,0,in_msk_nrow);
00871   free_dvector(msk_hole_siz_selr,0,in_msk_nrow);
00872   free_dvector(msk_hole_wgt_selr,0,in_msk_nrow);
00873 
00874   return;
00875  
00876 } /* end function do_corvel */
00877 
00878 
00879 void 
00880 do_ccf_f(double* mask_ll,double* mask_d,double* mask_w,double* sp_ll,
00881          float** sp_flux,double* sp_dll,double* rv_ccf,double* ccf_o,
00882          double* pix_tot,double* ll_range_tot,int in_msk_nrow, 
00883          int in_ima_ncol, int rv_ccf_size, int in_ima_id)
00884 {
00885 
00886   /* This routine should evaluate and return:
00887      ccf_o[rv_ccf_size]-the resulting CCF for a given order (not normalized)
00888      pix_passed-a double scalar
00889      ll_range-a double scalar
00890   */ 
00891      /* iter for v */ 
00892 
00893   /* at rest the mask holes are centered on the vector mask_ll.
00894      at a velocity rv, they will be centered on 
00895      mask_ll+rv*mask_ll/FLAMES_SPEED_OF_LIGHT
00896      The blue edge of the holes (Mask_blue) is then this new center minus
00897      half of the size of the hole. The same is valid for the red edge of 
00898      the hole.
00899 
00900   */
00901 
00902   /* local variable definition-initializzation */
00903 
00904   double** covar;
00905   double** alpha;
00906 
00907   double* msk_blu=NULL;
00908   double* msk_red=NULL;
00909   double* sp_ll_prime=NULL;
00910   double* sfit=NULL;
00911   double* xfit=NULL;
00912   double* yfit=NULL;
00913   double* aa=NULL;
00914   double* erraa=NULL;
00915 
00916 
00917   int* i_blu_masques=NULL;
00918   int* i_red_masques=NULL;
00919   int* ia=NULL;
00920 
00921   double intensity_s=0;
00922   double pix=0;
00923   double ll_range=0;
00924   double norm=0;
00925   double cen=0;
00926   double sig=0;
00927   double fwhm=0;
00928   double rv=0;
00929 
00930   int i=0;
00931   int j=0;
00932   int first_hole;
00933   int midas_unit = 0;
00934   int sp_ll_sz = in_ima_ncol;
00935   int guess=0;
00936   int ndeg=6;
00937 
00938   /* Function prototype */
00939 
00940 
00941   xfit=dvector(1,rv_ccf_size);
00942   yfit=dvector(1,rv_ccf_size);
00943   sfit=dvector(1,rv_ccf_size);
00944 
00945   covar = dmatrix(1,ndeg,1,ndeg);
00946   alpha = dmatrix(1,ndeg,1,ndeg);
00947 
00948   aa=dvector(1,ndeg);
00949   erraa=dvector(1,ndeg);
00950   ia=ivector(1,ndeg);
00951   sp_ll_prime=dvector(0,in_ima_ncol);
00952   msk_blu = dvector(0,in_msk_nrow);
00953   msk_red = dvector(0,in_msk_nrow);
00954   i_blu_masques = ivector(0,in_msk_nrow);
00955   i_red_masques = ivector(0,in_msk_nrow);
00956 
00957   for(i=0;i<rv_ccf_size;i++) {
00958     rv=rv_ccf[i];
00959     sfit[i]=1.0;
00960   }
00961 
00962   for(i=0;i<rv_ccf_size;i++) {
00963     rv=rv_ccf[i];
00964     /* 
00965        we define the 1st derivative: sp_ll_prime[j]=sp_ll[j]+sp_dll[j]*0.5; 
00966        j is a counter variable of values up to sp_ll_sz equal to the No of
00967        extracted spectra definition points
00968     */
00969     for(j=0; j<sp_ll_sz; j++) {
00970       sp_ll_prime[j]=sp_ll[j]+sp_dll[j]*0.5;
00971     }
00972     for(j=0;j<in_msk_nrow;j++) {
00973        /* shift the mask holes for a velocity RV[i] */
00974       msk_blu[j]=mask_ll[j]+rv*mask_ll[j]/FLAMES_SPEED_OF_LIGHT-0.5*mask_d[j];
00975       msk_red[j]=mask_ll[j]+rv*mask_ll[j]/FLAMES_SPEED_OF_LIGHT+0.5*mask_d[j];
00976 
00977       /*  
00978       The idea is to know where (i.e. in which pixel) a given hole will start 
00979       because we won't want to scan through the vector wave to find the pixel 
00980       i where lambda(i-1) < mask_start <lambda(i). The command search_sorted 
00981       does it (see below).
00982       It returns the position where the element mask_blue will fit in the 
00983       vector lamda+delta_lambda/2.
00984       This is done for the blue edge of the mask and for the red edge. 
00985       The +1 in the end is because phython vectors starts at 0 and F77 at 1.
00986       */
00987       
00988     }
00989     /*
00990     Look for the first and the last holes available for the crooss-correlation
00991     assuming the spectrum has a dimension nspec and sp_ll(nspec) and 
00992     flux(nspec) are the wavelength and spectral flux vectors
00993 
00994     Then finds the first hole such as
00995     wave[0]<=mask_blu[first_hole] && mask_red[first_hole-1]<wave[0]
00996     find last_hole such as 
00997     wave[nspec]>=mask_red[first_hole] && mask_red[first_hole+1]>wave[nspec]
00998     
00999     This search is done using
01000     find_pos_d(vector,len(vector),x,i,j,guess)
01001     which returns the index of the element in the vector such as
01002     vector[i]<=x<vector[i+1]
01003     The search is carried out between the elements:
01004     vector[i] and vector[j]
01005     and using "guess" and first "guess" for the position of "x" within "vector"
01006 
01007     (see NR F77 chapter 3.4)
01008     */
01009     
01010     first_hole=hunt(msk_blu-1, in_msk_nrow, sp_ll[0],0);
01011     guess=first_hole;
01012 
01013     for(j=0;j<in_msk_nrow;j++) {
01014       //for(j=0;j<3;j++) {
01015 
01016        i_blu_masques[j]=hunt(sp_ll_prime-1,sp_ll_sz,msk_blu[j],0)+1;
01017 
01018        guess=i_blu_masques[j];
01019        i_red_masques[j]=hunt(sp_ll_prime-1,sp_ll_sz,msk_red[j],guess)+1;
01020        guess=i_red_masques[j];
01021        //uves_msg_debug("masques: %d %d",i_blu_masques[j],i_red_masques[j]);
01022 
01023     }
01024   correl_bin(sp_ll_sz,sp_flux,sp_ll,sp_dll,
01025             &in_msk_nrow,msk_blu,msk_red,mask_w,i_blu_masques,
01026             i_red_masques,&intensity_s,&pix,&ll_range);
01027 
01028   ccf_o[i]=intensity_s;
01029 
01030   }
01031   *pix_tot+=pix;
01032   *ll_range_tot+=ll_range;
01033   for(i=0;i<rv_ccf_size;i++) {
01034     j=i+1;
01035     xfit[j]=rv_ccf[i];
01036     yfit[j]=ccf_o[i];
01037     sfit[j]=1;
01038   }
01039 
01040   aa[1]=300;
01041   aa[2]=0;
01042   aa[3]=1;
01043   aa[4]=1.;
01044 
01045 
01046   ia[1]=1;
01047   ia[2]=1;
01048   ia[3]=1;
01049   ia[4]=0;
01050 
01051   /*
01052   lfit(xfit,yfit,sfit,rv_ccf_size,aa,ia,3,covar,&chisq,fgauss); 
01053   non_lfit(xfit,yfit,sfit,rv_ccf_size,aa,ndeg,ia,4,fgauss,erraa,&chisq); 
01054   alambda=-1.0;
01055   mrqmin(xfit,yfit,sfit,rv_ccf_size,aa,ndeg,ia,mfit,covar,alpha,&chisq,
01056          fgauss,&alambda); 
01057   */
01058 
01059 
01060   gaussian_fit(rv_ccf,ccf_o,rv_ccf_size,&norm,&cen,&sig,&fwhm);
01061 
01062   /* write output in descriptor */
01063   uves_msg_debug("Position max corvel=%f",cen);
01064   SCDWRD(in_ima_id,"CORVEL_MAX",&cen,1,1,&midas_unit);
01065 
01066 
01067 
01068   /* Free allocated memory */
01069   free_dmatrix(covar,1,ndeg,1,ndeg);
01070   free_dmatrix(alpha,1,ndeg,1,ndeg);
01071 
01072   free_dvector(aa,1,ndeg);
01073   free_dvector(erraa,1,ndeg);
01074   free_ivector(ia,1,ndeg);
01075  
01076   free_dvector(xfit,1,rv_ccf_size);
01077   free_dvector(yfit,1,rv_ccf_size);
01078   free_dvector(sfit,1,rv_ccf_size);
01079 
01080   free_dvector(msk_blu,0,in_msk_nrow);
01081   free_dvector(msk_red,0,in_msk_nrow);
01082   free_ivector(i_blu_masques,0,in_msk_nrow);
01083   free_ivector(i_red_masques,0,in_msk_nrow);
01084 
01085   free_dvector(sp_ll_prime,0,in_ima_ncol);
01086   
01087 } /* end function do_ccf_f */
01088 
01089 void 
01090 correl_bin(int nx,        /* in: dimension of flux (is it necessary?) */
01091         float** flux,   /* in: Spectral flux (dim nx) */
01092         double *ll,        /* in: wavelength (dim nx) */
01093         double *dll,    /* in: Delta(lambda) D_ll (dim nx) */
01094         int *nbr_trou,  /* in: Number of holes read from the mask file */
01095         double *ll_s,   /* in: Mask hole start wavelength (dim nbr_trou) */
01096         double *ll_e,   /* in: Mask hole end wavelength (dim nbr_trou) */
01097         double *ll_wei, /* in: Mask hole weight wavelength (dim nbr_trou) */
01098         int *i_start,   /* in: see python code (page 9 line 76-77)  */
01099         int *i_end,        /* in: see python code (page 9 line 76-77)  */
01100         double *out_ccf, /* out: Value of the CCF for a given velocity 
01101                                 point */
01102         double *pix,     /* out: number of pixelx used in the 
01103                                 computation of the CCF */
01104         double *llrange) /* out: wavelenght interval covered by the 
01105                                 pixels used in computation of the CCF */
01106 {
01107 
01108     /* pointers */
01109     
01110     float *pflux=NULL;
01111     double *pll=NULL;
01112     double *pdll=NULL;
01113     double *pll_s=NULL;
01114     double *pll_e=NULL;
01115     double *pll_wei=NULL;
01116     int *pi_start=NULL;
01117     int *pi_end=NULL;
01118     int trou=0;
01119     int i=0;
01120 
01121     pflux = *flux;
01122     pll   = ll;
01123     pdll  = dll;
01124     pll_s = ll_s;
01125     pll_e = ll_e;
01126     pll_wei = ll_wei;
01127     pi_start = i_start;
01128     pi_end   = i_end;
01129     
01130 
01131     /*local param */
01132     
01133     
01134     *out_ccf=0.0;
01135     *pix=0.0;
01136     *llrange=0.0;
01137 
01138     
01139     for (trou=0;trou < *nbr_trou;trou++) {
01140         
01141       if (pi_start[trou] == pi_end[trou]) {
01142          *out_ccf=*out_ccf+(pll_e[trou]-pll_s[trou])/pdll[pi_start[trou]]*
01143                pflux[pi_start[trou]]*(pll_wei[trou]);
01144                  
01145          *pix=*pix+(pll_e[trou]-pll_s[trou])*pll_wei[trou]/
01146                    pdll[pi_start[trou]];
01147             
01148          *llrange=*llrange+(pll_e[trou]-pll_s[trou])*pll_wei[trou];
01149             
01150       } else if (pi_start[trou]+1 == pi_end[trou]) {
01151             
01152          *out_ccf=*out_ccf+
01153                    ((pll[pi_start[trou]]+pdll[pi_start[trou]]*.5-pll_s[trou])*
01154                  pflux[pi_start[trou]]/pdll[pi_start[trou]]+
01155            (pll_e[trou]-(pll[pi_start[trou]]+pdll[pi_start[trou]]*.5))*
01156               pflux[pi_end[trou]]/pdll[pi_start[trou]])*pll_wei[trou];
01157                 
01158              *pix=*pix+((pll[pi_start[trou]]+pdll[pi_start[trou]]*.5-
01159                   pll_s[trou])/pdll[pi_start[trou]]+
01160         (pll_e[trou]-(pll[pi_start[trou]]+pdll[pi_start[trou]]*.5))/
01161         pdll[pi_end[trou]])*pll_wei[trou];
01162                 
01163  
01164          *llrange=*llrange+((pll[pi_start[trou]]+pdll[pi_start[trou]]*.5-
01165                       pll_s[trou])+
01166         (pll_e[trou]-(pll[pi_start[trou]]+pdll[pi_start[trou]]*.5)))*
01167                       pll_wei[trou];
01168 
01169 
01170       } else {
01171         
01172          *out_ccf=*out_ccf+((pll[pi_start[trou]]+pdll[pi_start[trou]]*0.5-
01173                       pll_s[trou])*pflux[pi_start[trou]]/pdll[pi_start[trou]]+
01174                (pll_e[trou]-(pll[pi_end[trou]]-pdll[pi_end[trou]]*.5))*
01175             pflux[pi_end[trou]]/pdll[pi_end[trou]])*pll_wei[trou];
01176 
01177               *pix=*pix+
01178            ((pll[pi_start[trou]]+pdll[pi_start[trou]]*0.5-pll_s[trou])/
01179             pdll[pi_start[trou]]+
01180             (pll_e[trou]-(pll[pi_end[trou]]-pdll[pi_end[trou]]*.5))/
01181             pdll[pi_end[trou]])*pll_wei[trou];
01182 
01183                *llrange=*llrange+
01184           ((pll[pi_start[trou]]+pdll[pi_start[trou]]*0.5-pll_s[trou])+
01185            (pll_e[trou]-(pll[pi_end[trou]]-pdll[pi_end[trou]]*.5)))
01186             *pll_wei[trou];
01187 
01188           for (i=pi_start[trou]+1;i<=pi_end[trou]-1;i++) {
01189 
01190                   *out_ccf=*out_ccf+pflux[i]*pll_wei[trou];
01191                   *pix=*pix+pll_wei[trou];
01192                   *llrange=*llrange+pdll[i]*pll_wei[trou];
01193          }
01194       }
01195         }
01196 } /* end function correl_bin */
01197             
01198             
01199 void
01200 fit_ccf(double* rv_ccf,double* ccf_nor,int type,double* ccf_res,
01201         double* ccf_fit)
01202 {
01203   /* Gaussian Fit either in emission or in absorbtion depending on the flag, 
01204      emission for the ThAr 
01205      It first computes a single fit in order to find the first guess 
01206      parameters. Then it does the fit again now putting more weight on the 
01207      core of the Gaussian. It returns the fit coefficients and the fitted 
01208      function.
01209 
01210 */
01211 
01212 } /* end function fit_ccf */
01213 
01214 
01215 
01216 
01217   
01218 int 
01219 hunt(double* xx, int n, double x, int jlo) {
01220 
01221     int jm, jhi, inc;
01222     int ascnd;
01223     
01224     ascnd=(xx[n] >= xx[1]);
01225     if (jlo <= 0 || jlo >n) {
01226         jlo=0;
01227         jhi=n+1;
01228     } else {
01229         inc=1;
01230         if ((x>=xx[jlo]) == ascnd) {
01231             if (jlo == n) return jlo-1;
01232             jhi=jlo+1;
01233             while ((x>=xx[jhi]) == ascnd) {
01234                 jlo=jhi;
01235                 inc +=inc;
01236                 jhi=jlo+inc;
01237                 if (jhi>n) {
01238                     jhi=n+1;
01239                     break;
01240                 }
01241             }
01242         } else {
01243             if (jlo==1) {
01244                 jlo=0;
01245                 return jlo-1;
01246             }
01247             jhi=jlo--;
01248             while ((x<xx[jlo])==ascnd) {
01249                 jhi=jlo;
01250                 inc <<=1;
01251                 if (inc >= jhi) {
01252                     jlo=0;
01253                     break;
01254                 }
01255                 else jlo=jhi-inc;
01256             }
01257         }
01258     }
01259     while ((jhi-jlo) != 1) {
01260         jm=(jhi+jlo) >> 1;
01261         if ( (x >= xx[jm]) ==ascnd)
01262             jlo=jm;
01263         else
01264             jhi=jm;
01265     }
01266     if (x == xx[n]) jlo=n-1;
01267     if (x == xx[1]) jlo=1;
01268 
01269     return jlo-1;
01270 } /* end function hunt */
01271 
01272 
01273 /*
01274 void fgauss(double x,double g[],int ng)
01275 {
01276     int i=0;
01277     double arg=0.0;
01278     double ex=0.0;
01279     double fac=0.0;
01280     arg=(x-g[2])/g[3];
01281     ex=exp(-arg*arg);
01282     fac=g[4]+g[1]*ex*2.0*arg;
01283     return fac;
01284 }
01285 */
01286 
01287 
01288  /*
01289 static double 
01290 fgauss(double x,double a[],double y,double dyda[],int na)
01291 {
01292     double arg=0.0;
01293     double ex=0.0;
01294     double fac=0.0;
01295    
01296     arg=(x-a[2])/a[3];
01297     ex=exp(-arg*arg);
01298     fac=a[4]+a[1]*ex*2.0*arg;
01299     y = a[4]+fac;
01300 
01301     dyda[1]=ex;
01302     dyda[2]=fac/a[2];
01303     dyda[3]=fac*arg/a[2];
01304     dyda[4]=0;
01305     return fac;
01306 }
01307  */
01308 
01309 /*
01310 static void 
01311 fpoly(double x,double p[],int np)
01312 {
01313     int j=0;
01314     p[1]=1;
01315     for (j=2; j<=np;j++) p[j]=p[j-1]*x;
01316 }
01317 */
01318 
01319 
01320 static void
01321 gaussian_fit(const double *   x,
01322              const double *   y,
01323                    int        size,
01324                    double *   norm,
01325                    double *   xcen,
01326                    double *   sig_x,
01327                    double *   fwhm_x) 
01328 {
01329     double          u0, ux, uxx;
01330     double          max_val ;
01331     int             i;
01332 
01333     /* Check entries */
01334     /* Extraction zone */
01335     
01336     /* Extract the image zone to fit */
01337     /* Check if there are enough good pixels */
01338     /* Convert the image to double */
01339     /* Compute xcen  */
01340     u0 = ux = 0.0 ;
01341     for (i=0 ; i<size ; i++) {
01342         u0 += y[i] ;
01343         ux += x[i] * y[i] ;
01344     }
01345     /* Compute sig_x  */
01346     uxx = 0.0 ;
01347     for (i=0 ; i<size ; i++) {
01348         uxx += (x[i]-(ux/u0)) * (x[i]-(ux/u0)) * y[i] ;
01349     }
01350     if (sig_x) *sig_x = sqrt(fabs(uxx/u0)) ;
01351     if (fwhm_x) *fwhm_x = 2 * sqrt(2 * log(2.0)) * sqrt(fabs(uxx/u0)) ;
01352 
01353     max_val=y[0];
01354     for (i=1 ; i<size ; i++) {
01355       if(y[i] > max_val) max_val=y[i];
01356     }
01357     /* Compute norm */
01358     if (norm) *norm = max_val*2*M_PI*sqrt(fabs(uxx/u0)) ; 
01359     
01360     /* Shift xcen and ycen to coordinates in the input big image */
01361     if (xcen) *xcen = ux/u0;
01362     
01363 }

Generated on 8 Mar 2011 for UVES Pipeline Reference Manual by  doxygen 1.6.1