visir_spectro.c

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

Generated on Mon Feb 6 15:23:49 2012 for VISIR Pipeline Reference Manual by  doxygen 1.5.8