visir_spectro.c

00001 /* $Id: visir_spectro.c,v 1.209 2010/09/30 06:49:14 llundin Exp $
00002  *
00003  * This file is part of the VISIR Pipeline
00004  * Copyright (C) 2002,2003 European Southern Observatory
00005  *
00006  * This program is free software; you can redistribute it and/or modify
00007  * it under the terms of the GNU General Public License as published by
00008  * the Free Software Foundation; either version 2 of the License, or
00009  * (at your option) any later version.
00010  *
00011  * This program is distributed in the hope that it will be useful,
00012  * but WITHOUT ANY WARRANTY; without even the implied warranty of
00013  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
00014  * GNU General Public License for more details.
00015  *
00016  * You should have received a copy of the GNU General Public License
00017  * along with this program; if not, write to the Free Software
00018  * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA
00019  */
00020 
00021 /*
00022  * $Author: llundin $
00023  * $Date: 2010/09/30 06:49:14 $
00024  * $Revision: 1.209 $
00025  * $Name: HEAD $
00026  */
00027 
00028 #ifdef HAVE_CONFIG_H
00029 #include <config.h>
00030 #endif
00031 
00032 /*-----------------------------------------------------------------------------
00033                                    Includes
00034  -----------------------------------------------------------------------------*/
00035 
00036 #include <string.h>
00037 #include <math.h>
00038 #include <float.h>
00039 #include <assert.h>
00040 
00041 #include <cpl.h>
00042 
00043 #include "irplib_framelist.h"
00044 
00045 #include "visir_utils.h"
00046 #include "visir_pfits.h"
00047 #include "visir_inputs.h"
00048 #include "visir_spectro.h"
00049 
00050 /*----------------------------------------------------------------------------*/
00056 /*----------------------------------------------------------------------------*/
00057 
00058 /*-----------------------------------------------------------------------------
00059                             Private Function Prototypes
00060  -----------------------------------------------------------------------------*/
00061 static cpl_bivector * visir_spc_extract(cpl_image *, cpl_propertylist *,
00062                                         cpl_image **, int);
00063 
00064 static cpl_bivector * visir_bivector_load_fits(const char *, const char*,
00065                                                const char*);
00066 static cpl_error_code visir_bivector_interpolate(cpl_bivector *,
00067                                                  const cpl_bivector *);
00068 
00069 static cpl_error_code visir_spc_emission(cpl_bivector *, const cpl_vector *,
00070                                          const cpl_bivector *,
00071                                          const cpl_bivector *,
00072                                          const cpl_vector *, double);
00073 
00074 static cpl_polynomial * visir_spc_phys_disp(int, double, visir_spc_resol, int);
00075 static cpl_error_code visir_vector_convolve_symm(cpl_vector *,
00076                                                  const cpl_vector *);
00077 static cpl_image * visir_spc_flip(const cpl_image *, double, visir_spc_resol);
00078 static cpl_error_code visir_spc_xcorr(cpl_vector *, cpl_bivector *,
00079                                       cpl_vector *, const cpl_vector *,
00080                                       const cpl_bivector *,
00081                                       const cpl_bivector *,
00082                                       const cpl_vector *, const cpl_polynomial *,
00083                                       double, int, double, double *, int *);
00084 
00085 static cpl_vector * cpl_spc_convolve_init(int, double, double, int);
00086 
00087 static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist *,
00088                                                 int, double, double,
00089                                                 const cpl_polynomial *,
00090                                                 const cpl_polynomial *);
00091 
00092 static cpl_error_code visir_spectro_qclist_obs(cpl_propertylist *,
00093                                                double, double);
00094 
00095 static const double N_upper = 13.4e-6; /* Upper limit of N-band */
00096 static const double whechelle = 35.8/2; /* Half the echelle width */
00097 
00098 #ifndef VISIR_XC_LEN
00099 #define VISIR_XC_LEN 50
00100 #endif
00101 #ifndef VISIR_XC_FLEN
00102 #define VISIR_XC_FLEN 3
00103 #endif
00104 #ifndef VISIR_XC_SUBSEARCH
00105 #define VISIR_XC_SUBSEARCH 100
00106 #endif
00107 
00108 #ifndef VISIR_SPECTRO_SIGMA
00109 #define VISIR_SPECTRO_SIGMA 3.0
00110 #endif
00111 
00114 /*-----------------------------------------------------------------------------
00115                                 Function code
00116  -----------------------------------------------------------------------------*/
00117 
00118 /*----------------------------------------------------------------------------*/
00133 /*----------------------------------------------------------------------------*/
00134 visir_spc_resol visir_spc_get_res_wl(const irplib_framelist * rawframes,
00135                                      double * pwlen, double * pslitw,
00136                                      double * ptemp, double * pfwhm)
00137 {
00138     cpl_errorstate cleanstate = cpl_errorstate_get();
00139      /* Avoid (false) uninit warning */
00140     visir_spc_resol    resol = VISIR_SPC_R_ERR;
00141     char               ptmp[IRPLIB_FITS_STRLEN+1];
00142     double             wl, spx;
00143     double             sl = 0.0; /* Avoid (false) uninit warning */
00144     cpl_boolean        need_temp = ptemp != NULL;
00145     int                n;
00146     int                i;
00147 
00148     /* Check entries */
00149     cpl_ensure(rawframes != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
00150     cpl_ensure(pwlen     != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
00151     cpl_ensure(pslitw    != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
00152     cpl_ensure(pfwhm     != NULL, CPL_ERROR_NULL_INPUT, VISIR_SPC_R_ERR);
00153 
00154     n = irplib_framelist_get_size(rawframes);
00155 
00156     cpl_ensure(n > 0, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);
00157 
00158      /* Allow 1 nm difference */
00159     skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_WLEN,
00160                                       CPL_TYPE_DOUBLE, CPL_TRUE, 1e-3));
00161 
00162      /* Allow 1 micron difference */
00163     skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_PIXSPACE,
00164                                       CPL_TYPE_DOUBLE, CPL_TRUE, 1e-6));
00165 
00166     /* The actual value depends on the age of the file :-( */
00167     skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_DOUBLE_SLITWIDTH,
00168                                       CPL_TYPE_DOUBLE, CPL_FALSE, 0.0));
00169 
00170     skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_RESOL,
00171                                       CPL_TYPE_STRING, CPL_TRUE, 0.0));
00172 
00173     skip_if(irplib_framelist_contains(rawframes, VISIR_PFITS_STRING_SLITNAME,
00174                                       CPL_TYPE_STRING, CPL_TRUE, 0.0));
00175 
00176     for (i=0; i < n; i++) {
00177         const cpl_propertylist * plist;
00178         const char * filename =
00179             cpl_frame_get_filename(irplib_framelist_get_const(rawframes, i));
00180         const char * pfits;
00181         double             wl_tmp, sl_tmp, spx_tmp;
00182 
00183 
00184         cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
00185                       VISIR_SPC_R_ERR);
00186 
00187         cpl_ensure(filename != NULL, CPL_ERROR_DATA_NOT_FOUND,
00188                       VISIR_SPC_R_ERR);
00189 
00190         plist = irplib_framelist_get_propertylist_const(rawframes, i);
00191 
00192         cpl_ensure(plist != NULL, CPL_ERROR_DATA_NOT_FOUND, VISIR_SPC_R_ERR);
00193 
00194         wl_tmp = visir_pfits_get_wlen(plist); 
00195         sl_tmp = visir_pfits_get_slitwidth(plist);
00196         spx_tmp = visir_pfits_get_pixspace(plist);
00197         pfits = visir_pfits_get_resol(plist);
00198         
00199         cpl_ensure(!cpl_error_get_code(), CPL_ERROR_DATA_NOT_FOUND,
00200                       VISIR_SPC_R_ERR);
00201 
00202         if (i == 0) {
00203             
00204             visir_optmod ins_settings;
00205 
00206             sl = sl_tmp;
00207             spx = spx_tmp;
00208             wl = wl_tmp;
00209 
00210             /* Divide the slit width with the
00211                Spectral PFOV = 0.127 Arcseconds/pixel */
00212             /* FIXME: The Spectral PFOV may change with a new detector */
00213             *pslitw = sl / 0.127; /* Convert Slit width from Arcseconds to pixel */
00214 
00215             *pwlen = wl * 1e-6; /* Convert from micron to m */
00216 
00217             strncpy(ptmp, pfits, IRPLIB_FITS_STRLEN);
00218             ptmp[IRPLIB_FITS_STRLEN] = '\0';
00219 
00220             cpl_msg_info(cpl_func, "RESOL [LR|MR|HRS|HRG] and WLEN [m] (%d frames)"
00221                          ": %s %g", n, ptmp, *pwlen);
00222 
00223             if (spx <= 0) {
00224                 cpl_msg_error(cpl_func,"Pixel Spacing (%g) in %s is non-positive",
00225                               spx, filename);
00226                 cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
00227             }
00228 
00229             if (*pslitw <= 0) {
00230                 cpl_msg_error(cpl_func,"Slit Width (%g) in %s is non-positive",
00231                               sl, filename);
00232                 cpl_ensure(0, CPL_ERROR_ILLEGAL_INPUT, VISIR_SPC_R_ERR);
00233             }
00234 
00235             cpl_msg_info(cpl_func, "Slit Width [pixel] and Pixel Spacing [m]: "
00236                          "%g %g", *pslitw, spx);
00237 
00238             if (!strcmp("LR", ptmp)) {
00239                 resol = VISIR_SPC_R_LR;
00240             } else if (!strcmp("MR", ptmp)) {
00241                 resol = VISIR_SPC_R_MR;
00242             } else if (!strcmp("HRS", ptmp)) {
00243                 resol = VISIR_SPC_R_HR;
00244             } else if (!strcmp("HRG", ptmp)) {
00245                 resol = VISIR_SPC_R_GHR;
00246             } else {
00247                 cpl_msg_error(cpl_func,"Unsupported resolution (%s) in %s",
00248                               ptmp, filename);
00249                 cpl_ensure(0, CPL_ERROR_UNSUPPORTED_MODE, VISIR_SPC_R_ERR);
00250             }
00251             if (visir_spc_optmod_init(resol, *pwlen, &ins_settings)) {
00252                 cpl_msg_error(cpl_func, "Resolution %s does not support "
00253                               "Central Wavelength [m]: %g", ptmp, *pwlen);
00254                 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
00255             }
00256 
00257             cpl_msg_info(cpl_func, "The %s-Spectral Resolution at %gm: %g",
00258                          ptmp, *pwlen,
00259                          visir_spc_optmod_resolution(&ins_settings));
00260             cpl_msg_info(cpl_func, "The %s-Linear Dispersion at %gm [pixel/m]: "
00261                          "%g", ptmp, *pwlen,
00262                          visir_spc_optmod_dispersion(&ins_settings));
00263 
00264             *pfwhm  = *pwlen * visir_spc_optmod_dispersion(&ins_settings)
00265                 / visir_spc_optmod_resolution(&ins_settings);
00266 
00267             cpl_msg_info(cpl_func, "The %s-FWHM at %gm [pixel]: %g",
00268                          ptmp, *pwlen, *pfwhm);
00269         } else {
00270             if (fabs(sl-sl_tmp) > 1e-3) { /* Allow 1 micron difference */
00271                 cpl_msg_error(cpl_func, "Inconsistent slit width (%g <=>"
00272                               " %g) in %s (%d of %d)",
00273                               sl, sl_tmp, filename, i+1, n);
00274                 cpl_ensure(0, CPL_ERROR_INCOMPATIBLE_INPUT, VISIR_SPC_R_ERR);
00275             }
00276         }
00277         if (need_temp) {
00278             /* Temperature [Celcius] not yet found */
00279             const double temp = visir_pfits_get_temp(plist);
00280             if (cpl_error_get_code()) {
00281                 visir_error_reset("Could not get FITS key");
00282             } else if ((-20 < temp) && (temp < 60)) {
00283                 /* Only accept a non-extreme temperature */
00284                 need_temp = CPL_FALSE;
00285                 *ptemp = temp;
00286             }
00287         }
00288 
00289     }
00290 
00291     if (need_temp) {
00292         cpl_msg_warning(cpl_func, "No FITS-files specify the M1 temperature, "
00293                      "using default");
00294         *ptemp = 10; /* Default is 10 Celcius */
00295     }
00296 
00297 
00298     if (ptemp != NULL) {
00299         *ptemp += 273.15; /* Convert to Kelvin */
00300         cpl_msg_info(cpl_func, "The M1 temperature [Kelvin]: %g", *ptemp);
00301     }
00302 
00303     end_skip;
00304 
00305     return resol;
00306 
00307 }
00308 
00309 /*----------------------------------------------------------------------------*/
00330 /*----------------------------------------------------------------------------*/
00331 cpl_error_code visir_vector_resample(cpl_vector * self, 
00332                                      const cpl_vector * xbounds,
00333                                      const cpl_bivector * source)
00334 {
00335 
00336     const cpl_vector * xsource  = cpl_bivector_get_x_const(source);
00337     const cpl_vector * ysource  = cpl_bivector_get_y_const(source);
00338 
00339     const double     * pxsource = cpl_vector_get_data_const(xsource);
00340     const double     * pysource = cpl_vector_get_data_const(ysource);
00341     const double     * pxbounds = cpl_vector_get_data_const(xbounds);
00342 
00343 
00344     cpl_vector   * ybounds  = cpl_vector_new(cpl_vector_get_size(xbounds));
00345     cpl_bivector * boundary = cpl_bivector_wrap_vectors((cpl_vector*)xbounds,
00346                                                         ybounds);
00347     double       * pybounds = cpl_vector_get_data(ybounds);
00348 
00349     double       * pself  = cpl_vector_get_data(self);
00350     const int      npix     = cpl_vector_get_size(self);
00351     int i;
00352     int itt;
00353 
00354 
00355     cpl_ensure_code(cpl_bivector_get_size(boundary) == npix + 1,
00356                         CPL_ERROR_ILLEGAL_INPUT);
00357 
00358     skip_if (0);
00359 
00360     itt = cpl_vector_find(xsource, pxbounds[0]);
00361 
00362     skip_if (0);
00363 
00364     skip_if (visir_bivector_interpolate(boundary, source));
00365 
00366     /* At this point itt most likely points to element just below
00367        pxbounds[0] */
00368     while (pxsource[itt] < pxbounds[0]) itt++;
00369 
00370     for (i=0; i < npix; i++) {
00371 
00372         /* The i'th value is the weighted average of the two interpolated
00373            values at the boundaries and the source values in between */
00374 
00375         double xlow  = pxbounds[i];
00376         double x     = pxsource[itt];
00377 
00378         if (x > pxbounds[i+1]) x = pxbounds[i+1];
00379         /* Contribution from interpolated value at lower boundary */
00380         pself[i] = pybounds[i] * (x - xlow);
00381 
00382         /* Contribution from table values in between boundaries */
00383         while (pxsource[itt] < pxbounds[i+1]) {
00384             const double xprev = x;
00385             x = pxsource[itt+1];
00386             if (x > pxbounds[i+1]) x = pxbounds[i+1];
00387             pself[i] += pysource[itt] * (x - xlow);
00388             xlow = xprev;
00389             itt++;
00390         }
00391 
00392         /* Contribution from interpolated value at upper boundary */
00393         pself[i] += pybounds[i+1] * (pxbounds[i+1] - xlow);
00394 
00395         /* Compute average by dividing integral by length of sampling interval
00396            (the factor 2 comes from the contributions) */
00397         pself[i] /= 2 * (pxbounds[i+1] - pxbounds[i]);
00398 
00399     }
00400 
00401 
00402     end_skip;
00403 
00404     cpl_vector_delete(ybounds);
00405     cpl_bivector_unwrap_vectors(boundary);
00406 
00407     return cpl_error_get_code();
00408 }
00409 
00410 
00411 
00412 /*----------------------------------------------------------------------------*/
00436 /*----------------------------------------------------------------------------*/
00437 cpl_error_code visir_spc_extract_wcal(const cpl_image * combined,
00438                                       const cpl_image * hcycle,
00439                                       double wlen, double slitw,
00440                                       double temp, double fwhm,
00441                                       visir_spc_resol resol,
00442                                       int ioffset,
00443                                       const char * spc_cal_lines,
00444                                       const char * spc_cal_qeff,
00445                                       cpl_table ** pspc_table,
00446                                       cpl_image ** pweight2d,
00447                                       cpl_propertylist * qclist,
00448                                       int doplot)
00449 {
00450 
00451     /* Both spectrum and error */
00452     cpl_bivector  * spc_n_err = NULL;
00453     cpl_image     * flipped   = NULL;
00454     const int       npix = cpl_image_get_size_y(combined);
00455 
00456 
00457     cpl_ensure_code(pweight2d != NULL, CPL_ERROR_NULL_INPUT);
00458 
00459     *pweight2d = NULL;
00460 
00461     cpl_ensure_code(npix > 0, CPL_ERROR_ILLEGAL_INPUT);
00462     cpl_ensure_code(npix == cpl_image_get_size_y(hcycle),
00463                         CPL_ERROR_ILLEGAL_INPUT);
00464 
00465 
00466     skip_if (0);
00467 
00468     skip_if (visir_spc_wavecal(hcycle, qclist, wlen, slitw, temp, fwhm, resol,
00469                                ioffset, spc_cal_lines, spc_cal_qeff,
00470                                pspc_table, doplot));
00471 
00472     /* Convert the combined image */
00473     flipped = visir_spc_flip(combined, wlen, resol);
00474     skip_if (0);
00475 
00476     /* Extract spectrum with error from the combined image */
00477     /* FIXME: Move inside */
00478     spc_n_err = visir_spc_extract(flipped, qclist, pweight2d,
00479                                   doplot);
00480     skip_if (0);
00481 
00482     cpl_image_delete(flipped);
00483     flipped = NULL;
00484 
00485     skip_if (*pspc_table == NULL);
00486 
00487     skip_if (cpl_table_new_column(*pspc_table, "SPC_EXTRACTED", CPL_TYPE_DOUBLE));
00488     skip_if (cpl_table_new_column(*pspc_table, "SPC_ERROR", CPL_TYPE_DOUBLE));
00489 
00490     skip_if (cpl_table_set_column_unit(*pspc_table, "SPC_EXTRACTED", "ADU/s"));
00491     skip_if (cpl_table_set_column_unit(*pspc_table, "SPC_ERROR", "ADU/s"));
00492 
00493     skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_EXTRACTED", 
00494                                         cpl_bivector_get_x_data(spc_n_err)));
00495     skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_ERROR", 
00496                                         cpl_bivector_get_y_data(spc_n_err)));
00497 
00498     if (doplot) {
00499         visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
00500                          "t 'Extracted Spectrum' w linespoints",
00501                          "", *pspc_table, "WLEN", "SPC_EXTRACTED");
00502         visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
00503                          "t 'Error on Extracted Spectrum' w linespoints",
00504                          "", *pspc_table, "WLEN", "SPC_ERROR");
00505     }
00506 
00507     end_skip;
00508 
00509     cpl_image_delete(flipped);
00510     cpl_bivector_delete(spc_n_err);
00511 
00512     return cpl_error_get_code();
00513 }
00514 
00515 
00516 /*----------------------------------------------------------------------------*/
00541 /*----------------------------------------------------------------------------*/
00542 cpl_error_code visir_spc_wavecal(const cpl_image * hcycle,
00543                                  cpl_propertylist * qclist,
00544                                  double wlen, double slitw,
00545                                  double temp, double fwhm,
00546                                  visir_spc_resol resol,
00547                                  int ioffset,
00548                                  const char * linefile,
00549                                  const char * qefffile,
00550                                  cpl_table ** pspc_table, int doplot)
00551 {
00552 
00553     /* Dispersion relation from physical model */
00554     cpl_polynomial * phdisp = NULL;
00555     /* Dispersion relation corrected by cross-correlation */
00556     cpl_polynomial * xcdisp = NULL;
00557 
00558     cpl_bivector * emission = NULL;
00559     cpl_vector   * boundary = NULL;
00560 
00561     cpl_bivector * temiss = NULL;
00562     cpl_bivector * tqeff  = NULL;
00563 
00564     cpl_image    * corrected = NULL;
00565 
00566     cpl_image    * xc_image  = NULL;
00567     cpl_vector   * xc_vector = NULL;
00568     cpl_bivector * xc_subres = NULL;
00569 
00570     cpl_vector   * vsymm   = NULL;
00571 
00572     cpl_vector   * vxc       = NULL;
00573 
00574     cpl_vector   * xc_subresx;
00575     cpl_vector   * xc_subresy;
00576 
00577     const int      npix = cpl_image_get_size_y(hcycle);
00578     int            delta, bestdelta, rawdelta;
00579     double         subdelta;
00580     double         xc0;
00581     double         qcxc, qcsubdelta;
00582     double         hc_min;
00583     int            convohlen;
00584     int            xc_flen;
00585     const int      i0 = 0;
00586     const int      i1 = 1;
00587     int            i;
00588     int            minpos;
00589     double       * pemiss;
00590     cpl_vector   * xemiss;
00591 
00592 
00593     assert( VISIR_XC_LEN >=0 && VISIR_XC_FLEN >=0);
00594     assert( VISIR_XC_SUBSEARCH == 1 ||
00595            (VISIR_XC_SUBSEARCH  > 1 && (VISIR_XC_SUBSEARCH&1)) == 0);
00596 
00597     cpl_ensure_code(!cpl_error_get_code(), cpl_error_get_code());
00598     cpl_ensure_code(pspc_table, CPL_ERROR_NULL_INPUT);
00599     cpl_ensure_code(npix > 0,   CPL_ERROR_ILLEGAL_INPUT);
00600 
00601 
00602     /* Make sure the corrected image is of type double */
00603     corrected = cpl_image_cast(hcycle, CPL_TYPE_DOUBLE);
00604     skip_if (0);
00605 
00606     hc_min = cpl_image_get_min(corrected);
00607     skip_if (0);
00608     cpl_msg_info(cpl_func,"Half-cycle image [%d X %d] has minimum intensity: %g",
00609                  cpl_image_get_size_x(hcycle), npix, hc_min);
00610     if (hc_min < 0) {
00611         cpl_msg_warning(cpl_func, "Thresholding negative intensities in half-"
00612                         "cycle image: %g", hc_min);
00613         skip_if (cpl_image_threshold(corrected, 0.0, DBL_MAX, 0.0, DBL_MAX));
00614     } else if (hc_min > 0) {
00615         skip_if (cpl_image_subtract_scalar(corrected, hc_min));
00616     }      
00617 
00618     /* Average the spatial dimension - into a cpl_vector */
00619     xc_image = cpl_image_collapse_create(corrected, 1);
00620     skip_if (0);
00621     skip_if (cpl_image_divide_scalar(xc_image, npix));
00622 
00623     cpl_image_delete(corrected);
00624     corrected = NULL;
00625 
00626     /* The dispersion relation goes from the top of the image to the bottom */
00627     if (resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) {
00628         /* Flip (if A-side), nothing else */
00629         corrected = visir_spc_flip(xc_image, wlen, resol);
00630         skip_if (0);
00631 
00632         cpl_image_delete(xc_image);
00633         xc_image = corrected;
00634         corrected = NULL;
00635     } else {
00636         skip_if (cpl_image_flip(xc_image, 0));
00637     }
00638 
00639     xc_vector = cpl_vector_wrap(npix, cpl_image_get_data(xc_image));
00640     skip_if (0);
00641 
00642     emission = cpl_bivector_new(npix + 2 * VISIR_XC_LEN);
00643     skip_if (0);
00644 
00645     boundary = cpl_vector_new(npix + 2 * VISIR_XC_LEN + 1);
00646     skip_if (0);
00647 
00648     phdisp = visir_spc_phys_disp(npix, wlen, resol, ioffset);
00649     skip_if (0);
00650 
00651     cpl_msg_info(cpl_func, "Dispersion polynomial of physical model:"
00652                  " %gm + ipix * %gm/pixel [ipix = 1, 2, ..., %d]",
00653                  cpl_polynomial_get_coeff(phdisp, &i0),
00654                  cpl_polynomial_get_coeff(phdisp, &i1), npix);
00655 
00656     temiss = visir_bivector_load_fits(linefile, "Wavelength", "Emission");
00657     if (cpl_error_get_code()) {
00658         cpl_msg_error(cpl_func, "Could not load file with Emission Lines");
00659         skip_if (1);
00660     }
00661 
00662     tqeff  = visir_bivector_load_fits(qefffile, "Wavelength", "Efficiency");
00663     if (cpl_error_get_code()) {
00664         cpl_msg_error(cpl_func, "Could not load file with Quantum-Efficiencies");
00665         skip_if (1);
00666     }
00667 
00668     *pspc_table = cpl_table_new(npix);
00669     skip_if (0);
00670 
00671     skip_if (cpl_table_new_column(*pspc_table, "WLEN", CPL_TYPE_DOUBLE));
00672     skip_if (cpl_table_new_column(*pspc_table, "SPC_MODEL_PH", CPL_TYPE_DOUBLE));
00673     skip_if (cpl_table_new_column(*pspc_table, "SPC_MODEL_XC", CPL_TYPE_DOUBLE));
00674     skip_if (cpl_table_new_column(*pspc_table, "SPC_SKY", CPL_TYPE_DOUBLE));
00675 
00676     skip_if (cpl_table_set_column_unit(*pspc_table, "WLEN", "m"));
00677     skip_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_PH",
00678                                        "J*radian/m^3/s"));
00679     skip_if (cpl_table_set_column_unit(*pspc_table, "SPC_MODEL_XC",
00680                                        "J*radian/m^3/s"));
00681     skip_if (cpl_table_set_column_unit(*pspc_table, "SPC_SKY", "ADU/s"));
00682 
00683 
00684     vsymm = cpl_spc_convolve_init(npix, slitw, fwhm, doplot);
00685 
00686     skip_if (vsymm == NULL);
00687 
00688     convohlen = cpl_vector_get_size(vsymm);
00689 
00690     skip_if (convohlen < 1);
00691 
00692     xc_flen = convohlen-1 < VISIR_XC_FLEN ? VISIR_XC_FLEN
00693         : (convohlen-1 > VISIR_XC_LEN ? VISIR_XC_LEN : convohlen-1);
00694 
00695 
00696     /* Determine the (possibly large) initial pixel shift */
00697   
00698     xc_subres = cpl_bivector_new(VISIR_XC_SUBSEARCH);
00699     skip_if (0);
00700 
00701     xc_subresy = cpl_bivector_get_y(xc_subres);
00702     skip_if (0);
00703     xc_subresx = cpl_bivector_get_x(xc_subres);
00704     skip_if (0);
00705 
00706     /* Copy the dispersion relation */
00707     xcdisp = cpl_polynomial_new(1);
00708     skip_if (cpl_polynomial_copy(xcdisp, phdisp));
00709 
00710 
00711     vxc = cpl_vector_new(2 * VISIR_XC_LEN + 1);
00712     skip_if (visir_spc_xcorr(vxc, emission, boundary, xc_vector, temiss, tqeff,
00713                              vsymm, xcdisp, -VISIR_XC_LEN, VISIR_XC_LEN,
00714                              temp, &qcxc, &rawdelta));
00715 
00716     if (doplot > 0) {
00717         cpl_vector   * xaxis = cpl_vector_new(2 * VISIR_XC_LEN + 1);
00718         cpl_bivector * bivxc = cpl_bivector_wrap_vectors(xaxis, vxc);
00719 
00720         for (i=0; i < 2 * VISIR_XC_LEN + 1; i++)
00721             if (cpl_vector_set(xaxis, i, i-VISIR_XC_LEN)) break;
00722 
00723         if (!cpl_error_get_code())
00724             visir_bivector_plot("set grid;set xlabel 'Offset [pixel]';",
00725                                 "t 'Cross-correlation (coarse)'", "", bivxc);
00726         cpl_bivector_unwrap_vectors(bivxc);
00727         cpl_vector_delete(xaxis);
00728     }
00729 
00730     skip_if (cpl_vector_set_size(vxc, 2 * VISIR_XC_FLEN + 1));
00731 
00732     skip_if (cpl_vector_set(xc_subresx, VISIR_XC_SUBSEARCH/2, rawdelta));
00733     skip_if (cpl_vector_set(xc_subresy, VISIR_XC_SUBSEARCH/2, qcxc));
00734 
00735     qcsubdelta = rawdelta;
00736     bestdelta = 0;
00737 
00738     cpl_msg_debug(cpl_func, "xc (%d): %g", rawdelta, qcxc);
00739 
00740     /*  Dump the unshifted model spectrum to the table
00741         - The unshifted signal starts at index VISIR_XC_LEN */
00742     pemiss = cpl_bivector_get_y_data(emission) + VISIR_XC_LEN;
00743     skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_MODEL_PH", pemiss));
00744 
00745     /* Apply the initial pixel shift */
00746     skip_if (cpl_polynomial_shift_1d(xcdisp, 0, rawdelta));
00747 
00748     /* emission & boundary can be made shorter, but npix+VISIR_XC_FLEN
00749        elements must be free of edge-convolution effects */
00750     cpl_bivector_delete(emission);
00751     emission = NULL;
00752     cpl_vector_delete(boundary);
00753     boundary = NULL;
00754 
00755     emission = cpl_bivector_new(npix + 2 * xc_flen);
00756     skip_if (0);
00757 
00758     boundary = cpl_vector_new(npix + 2 * xc_flen + 1);
00759     skip_if (0);
00760 
00761     /* subdelta search starts with an offset of minus a half pixel
00762        and is in the range [-0.5; 0.5 [ */
00763     minpos = 0;
00764     subdelta = VISIR_XC_SUBSEARCH == 1 ? 0 : -0.5;
00765     for (i = 0; i < VISIR_XC_SUBSEARCH; i++,
00766              subdelta += 1/(double)VISIR_XC_SUBSEARCH) {
00767         double xc;
00768 
00769         if (2*i == VISIR_XC_SUBSEARCH) continue; /* subdelta == 0 */
00770 
00771         skip_if (visir_spc_xcorr(vxc, emission, boundary, xc_vector, temiss,
00772                                  tqeff, vsymm, xcdisp, -xc_flen + subdelta,
00773                                  VISIR_XC_FLEN, temp, &xc, &delta));
00774 
00775         skip_if (cpl_vector_set(xc_subresx, i, rawdelta+delta+subdelta));
00776         skip_if (cpl_vector_set(xc_subresy, i, xc));
00777         if (rawdelta+delta+subdelta < cpl_vector_get(xc_subresx, minpos))
00778             minpos = i;
00779 
00780         cpl_msg_debug(cpl_func, "xc (%g): %g %g", rawdelta+delta+subdelta, xc,
00781                       qcxc);
00782 
00783         skip_if (0);
00784 
00785         if (xc <= qcxc) continue; /* FIXME: Reverse expression ?! */
00786 
00787         qcxc = xc;
00788         bestdelta = delta;
00789         qcsubdelta = delta + subdelta + rawdelta;
00790 
00791     }
00792 
00793     if (minpos > 0) {
00794         /* Move the minimum offset to the beginning of the bivector */
00795         /* Currently only needed for plotting */
00796         const size_t size1 = sizeof(double) * minpos;
00797         const size_t size2 = sizeof(double) * (VISIR_XC_SUBSEARCH-minpos);
00798         double * swap = cpl_malloc(size1);
00799         double * pdata;
00800 
00801         pdata = cpl_vector_get_data(xc_subresx);
00802         memcpy(swap, pdata, size1);
00803         memmove(pdata, pdata + minpos, size2);
00804         memcpy(pdata+(VISIR_XC_SUBSEARCH-minpos), swap, size1);
00805 
00806         pdata = cpl_vector_get_data(xc_subresy);
00807         memcpy(swap, pdata, size1);
00808         memmove(pdata, pdata + minpos, size2);
00809         memcpy(pdata+(VISIR_XC_SUBSEARCH-minpos), swap, size1);
00810 
00811         cpl_free(swap);
00812     }
00813 
00814     cpl_vector_delete(boundary);
00815     boundary = NULL;
00816     cpl_bivector_delete(emission);
00817     emission = NULL;
00818 
00819     skip_if (0);
00820 
00821     if (fabs(qcsubdelta) >= VISIR_XC_LEN) {
00822         cpl_msg_warning(cpl_func, "Cross-correlation (%g pixel shift): %g",
00823                         qcsubdelta, qcxc);
00824     } else {
00825         cpl_msg_info(cpl_func,"XC pixel-shift: %d + %d + %g", rawdelta, bestdelta,
00826                      qcsubdelta - rawdelta - bestdelta);
00827         cpl_msg_info(cpl_func,"Cross-correlation (%g pixel shift): %g",
00828                      qcsubdelta, qcxc);
00829         assert( bestdelta <   VISIR_XC_LEN);
00830         assert( bestdelta >  -VISIR_XC_LEN);
00831     }
00832 
00833     if (qcxc <= 0) {
00834         /* Absolutely no cross-correlation */
00835         cpl_msg_error(cpl_func, "Atmospheric and Model Spectra have non-"
00836                       "positive cross-correlation (%g pixel shift): %g", 
00837                       qcsubdelta, qcxc);
00838         visir_error_set(CPL_ERROR_DATA_NOT_FOUND);
00839         skip_if(1);
00840     }
00841 
00842     /* Apply the sub-pixel precision shift - ignore the initial shift */
00843     skip_if (cpl_polynomial_shift_1d(xcdisp, 0, qcsubdelta - rawdelta));
00844 
00845     cpl_msg_info(cpl_func, "Dispersion polynomial from cross-correlation: "
00846                  "%gm + ipix * %gm/pixel [ipix = 1, 2, ..., %d]",
00847                  cpl_polynomial_get_coeff(xcdisp, &i0),
00848                  cpl_polynomial_get_coeff(xcdisp, &i1), npix);
00849 
00850     cpl_msg_info(cpl_func, "New Central Wavelength [m]: %g",
00851                  cpl_polynomial_eval_1d(xcdisp, 0.5*npix+0.5, NULL));
00852 
00853     /* Generate the new wavelengths based on the cross-correlation shift */
00854     emission = cpl_bivector_new(npix);
00855     xemiss = cpl_bivector_get_x(emission);
00856     skip_if (cpl_vector_fill_polynomial(xemiss, xcdisp, 1, 1));
00857 
00858     /* If the spectrum goes into N-band the sky spectrum may have variable
00859        atmospheric features, that are not in the model used for the model
00860        spectrum. This can cause the wavelength calibration to yield completely
00861        results */
00862     if (cpl_vector_get(xemiss,0) < N_upper &&
00863         N_upper < cpl_vector_get(xemiss,cpl_vector_get_size(xemiss)-1))
00864         cpl_msg_warning(cpl_func, "Spectrum goes above N-band (%gm). Wavelength "
00865                         "Calibration may be entirely inaccurate", N_upper);
00866 
00867     skip_if (cpl_table_copy_data_double(*pspc_table, "WLEN",
00868                                         cpl_bivector_get_x_data(emission)));
00869 
00870     /* - and the corresponding pixel boundaries */
00871     boundary = cpl_vector_new(npix + 1);
00872     skip_if (0);
00873     skip_if (cpl_vector_fill_polynomial(boundary, xcdisp, 0.5, 1));
00874 
00875     /* Get the emission at those wavelengths */
00876     skip_if (visir_spc_emission(emission, boundary, temiss, tqeff, vsymm,
00877                                 temp));
00878 
00879     skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_MODEL_XC", 
00880                                         cpl_bivector_get_y_data(emission)));
00881 
00882     skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_SKY", 
00883                                         cpl_vector_get_data(xc_vector)));
00884 
00885     /* The spectrum generated with xcdisp should have the maximum
00886        cross-correlation at zero offset */
00887     skip_if (cpl_vector_set_size(vxc, 1));
00888 
00889     delta = cpl_vector_correlate(vxc, cpl_bivector_get_y(emission),
00890                                  xc_vector);
00891     skip_if (delta < 0);
00892 
00893     xc0 = qcxc - cpl_vector_get(vxc, delta);
00894     cpl_vector_delete(vxc);
00895     vxc = NULL;
00896 
00897 #if 0
00898     /* FIXME: This check is broken with new concolution scheme */
00899     /* FIX ME: Why npix squared ? */
00900     /* The imperfect convolution at the spectral ends causes a warning here 
00901        when threshold is: 10 * npix * npix * DBL_EPSILON */
00902 
00903     if (delta || npix * fabs(xc0) > 25 * sigma)
00904         cpl_msg_warning(cpl_func, "Cross-correlation inconsistency(%d): %g",
00905                         delta, xc0);
00906 #endif
00907 
00908     if (doplot) {
00909         cpl_bivector * plot = cpl_bivector_wrap_vectors(xemiss,xc_vector);
00910 
00911         visir_bivector_plot("set grid;set xlabel 'Offset [pixel]';", "t 'Cross-"
00912                             "correlation (fine)' w linespoints", "", xc_subres);
00913 
00914         visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';", "t 'Spec"
00915                             "trum from Half-cycle' w linespoints", "", plot);
00916         cpl_bivector_unwrap_vectors(plot);
00917 
00918         visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';",
00919                              "t 'Shifted Model Spectrum' w linespoints",
00920                              "", emission);
00921 
00922         /* The unshifted model spectrum */
00923         visir_table_plot("set grid;set xlabel 'Wavelength [m]';",
00924                           "t 'Model Spectrum' w linespoints",
00925                           "", *pspc_table, "WLEN", "SPC_MODEL_PH");
00926 
00927     }
00928 
00929     /* Get the emissivity (range 0 to 1) for the calibrated wavelengths */
00930     skip_if (visir_vector_resample(cpl_bivector_get_y(emission),
00931                                       boundary, temiss));
00932 
00933     skip_if (cpl_table_new_column(*pspc_table, "SPC_EMISSIVITY",
00934                                   CPL_TYPE_DOUBLE));
00935 
00936     skip_if (cpl_table_copy_data_double(*pspc_table, "SPC_EMISSIVITY", 
00937                                         cpl_bivector_get_y_data(emission)));
00938 
00939     cpl_vector_delete(boundary);
00940     boundary = NULL;
00941 
00942     bug_if(visir_spectro_qclist_wcal(qclist, npix, qcxc, qcsubdelta,
00943                                      phdisp, xcdisp));
00944 
00945     if (doplot) {
00946 
00947         visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';",
00948                              "t 'Atmospheric Emissivity' w linespoints",
00949                              "", emission);
00950 
00951         /* Create an model spectrum of twice the npix length */
00952         cpl_bivector_delete(emission);
00953         emission = cpl_bivector_new(2 * npix);
00954 
00955         boundary = cpl_vector_new(2 * npix + 1);
00956 
00957         cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
00958                                    phdisp, -0.5*npix, 1);
00959         cpl_vector_fill_polynomial(boundary, phdisp, -0.5*(npix+1), 1);
00960 
00961         /* Get the emission at those wavelengths */
00962         visir_spc_emission(emission, boundary, temiss, tqeff, vsymm, temp);
00963         cpl_vector_delete(boundary);
00964         boundary = NULL;
00965 
00966         visir_bivector_plot("set grid;set xlabel 'Wavelength [m]';",
00967                              "t 'Extended Model Spectrum' w linespoints",
00968                              "", emission);
00969 
00970     }
00971 
00972     end_skip;
00973 
00974     cpl_polynomial_delete(phdisp);
00975     cpl_polynomial_delete(xcdisp);
00976     cpl_image_delete(xc_image);
00977     cpl_vector_delete(vsymm);
00978     cpl_image_delete(corrected);
00979     cpl_bivector_delete(temiss);
00980     cpl_bivector_delete(tqeff);
00981     cpl_vector_delete(boundary);
00982     cpl_bivector_delete(emission);
00983     cpl_vector_unwrap(xc_vector);
00984     cpl_bivector_delete(xc_subres);
00985     cpl_vector_delete(vxc);
00986 
00987     return cpl_error_get_code();
00988 }
00989 
00990 
00991 /*----------------------------------------------------------------------------*/
01007 /*----------------------------------------------------------------------------*/
01008 cpl_error_code visir_spc_echelle_limit(int * pcol1, int * pcol2, double wlen,
01009                                        int ioffset, int icolmin, int icolmax)
01010 {
01011 
01012     visir_optmod ins_settings;
01013     double echpos;
01014     double wleni;   /* The central wavelength at order offset ioffset */
01015     int order;
01016     int error;
01017 
01018 
01019     cpl_ensure_code(wlen > 0,              CPL_ERROR_ILLEGAL_INPUT);
01020     cpl_ensure_code(pcol1,                 CPL_ERROR_NULL_INPUT);
01021     cpl_ensure_code(pcol2,                 CPL_ERROR_NULL_INPUT);
01022     cpl_ensure_code(icolmin > 0,           CPL_ERROR_ILLEGAL_INPUT);
01023     cpl_ensure_code(icolmax >= icolmin,    CPL_ERROR_ILLEGAL_INPUT);
01024     /* There are up to 5 spectra in the imaage */
01025     cpl_ensure_code(ioffset >= -4,         CPL_ERROR_ILLEGAL_INPUT);
01026     cpl_ensure_code(ioffset <=  4,         CPL_ERROR_ILLEGAL_INPUT);
01027 
01028     error = visir_spc_optmod_init(VISIR_SPC_R_GHR, wlen, &ins_settings);
01029     if (error) {
01030         cpl_msg_error(cpl_func, "HRG Optical model initialization (%p) failed: %d "
01031                       "(%g)", (void*)&ins_settings, error, wlen);
01032         cpl_ensure_code(0, CPL_ERROR_ILLEGAL_INPUT);
01033     }
01034     order = ioffset + visir_spc_optmod_get_echelle_order(&ins_settings);
01035 
01036     /* There are 18 echelle orders */
01037     cpl_ensure_code(order >   0,           CPL_ERROR_ILLEGAL_INPUT);
01038     cpl_ensure_code(order <= 18,           CPL_ERROR_ILLEGAL_INPUT);
01039 
01040     wleni = visir_spc_optmod_echelle(&ins_settings, wlen, ioffset  );
01041 
01042     echpos = visir_spc_optmod_cross_dispersion(&ins_settings, wleni);
01043     if (echpos <= whechelle || echpos >= icolmax-whechelle) {
01044         cpl_msg_error(cpl_func, "Echelle (%d) location out of range [%d;%d]: %g",
01045                       order, icolmin, icolmax, echpos);
01046         cpl_ensure_code(0, CPL_ERROR_DATA_NOT_FOUND);
01047     }
01048 
01049     *pcol1 = ceil(echpos - whechelle); /* Round up */
01050     *pcol2 = echpos + whechelle; /* Round down */
01051 
01052     if (*pcol1 < icolmin) *pcol1 = icolmin;
01053     if (*pcol2 > icolmax) *pcol2 = icolmax;
01054 
01055     cpl_msg_info(cpl_func, "Echelle order %d at col %g [%d; %d]", order, echpos,
01056                  *pcol1, *pcol2);
01057 
01058     return cpl_error_get_code();
01059 
01060 }
01061 
01062 /*----------------------------------------------------------------------------*/
01075 /*----------------------------------------------------------------------------*/
01076 cpl_image * visir_spc_column_extract(const cpl_image * self, int icol1,
01077                                      int icol2, int doplot)
01078 {
01079 
01080     cpl_image  * band    = NULL;
01081     cpl_image  * spatial = NULL;
01082     const int nrow = cpl_image_get_size_y(self);
01083     const int ncol = cpl_image_get_size_x(self);
01084 
01085     cpl_ensure(self != NULL,   CPL_ERROR_NULL_INPUT,    NULL);
01086     cpl_ensure(icol1 > 0,      CPL_ERROR_ILLEGAL_INPUT, NULL);
01087     cpl_ensure(icol2 >= icol1, CPL_ERROR_ILLEGAL_INPUT, NULL);
01088 
01089     cpl_ensure(ncol >= icol2,  CPL_ERROR_ILLEGAL_INPUT, NULL);
01090 
01091     band = cpl_image_extract(self, icol1, 1, icol2, nrow);
01092     skip_if (0);
01093 
01094     if (doplot > 0) {
01095         visir_image_plot("", "t 'The full-width image'", "", self);
01096 
01097         if (doplot > 1) {
01098             /* Average the spectral dimension */
01099             spatial = cpl_image_collapse_create(self, 0);
01100             skip_if (0);
01101             skip_if (cpl_image_divide_scalar(spatial, nrow));
01102 
01103             visir_image_row_plot("set grid;", "t 'Spectral direction "
01104                                  "collapsed' w linespoints", "",
01105                                  spatial, 1, 1, 1);
01106         }
01107     }
01108 
01109     end_skip;
01110 
01111     cpl_image_delete(spatial);
01112     if (cpl_error_get_code() && band != NULL) {
01113         cpl_image_delete(band);
01114         band = NULL;
01115     }
01116 
01117     return band;
01118 
01119 }
01120 
01121 
01122 /*----------------------------------------------------------------------------*/
01135 /*----------------------------------------------------------------------------*/
01136 cpl_error_code visir_spectro_qc(cpl_propertylist * qclist,
01137                                 cpl_propertylist * paflist,
01138                                 cpl_boolean        drop_wcs,
01139                                 const irplib_framelist * rawframes,
01140                                 const char * regcopy,
01141                                 const char * regcopypaf)
01142 {
01143 
01144     const cpl_propertylist * reflist
01145         = irplib_framelist_get_propertylist_const(rawframes, 0);
01146 
01147     bug_if (0);
01148 
01149     bug_if (visir_qc_append_capa(qclist, rawframes));
01150 
01151     if (regcopy != NULL)
01152         bug_if (cpl_propertylist_copy_property_regexp(qclist, reflist,
01153                                                       regcopy, 0));
01154 
01155     if (regcopypaf != NULL)
01156         bug_if (cpl_propertylist_copy_property_regexp(paflist, reflist,
01157                                                       regcopypaf, 0));
01158 
01159     bug_if (cpl_propertylist_append(paflist, qclist));
01160 
01161     if (drop_wcs) {
01162         cpl_propertylist * pcopy = cpl_propertylist_new();
01163         const cpl_error_code error
01164             = cpl_propertylist_copy_property_regexp(pcopy, reflist, "^("
01165                                                     IRPLIB_PFITS_WCS_REGEXP
01166                                                     ")$", 0);
01167         if (!error && cpl_propertylist_get_size(pcopy) > 0) {
01168             cpl_msg_warning(cpl_func, "Combined image will have no WCS "
01169                             "coordinates");
01170         }
01171         cpl_propertylist_delete(pcopy);
01172         bug_if(0);
01173     } else {
01174         bug_if(cpl_propertylist_copy_property_regexp(qclist, reflist, "^("
01175                                                      IRPLIB_PFITS_WCS_REGEXP
01176                                                      ")$", 0));
01177     }
01178 
01179     end_skip;
01180 
01181     return cpl_error_get_code();
01182 
01183 }
01184 
01185 
01189 /*----------------------------------------------------------------------------*/
01201 /*----------------------------------------------------------------------------*/
01202 static cpl_error_code visir_spectro_qclist_wcal(cpl_propertylist * self,
01203                                                 int npix, double xc,
01204                                                 double subdelta,
01205                                                 const cpl_polynomial * phdisp,
01206                                                 const cpl_polynomial * xcdisp)
01207 {
01208 
01209     const int    phdegree = cpl_polynomial_get_degree(phdisp);
01210     const int    xcdegree = cpl_polynomial_get_degree(xcdisp);
01211 
01212     const double phdisp1  = cpl_polynomial_get_coeff(phdisp, &phdegree);
01213     const double phdisp0  = cpl_polynomial_eval_1d(phdisp, 1.0, NULL);
01214 
01215     const double xcdisp1  = cpl_polynomial_get_coeff(xcdisp, &xcdegree);
01216     const double xcdisp0  = cpl_polynomial_eval_1d(xcdisp, 1.0, NULL);
01217 
01218     const double xcwlen   = cpl_polynomial_eval_1d(xcdisp, 0.5*(double)npix+0.5,
01219                                                    NULL);
01220 
01221 
01222     bug_if (0);
01223     bug_if (phdegree != 1);
01224     bug_if (xcdegree != 1);
01225 
01226     bug_if (cpl_propertylist_append_double(self, "ESO QC XC",       xc));
01227     bug_if (cpl_propertylist_append_double(self, "ESO QC XCSHIFT",  subdelta));
01228 
01229     bug_if (cpl_propertylist_append_int(self,    "ESO QC PHDEGREE", phdegree));
01230     bug_if (cpl_propertylist_append_double(self, "ESO QC PHDISPX1", phdisp1));
01231     bug_if (cpl_propertylist_append_double(self, "ESO QC PHDISPX0", phdisp0));
01232 
01233     bug_if (cpl_propertylist_append_double(self, "ESO QC XCWLEN",   xcwlen));
01234 
01235     bug_if (cpl_propertylist_append_int(self,    "ESO QC XCDEGREE", xcdegree));
01236     bug_if (cpl_propertylist_append_double(self, "ESO QC XCDISPX1", xcdisp1));
01237     bug_if (cpl_propertylist_append_double(self, "ESO QC XCDISPX0", xcdisp0));
01238 
01239     end_skip;
01240 
01241     return cpl_error_get_code();
01242 
01243 }
01244 
01245 
01246 
01247 /*----------------------------------------------------------------------------*/
01259 /*----------------------------------------------------------------------------*/
01260 static cpl_error_code visir_spectro_qclist_obs(cpl_propertylist * self,
01261                                                double xfwhm, double xcentro)
01262 {
01263 
01264 
01265     bug_if (0);
01266 
01267     bug_if (cpl_propertylist_append_double(self, "ESO QC XFWHM",    xfwhm));
01268     bug_if (cpl_propertylist_append_double(self, "ESO QC XCENTROI", xcentro));
01269 
01270     end_skip;
01271 
01272     return cpl_error_get_code();
01273 
01274 }
01275 
01276 
01277 /*----------------------------------------------------------------------------*/
01303 /*----------------------------------------------------------------------------*/
01304 static cpl_error_code visir_bivector_interpolate(cpl_bivector * out,
01305                                                  const cpl_bivector * in)
01306 {
01307     const cpl_error_code err = CPL_ERROR_ILLEGAL_INPUT;
01308 
01309     int m, n;
01310 
01311     const double * xref;
01312     const double * yref;
01313     double * xout;
01314     double * yout;
01315 
01316     /* Initialize to avoid unjustified compiler warning */
01317     double grad = 0.0;
01318     double y00  = 0.0;
01319     /* Start interpolation from below */
01320     int iabove = 0;
01321     int ibelow = 0;  /* Avoid (false) uninit warning */
01322     int i;
01323 
01324 
01325     cpl_ensure_code(out,   CPL_ERROR_NULL_INPUT);
01326     cpl_ensure_code(in,    CPL_ERROR_NULL_INPUT);
01327 
01328     m = cpl_bivector_get_size(in);
01329     n = cpl_bivector_get_size(out);
01330 
01331     cpl_ensure_code(m > 1, err);
01332     cpl_ensure_code(n > 0, err);
01333 
01334     xref = cpl_bivector_get_x_data_const(in);
01335     yref = cpl_bivector_get_y_data_const(in);
01336     xout = cpl_bivector_get_x_data(out);
01337     yout = cpl_bivector_get_y_data(out);
01338 
01339     assert( xref);
01340     assert( yref);
01341     assert( xout);
01342     assert( yout);
01343 
01344     /* Verify that extrapolation is not necessary */
01345     cpl_ensure_code(xref[0  ] <= xout[0  ], err);
01346     cpl_ensure_code(xout[0  ] <  xout[n-1], err);
01347     cpl_ensure_code(xout[n-1] <= xref[m-1], err);
01348 
01349     for (i = 0; i < n; i++) {
01350         /* When possible reuse reference function abscissa points */
01351         if (xout[i] > xref[iabove] || i == 0) {
01352             /* No, need new points */
01353             while (xout[i] > xref[++iabove]);
01354             ibelow = iabove - 1;
01355 
01356             /* Verify that reference abscissa points are valid */
01357             cpl_ensure_code(xref[iabove] > xref[ibelow], err);
01358 
01359             grad = (yref[iabove] - yref[ibelow])
01360                  / (xref[iabove] - xref[ibelow]);
01361 
01362             y00   = yref[ibelow] - grad * xref[ibelow];
01363         } else
01364             /* Interpolation point may not be smaller than
01365                the lower reference point */
01366             cpl_ensure_code(xout[i] >= xref[ibelow], err);
01367 
01368         yout[i] = y00 + grad * xout[i];
01369 
01370     }
01371 
01372     return CPL_ERROR_NONE;
01373 }
01374 
01375 /*----------------------------------------------------------------------------*/
01387 /*----------------------------------------------------------------------------*/
01388 static cpl_error_code visir_vector_convolve_symm(cpl_vector * self,
01389                                                  const cpl_vector * vsymm)
01390 {
01391 
01392     const int      npix = cpl_vector_get_size(self);
01393     const int      ihwidth = cpl_vector_get_size(vsymm) - 1;
01394     cpl_vector   * raw     = cpl_vector_duplicate(self);
01395     double       * pself= cpl_vector_get_data(self);
01396     double       * praw    = cpl_vector_get_data(raw);
01397     const double * psymm  = cpl_vector_get_data_const(vsymm);
01398 
01399     int i, j;
01400 
01401 
01402     skip_if (0);
01403 
01404     /* The convolution does not support this */
01405     skip_if (ihwidth >= npix);
01406 
01407     /* Convolve with the symmetric function */
01408     for (i = 0; i < ihwidth; i++) {
01409         pself[i] = praw[i] * psymm[0];
01410         for (j = 1; j <= ihwidth; j++) {
01411             const int k = i-j < 0 ? 0 : i-j;
01412             pself[i] += (praw[k]+praw[i+j]) * psymm[j];
01413         }
01414 
01415     }
01416 
01417     for (i = ihwidth; i < npix-ihwidth; i++) {
01418         pself[i] = praw[i] * psymm[0];
01419         for (j = 1; j <= ihwidth; j++)
01420             pself[i] += (praw[i-j]+praw[i+j]) * psymm[j];
01421 
01422     }
01423     for (i = npix-ihwidth; i < npix; i++) {
01424         pself[i] = praw[i] * psymm[0];
01425         for (j = 1; j <= ihwidth; j++) {
01426             const int k = i+j > npix-1 ? npix - 1 : i+j;
01427             pself[i] += (praw[k]+praw[i-j]) * psymm[j];
01428         }
01429 
01430     }
01431 
01432     end_skip;
01433 
01434     cpl_vector_delete(raw);
01435 
01436     return cpl_error_get_code();
01437 }
01438 
01439 /*----------------------------------------------------------------------------*/
01458 /*----------------------------------------------------------------------------*/
01459 static cpl_image * visir_spc_flip(const cpl_image * image, double wlen,
01460                               visir_spc_resol resol)
01461 {
01462     cpl_image  * flipped = cpl_image_cast(image, CPL_TYPE_DOUBLE);
01463     visir_optmod ins_settings;
01464 
01465 
01466     skip_if (0);
01467 
01468     if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
01469         visir_spc_optmod_init(resol, wlen, &ins_settings)) {
01470         visir_error_set(CPL_ERROR_ILLEGAL_INPUT);
01471         skip_if (1);
01472     }
01473 
01474     /* The dispersion relation goes from the top of the image to the bottom
01475        - except using the B-side (in high resolution) */
01476     if ((resol != VISIR_SPC_R_HR && resol != VISIR_SPC_R_GHR) ||
01477         visir_spc_optmod_side_is_A(&ins_settings) > 0) {
01478 
01479         cpl_msg_info(cpl_func, "Flipping image");
01480 
01481         skip_if (cpl_image_flip(flipped, 0));
01482     }
01483 
01484     end_skip;
01485 
01486     if (cpl_error_get_code() && flipped) {
01487         cpl_image_delete(flipped);
01488         flipped = NULL;
01489     }
01490 
01491     return flipped;
01492 
01493 }
01494 
01495 /*----------------------------------------------------------------------------*/
01510 /*----------------------------------------------------------------------------*/
01511 static cpl_polynomial * visir_spc_phys_disp(int npix, double wlen,
01512                                             visir_spc_resol resol, int ioffset)
01513 {
01514 
01515     cpl_polynomial * phdisp = NULL;
01516     visir_optmod     ins_settings;
01517 
01518     double dwl;
01519     double wlen0;
01520     double wlen1;
01521     double disp;
01522     const int i1 = 1;
01523     const int i0 = 0;
01524 
01525 
01526     cpl_ensure(resol,    CPL_ERROR_ILLEGAL_INPUT, NULL);
01527     cpl_ensure(wlen > 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
01528     cpl_ensure(npix > 1, CPL_ERROR_ILLEGAL_INPUT, NULL);
01529 
01530     /* Initialize instrument-specific settings
01531         - the resolution is not needed hereafter
01532        visir_spc_optmod_init() does itself not use the CPL-error system
01533           because it is also used in a non-CPL scope */
01534 
01535     cpl_ensure(!visir_spc_optmod_init(resol, wlen, &ins_settings),
01536                CPL_ERROR_ILLEGAL_INPUT, NULL);
01537 
01538     /* Get wavelength range (and corresponding central-wavelength)
01539        visir_spc_optmod_wlen() does not use the CPL-error system
01540          because it is also used in a non-CPL scope */
01541     dwl = visir_spc_optmod_wlen(&ins_settings, &wlen0, &wlen1);
01542 
01543     cpl_ensure(dwl >= 0, CPL_ERROR_ILLEGAL_INPUT, NULL);
01544 
01545     /* Central-wavelength residual on Scan-Angle determination */
01546     dwl -= wlen;
01547     /* Warn if the residual exceeds twice the machine-precision */
01548     if (fabs(dwl) > 2*wlen*DBL_EPSILON) cpl_msg_warning(cpl_func, "Too large res"
01549         "idual in Scan-Angle determination [meps]: %g", dwl/DBL_EPSILON/wlen);
01550 
01551     if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
01552         !visir_spc_optmod_side_is_A(&ins_settings)) {
01553         const double swap = wlen1;
01554         wlen1 = wlen0;
01555         wlen0 = swap;
01556     }
01557     cpl_ensure(wlen1 > wlen0, CPL_ERROR_ILLEGAL_INPUT, NULL);
01558 
01559     /* Construct the 1st degree dispersion relation
01560        based on the physical model */
01561     phdisp = cpl_polynomial_new(1);
01562 
01563     /* The dispersion */
01564     disp = (wlen1-wlen0)/(npix-1);
01565 
01566     skip_if (0);
01567 
01568     skip_if (cpl_polynomial_set_coeff(phdisp, &i1, disp));
01569 
01570     skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0-disp));
01571 
01572     if ((resol == VISIR_SPC_R_HR || resol == VISIR_SPC_R_GHR) &&
01573         !visir_spc_optmod_side_is_A(&ins_settings)) {
01574         cpl_msg_info(cpl_func,"HR B-side WLMin, WLMax, Disp: %g %g %g", wlen0,
01575                      wlen1, cpl_polynomial_get_coeff(phdisp, &i1));
01576     } else {
01577         cpl_msg_info(cpl_func,"WLMin, WLMax, Disp: %g %g %g", wlen0, wlen1,
01578                      cpl_polynomial_get_coeff(phdisp, &i1));
01579     }
01580 
01581     if (resol == VISIR_SPC_R_GHR && ioffset != 0) {
01582         /* Another HRG Echelle order is requested
01583            - shift the 1st degree polynomial */
01584         const double dispi = visir_spc_optmod_echelle(&ins_settings,
01585                                 cpl_polynomial_get_coeff(phdisp, &i1), ioffset);
01586         const double wlen0i= visir_spc_optmod_echelle(&ins_settings,
01587                                 cpl_polynomial_get_coeff(phdisp, &i0), ioffset);
01588 
01589         skip_if (cpl_polynomial_set_coeff(phdisp, &i1, dispi));
01590 
01591         skip_if (cpl_polynomial_set_coeff(phdisp, &i0, wlen0i));
01592 
01593         cpl_msg_info(cpl_func, "WLc relative error(%d): %g", ioffset,
01594                      (wlen0i - cpl_polynomial_eval_1d(phdisp, 1, NULL))/wlen0i);
01595     }
01596 
01597 
01598     end_skip;
01599 
01600     if (cpl_error_get_code() && phdisp != NULL) {
01601         cpl_polynomial_delete(phdisp);
01602         phdisp = NULL;
01603     }
01604 
01605     return phdisp;
01606 
01607 }
01608 
01609 
01610 /*----------------------------------------------------------------------------*/
01634 /*----------------------------------------------------------------------------*/
01635 static cpl_error_code visir_spc_xcorr(cpl_vector * vxc,
01636                                       cpl_bivector * emission,
01637                                       cpl_vector   * boundary,
01638                                       const cpl_vector * xc_vector,
01639                                       const cpl_bivector * temiss,
01640                                       const cpl_bivector * tqeff,
01641                                       const cpl_vector   * vsymm,
01642                                       const cpl_polynomial * xcdisp,
01643                                       double firstpix,
01644                                       int half_search,
01645                                       double temp,
01646                                       double * pxc,
01647                                       int    * pdelta)
01648 {
01649 
01650     cpl_ensure_code(emission, CPL_ERROR_NULL_INPUT);
01651     cpl_ensure_code(boundary, CPL_ERROR_NULL_INPUT);
01652     cpl_ensure_code(xc_vector,CPL_ERROR_NULL_INPUT);
01653     cpl_ensure_code(temiss,   CPL_ERROR_NULL_INPUT);
01654     cpl_ensure_code(tqeff,    CPL_ERROR_NULL_INPUT);
01655     cpl_ensure_code(vsymm,  CPL_ERROR_NULL_INPUT);
01656     cpl_ensure_code(xcdisp,   CPL_ERROR_NULL_INPUT);
01657     cpl_ensure_code(pxc,      CPL_ERROR_NULL_INPUT);
01658     cpl_ensure_code(pdelta,   CPL_ERROR_NULL_INPUT);
01659 
01660 
01661     /* Compute the wavelengths of the spectrum
01662        according to the physical model */
01663     skip_if (cpl_vector_fill_polynomial(cpl_bivector_get_x(emission),
01664                                         xcdisp, firstpix+1, 1));
01665     skip_if (cpl_vector_fill_polynomial(boundary, xcdisp,
01666                                         firstpix+0.5, 1));
01667 
01668     /* Get the emission at those wavelengths */
01669     skip_if (visir_spc_emission(emission, boundary, temiss, tqeff, vsymm,
01670                                 temp));
01671 
01672     *pdelta = cpl_vector_correlate(vxc, cpl_bivector_get_y(emission),
01673                                    xc_vector);
01674     skip_if (*pdelta < 0);
01675 
01676     *pxc = cpl_vector_get(vxc, *pdelta);
01677 
01678     skip_if (0);
01679 
01680     *pdelta -= half_search;
01681 
01682     end_skip;
01683 
01684     return cpl_error_get_code();
01685 
01686 }
01687 
01688 
01689 /*----------------------------------------------------------------------------*/
01702 /*----------------------------------------------------------------------------*/
01703 
01704 static cpl_bivector * visir_bivector_load_fits(const char * file,
01705                                                const char * labelx,
01706                                                const char * labely)
01707 {
01708 
01709     cpl_bivector * result = NULL;
01710     cpl_table    * table  = NULL;
01711     double       * prow;
01712     int            nlines;
01713 
01714 
01715     skip_if (0);
01716 
01717     table = cpl_table_load(file, 1, 0);
01718     if (cpl_error_get_code()) {
01719         cpl_msg_error(cpl_func, "Could not load FITS table from file: %s",
01720                       file ? file : "<NULL>");
01721         skip_if (1);
01722     }
01723 
01724     nlines = cpl_table_get_nrow(table);
01725     skip_if (0);
01726 
01727     prow = cpl_table_get_data_double(table, labelx);
01728     skip_if (0);
01729 
01730     result = cpl_bivector_new(nlines);
01731     skip_if (0);
01732 
01733     skip_if (!memcpy(cpl_bivector_get_x_data(result), prow,
01734                      nlines * sizeof(double)));
01735 
01736     prow = cpl_table_get_data_double(table, labely);
01737     skip_if (0);
01738 
01739     skip_if (!memcpy(cpl_bivector_get_y_data(result), prow,
01740                      nlines * sizeof(double)));
01741 
01742     cpl_msg_info(cpl_func, "Read %d rows from %s [%g;%g]",
01743                  nlines, file,
01744                  cpl_vector_get(cpl_bivector_get_x(result), 0),
01745                  cpl_vector_get(cpl_bivector_get_x(result), nlines-1));
01746 
01747     end_skip;
01748 
01749     cpl_table_delete(table);
01750 
01751     if (result && cpl_error_get_code()) {
01752         cpl_bivector_delete(result);
01753         result = NULL;
01754     }
01755 
01756     return result;
01757 
01758 }
01759 
01760 
01761 /*----------------------------------------------------------------------------*/
01788 /*----------------------------------------------------------------------------*/
01789 static cpl_error_code visir_spc_emission(cpl_bivector       * emission,
01790                                          const cpl_vector   * boundary,
01791                                          const cpl_bivector * temiss,
01792                                          const cpl_bivector * tqeff,
01793                                          const cpl_vector   * vsymm,
01794                                          double temp)
01795 {
01796     cpl_bivector * tqeffi   = NULL;
01797     cpl_vector   * planck   = NULL;
01798     const int      npix = cpl_bivector_get_size(emission);
01799 
01800 
01801     cpl_ensure_code(emission, CPL_ERROR_NULL_INPUT);
01802     cpl_ensure_code(boundary, CPL_ERROR_NULL_INPUT);
01803     cpl_ensure_code(temiss,   CPL_ERROR_NULL_INPUT);
01804     cpl_ensure_code(tqeff,    CPL_ERROR_NULL_INPUT);
01805 
01806     /* npix is currently 256 */
01807     cpl_ensure_code(npix > 1, CPL_ERROR_ILLEGAL_INPUT);
01808 
01809     cpl_ensure_code(cpl_vector_get_size(boundary) == npix + 1,
01810                         CPL_ERROR_ILLEGAL_INPUT);
01811 
01812 
01813     skip_if (0);
01814 
01815     planck = cpl_vector_new(npix);
01816     skip_if (0);
01817 
01818     /* The atmospheric emission is assumed to be equivalent to that of
01819        a Black Body at 253 K */
01820     cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
01821                               cpl_bivector_get_x(emission),
01822                               CPL_UNIT_LENGTH, 253);
01823 
01824     skip_if (visir_vector_resample(cpl_bivector_get_y(emission),
01825                                       boundary, temiss));
01826 
01827     /* Convolve to reflect the instrument resolution */
01828     skip_if (visir_vector_convolve_symm(cpl_bivector_get_y(emission),
01829                                             vsymm));
01830 
01831     skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission), planck));
01832 
01833     /* The telescope emission is assumed to be equivalent to that of
01834        a Black Body */
01835     cpl_photom_fill_blackbody(planck, CPL_UNIT_ENERGYRADIANCE,
01836                               cpl_bivector_get_x(emission),
01837                               CPL_UNIT_LENGTH, temp);
01838 
01839     /* The telescope emissivity is assumed to be uniform at 0.12 */
01840     skip_if (cpl_vector_multiply_scalar(planck, 0.12));
01841 
01842     /* Add the telescope emission to the atmospheric */
01843     skip_if (cpl_vector_add(cpl_bivector_get_y(emission), planck));
01844 
01845     /* Multiply by the detector quantum efficiency */
01846     tqeffi = cpl_bivector_duplicate(emission);
01847     skip_if (visir_bivector_interpolate(tqeffi, tqeff));
01848 
01849     skip_if (cpl_vector_multiply(cpl_bivector_get_y(emission),
01850                                  cpl_bivector_get_y(tqeffi)));
01851 
01852     end_skip;
01853 
01854     cpl_bivector_delete(tqeffi);
01855     cpl_vector_delete(planck);
01856 
01857     return cpl_error_get_code();
01858 }
01859 
01860 
01861 /*----------------------------------------------------------------------------*/
01884 /*----------------------------------------------------------------------------*/
01885 static cpl_vector * cpl_spc_convolve_init(int maxlen, double slitw,
01886                                           double fwhm, int doplot)
01887 {
01888 
01889     const double sigma  = fwhm * CPL_MATH_SIG_FWHM;
01890     const int ihtophat  = (int)slitw/2;
01891     const int gausshlen = 1 + 5 * sigma + ihtophat < maxlen/2
01892         ? 1 + 5 * sigma + ihtophat : maxlen/2 - 1;
01893     /* convolen must be at least twice the gausshlen */
01894     const int convolen  = 1 + 10 * sigma + 8*ihtophat;
01895     cpl_vector * self = cpl_vector_new(gausshlen);
01896     cpl_vector * tophat = cpl_vector_new(convolen);
01897     int i;
01898 
01899     /* Easiest way to fill with a Gaussian is via a CPL image */
01900     cpl_image  * iself = cpl_image_wrap_double(gausshlen, 1,
01901                                                cpl_vector_get_data(self));
01902 
01903 
01904     skip_if (0);
01905 
01906     skip_if( slitw <= 0.0);
01907     skip_if( fwhm  <= 0.0);
01908     skip_if( convolen < 2 * gausshlen); /* This would indicate a bug */
01909 
01910     /* Place the top point of the Gaussian on left-most pixel */
01911     skip_if (cpl_image_fill_gaussian(iself, 1.0, 1.0, CPL_MATH_SQRT2PI,
01912                                      sigma, 1.0));
01913 
01914     if (doplot > 2) visir_vector_plot("set grid;", "t 'Right Half of Gaussian' "
01915                                       "w linespoints", "", self);
01916     
01917     /* The number of non-zero elements is 1+2*ihtophat */
01918     skip_if( cpl_vector_fill(tophat, 0.0));
01919 
01920     for (i = convolen/2-ihtophat; i < 1+convolen/2+ihtophat; i++)
01921         skip_if (cpl_vector_set(tophat, i, 1.0/(1.0+2.0*ihtophat)));
01922 
01923     /* Convolve the Top-hat with the Gaussian */
01924     skip_if (visir_vector_convolve_symm(tophat, self));
01925 
01926     if (doplot > 2) visir_vector_plot("set grid;","t 'Full Width Convolution' "
01927                                       "w linespoints", "", tophat);
01928     
01929     /* Overwrite the Gaussian with the Right Half of the convolution of the
01930        Top-hat + Gausssian */
01931 #if 1
01932     memcpy(cpl_vector_get_data(self),
01933            cpl_vector_get_data(tophat) + convolen/2,
01934            sizeof(double)*gausshlen);
01935 #else
01936     /* Equivalent, but slower */
01937     for (i = 0 ; i < gausshlen; i++)
01938         skip_if (cpl_vector_set(self, i, cpl_vector_get(tophat,
01939                                                           i + convolen/2)));
01940 #endif
01941 
01942     skip_if (0);
01943 
01944     cpl_msg_info(cpl_func, "Convolving Model Spectrum, Gauss-sigma=%g, "
01945                  "Tophat-width=%d, Truncation-Error=%g with width=%d", sigma,
01946                  1+2*ihtophat,
01947                  cpl_vector_get(self,gausshlen-1)/cpl_vector_get(self,0),
01948                  2*gausshlen-1);
01949 
01950     if (doplot > 1) visir_vector_plot("set grid;","t 'Right Half of Convolution"
01951                                       "' w linespoints", "", self);
01952 
01953     end_skip;
01954 
01955     cpl_vector_delete(tophat);
01956     cpl_image_unwrap(iself);
01957 
01958     if (cpl_error_get_code()) {
01959         cpl_vector_delete(self);
01960         self = NULL;
01961     }
01962 
01963     return self;
01964 
01965 }
01966 
01967 /*----------------------------------------------------------------------------*/
01984 /*----------------------------------------------------------------------------*/
01985 static cpl_bivector * visir_spc_extract(cpl_image * flipped,
01986                                         cpl_propertylist * qclist,
01987                                         cpl_image ** pweight2d,
01988                                         int doplot)
01989 {
01990     const int       ncol    = cpl_image_get_size_x(flipped);
01991     const int       npix    = cpl_image_get_size_y(flipped);
01992 
01993     cpl_bivector * result   = NULL;
01994     cpl_vector   * spectrum = NULL;
01995     cpl_vector   * error    = NULL;
01996     cpl_vector   * col      = NULL;
01997 
01998     cpl_image  * spatial  = NULL;
01999     cpl_image  * iweight  = NULL;
02000     cpl_vector * row      = NULL;
02001     cpl_image  * imrow    = NULL;
02002 
02003     double     * pweight  = NULL;
02004 
02005     cpl_apertures  * objects  = NULL;
02006     cpl_mask   * binary    = NULL;
02007     cpl_image  * locnoise  = NULL;
02008 
02009     double       xfwhm;   /* FWHM of brightest object */
02010     double       xcentro; /* X-Centroid of brightest object */
02011 
02012     int i, j;
02013     int is_rejected;
02014 
02015     const double sigma = VISIR_SPECTRO_SIGMA; /* Assume signal at this level */
02016     double sp_median;
02017     double stdev2d, min, max, yfwhm;
02018     double weight_2norm;
02019     /* Position of the widest signal region */
02020     int ifwhm, jfwhm;
02021     int mspix;
02022     /* Low and High pixel of the widest signal-less region */
02023     int ilnoise, ihnoise;
02024     const int is_echelle = ncol <= 2 * (whechelle + 1);
02025 
02026 
02027     cpl_ensure(pweight2d != NULL, CPL_ERROR_NULL_INPUT, NULL);
02028 
02029     cpl_ensure(sigma > 0.0, CPL_ERROR_UNSUPPORTED_MODE, NULL);
02030 
02031     *pweight2d = NULL;
02032 
02033     skip_if (0);
02034 
02035     /* Compute spatial weights:
02036        mean-subtract each row and average + normalize */
02037 
02038     if (!is_echelle) {
02039         /* All but HR Grism has a negative signal equal to the positive
02040            i.e. the mean is zero */
02041         /* FIXME: Not true for large offsets (or very extended objects) */
02042         cpl_msg_info(cpl_func, "Combined image has mean: %g",
02043                      cpl_image_get_mean(flipped));
02044 
02045         col = cpl_vector_new(npix);
02046         skip_if (0);
02047 
02048         /* Subtract the mean from each row/wavelength */
02049         pweight = cpl_image_get_data(flipped);
02050         for (j=0; j < npix; j++, pweight += ncol) {
02051             double mean;
02052 
02053             imrow = cpl_image_wrap_double(1, ncol, pweight);
02054             skip_if (0);
02055 
02056             mean = cpl_image_get_mean(imrow);
02057             skip_if (0);
02058 
02059             skip_if (cpl_vector_set(col, j, mean));
02060 
02061             skip_if (cpl_image_subtract_scalar(imrow, mean));
02062 
02063             cpl_image_unwrap(imrow);
02064             imrow = NULL;
02065 
02066         }
02067 
02068         if (doplot > 1) visir_vector_plot("set grid;","t 'Estimated Background'"
02069                                           " w linespoints", "", col);
02070         cpl_vector_delete(col);
02071         col = NULL;
02072     }
02073 
02074     /* The st.dev. of the noise */
02075     stdev2d = visir_img_phot_sigma_clip(flipped)/sqrt(npix);
02076     skip_if (0);
02077 
02078     cpl_msg_info(cpl_func, "St.Dev. on noise in 2D-combined image: %g",
02079                  stdev2d);
02080 
02081     /* Average the spectral dimension */
02082     spatial = cpl_image_collapse_create(flipped, 0);
02083     skip_if (0);
02084     skip_if (cpl_image_divide_scalar(spatial, npix));
02085 
02086     iweight = cpl_image_duplicate(spatial);
02087 
02088     /* Reject noise from spatial */
02089     sp_median = cpl_image_get_median(spatial);
02090     binary = cpl_mask_threshold_image_create(spatial, sp_median - sigma * stdev2d,
02091                                              sp_median + sigma * stdev2d);
02092 
02093     if (cpl_mask_count(binary) == ncol) {
02094         (void)cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
02095                                     "%d spatial weights too noisy. sigma=%g. "
02096                                     "stdev2d=%g. Spatial median=%g", ncol,
02097                                     sigma, stdev2d, sp_median);
02098         skip_if (1);
02099     }
02100 
02101 
02102     bug_if (cpl_image_reject_from_mask(spatial, binary));
02103 
02104     bug_if (cpl_image_get_maxpos(spatial, &ifwhm, &jfwhm));
02105 
02106     if (doplot > 1) {
02107         visir_image_col_plot("","t 'Most intense column' w linespoints",
02108                              "", flipped, ifwhm, ifwhm, 1);
02109         visir_image_row_plot("set grid;", "t 'Combined image with "
02110                              "spectral direction collapsed' w linespoints",
02111                              "", spatial, 1, 1, 1);
02112     }
02113 
02114     max = cpl_image_get(spatial, ifwhm, 1, &is_rejected);
02115     bug_if(is_rejected);
02116     if (max <= 0.0) {
02117         (void)cpl_error_set_message(cpl_func, CPL_ERROR_DATA_NOT_FOUND,
02118                                     "Cannot compute FWHM on a collapsed spectrum "
02119                                     "with a non-positive maximum: %g (at i=%d)",
02120                                     max, ifwhm);
02121         skip_if (1);
02122     }
02123 
02124     skip_if (cpl_image_get_fwhm(spatial, ifwhm, 1, &xfwhm,  &yfwhm));
02125 
02126     /* Find centroid in spatial */
02127     for (ilnoise = ifwhm; ilnoise > 0 &&
02128              !cpl_image_is_rejected(spatial, ilnoise, 1); ilnoise--);
02129     bug_if (0);
02130     for (ihnoise = ifwhm; ihnoise <= ncol &&
02131              !cpl_image_is_rejected(spatial, ihnoise, 1); ihnoise++);
02132     bug_if (0);
02133     /* There may be no negative weights at all */
02134     if (!ilnoise) ilnoise = 1;
02135     if (ihnoise > ncol) ihnoise = ncol;
02136 
02137     xcentro = cpl_image_get_centroid_x_window(spatial, ilnoise, 1, ihnoise, 1);
02138 
02139     cpl_msg_info(cpl_func, "Spatial FWHM(%d:%d:%d:%g): %g", ilnoise, ifwhm,
02140                  ihnoise, xcentro, xfwhm);
02141 
02142     /* Create weights that have an absolute sum of 1 - as an image */
02143     skip_if (cpl_image_normalise(iweight, CPL_NORM_ABSFLUX));
02144 
02145     if (doplot > 1) visir_image_row_plot("set grid;", "t 'Cleaned, normalized "
02146                                          "combined image with spectral direction"
02147                                          " averaged' w linespoints", "",
02148                                          iweight, 1, 1, 1);
02149 
02150     weight_2norm = sqrt(cpl_image_get_sqflux(iweight));
02151 
02152     cpl_msg_info(cpl_func, "2-norm of weights: %g", weight_2norm);
02153 
02154 
02155 
02156     /* Determine st.dev. on noise at signal-less pixels */
02157     if (is_echelle) {
02158         int ileft = 5;
02159         int iright = ncol - 5;
02160         cpl_binary * pbin;
02161 
02162 
02163         if (ileft  > xcentro - xfwhm * 2)
02164             ileft  = xcentro - xfwhm * 2;
02165         if (iright < xcentro + xfwhm * 2)
02166             iright = xcentro + xfwhm * 2;
02167 
02168         cpl_msg_info(cpl_func, "HRG pixels of noise: [1 %d] [%d %d]", ileft,
02169                      iright, ncol);
02170 
02171         bug_if(cpl_mask_xor(binary, binary));
02172 
02173         pbin = cpl_mask_get_data(binary);
02174         bug_if (0);
02175 
02176         for (i = 0; i < ncol; i++) pbin[i] = CPL_BINARY_0;
02177         for (i = 0; i < ileft; i++) pbin[i] = CPL_BINARY_1;
02178         for (i = iright; i < ncol; i++) pbin[i] = CPL_BINARY_1;
02179 
02180     }
02181     skip_if (0);
02182 
02183     mspix = cpl_mask_count(binary);
02184     cpl_msg_info(cpl_func, "Pixels of noise(%g +/- %g*%g): %d",
02185                  sp_median, stdev2d, sigma, mspix);
02186     skip_if (0);
02187 
02188     if (mspix < 2) {
02189         /* No noise pixels found */
02190         cpl_msg_error(cpl_func, "Cannot estimate spectrum noise with just %d "
02191                       "pixels of noise", mspix);
02192         visir_error_set(CPL_ERROR_DATA_NOT_FOUND);
02193         skip_if (1);
02194     }
02195 
02196     locnoise = cpl_image_new_from_mask(binary);
02197     cpl_mask_delete(binary);
02198     binary = NULL;
02199 
02200     skip_if (0);
02201 
02202     error = cpl_vector_new(npix);
02203     skip_if (0);
02204 
02205 
02206     /* Compute for each wavelength the noise */
02207     for (j=0; j < npix; j++) {
02208 
02209         double npp, stdev1d;
02210 
02211 
02212         imrow = cpl_image_extract(flipped, 1, j+1, ncol, j+1);
02213 
02214         skip_if (0);
02215 
02216         objects = cpl_apertures_new_from_image(imrow, locnoise);
02217         cpl_image_delete(imrow);
02218         imrow = NULL;
02219              
02220         skip_if (0);
02221 
02222         stdev1d = cpl_apertures_get_stdev(objects, 1);
02223         cpl_apertures_delete(objects);
02224         objects = NULL;
02225 
02226         /* The noise per pixel is defined as the Standard Deviation
02227            on the noise (computed from the part of the signal that
02228            has no object signal) multiplied by the 2-norm of the
02229            noise-thresholded spatial weights */
02230 
02231         npp = weight_2norm * stdev1d;
02232 
02233         skip_if (cpl_vector_set(error, j, npp));
02234     }
02235 
02236     /* Spectrum noise computation done */
02237 
02238 
02239     /* Iterate through the spatial dimension - sum up the weighted column */
02240     for (i=1; i <= ncol; i++) {
02241         const double weight = cpl_image_get(iweight, i, 1, &is_rejected);
02242 
02243         skip_if (0);
02244         if (is_rejected) {
02245             /* This would require a whole column to be rejected */
02246             visir_error_set(CPL_ERROR_DATA_NOT_FOUND);
02247             skip_if (1);
02248         }
02249             
02250         /* The sigma-clipping may cause many columns to be zero */
02251         if (weight == 0) continue;
02252 
02253         col = cpl_vector_new_from_image_column(flipped, i); /* or medcorr */
02254         skip_if (0);
02255 
02256         skip_if (cpl_vector_multiply_scalar(col, weight));
02257 
02258         if (spectrum == NULL) {
02259             spectrum = col;
02260         } else {
02261             skip_if (cpl_vector_add(spectrum, col));
02262             cpl_vector_delete(col);
02263         }
02264         col = NULL;
02265     }
02266 
02267     /* assert( spectrum ); */
02268 
02269     min = cpl_vector_get_min(spectrum);
02270     if (min <0) cpl_msg_warning(cpl_func, "Extracted spectrum has negative "
02271                                 "intensity: %g", min);
02272 
02273     /* Create 2D-weight map by replicating the 1D-weights over the
02274        wavelengths */
02275 
02276     *pweight2d = cpl_image_new(ncol, npix, CPL_TYPE_DOUBLE);
02277 
02278     for (j=1; j <= npix; j++)
02279         skip_if (cpl_image_copy(*pweight2d, iweight, 1, j));
02280 
02281     if (doplot > 0) visir_image_plot("", "t 'The weight map'", "", *pweight2d);
02282 
02283     bug_if(visir_spectro_qclist_obs(qclist, xfwhm, xcentro));
02284 
02285     end_skip;
02286 
02287     cpl_image_delete(locnoise);
02288     cpl_mask_delete(binary);
02289     cpl_image_delete(spatial);
02290     cpl_apertures_delete(objects);
02291     cpl_vector_delete(col);
02292     cpl_vector_delete(row);
02293     cpl_image_delete(imrow);
02294     cpl_image_delete(iweight);
02295 
02296     if (cpl_error_get_code()) {
02297         cpl_vector_delete(spectrum);
02298         cpl_vector_delete(error);
02299     } else {
02300 
02301         result = cpl_bivector_wrap_vectors(spectrum, error);
02302 
02303         if (doplot > 2) visir_bivector_plot("", "t 'error versus spectrum'",
02304                                             "", result);
02305     }
02306 
02307     return result;
02308 }
02309 

Generated on Thu Mar 24 11:59:40 2011 for VISIR Pipeline Reference Manual by  doxygen 1.5.8