/* $Id: visir_utils.c,v 1.187 2013-09-24 10:19:57 jtaylor Exp $
 *
 * This file is part of the VISIR Pipeline
 * Copyright (C) 2002,2003,2013,2014 European Southern Observatory
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA
 */

#ifdef HAVE_CONFIG_H
#include "config.h"
#endif

/* for mkstemp */
#if !defined _XOPEN_SOURCE
#define _XOPEN_SOURCE  500
#endif

/*-----------------------------------------------------------------------------
                                   Includes
 -----------------------------------------------------------------------------*/

#include "visir_utils.h"

#include "irplib_utils.h"

#include "visir_inputs.h"
#include "visir_pfits.h"
#define visir_pfits_get_int(KEY)    irplib_pfits_get_int(self, KEY)
#include "visir_spc_distortion.h"
#include "visir_cpl_compat.h"
#include <cpl.h>
#include <cxlist.h>
#include <sys/types.h> /* for waitpid */
#include <sys/wait.h> /* for waitpid */
#include <errno.h>

#include <string.h>
#include <math.h>
#include <assert.h>
#include <stdlib.h>
#include <unistd.h>
#include <libgen.h>
#include <stdint.h> /* for intptr_t */

/* for mkdir, open, posix_fadvise */
#include <sys/stat.h>
#include <sys/types.h>
#include <fcntl.h>

#include <signal.h> /* for sigaction, sigemptyset */

#ifdef _OPENMP
#include <omp.h>
#endif

/* make sure we have fdopen (posix 1990) */
IRPLIB_DIAG_PRAGMA_PUSH_ERR(-Wimplicit-function-declaration)

#ifdef __SSE3__
#include <pmmintrin.h>
#endif
#ifdef __SSE2__
#include <xmmintrin.h>
#endif

/*-----------------------------------------------------------------------------
                                   Define
 -----------------------------------------------------------------------------*/

#define VISIR_BACKGD_START  76
#define VISIR_BACKGD_STOP   172

/*----------------------------------------------------------------------------*/
/**
 * @defgroup visir_utils Miscellaneous Utilities
 *
 * TBD
 */
/*----------------------------------------------------------------------------*/

#define IND(x, y , nx) ((x) + (nx) * (y))

/*-----------------------------------------------------------------------------
                        Private function prototypes
 -----------------------------------------------------------------------------*/


static double visir_great_circle_dist(double, double, double, double);
static double ra_hms2deg(int, int, double);
static double dec_hms2deg(int, int, double);

static const char * visir_get_capa(const cpl_propertylist *);
static double visir_hcycle_background(const irplib_framelist *, int, int);

#ifdef VISIR_MASK_HAS
static cpl_boolean visir_mask_has(const cpl_mask *, cpl_binary, int);
#endif

/**@{*/


/*----------------------------------------------------------------------------*/
/**
  @brief    Get the number of available threads
  @param    force   override OMP_NUM_THREADS with number of processors
  @return   if set OMP_NUM_THREADS else number of available processors
 */
/*----------------------------------------------------------------------------*/
size_t visir_get_num_threads(cpl_boolean force)
{
    long ret = 1;
    FILE * f;
    if (force == CPL_FALSE && getenv("OMP_NUM_THREADS")) {
        char * endptr, * str = getenv("OMP_NUM_THREADS");
        int r = (int)strtol(str, &endptr, 10);
        return (str == endptr || r < 1) ? 1 : r;
    }
#ifdef _OPENMP
    /* respects affinity */
    ret = omp_get_max_threads();
#endif
#if defined HAVE_SYSCONF && defined _SC_NPROCESSORS_ONLN
    ret = sysconf(_SC_NPROCESSORS_ONLN);
#endif
    /* simple linux only check for hyperthreading, not useful for visir */
    f = fopen("/sys/devices/system/cpu/cpu0/"
              "topology/thread_siblings_list", "r");
    if (f) {
        char buf[80];
        if (fgets(buf, 80, f) != NULL) {
            int a, b;
            buf[79] = 0;
            if (sscanf(buf, "%d,%d", &a, &b) == 2) {
                ret /= 2;
            }
        }
        fclose(f);
    }
    return ret < 1 ? 1 : ret;
}


/*----------------------------------------------------------------------------*/
/**
  @brief    get temporary directory
  @param    tmpdir_   tmpdir prefix, must be suitable for mkstemp
                      will be modified to contain dir path if successful
  @return   true or false tmpdir creation was successful
 */
/*----------------------------------------------------------------------------*/
cpl_boolean visir_get_tempdir(char * tmpdir_)
{
    cpl_boolean have_tmpdir = CPL_FALSE;
    char tmpdir[strlen(tmpdir_) + 1];

    /* create safe tempfile, remove it and reuse name for mkdir,
     * mkdir is atomic and symlink safe but we need to try multiple times
     * due to the possible race between unlink and mkdir */
    for (int i = 0; i < 10 && !have_tmpdir; i++) {
        strcpy(tmpdir, tmpdir_);
        int fd = mkstemp(tmpdir);
        skip_if(fd < 0);
        close(fd);
        skip_if(unlink(tmpdir));
        have_tmpdir = mkdir(tmpdir, O_RDWR | S_IRWXU) == 0;
    }

    error_if(have_tmpdir != CPL_TRUE, CPL_ERROR_FILE_IO,
             "Temporary directory creation failed");

    strcpy(tmpdir_, tmpdir);

    end_skip;

    return have_tmpdir;
}

/* ---------------------------------------------------------------------------*/
/**
 @brief get the absoluet current working directory
 @return char string, must be deleted by the user with cpl_free
 */
/* ---------------------------------------------------------------------------*/
char * visir_get_cwd(void)
{
    size_t n = 4096;
    char * buf;
    errno = 0;
    /* if only we could use sane GNU functions instead of this posix crap */
    while (1) {
        buf = cpl_malloc(n);
        if (getcwd(buf, n) != 0) {
            break;
        }
        else if (errno == ERANGE) {
            /* increase buffer, repeat */
            errno = 0;
            n *= 2;
            cpl_free(buf);
        }
        else {
            cpl_free(buf);
            cpl_error_set_message(cpl_func, CPL_ERROR_FILE_IO,
                                  "Could not determine current working "
                                  "directory: %s", strerror(errno));
            return NULL;
        }
    }

    return buf;
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief advise kernel to drop cached pages of file
 * @param filename
 * @param offset offset in file
 * @param length length in to drop, 0 for full file
 */
/* ---------------------------------------------------------------------------*/
void visir_drop_cache(const char * VISIR_ATTR_UNUSED filename,
                      off_t VISIR_ATTR_UNUSED offset,
                      off_t VISIR_ATTR_UNUSED length)
{
#if defined HAVE_POSIX_FADVISE && defined POSIX_FADV_DONTNEED
    int fd = open(filename, O_RDONLY);
    if (fd != -1) {
        /* POSIX_FADV_NOREUSE is a nop on linux */
        posix_fadvise(fd, offset, length, POSIX_FADV_DONTNEED);
        close(fd);
    }
#endif
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief readahead file into page cache
 * @param filename
 * @param offset offset in file
 * @param length length in to drop, 0 for full file
 *
 * useful e.g. before loading compressed fits files from multiple threads
 * the sequential readahead will read from disk in the ideal manner so the
 * following reader threads can read in any order as they will actually cause
 * any disk seeks.
 */
/* ---------------------------------------------------------------------------*/
void visir_readahead(const char * VISIR_ATTR_UNUSED filename,
                     off_t VISIR_ATTR_UNUSED offset, off_t VISIR_ATTR_UNUSED length)
{
#if defined HAVE_POSIX_FADVISE && defined POSIX_FADV_WILLNEED
    int fd = open(filename, O_RDONLY);
    if (fd != -1) {
        /* does the same as readahead(2) on linux */
        posix_fadvise(fd, offset, length, POSIX_FADV_WILLNEED);
        close(fd);
    }
#endif
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief get number of bytes the image data has
 * @param img
 */
/* ---------------------------------------------------------------------------*/
size_t visir_get_nbytes(const cpl_image * img)
{
    return cpl_image_get_size_x(img) *
           cpl_image_get_size_y(img) *
           cpl_type_get_sizeof(cpl_image_get_type(img));
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief get number of bytes an extension has
 * @param plist  propertylist with mandatory FITS keywords
 * @return number of bytes of the data of an extension + 80 * number of keys
 *
 * the size is an approximation as a fits header may have empty header cards
 * that are not stored in the cpl_propertylist
 */
/* ---------------------------------------------------------------------------*/
size_t visir_get_nbytes_plist(const cpl_propertylist * self)
{
    int naxis = visir_pfits_get_int("NAXIS");
    int bitpix = abs(visir_pfits_get_int("BITPIX"));
    int pcount = 0;
    int gcount = 1;
    size_t naxis_bytes = 1;
    size_t nbytes;
    for (int i = 0; i < naxis; i++) {
        char buffer[80];
        sprintf(buffer, "NAXIS%d", i + 1);
        naxis_bytes *= visir_pfits_get_int(buffer);
    }
    if (cpl_propertylist_has(self, "XTENSION")) {
        pcount = visir_pfits_get_int("PCOUNT");
        gcount = visir_pfits_get_int("GCOUNT");
    }
    if (cpl_error_get_code())
        return 0;

    nbytes = (bitpix / 8) * gcount * (pcount + naxis_bytes);
    /* approximation as there may be empty headers */
    nbytes += cpl_propertylist_get_size(self) * 80;
    return nbytes;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Multiply two images, store the result in the first image.
  @param    im1     first operand.
  @param    im2     second operand.
  @return   the #_cpl_error_code_ or CPL_ERROR_NONE
  @see      cpl_image_multiply()

  Fast simd version if memory is aligned and sse is available.
  Slightly faster than cpl 6.1 version as it will *not* handle NaN correctly!
 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_image_multiply_fast(cpl_image       *   im1,
                                         const cpl_image *   im2)
{
#if defined __SSE3__ || defined __SSE2__
    cpl_ensure_code(im1     != NULL, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(im2     != NULL, CPL_ERROR_NULL_INPUT);

    if (cpl_image_get_type(im1) == CPL_TYPE_FLOAT_COMPLEX &&
        cpl_image_get_type(im2) == CPL_TYPE_FLOAT_COMPLEX) {
        const cpl_size nx1 = cpl_image_get_size_x(im1);
        const cpl_size ny1 = cpl_image_get_size_y(im1);
        const cpl_size nx2 = cpl_image_get_size_x(im2);
        const cpl_size ny2 = cpl_image_get_size_y(im2);
        const size_t Nt = nx1 * ny1;
        const size_t n = (Nt % 2) == 1 ? Nt - 1 : Nt;

        float complex * a = cpl_image_get_data(im1);
        const float complex * b = cpl_image_get_data_const(im2);

        cpl_ensure_code(nx1 == nx2, CPL_ERROR_INCOMPATIBLE_INPUT);
        cpl_ensure_code(ny1 == ny2, CPL_ERROR_INCOMPATIBLE_INPUT);
        cpl_ensure_code(n < SIZE_MAX - 1, CPL_ERROR_ACCESS_OUT_OF_RANGE);

        /* if unaligned fall back to cpl, it is vectorized since 6.1 too but
         * checks for NaN which makes it a bit slower */
        if (((intptr_t)a % 16) != 0 || ((intptr_t)b % 16) != 0)
            return cpl_image_multiply(im1, im2);

#if defined __SSE2__ && !defined __SSE3__
        const __m128 neg = (__m128)_mm_set_epi32(0x0u, 0x80000000u, 0x0u, 0x80000000u);
#endif
        for (size_t i = 0; i < n; i += 2) {
            __m128 ua = _mm_load_ps((float *)&a[i]); /* x w */
            __m128 ub = _mm_load_ps((const float *)&b[i]); /* y z */
            /* optimized to SSE3 _mm_move[hl]dup_ps by gcc */
            __m128 reala = _mm_shuffle_ps(ua, ua, _MM_SHUFFLE(2, 2, 0, 0)); /* x x */
            __m128 imaga = _mm_shuffle_ps(ua, ua, _MM_SHUFFLE(3, 3, 1, 1)); /* w w */
            __m128 t1 = _mm_mul_ps(reala, ub); /* x*y x*z */
            __m128 sb = _mm_shuffle_ps(ub, ub, _MM_SHUFFLE(2, 3, 0, 1)); /* z y */
            __m128 t2 = _mm_mul_ps(imaga, sb); /* w*z w*y */
#if defined __SSE2__ && !defined __SSE3__
            t2 = _mm_xor_ps(t2, neg); /* faster than multipling with 1,-1,1,-1 */
            __m128 res = _mm_add_ps(t1, t2);
#else
            __m128 res = _mm_addsub_ps(t1, t2); /* x*y-w*z x*z+w*y*/
#endif
            _mm_store_ps((float *)&a[i], res);
        }

        if ((Nt) % 2 == 1)
            a[Nt - 1] = a[Nt - 1] * b[Nt - 1];

        /* Handle bad pixels map */
        const cpl_mask * bpm1 = cpl_image_get_bpm_const(im1);
        const cpl_mask * bpm2 = cpl_image_get_bpm_const(im2);
        if (bpm2 != NULL) {
            if (bpm1 == NULL)
                cpl_image_reject_from_mask(im1, bpm2);
            else {
                cpl_mask_or(cpl_image_get_bpm(im1), bpm2);
            }
        }

    } else
#endif
        cpl_image_multiply(im1, im2);

    return CPL_ERROR_NONE;
}

/* ---------------------------------------------------------------------------*/
/**
   @brief compute the mean of an image
   @param im   input image
   @return mean of image

   Faster than cpl_image_get_mean as that as of 6.4.2 computes multiple
   statistics at once when only the mean is asked for.
   Also sacrifices accuracy for performance by applying a simple sum instead of
   the recurrence relation.
 */
/* ---------------------------------------------------------------------------*/
double visir_image_get_mean_fast(const cpl_image * im)
{
    if (im == NULL || cpl_image_get_type(im) != CPL_TYPE_FLOAT) {
        return cpl_image_get_mean(im);
    }
    else {
        const size_t npix = cpl_image_get_size_x(im) *
                            cpl_image_get_size_y(im);
        const float * data = cpl_image_get_data_float_const(im);
        const size_t nbad = cpl_image_count_rejected(im);
        /* sum into multiple values to break dependency cycle and improve
         * accuracy slightly (see pairwise summation) */
        double sum1 = 0;
        double sum2 = 0;
        double sum3 = 0;
        double sum4 = 0;
        if (nbad == 0) {
            size_t i;
            for (i = 0; i < npix - (npix % 4u); i+=4) {
                sum1 += data[i];
                sum2 += data[i + 1];
                sum3 += data[i + 2];
                sum4 += data[i + 3];
            }
            for (; i < npix; i++) {
                sum1 += data[i];
            }
        }
        else if (nbad == npix) {
            return 0.;
        }
        else {
            size_t i;
            const cpl_binary * m =
                cpl_mask_get_data_const(cpl_image_get_bpm_const(im));
            for (i = 0; i < npix - (npix % 4u); i+=4) {
                if (!m[i])
                    sum1 += data[i];
                if (!m[i + 1])
                    sum2 += data[i + 1];
                if (!m[i + 2])
                    sum3 += data[i + 2];
                if (!m[i + 3])
                    sum4 += data[i + 3];
            }
            for (; i < npix; i++) {
                if (!m[i])
                    sum1 += data[i];
            }
        }
        return (sum1 + sum2 + sum3 + sum4) / (npix - nbad);
    }
}


/*----------------------------------------------------------------------------*/
/**
  @brief    compares the filename of a frame
  @param    a   frame
  @param    b   frame
  @return   output of strcmp on the filename

 */
/*----------------------------------------------------------------------------*/
int visir_cmp_frm_fn(const cpl_frame * a, const cpl_frame * b)
{
    const char * fna = cpl_frame_get_filename(a);
    const char * fnb = cpl_frame_get_filename(b);

    return strcmp(fna, fnb);
}

/*----------------------------------------------------------------------------*/
/**
  @brief    moves files in frame
  @param    frames  framelist
  @param    dest_   directory to move the files to, cwd if NULL
  @param    src_    directory to move the files from, cwd if NULL
  @return CPL_ERROR_NONE iff OK, otherwise the relevant CPL error code.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_move_products(cpl_frameset *frames,
                                   const char * dest_, const char * src_)
{
    const char * dest = dest_ ? dest_ : ".";
    const char * src = src_ ? src_ : ".";

    FOR_EACH_FRAMESET(frm, frames) {
        if (cpl_frame_get_group(frm) == CPL_FRAME_GROUP_PRODUCT) {
            char * buf = cpl_strdup(cpl_frame_get_filename(frm));
            char * new_fn = cpl_sprintf("%s/%s", dest, basename(buf));
            cpl_free(buf);

            buf = cpl_sprintf("mv \"%s/%s\" \"%s\"", src,
                              cpl_frame_get_filename(frm), new_fn);
            if (WEXITSTATUS(system(buf)) != 0) {
                cpl_error_set_message(cpl_func, CPL_ERROR_FILE_IO,
                                      "Could not move %s/%s to %s", src,
                                      cpl_frame_get_filename(frm), new_fn);
                cpl_free(buf);
                cpl_free(new_fn);
                skip_if(0);
            }
            /* DFS11986: new_fn is an absolute path
             * esorex cannot deal with paths in the filename */
            /* cpl_frame_set_filename(frm, new_fn); */
            cpl_free(buf);
            cpl_free(new_fn);
            skip_if(0);
        }
        /* remove ../ from adapted relative paths again so esorex finds them */
        if (cpl_frame_get_group(frm) == CPL_FRAME_GROUP_RAW ||
            cpl_frame_get_group(frm) == CPL_FRAME_GROUP_CALIB) {
            if (strncmp(cpl_frame_get_filename(frm), "../", 3) != 0) {
                continue;
            }
            char * buf = cpl_strdup(cpl_frame_get_filename(frm));
            cpl_frame_set_filename(frm, buf + 3);
            cpl_free(buf);
        }
    }

    end_skip;

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Make a copy of a parameter
  @param    p    parameter to copy
  @return new parameter or NULL on error

  can be removed when it is in cpl (DFS11844)
  FIXME: only handles value parameters, no ranges or enums!
 */
/*----------------------------------------------------------------------------*/
cpl_parameter * visir_parameter_duplicate(const cpl_parameter * p)
{
    cpl_parameter * np = NULL;

    cpl_ensure(p != NULL, CPL_ERROR_NULL_INPUT, NULL);
    cpl_ensure(cpl_parameter_get_class(p) == CPL_PARAMETER_CLASS_VALUE,
               CPL_ERROR_UNSUPPORTED_MODE, NULL);

    switch (cpl_parameter_get_type(p)) {
        case CPL_TYPE_BOOL:
            np = cpl_parameter_new_value(cpl_parameter_get_name(p),
                                         cpl_parameter_get_type(p),
                                         cpl_parameter_get_help(p),
                                         cpl_parameter_get_context(p),
                                         cpl_parameter_get_default_bool(p));
            cpl_parameter_set_bool(np, cpl_parameter_get_bool(p));
            break;

        case CPL_TYPE_INT:
            np = cpl_parameter_new_value(cpl_parameter_get_name(p),
                                         cpl_parameter_get_type(p),
                                         cpl_parameter_get_help(p),
                                         cpl_parameter_get_context(p),
                                         cpl_parameter_get_default_int(p));
            cpl_parameter_set_int(np, cpl_parameter_get_int(p));
            break;

        case CPL_TYPE_DOUBLE:
            np = cpl_parameter_new_value(cpl_parameter_get_name(p),
                                         cpl_parameter_get_type(p),
                                         cpl_parameter_get_help(p),
                                         cpl_parameter_get_context(p),
                                         cpl_parameter_get_default_double(p));
            cpl_parameter_set_double(np, cpl_parameter_get_double(p));
            break;

        case CPL_TYPE_STRING:
            np = cpl_parameter_new_value(cpl_parameter_get_name(p),
                                         cpl_parameter_get_type(p),
                                         cpl_parameter_get_help(p),
                                         cpl_parameter_get_context(p),
                                         cpl_parameter_get_default_string(p));
            cpl_parameter_set_string(np, cpl_parameter_get_string(p));
            break;

        default:
            cpl_error_set_message(cpl_func, CPL_ERROR_UNSUPPORTED_MODE,
                                  "Parameter has unknown type");
            break;
    }

    if (np == NULL)
        return NULL;

    if (cpl_parameter_get_tag(p))
        cpl_parameter_set_tag(np, cpl_parameter_get_tag(p));

    {
        cpl_parameter_mode modes[] = {CPL_PARAMETER_MODE_CLI,
            CPL_PARAMETER_MODE_CFG, CPL_PARAMETER_MODE_ENV};

        for (size_t i = 0; i < ARRAY_LEN(modes); i++) {
            cpl_parameter_set_alias(np, modes[i],
                                    cpl_parameter_get_alias(p, modes[i]));
            if (!cpl_parameter_is_enabled(p, modes[i]))
                cpl_parameter_disable(np, modes[i]);
        }
    }

    return np;
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Copies parameter values from one list into another
  @param    dest   destination parameter list
  @param    src    source parameter list
  @return CPL_ERROR_NONE iff OK, otherwise the relevant CPL error code.

  only copies the values if the parameter exists in the destination.
  Useful for chain recipes.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_copy_parameters(cpl_parameterlist * dest,
                                     const cpl_parameterlist * src)
{
    for (const cpl_parameter * p = cpl_parameterlist_get_first_const(src);
         p != NULL; p = cpl_parameterlist_get_next_const(src)) {
        cpl_parameter * par =
            cpl_parameterlist_find(dest, cpl_parameter_get_name(p));

        if (!par)
            continue;

        cpl_type t = cpl_parameter_get_type(par);
        if (t == CPL_TYPE_BOOL)
            cpl_parameter_set_bool(par, cpl_parameter_get_bool(p));
        else if (t == CPL_TYPE_INT)
            cpl_parameter_set_int(par, cpl_parameter_get_int(p));
        else if (t == CPL_TYPE_DOUBLE)
            cpl_parameter_set_double(par, cpl_parameter_get_double(p));
        else if (t == CPL_TYPE_STRING)
            cpl_parameter_set_string(par, cpl_parameter_get_string(p));
        else
            bug_if(1);
    }

    end_skip;

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Initializes a recipe
  @param    name      recipe name
  @param    get_info  pointer to the plugin get_info function
  @param    plugins   pluginlist
  @return   initialized recipe

 */
/*----------------------------------------------------------------------------*/
cpl_recipe *
visir_init_recipe(const char * name, int (*get_info)(cpl_pluginlist *),
                  cpl_pluginlist * plugins)
{
    cpl_recipe * recipe = cpl_calloc(1, sizeof(cpl_recipe));
    get_info(plugins);
    cpl_plugin * pl = cpl_pluginlist_find (plugins, name);
    cpl_plugin_copy ((cpl_plugin *) & recipe->interface, pl);
    return recipe;
}


/*----------------------------------------------------------------------------*/
/**
  @brief    runs a recipe
  @param    recipe        recipe to run
  @param    framelist     framelist for recipe to run on
  @param    parlist       global parameterlist
  @param    set_parlist   function to update the recipe parameter list
                          with values from global one
  @return CPL_ERROR_NONE iff OK, otherwise the relevant CPL error code.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code
visir_run_recipe(cpl_recipe * recipe,
                 cpl_frameset * framelist, const cpl_parameterlist * parlist,
                 cpl_error_code (*set_parlist)(cpl_parameterlist *,
                                               const cpl_parameterlist *))
{
    cpl_plugin * pl = &recipe->interface;
    cpl_plugin_func plugin_func_init = cpl_plugin_get_init(pl);
    cpl_plugin_func plugin_func_exec = cpl_plugin_get_exec(pl);
    cpl_plugin_func plugin_func_deinit = cpl_plugin_get_deinit(pl);

    skip_if(0);

    recipe->frames = framelist;

    /* write out sof file for easier debugging of recipe chains */
    if (getenv("VISIR_TEST_MODE")) {
        char * buf = cpl_sprintf("%s.sof", cpl_plugin_get_name(pl));
        FILE * f = fopen(buf, "wt");
        cpl_free(buf);
        FOR_EACH_FRAMESET(frm, framelist) {
            fprintf(f, "%s %s\n", cpl_frame_get_filename(frm), cpl_frame_get_tag(frm));
        }
        fclose(f);
    }

    /* clear cache as new recipes usually start from extension 1 */
    cpl_fits_set_mode(CPL_FITS_RESTART_CACHING);

    plugin_func_init(&recipe->interface);
    if (set_parlist)
        set_parlist(recipe->parameters, parlist);
    plugin_func_exec(&recipe->interface);
    plugin_func_deinit(&recipe->interface);

    end_skip;

    cpl_fits_set_mode(CPL_FITS_RESTART_CACHING);

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @brief    prepare a frameset for a recipe, including changing tags
  @param    frameset   frameset to modify
  @param    tagmap     array of even size containing original and new tag
  @param    ntags      size of tagmap array
  @param    reverse    if true reverse the frameset
  @return   the new frameset

  prepares a recipe output frameset to be suitable as input for a recipe
  tagmap is an array of even size, the even entries declare tags to be changed
  to the content of the following uneven entry.
  Additionally it sorts the set by the filename, optionally reversing it to
  improve page cache reuse

 */
/*----------------------------------------------------------------------------*/
cpl_frameset *
visir_prepare_frameset(const cpl_frameset * frameset,
                       const char ** tagmap, size_t ntags,
                       cpl_boolean reverse)
{
    cpl_frameset * nlist = cpl_frameset_new();
    cx_list * _nlist = cx_list_new();
    cpl_ensure(ntags % 2 == 0, CPL_ERROR_ILLEGAL_INPUT, nlist);

    FOR_EACH_FRAMESET_C(frame, frameset) {
        if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_PRODUCT) {
            cpl_frame * frm = cpl_frame_duplicate(frame);
            cpl_frame_set_group(frm, CPL_FRAME_GROUP_RAW);
            cpl_frame_set_level(frm, CPL_FRAME_LEVEL_NONE);
            for (size_t i = 0; i < ntags; i += 2)
                if (strcmp(tagmap[i], cpl_frame_get_tag(frm)) == 0)
                    cpl_frame_set_tag(frm, tagmap[i + 1]);

            cx_list_push_back(_nlist, frm);
        }
        if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_CALIB)
            cx_list_push_back(_nlist, cpl_frame_duplicate(frame));
    }

    cx_list_sort(_nlist, (cx_compare_func)visir_cmp_frm_fn);
    if (reverse) {
        cx_list_reverse(_nlist);
    }

    FOR_EACH(it, _nlist)
        cpl_frameset_insert(nlist, cx_list_get(_nlist, it));
    cx_list_delete(_nlist);

    return nlist;
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief remove input calibration files that have been replaced by
 *        recipe output
 * @param set input frameset, cleaned and deleted
 * @return  frameset with calib files removed
 *
 * currently only removes input STATIC_MASK which is jittered by repack
 */
/* ---------------------------------------------------------------------------*/
cpl_frameset * visir_remove_modified_calib(cpl_frameset * set)
{
    cpl_frameset * cleanset = cpl_frameset_new();
    FOR_EACH_FRAMESET(frame, set) {
        if (cpl_frame_get_group(frame) == CPL_FRAME_GROUP_CALIB &&
            strcmp(cpl_frame_get_tag(frame),
                   "STATIC_MASK") == 0) {
            continue;
        }
        cpl_frameset_insert(cleanset, cpl_frame_duplicate(frame));
    }
    cpl_frameset_delete(set);

    return cleanset;
}


/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    wait for child process returning a frameset via a pipe
  @param    pid      child pid
  @param    rpipe   pipe file stream
  @return   the result frameset or NULL

 */
/*----------------------------------------------------------------------------*/
static cpl_frameset *
visir_wait_for_child(pid_t pid, FILE * rpipe)
{
    char * rbuffer = NULL;
    int status;
    cpl_error_code err;
    size_t size;
    cpl_frameset * result = NULL;

    /* we must read before waiting for the child else the writes may block
     * use stream to save us the EINTR and partial read loops
     * pipes are all closed on error so fread will fail if child fails */
    cpl_ensure(rpipe != NULL, CPL_ERROR_NULL_INPUT, NULL);
    skip_if(fread(&err, sizeof(err), 1, rpipe) != 1);
    cpl_error_set(cpl_func, err);

    skip_if(fread(&size, sizeof(size), 1, rpipe) != 1);

    rbuffer = cpl_malloc(size);
    skip_if(fread(rbuffer, size, 1, rpipe) != 1);

    result = visir_frameset_deserialize(rbuffer, NULL);

    end_skip;

    /* wait for child to end */
    if (waitpid(pid, &status, 0) != pid) {
        cpl_error_set_message(cpl_func, CPL_ERROR_FILE_IO,
                              "%s", strerror(errno));
    }
    else if (WIFSIGNALED(status)) {
        cpl_error_set_message(cpl_func, CPL_ERROR_FILE_IO,
                              "Process killed by signal %d", WTERMSIG(status));
    }
    else if (WIFEXITED(status) && WEXITSTATUS(status) != 0) {
        cpl_error_set_message(cpl_func, CPL_ERROR_UNSPECIFIED,
                              "Process failed with code %d",
                              WEXITSTATUS(status));
    }
    else
        assert(1);

    cpl_free(rbuffer);

    return result;
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief remove temporary directory if delete-temp parameter is true
 *
 * @param parlist    parameter list containing delete-temp
 * @param recipename name of recipe
 * @param tmpdir     path of temporary directory
 */
/* ---------------------------------------------------------------------------*/
static void
remove_tempdir(const cpl_parameterlist * parlist, const char*  recipename,
               const char * tmpdir)
{
    const cpl_boolean delete =
        irplib_parameterlist_get_bool(parlist, PACKAGE,
                                      recipename, "delete-temp");

    if (delete) {
        char * cmd = cpl_sprintf("rm -rf \"%s\"", tmpdir);
        cpl_msg_info(cpl_func, "Removing temporary directory: %s", tmpdir);
        if (WEXITSTATUS(system(cmd)) != 0)
            cpl_msg_warning(cpl_func, "Removing temporary "
                            "directory %s failed", tmpdir);
        cpl_free(cmd);
    }
    else
        cpl_msg_info(cpl_func, "Keeping temporary directory: %s", tmpdir);
}

/*----------------------------------------------------------------------------*/
/**
  @brief    execute a recipe in a temporary directory
  @param    recipename   name of thye recipe
  @param    recipe       plugin structure
  @param    function     pointer to main execution function
  @return   errorcode

 */
/*----------------------------------------------------------------------------*/
cpl_error_code
visir_tmpdir_exec(const char * recipename, cpl_plugin * plugin,
                  int (*function)(cpl_frameset *, const cpl_parameterlist *))
{
    char tmpdir[strlen(recipename) + 8];
    cpl_boolean have_tmpdir = CPL_FALSE;
    cpl_errorstate cleanstate = cpl_errorstate_get();
    cpl_recipe * recipe = (cpl_recipe *)plugin;
    sprintf(tmpdir, "%s_XXXXXX", recipename);

    have_tmpdir = visir_get_tempdir(tmpdir);
    skip_if(have_tmpdir != CPL_TRUE);

    cpl_msg_info(cpl_func, "Working in temporary directory: %s", tmpdir);

    /* go to tmpdir */
    if (chdir(tmpdir) != 0) {
        return cpl_error_set_message(cpl_func, CPL_ERROR_FILE_IO,
                     "Could not change to temporary directory %s", tmpdir);
    }

    /* correct relative paths for the change to the tmpdir */
    FOR_EACH_FRAMESET(frm, recipe->frames) {
        if (cpl_frame_get_filename(frm)[0] != '/') {
            char * buf = cpl_sprintf("../%s", cpl_frame_get_filename(frm));
            cpl_frame_set_filename(frm, buf);
            cpl_free(buf);
        }
    }

    cpl_recipedefine_exec(plugin, function);

    if (chdir("..") != 0) {
        return cpl_error_set_message(cpl_func, CPL_ERROR_FILE_IO,
                     "Could not change back to base directory");
    }

    /* move end products from tmp to cwd */
    skip_if(visir_move_products(recipe->frames, ".", tmpdir));

    end_skip;

    if (have_tmpdir) {
        remove_tempdir(recipe->parameters, recipename, tmpdir);
    }

    if (!cpl_errorstate_is_equal(cleanstate))
        cpl_errorstate_dump(cleanstate, CPL_FALSE, NULL);

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @brief    execute a recipe in a fork
  @param    recipename   name of thye recipe
  @param    recipe       plugin structure
  @param    function     pointer to main execution function
  @return   errocode

 */
/*----------------------------------------------------------------------------*/
cpl_error_code
visir_forking_exec(const char * recipename, cpl_plugin * plugin,
                   int (*function)(cpl_frameset *, const cpl_parameterlist *))
{
    char tmpdir[strlen(recipename) + 8];
    cpl_boolean have_tmpdir = CPL_FALSE;
    cpl_errorstate cleanstate = cpl_errorstate_get();
    cpl_recipe * recipe = (cpl_recipe *)plugin;
    FILE * pipe_stream = NULL;
    int pipe_fd[2];
    static const int READ = 0, WRITE = 1;
    sprintf(tmpdir, "%s_XXXXXX", recipename);

    /* ignore sigint in parent to ensure cleanup */
    struct sigaction sa, sa_orig;
    sa.sa_handler = SIG_IGN;
    sigemptyset(&sa.sa_mask);
    sa.sa_flags = 0;
    skip_if(sigaction(SIGINT, &sa, &sa_orig) != 0);

    have_tmpdir = visir_get_tempdir(tmpdir);
    skip_if(have_tmpdir != CPL_TRUE);

    cpl_msg_info(cpl_func, "Working in temporary directory: %s", tmpdir);

    skip_if(pipe(pipe_fd) != 0);

    pid_t pid = fork();
    if (pid == -1) {
        close(pipe_fd[READ]);
        close(pipe_fd[WRITE]);
        cpl_error_set_message(cpl_func, CPL_ERROR_UNSPECIFIED,
                              "fork failed: %s", strerror(errno));
        skip_if(0);
    }
    else if (pid == 0) {
        /* restore default signal handler */
        sigaction(SIGINT, &sa_orig, NULL);

        /* close unused read and convert write to stream for convinience */
        close(pipe_fd[READ]);
        pipe_stream = fdopen(pipe_fd[WRITE], "w");

        /* go to tmpdir */
        if (!pipe_stream || chdir(tmpdir) != 0) {
            close(pipe_fd[WRITE]);
            _exit(EXIT_FAILURE);
        }

        /* correct relative paths for the change to the tmpdir */
        FOR_EACH_FRAMESET(frm, recipe->frames) {
            if (cpl_frame_get_filename(frm)[0] != '/') {
                char * buf = cpl_sprintf("../%s", cpl_frame_get_filename(frm));
                cpl_frame_set_filename(frm, buf);
                cpl_free(buf);
            }
        }

        cpl_error_code err = cpl_recipedefine_exec(plugin, function)
            ? (int)cpl_error_set_where(cpl_func) : 0;

        if (err == CPL_ERROR_NONE) {
            assert((void*)recipe == (void*)plugin);
            err = visir_send_frameset(pipe_stream, recipe->frames);
        }
        fclose(pipe_stream);
        _exit(err);
    }
    else {
        /* close unused write and convert read to stream for convinience */
        close(pipe_fd[WRITE]);
        pipe_stream = fdopen(pipe_fd[READ], "r");
        skip_if(pipe_stream == NULL);

        recipe->frames = visir_wait_for_child(pid, pipe_stream);
        fclose(pipe_stream);
        skip_if(recipe->frames == NULL);

        /* move end products from tmp to cwd */
        skip_if(visir_move_products(recipe->frames, ".", tmpdir));
    }

    end_skip;

    if (have_tmpdir) {
        remove_tempdir(recipe->parameters, recipename, tmpdir);
    }

    if (!cpl_errorstate_is_equal(cleanstate))
        cpl_errorstate_dump(cleanstate, CPL_FALSE, NULL);

    return cpl_error_get_code();
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Get the total exposure time
  @param    nnod    number of nodding cycles
  @param    plist   property list
  @return   The exposure time

 */
/*----------------------------------------------------------------------------*/
double visir_utils_get_exptime(const int nnod, const cpl_propertylist * plist)
{
    /* fits EXPTIME key is equal to DIT * NAVRG with NGC */
    /* DIT */
    const double dit = visir_pfits_get_dit(plist);
    /* NDIT */
    const int ndit = visir_pfits_get_ndit(plist);
    /* NAVRG */
    const int navrg = visir_pfits_get_navrg(plist);
    /* Number of chopping cycles */
    const int ncycles = visir_pfits_get_chop_ncycles(plist);

    /* exptime *= 2 because of chopping */
    const double value = 2 * dit * ndit * nnod * ncycles * navrg;

    if (value <= 0) {
        cpl_msg_error(cpl_func, "Illegal exposure time "
                      "(dit=%g:ndit=%d:ncycles=%d:nnod=%d): %g",
                      dit, ndit, ncycles, nnod, value);
        skip_if(1);
    }

    end_skip;
    return value;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Get the wavelengths from a frame set
  @param    self   framelist
  @return   The array wavelengths or NULL on error

  FIXME: Pass a CPL table and insert into a column ...

 */
/*----------------------------------------------------------------------------*/
double * visir_utils_get_wls(const irplib_framelist * self)
{
    /* Get the number of files */
    const int   size = irplib_framelist_get_size(self);
    double    * wls = NULL;
    int         i;


    skip_if (0);

    skip_if(irplib_framelist_contains(self, VISIR_PFITS_DOUBLE_MONOC_POS,
                                      CPL_TYPE_DOUBLE, CPL_FALSE, 0.0));

    /* Allocate the output array */
    wls = cpl_malloc(size * sizeof(double));

    /* Get the wavelengths */
    for (i=0; i < size; i++) {
        const cpl_propertylist * plist
            = irplib_framelist_get_propertylist_const(self, i);

        wls[i] = visir_pfits_get_monoc_pos(plist);

        skip_if (0);
    }

    end_skip;

    if (cpl_error_get_code()) {
        cpl_free(wls);
        wls = NULL;
    }

    return wls;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Create an int image with 0 for the background and 1 for the disk
  @param    nx      x size of the created image
  @param    ny      y size of the created image
  @param    x_pos   x position of the disk center (FITS convention)
  @param    y_pos   y position of the disk center (FITS convention)
  @param    radius  disk radius
  @return   the newly allocated image
 */
/*----------------------------------------------------------------------------*/
cpl_image * visir_create_disk_intimage(
        int     nx,
        int     ny,
        int     x_pos,
        int     y_pos,
        int     radius)
{
    cpl_image   *   intima;
    int         *   pintima;
    double          dist;
    int             i, j;

    /* Create the empty output image */
    intima = cpl_image_new(nx, ny, CPL_TYPE_INT);
    pintima = cpl_image_get_data_int(intima);

    /* Loop on the pixels */
    for (j=0;j<ny ; j++) {
        for (i=0;i<nx ; i++) {
            dist = (i+1-x_pos)*(i+1-x_pos)+(j+1-y_pos)*(j+1-y_pos);
            if (dist < radius*radius) {
                pintima[i+j*nx] = 1;
            } else {
                pintima[i+j*nx] = 0;
            }
        }
    }
    return intima;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Create an int image with 0 for the background and 1 for the ring
  @param    nx      x size of the created image
  @param    ny      y size of the created image
  @param    x_pos   x position of the ring center (FITS convention)
  @param    y_pos   y position of the ring center (FITS convention)
  @param    radius1 ring small radius
  @param    radius2 ring big radius
  @return   the newly allocated image
 */
/*----------------------------------------------------------------------------*/
cpl_image * visir_create_ring_intimage(
        int     nx,
        int     ny,
        int     x_pos,
        int     y_pos,
        int     radius1,
        int     radius2)
{
    cpl_image   *   intima;
    int         *   pintima;
    double          dist;
    if (radius1 >= radius2) {
        cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
                              "Small ring radius %d larger than big "
                              "ring radius %d", radius1, radius2);
        return NULL;
    }
    if ((nx - x_pos) < radius2 || x_pos < radius2 ||
        (ny - y_pos) < radius2 || y_pos < radius2) {
        cpl_error_set_message(cpl_func, CPL_ERROR_ILLEGAL_INPUT,
                              "Image of size [%d,%d] with object at "
                              "[%d,%d] too small to create ring mask of "
                              "radius %d", nx, ny, x_pos, y_pos, radius2);
        return NULL;
    }

    /* Create the empty output image */
    intima = cpl_image_new(nx, ny, CPL_TYPE_INT);
    pintima = cpl_image_get_data_int(intima);

    /* Loop on the pixels */
    for (int j=0;j<ny ; j++) {
        for (int i=0;i<nx ; i++) {
            dist = (i+1-x_pos)*(i+1-x_pos)+(j+1-y_pos)*(j+1-y_pos);
            if ((dist < radius2*radius2) && (dist > radius1*radius1)) {
                pintima[i+j*nx] = 1;
            } else {
                pintima[i+j*nx] = 0;
            }
        }
    }
    return intima;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Compute the background noise with an iterative sigma clipping
  @param    self     The image
  @param    pstdev   Set to the stdev of the noise and the background (optional)
  @return   the noise or a negative value on error.
  @note pstdev may be NULL.

  FIXME: This routine uses some numbers set from heuristics

 */
/*----------------------------------------------------------------------------*/
double visir_image_sigma_clip(const cpl_image * self, double * pstdev)
{
    const int      dimx = cpl_image_get_size_x(self);
    const int      dimy = cpl_image_get_size_y(self);
    const cpl_type type = cpl_image_get_type(self);
    /* Apply a 3x3 median filter to the input image  */
    /* FIXME: A wrap (around float/double) would be sufficient */
    cpl_image    * noise = cpl_image_new(dimx, dimy, type);
    cpl_mask     * bpm = NULL;
    cpl_mask     * kernel = cpl_mask_new(3, 3);
    const int      niterations = 5;
    const double   sigma = 3.0;
    const double   median_corr = 0.94;
    double         bgnoise = -1;
    int            i = -1;


    bug_if (0);

    bug_if(cpl_mask_not(kernel));
    bug_if(cpl_image_filter_mask(noise, self, kernel, CPL_FILTER_MEDIAN,
                                 CPL_BORDER_FILTER));

    /* (Inverted) Noise image */
    bug_if (cpl_image_subtract(noise, self));

    for (i=0; i < niterations ; i++) {
        /* Compute mean and stdev */
        cpl_stats * stats =
            cpl_stats_new_from_image(noise, CPL_STATS_MEAN | CPL_STATS_STDEV);

        const double mean  = cpl_stats_get_mean(stats);
        const double stdev = cpl_stats_get_stdev(stats);

        /* Set the thresholds */
        const double low_thresh  = mean - sigma * stdev;
        const double high_thresh = mean + sigma * stdev;


        cpl_stats_delete(stats); /* :-( */

        /* The previous thresholding may have left too few good pixels */
        skip_if (0);

        /* Identify where mean-sigma*stdev < noise < mean+sigma*stdev */
        bpm = cpl_mask_threshold_image_create(noise, low_thresh, high_thresh);

        bug_if (0);

        bug_if (cpl_mask_not(bpm));

        bug_if (cpl_image_reject_from_mask(noise, bpm));

        cpl_mask_delete(bpm);  /* :-( */
        bpm = NULL;

    }

    if (pstdev != NULL) {
        /* Compute the stdev of the noise and the background */

        cpl_stats * stats =
            cpl_stats_new_from_image(noise, CPL_STATS_MEAN | CPL_STATS_STDEV);

        /* Compute mean and stdev */
        bgnoise = cpl_stats_get_stdev(stats);
        *pstdev = cpl_image_get_median(self) - cpl_stats_get_mean(stats);

        cpl_stats_delete(stats);
    } else {
        /* Compute the stdev */
        bgnoise = cpl_image_get_stdev(noise);
    }

    bug_if(0);

    bgnoise /= median_corr;

    end_skip;

    if (cpl_error_get_code())
        cpl_msg_error(cpl_func, "Computation of background noise using sigma=%g"
                      " failed in iteration %d of %d", sigma, i+1, niterations);

    cpl_mask_delete(kernel);
    cpl_mask_delete(bpm);
    cpl_image_delete(noise);

    return bgnoise;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Compute the background noise with an iterative sigma clipping
  @param    self        The image
  @return   the noise or a negative value on error.
  @see visir_image_sigma_clip

  FIXME: Deprecate

 */
/*----------------------------------------------------------------------------*/
double visir_img_phot_sigma_clip(const cpl_image * self)
{

    const double noise = visir_image_sigma_clip(self, NULL);

    cpl_ensure(!cpl_error_get_code(), cpl_error_get_code(), noise);

    return noise;

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Find the index of the star closest to (ra, dec)
  @param    v_ra     Vector of Right Ascensions (ra, dec) [degree]
  @param    v_dec    Vector of Declinations (ra, dec)  [degree]
  @param    ra       Right Ascension of position to search for
  @param    dec      Declination of ditto
  @param    maxdist  Maximum acceptable (non-negative) distance [degree]
  @param    pdist    Actual distance (if not NULL)
  @return   The index (starting from zero), or negative on error.

  The two vectors must be of identical length.

  pdist may be NULL.

  It is an error if no star is found.

 */
/*----------------------------------------------------------------------------*/
int visir_star_find(const cpl_vector * v_ra, const cpl_vector * v_dec,
                    double ra, double dec, double maxdist, double * pdist)
{
    const int    nra   = cpl_vector_get_size(v_ra);
    const int    ndec  = cpl_vector_get_size(v_dec);
    double       dmin = 0.0;  /* Avoid (false) uninit warning */
    int          minind = 0;
    int          i;


    /* Catch NULL input */
    cpl_ensure(nra  > 0,     cpl_error_get_code(), -2);
    cpl_ensure(ndec > 0,     cpl_error_get_code(), -3);

    /* It would be natural to use a cpl_bivector for the positions,
       but since CPL cannot ensure that a bivector comprises two vectors
       of the same length this would be pointless :-( */
    cpl_ensure(nra == ndec,  CPL_ERROR_INCOMPATIBLE_INPUT, -4);

    cpl_ensure(maxdist >= 0, CPL_ERROR_ILLEGAL_INPUT, -5);

    /* Find the index of the star closest to the given coordinate */
    for (i=0 ; i < nra ; i++) {
        const double rai  = cpl_vector_get(v_ra,  i);
        const double deci = cpl_vector_get(v_dec, i);
        const double gdist = visir_great_circle_dist(rai, deci, ra, dec);

        cpl_msg_debug(cpl_func, "DISTANCE (RAi,DECi)=(%g,%g) <=> "
                      "(RA,DEC)=(%g,%g): %g", rai, deci, ra, dec, gdist);

        if (i == 0 || gdist < dmin) {
            minind = i;
            dmin = gdist;
        }
    }

    if (pdist != NULL) *pdist = dmin;

    /* Check that it is close enough */
    if (dmin > maxdist) {
        cpl_msg_error(cpl_func, "Nearest standard star (%d of %d) at (RA,DEC)="
                      "(%g,%g) is too distant from (RA,DEC)=(%g, %g): %g > %g",
                      1+minind, nra, cpl_vector_get(v_ra,  minind),
                      cpl_vector_get(v_dec,  minind), ra, dec, dmin, maxdist);
        cpl_ensure(0, CPL_ERROR_DATA_NOT_FOUND, -1);
    }

    return minind;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Check and Convert RA and DEC
  @param    line     Text line available for error messages
  @param    ra_hh    hours of RA
  @param    ra_mm    minutes of RA
  @param    ra_ss    seconds of RA
  @param    isign    Sign of Declination ('+' or '-')
  @param    dec_hh   hours of DEC
  @param    dec_mm   minutes of DEC
  @param    dec_ss   seconds of DEC
  @param    jys      The array of Jansky values
  @param    njys     Number of Jansky values
  @param    pra      RA in degrees
  @param    pdec     DEC in degrees
  @return   CPL_ERROR_NONE iff the conversion went OK
  @note The function will assert() on NULL input or non-positive njys

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_star_convert(const char * line, int ra_hh, int ra_mm,
                                  double ra_ss, char isign, int dec_hh,
                                  int dec_mm, double dec_ss,
                                  const double * jys, int njys,
                                  double * pra, double * pdec)
{

    double sign;
    int i;

    assert( line );
    assert( pra );
    assert( pdec );
    assert( jys );
    assert( njys > 0 );


    if (isign == '+')
      sign = 1.0;
    else if (isign == '-')
      sign = -1.0;
    else {
        cpl_msg_error(cpl_func, "Line has illegal declination-sign character "
                      "(%c): %s", isign, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }

    if (ra_hh < 0) {
        cpl_msg_error(cpl_func, "Line has negative RA hh (%d): %s",
                      ra_hh, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (ra_mm < 0) {
        cpl_msg_error(cpl_func, "Line has negative RA mm (%d): %s",
                      ra_hh, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (ra_mm >= 60) {
        cpl_msg_error(cpl_func, "Line has too large RA mm (%d): %s ",
                      ra_mm, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (ra_ss < 0) {
        cpl_msg_error(cpl_func, "Line has negative RA ss (%g): %s",
                      ra_ss, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (ra_ss >= 60) {
        cpl_msg_error(cpl_func, "Line has too large RA ss (%g): %s ",
                      ra_ss, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }

    if (dec_hh < 0) {
        cpl_msg_error(cpl_func, "Line has negative DEC hh (%d): %s",
                      dec_hh, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (dec_mm < 0) {
        cpl_msg_error(cpl_func, "Line has negative DEC mm (%d): %s",
                      dec_hh, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (dec_mm >= 60) {
        cpl_msg_error(cpl_func, "Line has too large DEC mm (%d): %s ",
                      dec_mm, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (dec_ss < 0) {
        cpl_msg_error(cpl_func, "Line has negative DEC ss (%g): %s",
                      dec_ss, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (dec_ss >= 60) {
        cpl_msg_error(cpl_func, "Line has too large DEC ss (%g): %s ",
                      dec_ss, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }

    *pra = ra_hms2deg(ra_hh, ra_mm, ra_ss);
    if (*pra >= 360.0) {
        cpl_msg_error(cpl_func, "Line has too large RA (%g): %s ",
                      *pra, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }

    *pdec = sign * dec_hms2deg(dec_hh, dec_mm, dec_ss);
    if (*pdec > 90.0) {
        cpl_msg_error(cpl_func, "Line has too large RA (%g): %s ",
                      *pdec, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }
    if (*pdec < -90.0) {
        cpl_msg_error(cpl_func, "Line has too small RA (%g): %s ",
                      *pdec, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }

    for (i=0; i < njys; i++) if (jys[i] <= 0.0) {
        cpl_msg_error(cpl_func,"Line has non-positive Jy value (%g) at %d: %s ",
                      jys[i], i+1, line);
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }

    return CPL_ERROR_NONE;

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Create a table of positions of apertures of maximal flux
  @param    images List of images
  @param    label  The type of value to insert, FLUX or FWHM.
  @return   A newly created cpl_table with columns of doubles or NULL on error

  A table row is created for each image.
  The table labels are: X_POS, Y_POS and either FLUX or X_FWHM and Y_FWHM.
  Pixel-position (-1,-1) indicate an invalid table row.
  A non-positive flux leads to an invalid row.

 */
/*----------------------------------------------------------------------------*/
cpl_table * visir_table_new_xypos(const cpl_imagelist * images,
                                  const char * label)
{
    cpl_errorstate cleanstate = cpl_errorstate_get();
    const int    nsize = cpl_imagelist_get_size(images);
    double       psigmas[] = {5, 2, 1, 0.5}; /* Actually not modified */
    cpl_vector * sigmas = NULL;
    cpl_table  * self  = NULL;
    const int           nsigmas = sizeof(psigmas)/sizeof(double);
    int isflux = 0;
    int nfail, i;

    cpl_ensure(nsize > 0, cpl_error_get_code(), NULL);
    cpl_ensure(label,     CPL_ERROR_NULL_INPUT, NULL);
    cpl_ensure(!strcmp(label, "FLUX") || !strcmp(label, "FWHM"),
               CPL_ERROR_UNSUPPORTED_MODE, NULL);

    self = cpl_table_new(nsize);

    skip_if (cpl_table_new_column(self, "X_POS", CPL_TYPE_DOUBLE));
    skip_if (cpl_table_new_column(self, "Y_POS", CPL_TYPE_DOUBLE));

    if (!strcmp(label,"FLUX")) {
        isflux = 1;
        skip_if (cpl_table_new_column(self, label,    CPL_TYPE_DOUBLE));
    } else {
        skip_if (cpl_table_new_column(self, "X_FWHM", CPL_TYPE_DOUBLE));
        skip_if (cpl_table_new_column(self, "Y_FWHM", CPL_TYPE_DOUBLE));
    }

    sigmas = cpl_vector_wrap(4, psigmas);
    skip_if (sigmas == NULL);

    cpl_msg_info(cpl_func, "Detecting apertures using %d sigma-levels "
                 "ranging from %g down to %g", nsigmas, psigmas[0],
                 psigmas[nsigmas-1]);

    /* Object detection */
    nfail = 0;
    for (i=0 ; i < nsize ; i++) {
        const cpl_image * image = cpl_imagelist_get_const(images, i);
        cpl_apertures   * apert;
        cpl_size          isigma;


        double posx  = -1;
        double posy  = -1;
        double fwhmx = -1;
        double fwhmy = -1;
        double flux  = -1;
        int iflux;

        skip_if (0);

        /* Find any apertures in each image */
        apert = cpl_apertures_extract(image, sigmas, &isigma);

        if (apert != NULL && cpl_error_get_code()) {
            /* FIX for DFS 2616 */
            cpl_msg_error(cpl_func, "cpl_apertures_extract() returned non-NULL "
                          "while setting the CPL error-state to '%s' at '%s'",
                          cpl_error_get_message(), cpl_error_get_where());
            cpl_msg_debug(cpl_func, "Deleting the spurious aperture list at %p:",
                          (void*)apert);
            if (cpl_msg_get_level() <= CPL_MSG_DEBUG)
                cpl_apertures_dump(apert, stdout);
            cpl_apertures_delete(apert);
            apert = NULL;
        }

        if (apert != NULL &&
            !irplib_apertures_find_max_flux(apert, &iflux, 1) &&
            cpl_apertures_get_flux(apert, iflux) > 0) {

            posx = cpl_apertures_get_centroid_x(apert, iflux);
            posy = cpl_apertures_get_centroid_y(apert, iflux);
            flux = cpl_apertures_get_flux(apert, iflux);
            if (!isflux)
                cpl_image_get_fwhm(image, (int)posx, (int)posy, &fwhmx, &fwhmy);

            cpl_msg_info(cpl_func, "Detected an aperture with flux=%g at "
                         "sigma=%g, at position: %g %g", flux,
                         psigmas[isigma], posx, posy);
        }

        if (apert == NULL || cpl_error_get_code()) {
            visir_error_reset("Aperture detection in image %d of %d failed",
                             i+1, nsize);
            nfail++;
        } else if (flux <= 0) {
            cpl_msg_warning(cpl_func, "Ignoring %d-pixel aperture %d (out of "
                            "%d) in file %d of %d with non-positive flux: %g",
                            (int)cpl_apertures_get_npix(apert, iflux), iflux,
                            (int)cpl_apertures_get_size(apert), i+1, nsize,
                            flux);
            nfail++;
        }

        cpl_apertures_delete(apert);
        apert = NULL;

        skip_if (cpl_table_set_double(self, "X_POS", i, posx));
        skip_if (cpl_table_set_double(self, "Y_POS", i, posy));

        if (isflux)
            skip_if (cpl_table_set_double(self, "FLUX",  i, flux));
        else {
            skip_if (cpl_table_set_double(self, "X_FWHM", i, fwhmx));
            skip_if (cpl_table_set_double(self, "Y_FWHM", i, fwhmy));
        }

    }

    /* Check if some detections were successful */
    if (nfail == nsize) {
        cpl_msg_error(cpl_func, "Aperture detection failed in all %d images",
                      nsize);
        visir_error_set(CPL_ERROR_DATA_NOT_FOUND);
        skip_if(1);
    }

    end_skip;

    cpl_vector_unwrap(sigmas);

    if (self && cpl_error_get_code()) {
        cpl_table_delete(self);
        self = NULL;
    }

    return self;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Find the (first) index with the minimum value
  @param    v  The vector
  @return   Index (starting with zero), or negative on error.

 */
/*----------------------------------------------------------------------------*/
int visir_vector_minpos(const cpl_vector * v)
{
    const double * x     = cpl_vector_get_data_const(v);
    const int      n     = cpl_vector_get_size(v);
    int minpos = 0;
    int i;

    cpl_ensure(x, CPL_ERROR_NULL_INPUT, -1);

    for (i = 1; i < n; i++) if (x[i] < x[minpos]) minpos = i;

    return minpos;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Set a bivector with values from an ASCII file
  @param    self     Bivector to set
  @param    stream   Input stream
  @return   CPL_ERROR_NONE or the relevant #_cpl_error_code_ on error
  @see cpl_bivector_read

  In addition to normal files, FIFO (see man mknod) are also supported.

  Possible #_cpl_error_code_ set in this function:
  - CPL_ERROR_NULL_INPUT if an input pointer is NULL
  - CPL_ERROR_FILE_IO if the file cannot be read
  - CPL_ERROR_BAD_FILE_FORMAT if the file contains no valid lines
 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_bivector_load(cpl_bivector * self, FILE * stream)
{
    cpl_vector * v1;
    cpl_vector * v2;
    int          np = 0;
    int          xsize, ysize;
    char         line[1024];

    cpl_ensure_code(self,   CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(stream, CPL_ERROR_NULL_INPUT);

    /* Create and fill the vectors */
    v1 = cpl_bivector_get_x(self);
    v2 = cpl_bivector_get_y(self);

    xsize = cpl_vector_get_size(v1);
    ysize = cpl_vector_get_size(v2);

    while (fgets(line, 1024, stream) != NULL) {
        double x, y;
        if (line[0] != '#' && sscanf(line, "%lg %lg", &x, &y) == 2) {
            /* Found new element-pair
               - increase vector sizes if necessary,
               - insert element at end and
               - increment size counter */
            if (np == xsize) {
                xsize *= 2;
                cpl_vector_set_size(v1, xsize);
            }
            if (np == ysize) {
                ysize *= 2;
                cpl_vector_set_size(v2, ysize);
            }
            cpl_vector_set(v1, np, x);
            cpl_vector_set(v2, np, y);
            np++;
        }
    }

    /* Check that the loop ended due to eof and not an error */
    cpl_ensure_code(!ferror(stream), CPL_ERROR_FILE_IO);

    /* Check that the file was not empty and set the size to its true value */
    if (np == 0 || cpl_vector_set_size(v1, np) || cpl_vector_set_size(v2, np)) {
        cpl_ensure_code(0, CPL_ERROR_BAD_FILE_FORMAT);
    }

    return CPL_ERROR_NONE;

}

/*----------------------------------------------------------------------------*/
/**
  @brief   Find the pair of locations with the minimum distance
  @param   pras    Right ascension of locations [degrees]
  @param   pdecs   Declination of locations [degrees]
  @param   nloc    Number of locations
  @param   piloc1  First member of pair (0 for first)
  @param   piloc2  Second member of pair (0 for first), *piloc1 < *piloc2
  @return  Non-negative distance [degrees]
  @note The function will assert() on NULL input or non-positive nloc
  @see     http://en.wikipedia.org/wiki/Great-circle_distance (on 2005-10-23)

 */
/*----------------------------------------------------------------------------*/
double visir_star_dist_min(const double * pras, const double * pdecs, int nloc,
                           int * piloc1, int * piloc2)
{

    int i, j;
    double dmin = 180;


    assert( pras != NULL);
    assert( pdecs != NULL);
    assert( piloc1 != NULL);
    assert( piloc2 != NULL);
    assert( nloc > 0 );

    for (j = 0; j < nloc; j++) {
        for (i = 0; i < j; i++) {
            const double dist = visir_great_circle_dist(pras[i], pdecs[i],
                                                        pras[j], pdecs[j]);
            if (dist < dmin) {
                dmin = dist;
                *piloc1 = i;
                *piloc2 = j;
            }
            if (dist < VISIR_STAR_MAX_RADIUS)
                cpl_msg_warning(cpl_func,"The two stars (%d,%d) have a distance"
                                ": %g < %g", i, j, dist, VISIR_STAR_MAX_RADIUS);
        }
    }

    return dmin;
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Retag a framelist according to the given tagging function
  @param    self   Framelist with frames to retag
  @param    pftag  Function to create a new tag for one frame
  @param    pntags On success, number of new tags in framelist, otherwise undef
  @return   List of new tags or NULL on error
  @note (*pftag)() must return a newly allocated pointer. It must indicate an
        error by returning NULL and by setting a CPL error code.
        On error some of the the tags in the framelist may be modified.
        The integer parameter to (*pftag)() is its index in the framelist
        (starting with zero).

 */
/*----------------------------------------------------------------------------*/
const char ** visir_framelist_set_tag(irplib_framelist * self,
                                      char * (*pftag)(const cpl_frame *,
                                                      const cpl_propertylist *,
                                                      int),
                                      int *pntags)
{

    /* FIXME: Copied from NACO - move to irplib */

    const char ** taglist = NULL; /* Must be initialized due to realloc call */
    int iframe, size;

    cpl_ensure(!cpl_error_get_code(), cpl_error_get_code(), NULL);
    cpl_ensure(self   != NULL, CPL_ERROR_NULL_INPUT, NULL);
    cpl_ensure(pftag  != NULL, CPL_ERROR_NULL_INPUT, NULL);
    cpl_ensure(pntags != NULL, CPL_ERROR_NULL_INPUT, NULL);

    size = irplib_framelist_get_size(self);

    cpl_ensure(size > 0, CPL_ERROR_DATA_NOT_FOUND, NULL);

    *pntags = 0;

    for (iframe = 0; iframe < size ; iframe++) {
        cpl_frame  * frame = irplib_framelist_get(self, iframe);
        const cpl_propertylist * plist
            = irplib_framelist_get_propertylist_const(self, iframe);
        char       * tag;
        const char * newtag;
        int          i;


        /* This should really be an assert() */
        cpl_ensure(frame != NULL, CPL_ERROR_ILLEGAL_INPUT, NULL);
        cpl_ensure(plist != NULL, CPL_ERROR_ILLEGAL_INPUT, NULL);

        tag = (*pftag)(frame, plist, iframe);

        cpl_ensure(tag != NULL, cpl_error_get_code(), NULL);

        /* From this point on failures should not really happen */

        (void)cpl_frame_set_tag(frame, tag);
        cpl_free(tag);

        newtag = cpl_frame_get_tag(frame);

        cpl_ensure(!cpl_error_get_code(), cpl_error_get_code(), NULL);

        /* Compare the new tags with those of previous frames */
        for (i=0; i < *pntags; i++)
            if (strcmp(newtag, taglist[i]) == 0) break;

        if (i == *pntags) {
            /* The new tag is different from the previous ones
               - add it to the list */
            (*pntags)++;
            taglist = (const char **)cpl_realloc(taglist, *pntags *
                                                 sizeof(const char *));
            taglist[i] = newtag;
        }

    }

    return taglist;

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Append the background to the propertylist as "ESO QC BACKGD MEAN"
  @param    self      Propertylist to append to
  @param    rawframes List of rawframes and their propertylists
  @param    icol1     First column to use or zero
  @param    icol2     Last column to use or zero
  @return   CPL_ERROR_NONE or the relevant CPL error code on error

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_qc_append_background(cpl_propertylist * self,
                                          const irplib_framelist * rawframes,
                                          int icol1, int icol2)
{

    /* Compute the background values of the HCYCLE frames */
    const double bg_mean = visir_hcycle_background(rawframes, icol1, icol2);

    skip_if (0);

    bug_if (cpl_propertylist_append_double(self, "ESO QC BACKGD MEAN",
                                           bg_mean));

    end_skip;

    return cpl_error_get_code();

}


/*----------------------------------------------------------------------------*/
/**
  @brief    Append the capa value to the propertylist as "ESO QC CAPA"
  @param    self      Propertylist to append to
  @param    rawframes List of rawframes and their propertylists
  @note     It is a bug in the pipeline if this functions fails
  @return   CPL_ERROR_NONE or the relevant CPL error code on error

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_qc_append_capa(cpl_propertylist * self,
                                    const irplib_framelist * rawframes)
{

    cpl_errorstate cleanstate = cpl_errorstate_get();
    const cpl_propertylist * plist
        = irplib_framelist_get_propertylist_const(rawframes, 0);
    const char             * capa;


    bug_if (0);

    capa = visir_get_capa(plist);

    if (cpl_error_get_code()) {
        /* ignore error as keys are not defined for aqu data */
        //visir_error_reset("Could not determine capa");
        cpl_msg_info(cpl_func, "Could not determine capa");
        cpl_errorstate_set(cleanstate);
    } else {
        bug_if (cpl_propertylist_append_string(self, "ESO QC CAPA", capa));
    }

    end_skip;

    return cpl_error_get_code();

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Append the filter name to the propertylist as "ESO QC FILTER"
  @param    self      Propertylist to append to
  @param    rawframes List of rawframes and their propertylists
  @return   CPL_ERROR_NONE or the relevant CPL error code on error

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_qc_append_filter(cpl_propertylist * self,
                                      const irplib_framelist * rawframes)
{

    const cpl_propertylist * plist
        = irplib_framelist_get_propertylist_const(rawframes, 0);
    const char             * value = visir_pfits_get_filter(plist);


    skip_if (0);

    bug_if (cpl_propertylist_append_string(self, "ESO QC FILTER", value));

    end_skip;

    return cpl_error_get_code();

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Append the exposure time  to the propertylist as "ESO QC EXPTIME"
  @param    self      Propertylist to append to
  @param    rawframes List of rawframes and their propertylists
  @return   CPL_ERROR_NONE or the relevant CPL error code on error

 */
/*----------------------------------------------------------------------------*/
cpl_error_code visir_qc_append_exptime(cpl_propertylist * self,
                                       const irplib_framelist * rawframes)
{
    const cpl_propertylist * plist
        = irplib_framelist_get_propertylist_const(rawframes, 0);

    /* NNOD */
    const int nnod = irplib_framelist_get_size(rawframes);
    /* Get the total exposure time */
    const double value = visir_utils_get_exptime(nnod, plist);

    skip_if (0);

    bug_if (cpl_propertylist_append_double(self, "ESO QC EXPTIME", value));

    end_skip;

    return cpl_error_get_code();

}

/**@}*/

/*----------------------------------------------------------------------------*/
/**
  @brief   Compute the great-circle distance between two points on a sphere
  @param   ra1    Right ascension of first point [degrees]
  @param   dec1   Declination of first point [degrees]
  @param   ra2    Right ascension of second point [degrees]
  @param   dec2   Declination of second point [degrees]
  @return  Non-negative distance [degrees].
  @see     http://en.wikipedia.org/wiki/Great-circle_distance (on 2005-10-23)

 */
/*----------------------------------------------------------------------------*/
static double visir_great_circle_dist(double ra1, double dec1,
                                      double ra2, double dec2)
{

  /* Convert all input from degrees to radian - and back for the result */
  const double dra  = sin( CPL_MATH_RAD_DEG * (ra2  - ra1 )/2.0 );
  const double ddec = sin( CPL_MATH_RAD_DEG * (dec2 - dec1)/2.0 );

  dec1 *= CPL_MATH_RAD_DEG;
  dec2 *= CPL_MATH_RAD_DEG;

  return 2.0 * asin(sqrt( ddec*ddec + cos(dec1)*cos(dec2)*dra*dra))
      * CPL_MATH_DEG_RAD;

}

/*----------------------------------------------------------------------------*/
/**
  @brief    Convert the RA from hh mm ss to degrees
  @param    hh      hours
  @param    mm      minutes
  @param    ss      seconds
  @return   RA in degrees

  An arc-hour is 15 degrees,
  60 arc-minutes is one arc-hour and
  60 arc-seconds is one arc-minute.

 */
/*----------------------------------------------------------------------------*/
static double ra_hms2deg(int hh, int mm, double ss)
{
    return 15.0 * dec_hms2deg(hh, mm, ss);
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Convert the DEC from dd mm ss to degrees
  @param    dd      degrees
  @param    mm      minutes
  @param    ss      seconds
  @return   DEC in degrees

  60 arc-minutes is one degree and
  60 arc-seconds is one arc-minute.

 */
/*----------------------------------------------------------------------------*/
static double dec_hms2deg(int dd, int mm, double ss)
{
    return ((double)ss/60.0 + (double)mm)/60.0 + dd;
}

/*----------------------------------------------------------------------------*/
/**
  @brief    Compute the background value from the HCYCLE frames
  @param    rawframes Input raw frames
  @param    icol1     First column to use or zero
  @param    icol2     Last column to use or zero
  @return   The mean value of all median values of all HCYCLE frames

  The function returns a negative number on error.

  Use zero to indicate the default column.

 */
/*----------------------------------------------------------------------------*/
static double visir_hcycle_background(const irplib_framelist * rawframes,
                               int icol1, int icol2)
{
    cpl_imagelist * iset = NULL;
    /* Get the number of files */
    const int       nfiles = irplib_framelist_get_size(rawframes);
    double          bgsum  = 0;
    double          bgmean = -1;
    int             nsum  = 0;
    int             i, j;

    skip_if (nfiles < 1);

    if (icol1 == 0) icol1 = VISIR_BACKGD_START;
    if (icol2 == 0) icol2 = VISIR_BACKGD_STOP;

    cpl_msg_info(cpl_func, "Computing Half-cycle background level from column %d "
                 "through %d", icol1, icol2);

    /* Loop on the hcycles images */
    for (i=0; i < nfiles; i++) {

        iset = visir_load_hcycle(rawframes, i);

        skip_if (0);

        for (j = 0; j < cpl_imagelist_get_size(iset) ; j++) {
            const double median =
                cpl_image_get_median_window(cpl_imagelist_get(iset, j),
                                            VISIR_BACKGD_START, icol1,
                                            VISIR_BACKGD_STOP, icol2);

            skip_if (0);

            if (median != median) {
                const cpl_frame * frame = irplib_framelist_get_const(rawframes,
                                                                     i);
                /* Some Comm. I data contains NaNs */
                cpl_msg_error(cpl_func, "Image window (%d, %d, %d, %d) "
                              "(image %d of %d) in %s (frame %d of %d) "
                              "has NaN median",
                              VISIR_BACKGD_START, icol1,
                              VISIR_BACKGD_STOP, icol2,
                              j+1, (int)cpl_imagelist_get_size(iset),
                              cpl_frame_get_filename(frame), i+1, nfiles);
                visir_error_set(CPL_ERROR_BAD_FILE_FORMAT);
                skip_if(1);
            }
            bgsum += median;
        }
        nsum += j;
        cpl_imagelist_delete(iset);
        iset = NULL;
    }

    /* Test if there are some HCYCLE frames */
    skip_if (nsum < 1);

    bgmean = bgsum / nsum;

    end_skip;

    cpl_imagelist_delete(iset);

    /* The background was requested to not include the offset correction */
    return bgmean - VISIR_HCYCLE_OFFSET;
}


/*----------------------------------------------------------------------------*/
/**
  @brief    get subpixel maximum by looking at neighbooring pixels
  @param    img          image
  @param    x            max x
  @param    y            max y
  @param    xsub         out, subpixel increment to x
  @param    ysub         out, subpixel increment to y
  @return CPL_ERROR_NONE iff OK, otherwise the relevant CPL error code.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code
visir_get_subpixel_maxpos(const cpl_image * img, cpl_size x, cpl_size y,
                          double * xsub, double * ysub)
{
    int bad;
    const cpl_size nx = cpl_image_get_size_x(img);
    const cpl_size ny = cpl_image_get_size_y(img);

    *xsub = 0;
    *ysub = 0;
    if (x - 1 > 0 && x + 1 <= nx) {
        double sub[] = {
            cpl_image_get(img, x - 1, y, &bad),
            cpl_image_get(img, x - 0, y, &bad),
            cpl_image_get(img, x + 1, y, &bad),
        };
        if (!bad)
            *xsub = 0.5 * (sub[0] - sub[2])/(sub[0] - 2*sub[1] + sub[2]);
    }
    if (y - 1 > 0 && y + 1 <= ny) {
        double sub[] = {
            cpl_image_get(img, x, y - 1, &bad),
            cpl_image_get(img, x, y - 0, &bad),
            cpl_image_get(img, x, y + 1, &bad),
        };
        if (!bad)
            *ysub = 0.5 * (sub[0] - sub[2])/(sub[0] - 2*sub[1] + sub[2]);
    }

    return cpl_error_get_code();
}

static inline unsigned long get_msb(unsigned long a)
{
    /* dumb integer msb, (63 - __builtin_clzl(a)) would be faster */
    unsigned long msb = 0;
    while (a >>= 1)  {
        msb++;
    }
    return msb;
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief  get next 5-smooth number next to a certain value
 * @param a  lower bound of result
 *
 * 5-smooth number is a number with only prime factors 2, 3 or 5.
 * This can be used to get minimal padding sizes that still allow efficient fft
 * transforms.
 */
/* ---------------------------------------------------------------------------*/
size_t visir_get_next_regular(size_t a)
{
    /* fftw can also deal efficiently with factors of 7 and 13 but it needs
     * testing that the speed of these algorithms will not cancel out the gain
     * of smaller input sizes */
    if (a <= 6)
        return a;
    /* is already power of 2 */
    if ((a & (a - 1)) == 0)
        return a;
    /* overflow */
    if (5 > SIZE_MAX / a)
        return a;

    size_t match = SIZE_MAX;
    size_t p5 = 1;
    while(p5 < a) {
        size_t p35 = p5;
        while (p35 < a) {
            /* ceil division */
            size_t quotient = a % p35 != 0 ? a / p35 + 1 : a / p35;
            /* next power of two of quotient */
            size_t p2 = 2 << get_msb(quotient - 1);

            size_t n = p2 * p35;
            if (n == a)
                return n;
            else if (n < match)
                match = n;

            p35 *= 3;
            if (p35 == a)
                return p35;
        }
        if (p35 < match)
            match = p35;
        p5 *= 5;
        if (p5 == a)
            return p5;
    }
    if (p5 < match)
        match = p5;
    return match;
}

struct _visir_fftx_cache {
    int initialized;
    cpl_image * template_fft;
    double template_stdev;
};

visir_fftx_cache * visir_new_fftx_cache(void)
{
    return cpl_calloc(sizeof(visir_fftx_cache), 1);
}

void visir_delete_fftx_cache(visir_fftx_cache * c)
{
    irplib_aligned_free(cpl_image_unwrap(c->template_fft));
    cpl_free(c);
}

/*----------------------------------------------------------------------------*/
/**
  @brief    cross correlate image against a template using fft
  @param    atemplate        template to correlate against
  @param    aimg             image to correlate against template
  @param    normalize        do a normalized correlation
  @param    xshift           out, x-shift of aimg against template or NULL
  @param    yshift           out, y-shift of aimg against template or NULL
  @param    max_correlation  out, maximum correlation or NULL
  @param    cache            out, structure holding reusable data or NULL
  @return CPL_ERROR_NONE iff OK, otherwise the relevant CPL error code.

  if cache is not NULL it stores some data that can be reused for future calls
  if the template and data sizes do not change.

 */
/*----------------------------------------------------------------------------*/
cpl_error_code
visir_fftxcorrelate(const cpl_image * atemplate, const cpl_image * aimg,
                    cpl_boolean normalize, double * xshift, double * yshift,
                    double * max_correlation, visir_fftx_cache * cache)
{
    const cpl_size Nxi = cpl_image_get_size_x(aimg);
    const cpl_size Nyi = cpl_image_get_size_y(aimg);
    const cpl_size Nxt = cpl_image_get_size_x(atemplate);
    const cpl_size Nyt = cpl_image_get_size_y(atemplate);
    /* pad to small prime factors for better performance */
    const cpl_size Nxe = visir_get_next_regular(Nxi + Nxt - 1);
    const cpl_size Nye = visir_get_next_regular(Nyi + Nyt - 1);
    cpl_size txshift, tyshift;
    double subx = 0, suby = 0;
    cpl_image * img = NULL;
    cpl_image * zimg = NULL;
    cpl_image * ztemp = NULL;
    cpl_image * fft1 = NULL;
    cpl_image * fft2 = NULL;
    cpl_image * res = NULL;
    void * buffer;
    double template_stdev;
    /* measure is nondeterministic in the last ulp */
    cpl_fft_mode mode = getenv("VISIR_TEST_MODE") ? 0 : CPL_FFT_FIND_MEASURE;

    cpl_ensure_code(atemplate != NULL, CPL_ERROR_NULL_INPUT);
    cpl_ensure_code(aimg != NULL, CPL_ERROR_NULL_INPUT);

    if (cache == NULL || cache->initialized == 0) {
        /* prepare template */
        cpl_image * template = NULL;
        if (cpl_image_get_type(atemplate) != CPL_TYPE_FLOAT)
            template = cpl_image_cast(atemplate, CPL_TYPE_FLOAT);
        else
            template = cpl_image_duplicate(atemplate);

        cpl_image_fill_rejected(template, 0);
        if (normalize)
            skip_if(cpl_image_subtract_scalar(template,
                                              visir_image_get_mean_fast(template)));
        template_stdev = cpl_image_get_stdev(template);

        buffer = irplib_aligned_calloc(32, Nxe * Nye, sizeof(float));
        ztemp = cpl_image_wrap(Nxe, Nye, CPL_TYPE_FLOAT, buffer);

        /* flip we have a fft correlation instead of a convolution
         * due to FT(f(x))* = FT(f(-x)) for real values*/
        skip_if(cpl_image_flip(template, 1));
        skip_if(cpl_image_flip(template, 3));

        /* zero pad */
        skip_if(cpl_image_copy(ztemp, template, 1, 1));
        cpl_image_delete(template);

        buffer = irplib_aligned_malloc(32, (Nxe / 2 + 1) * Nye *
                                       sizeof(float complex));
        fft2 = cpl_image_wrap(Nxe / 2 + 1, Nye, CPL_TYPE_FLOAT_COMPLEX,
                              buffer);
        skip_if(cpl_fft_image(fft2, ztemp, CPL_FFT_FORWARD));
        if (cache) {
            cache->template_fft = fft2;
            cache->template_stdev = template_stdev;
            cache->initialized = 1;
        }
    }
    else {
        fft2 = cache->template_fft;
        template_stdev = cache->template_stdev;
        error_if(cpl_image_get_type(fft2) != CPL_TYPE_FLOAT_COMPLEX ||
                 cpl_image_get_size_x(fft2) != Nxe / 2 + 1 ||
                 cpl_image_get_size_y(fft2) != Nye, CPL_ERROR_ILLEGAL_INPUT,
                 "Invalid fourier transformed template");
    }

    /* prepare image */

    buffer = irplib_aligned_calloc(32, Nxe * Nye, sizeof(float));
    zimg = cpl_image_wrap(Nxe, Nye, CPL_TYPE_FLOAT, buffer);
    if (cpl_image_get_type(aimg) != CPL_TYPE_FLOAT)
        img = cpl_image_cast(aimg, CPL_TYPE_FLOAT);
    else
        img = cpl_image_duplicate(aimg);

    skip_if(img == NULL);

    cpl_image_fill_rejected(img, 0);

    if (normalize)
        skip_if(cpl_image_subtract_scalar(img,
                                          visir_image_get_mean_fast(img)));

    /* zero pad */
    skip_if(cpl_image_copy(zimg, img, 1, 1));

    buffer = irplib_aligned_malloc(32, (Nxe / 2 + 1) * Nye *
                                   sizeof(float complex));
    fft1 = cpl_image_wrap(Nxe / 2 + 1, Nye, CPL_TYPE_FLOAT_COMPLEX, buffer);

    skip_if(cpl_fft_image(fft1, zimg, CPL_FFT_FORWARD | mode));


    /* correlate, no conjugation necessary due to flipping */
    skip_if(visir_image_multiply_fast(fft1, fft2));

    buffer = irplib_aligned_malloc(32, Nxe * Nye * sizeof(float));
    res = cpl_image_wrap(Nxe, Nye, CPL_TYPE_FLOAT, buffer);
    skip_if(cpl_fft_image(res, fft1, CPL_FFT_BACKWARD | CPL_FFT_NOSCALE |
                          mode));

    skip_if(cpl_image_get_maxpos_window(res, Nxt / 2 , Nyt / 2,
                                        Nxt / 2 + Nxi, Nyt / 2 + Nyi,
                                        &txshift, &tyshift));

    if (max_correlation != NULL) {
        int rej;
        *max_correlation = cpl_image_get(res, txshift, tyshift, &rej);
        // remove fftw scaling
        *max_correlation /= Nxe * Nye;

        if (normalize) {
            double tstd = template_stdev;
            int mx = txshift - Nxt;
            int my = tyshift - Nyt;
            double istd= cpl_image_get_stdev_window(zimg,
                                                    CX_MAX(1, mx + 1),
                                                    CX_MAX(1, my + 1),
                                                    CX_MIN(Nxe, mx + Nxt),
                                                    CX_MIN(Nye, my + Nyt));

            if (tstd * istd == 0)
                *max_correlation = 0;
            else
                *max_correlation /= (tstd * istd * Nxt * Nyt);

            skip_if(0);
        }
    }
    skip_if(visir_get_subpixel_maxpos(res, txshift, tyshift, &subx, &suby));
    if (xshift != NULL) {
        *xshift = txshift - Nxt + subx;
    }
    if (yshift != NULL) {
        *yshift = tyshift - Nyt + suby;
    }

    end_skip;

    cpl_image_delete(img);
    if (cache == NULL)
        irplib_aligned_free(cpl_image_unwrap(fft2));
    irplib_aligned_free(cpl_image_unwrap(fft1));
    irplib_aligned_free(cpl_image_unwrap(zimg));
    irplib_aligned_free(cpl_image_unwrap(ztemp));
    irplib_aligned_free(cpl_image_unwrap(res));

    return cpl_error_get_code();
}


/*----------------------------------------------------------------------------*/
/**
  @internal
  @brief    get interpolation points of bad pixel
  @param    x      x coordinate of bad pixel
  @param    y      y coordinate of bad pixel
  @param    nx     number of image columns
  @param    nx     number of image rows
  @param    bpm    bad pixel map
  @return   list of points usuable for interpolation
  @see visir_interpolate_rejected

  Finds the nearest non-bad pixels on the x or y axis.
  Chooses the pixels with a distance lower than the narrowest dimension/2 on
  the x and y axis and returns them in a list.
 */
/*----------------------------------------------------------------------------*/
static cx_list *
get_interpolation_points(size_t x, size_t y,
                         size_t nx_, size_t ny_, cpl_binary *bpm)
{
    ssize_t l = -1, r = -1 , u = -1, d = -1;
    ssize_t xl = x;
    ssize_t xh = x;
    ssize_t yl = y;
    ssize_t yh = y;
    ssize_t nx = (ssize_t)nx_;
    ssize_t ny = (ssize_t)ny_;
    cx_list * p = cx_list_new();

    /* FIXME: only uses x and y axes, add diagonal?
     * maybe a circle around bp? */
    while (1) {
        xl--;
        xh++;
        yl--;
        yh++;

        if (l < 0 && xl >= 0 && bpm[IND(xl, y, nx)] == CPL_BINARY_0)
            l = xl;
        if (r < 0 && xh < nx && bpm[IND(xh, y, nx)] == CPL_BINARY_0)
            r = xh;
        if (d < 0 && yl >= 0 && bpm[IND(x, yl, nx)] == CPL_BINARY_0)
            d = yl;
        if (u < 0 && yh < ny && bpm[IND(x, yh, nx)] == CPL_BINARY_0)
            u = yh;

        /* stop on first pair or end of image */
        /* FIXME: searches too much for bp on corner */
        if ((l != -1 && r != -1) || (d != -1 && u != -1) ||
            (xl < 0 && xh >= nx && yl < 0 && yh >= ny))
            break;
    }

    /* save the valid points */
    if (r >= 0)
        cx_list_push_back(p, (cxcptr)(IND(r, y, nx)));
    if (l >= 0)
        cx_list_push_back(p, (cxcptr)(IND(l, y, nx)));
    if (u >= 0)
        cx_list_push_back(p, (cxcptr)(IND(x, u, nx)));
    if (d >= 0)
        cx_list_push_back(p, (cxcptr)(IND(x, d, nx)));
    return p;
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Interpolate rejected pixels by their nearest neighboors
  @param    img      image with bad pixels
  @param    ppoints  pointer to storage for array pointer or NULL
  @param    n        pointer to size of array or NULL
  @see get_interpolation_points

  Interpolates by averaging the nearest neighboors.
  Chooses the pixels with a distance lower than the narrowest dimension/2 on
  the x and y axis as interpolation points.

  If ppoints is given and points to NULL it is filled with the bad pixels
  and their interpolation points.
  If it points to the result of a previous invocation it will reuse the
  information which is much faster.
  This only works with images of the same size and the same bad pixel map.
 */
/*----------------------------------------------------------------------------*/
cpl_error_code
visir_interpolate_rejected(cpl_image * img, size_t ** ppoints, size_t * n)
{
    cpl_mask * mask = cpl_image_get_bpm(img);
    float * data = cpl_image_get_data_float(img);
    cpl_binary * bpm = cpl_mask_get_data(mask);
    const size_t nx = (size_t)cpl_image_get_size_x(img);
    const size_t ny = (size_t)cpl_image_get_size_y(img);

    /*  FIXME: support more image types */
    skip_if(data == NULL);

    if (ppoints == NULL || *ppoints == NULL) {
        size_t i = 0;
        cpl_binary * found = memchr(bpm, CPL_BINARY_1,
                                    sizeof(cpl_binary) * nx * ny);
        /* max 4 points per bp + number of points + bp index */
        size_t * restrict pbpm = cpl_calloc(cpl_image_count_rejected(img) * 6,
                                            sizeof(size_t));

        while (found != NULL) {
            const size_t ind = found - bpm;
            const size_t y = ind / nx;
            const size_t x = ind - y * nx;
            cx_list * p = get_interpolation_points(x, y, nx, ny, bpm);
            cx_list_iterator it = cx_list_begin(p);
            const size_t npix = cx_list_size(p);
            double sum = 0;

            pbpm[i++] = ind;
            pbpm[i++] = npix;
            assert(pbpm[i - 1] <= 4);

            while (it != cx_list_end(p)) {
                const size_t lind = (size_t)cx_list_get(p, it);
                pbpm[i++] = lind;
                sum += data[lind];
                it = cx_list_next(p, it);
            }
            data[ind] = sum / npix;
            cx_list_delete(p);

            found = memchr(found + 1, CPL_BINARY_1,
                           sizeof(cpl_binary) * nx * ny - ind - 1);
        }
        if (ppoints && n) {
            *n = i;
            *ppoints = pbpm;
        }
        else
            cpl_free(pbpm);
    }
    else {
        const size_t n_ = *n;
        size_t * restrict points = *ppoints;
        for (size_t i = 0; i < n_;) {
            const size_t ind = points[i++];
            const size_t m = points[i++];
            double sum = 0;
            for (size_t j = 0; j < m; j++) {
                const size_t lind = points[i++];
                sum += data[lind];
            }
            data[ind] = sum / m;
        }
    }

    cpl_image_accept_all(img);

    end_skip;

    return cpl_error_get_code();
}

#ifdef _OPENMP
static const cpl_image *
image_const_row_view_create(const cpl_image * img,
                            cpl_size ly,
                            cpl_size uy)
{
    const size_t dsz = cpl_type_get_sizeof(cpl_image_get_type(img));
    const cpl_size nx = cpl_image_get_size_x(img);
    const char * d = cpl_image_get_data_const(img);
    size_t offset = (ly - 1) * nx;
    cpl_size nny = uy - ly + 1;
    cpl_image * wimg = cpl_image_wrap(nx, nny, cpl_image_get_type(img),
                                     (char*)d + offset * dsz);

    const cpl_mask * omask = cpl_image_get_bpm_const(img);
    if (omask) {
        cpl_mask * mask = cpl_mask_wrap(nx, nny,
                        (cpl_binary*)cpl_mask_get_data_const(omask) + offset);
        cpl_mask_delete(cpl_image_set_bpm(wimg, mask));
    }

    return wimg;
}

static void
image_const_row_view_delete(const cpl_image * img)
{
    cpl_mask_unwrap(cpl_image_unset_bpm((cpl_image*)(img)));
    cpl_image_unwrap((cpl_image *)img);
}
#endif

/* ---------------------------------------------------------------------------*/
/**
 * @brief compute median of imagelist in parallel
 * @param l  imagelist
 * @return cpl_image containing median along list axis
 * @see cpl_imagelist_collapse_median_create
 */
/* ---------------------------------------------------------------------------*/
cpl_image *
visir_parallel_median_collapse(const cpl_imagelist * l)
{
#ifndef _OPENMP
    return cpl_imagelist_collapse_median_create(l);
#else
    cpl_ensure(l != NULL, CPL_ERROR_NULL_INPUT, NULL);
    cpl_ensure(cpl_imagelist_get_size(l) > 0,
               CPL_ERROR_ILLEGAL_INPUT, NULL);

    const size_t n = cpl_imagelist_get_size(l);
    const cpl_image * img = cpl_imagelist_get_const(l, 0);
    const size_t ny = cpl_image_get_size_y(img);
    const size_t nx = cpl_image_get_size_x(img);
    const size_t nthreads = CX_MIN(visir_get_num_threads(CPL_FALSE), ny);
    cpl_image * res = cpl_image_new(nx, ny, cpl_image_get_type(img));
    /* make sure image has bpm to avoid creation races later */
    cpl_image_get_bpm(res);

    OMP_PRAGMA(omp parallel for num_threads(nthreads))
    for (size_t j = 0; j < nthreads; j++) {
        size_t ylow = j * (ny / nthreads) + 1;
        size_t yhigh = (j + 1) * (ny / nthreads);
        if (j == nthreads - 1)
            yhigh = ny;
        /* create list with images pointing to row views of the original */
        cpl_imagelist * view = cpl_imagelist_new();
        for (size_t i = 0; i < n; i++) {
            const cpl_image * iview =
                image_const_row_view_create(cpl_imagelist_get_const(l, i),
                                            ylow, yhigh);
IRPLIB_DIAG_PRAGMA_PUSH_IGN(-Wcast-qual);
            cpl_imagelist_set(view, (cpl_image *)iview, i);
IRPLIB_DIAG_PRAGMA_POP;
        }

        /* collapse views and copy to full result image */
        cpl_image * r = cpl_imagelist_collapse_median_create(view);
        cpl_image_copy(res, r, 1, ylow);

        /* cleanup */
        cpl_image_delete(r);
        for (size_t i = 0; i < n; i++) {
            image_const_row_view_delete(cpl_imagelist_get(view, i));
        }
        cpl_imagelist_unwrap(view);
    }

    return res;
#endif
}


/*----------------------------------------------------------------------------*/
/**
  @brief    Find out the capa value from several keywords values
  @param    plist       property list to read from
  @return   A pointer to a static string
 */
/*----------------------------------------------------------------------------*/
static const char * visir_get_capa(const cpl_propertylist * plist)
{
    const char  * capa = "Pb with Capa";
    const char  * sval;
    double        mean;


    skip_if (0);


    /* Get the instrument mode */
    sval = visir_pfits_get_insmode(plist);
    skip_if (0);

    /* Identify the mode */
    if (!strcmp(sval, "IMG")) {
        /* Imaging mode */
        mean  = visir_pfits_get_volt1dcta9(plist);
        mean += visir_pfits_get_volt1dctb9(plist);
    } else if (!strcmp(sval, "SPC") || !strcmp(sval, "SPCIMG")) {
        /* Spectro mode */
        mean  = visir_pfits_get_volt2dcta9(plist);
        mean += visir_pfits_get_volt2dctb9(plist);
    } else
        skip_if (1);

    skip_if (0);

    mean *= 0.5;

    /* Compute Capa value */
    if (mean < 1.0) {
        capa = "Large Capa";
    } else if (mean > 4.5) {
        capa = "Small Capa";
    }

    end_skip;

    return capa;
}

#ifdef VISIR_MASK_HAS
/*----------------------------------------------------------------------------*/
/**
  @brief    Determine if the mask has a sufficient number of good/bad pixels
  @param    self      The mask to search
  @param    value     The value to look for
  @param    ngood     The minimum required number of pixels with the given value
  @return   CPL_TRUE iff the mask has at least ngood good pixels
  @note The function always return CPL_TRUE when ngood is zero.

  Example of usage:
    @code

        if (!visir_mask_has(mask, CPL_BINARY_0, 1)) {
            // mask does not have a single good pixel,
            // i.e. all pixels are bad
        }

   @endcode

 */
/*----------------------------------------------------------------------------*/
static cpl_boolean visir_mask_has(const cpl_mask * self, cpl_binary value,
                                  int ngood)
{
    const cpl_binary * pself = cpl_mask_get_data_const(self);
    int                size  = cpl_mask_get_size_x(self)
                             * cpl_mask_get_size_y(self);
    int i;

    cpl_ensure(self,          CPL_ERROR_NULL_INPUT,          CPL_FALSE);
    cpl_ensure(ngood >= 0,    CPL_ERROR_ILLEGAL_INPUT,       CPL_FALSE);
    cpl_ensure(ngood <= size, CPL_ERROR_ACCESS_OUT_OF_RANGE, CPL_FALSE);
    cpl_ensure(value == CPL_BINARY_0 || value == CPL_BINARY_1,
               CPL_ERROR_INCOMPATIBLE_INPUT, CPL_FALSE);

    for (i = 0; i < ngood; i++) {
        /* Assume NULL is returned if size == 0 */
        const cpl_binary * ppos = memchr(pself, value, (size_t)size);
        if (ppos == NULL) break;

        size -= 1 + (int)(ppos - pself);
        pself = 1 + ppos;
    }

    return i == ngood ? CPL_TRUE : CPL_FALSE;
}
#endif


/* ---------------------------------------------------------------------------*/
/**
 * @brief get first index that compares greater than value
 * @param vec sorted vector to check
 * @param val upper bound to check
 */
/* ---------------------------------------------------------------------------*/
size_t visir_upper_bound(const cpl_vector * vec, double val)
{
    const double * d = cpl_vector_get_data_const(vec);
    long count = cpl_vector_get_size(vec);
    long first = 0;
    while (count > 0)
    {
        long step = count / 2;
        long it = first + step;
        if (!(val < d[it])) {
            first = it + 1;
            count -= step + 1;
        }
        else
            count = step;
    }
    return first;
}


/* ---------------------------------------------------------------------------*/
/**
 * @brief get index that compares does not compare less than value
 * @param vec sorted vector to check
 * @param val upper bound to check
 */
/* ---------------------------------------------------------------------------*/
size_t visir_lower_bound(const cpl_vector * vec, double val)
{
    const double * d = cpl_vector_get_data_const(vec);
    long count = cpl_vector_get_size(vec);
    long first = 0;
    while (count > 0)
    {
        long step = count / 2;
        long it = first + step;
        if (d[it] < val) {
            first = it + 1;
            count -= step + 1;
        }
        else
            count = step;
    }
    return first;
}


/* ---------------------------------------------------------------------------*/
/**
 * @brief transform image values based on linear interpolated sampled function
 *
 * @param inp input image
 * @param ref data to interpolate at image value points, x must be sorted
 *
 * result[x, y] = fun(inp[x, y])
 * where fun(z) linear interpolates from points in ref
 *
 * @return new image with interpolated values from ref
 */
/* ---------------------------------------------------------------------------*/
cpl_image * visir_linintp_values(const cpl_image * inp, const cpl_bivector * ref)
{
    const double * data = cpl_image_get_data_double_const(inp);
    const cpl_vector * rx = cpl_bivector_get_x_const(ref);
    const cpl_vector * ry = cpl_bivector_get_y_const(ref);
    size_t nref = cpl_bivector_get_size(ref);
    size_t nx = cpl_image_get_size_x(inp);
    size_t ny = cpl_image_get_size_y(inp);
    cpl_image * res = cpl_image_new(nx, ny, CPL_TYPE_DOUBLE);
    double * rdata = cpl_image_get_data_double(res);
    cpl_ensure(nref >= 2, CPL_ERROR_ILLEGAL_INPUT, NULL);

    for (size_t y = 0; y < ny; y++) {
        for (size_t x = 0; x < nx; x++) {
            double val = data[y * nx + x];
            intptr_t ilo = visir_lower_bound(rx, val);
            //double intval, rx1, rx2, ry1, ry2;
            //if (ilo == 0) {
            //    /* extrapolate low */
            //    ilo += 1;
            //}
            //else if (ilo == nref) {
            //    /* extrapolate high */
            //    ilo -= 1;
            //}
            //rx1 = cpl_vector_get(rx, ilo - 1);
            //rx2 = cpl_vector_get(rx, ilo);
            //ry1 = cpl_vector_get(ry, ilo - 1);
            //ry2 = cpl_vector_get(ry, ilo);
            //double grad = (ry2 - ry1) / (rx2 - rx1);
            //double y0 = ry1 - grad * rx1;
            //rdata[y * nx + x] = grad * val + y0;

            if (ilo == 0) {
                rdata[y * nx + x] = cpl_vector_get(ry, 0);
                cpl_image_reject(res, x + 1, y + 1);
            }
            else if (ilo == (intptr_t)nref) {
                rdata[y * nx + x] = cpl_vector_get(ry, nref - 1);
                cpl_image_reject(res, x + 1, y + 1);
            }
            else {
                double rx1 = cpl_vector_get(rx, ilo - 1);
                double rx2 = cpl_vector_get(rx, ilo);
                double ry1 = cpl_vector_get(ry, ilo - 1);
                double ry2 = cpl_vector_get(ry, ilo);
                double grad = (ry2 - ry1) / (rx2 - rx1);
                double y0 = ry1 - grad * rx1;
                rdata[y * nx + x] = grad * val + y0;
            }
        }
    }
    return res;
}

/* ---------------------------------------------------------------------------*/
/**
 * @brief fit 2d gaussian to image
 *
 * @param img_       image to fit
 * @param weights    weights of the image (error = 1/sqrt(weight))
 * @param x          approximate mean x of gauss
 * @param y          approximate mean y of gauss
 * @param est_fwhmx  approximate fwhm x
 * @param est_fwhmy  approximate fwhm x
 * @param peak       output peak or NULL
 * @param peak_err   output peak error or NULL
 * @param major      output major axis FWHM or NULL
 * @param major_err  output major axis FWHM error or NULL
 * @param minor      output minor axis FWHM or NULL
 * @param minor_err  output minor axis FWHM error or NULL
 * @param angle      output angle or NULL [rad]
 * @param angle_err  output angle error or NULL [rad]
 */
/* ---------------------------------------------------------------------------*/
cpl_error_code
fit_2d_gauss(const cpl_image * img_, const cpl_image * weights, cpl_size x, cpl_size y,
             double est_fwhmx, double est_fwhmy,
             double * peak, double * peak_err,
             double * major, double * major_err,
             double * minor, double * minor_err,
             double * angle, double * angle_err)
{
    cpl_image * img = cpl_image_cast(img_, CPL_TYPE_DOUBLE);
    cpl_size llx = CX_MAX(x - est_fwhmx * 3, 1);
    cpl_size lly = CX_MAX(y - est_fwhmy * 3, 1);
    cpl_size urx = CX_MIN(x + est_fwhmx * 3, cpl_image_get_size_x(img));
    cpl_size ury = CX_MIN(y + est_fwhmy * 3, cpl_image_get_size_y(img));
    cpl_array * dpar = cpl_array_new(7, CPL_TYPE_DOUBLE);
    cpl_array * epar = cpl_array_new(7, CPL_TYPE_DOUBLE);
    cpl_matrix * cov = NULL;
    cpl_matrix * phys_cov = NULL;

    cpl_array_set_double(dpar, 0, cpl_image_get_median(img));
    cpl_array_set_double(dpar, 1, cpl_image_get_flux_window(img, llx, lly,
                                                            urx, ury));
    cpl_array_set_double(dpar, 2, 0.);
    cpl_array_set_double(dpar, 3, x);
    cpl_array_set_double(dpar, 4, y);
    cpl_array_set_double(dpar, 5, est_fwhmx / 2.355);
    cpl_array_set_double(dpar, 6, est_fwhmx / 2.355);

    cpl_image * err = cpl_image_new(cpl_image_get_size_x(img),
                                       cpl_image_get_size_y(img),
                                       CPL_TYPE_DOUBLE);
    cpl_image_add_scalar(err, 1.);
    cpl_image_divide(err, weights);
    cpl_image_power(err, 0.5);

    skip_if(cpl_fit_image_gaussian(img, err,
                x,
                y,
                urx - llx + 1,
                ury - lly + 1,
                dpar,
                epar,
                NULL, /* fit params */
                NULL,
                NULL,
                &cov,
                major,
                minor,
                angle,
                &phys_cov
        ));

    /* ignores covariance, values become nan for near circular gauss, forumula
     * illdefined for e.g. rho < 0 or theta = 45
     * nan cannot be in fits header, so set to -1 */
    if (peak) {
        double * a = cpl_array_get_data_double(dpar);
        *peak = a[0] + a[1] /
            (CPL_MATH_2PI * a[5] * a[6] * sqrt(1.0 - a[2] * a[2]));
        if (isnan(*peak)) {
            cpl_msg_warning(cpl_func, "2d gaussfit, could not determine peak");
            *peak = -1.;
        }
    }
    if (peak_err) {
        double * a = cpl_array_get_data_double(dpar);
        double * e = cpl_array_get_data_double(epar);
        double A = a[1];
        double sigx = a[5];
        double sigy = a[6];
        double rho = a[2];
        double dB = sqrt(e[0]);
        double dA = sqrt(e[1]);
        double dsigx = sqrt(e[5]);
        double dsigy = sqrt(e[6]);
        double drho = sqrt(e[2]);
        double A2 = A * A;
        double rho2 = rho * rho;
        double xd = CPL_MATH_PI * CPL_MATH_PI * 4 * sigx * sigx * sigy * sigy;
        *peak_err =
        sqrt(A2 * drho * drho * rho2 /(xd * pow(-rho2 + 1.0, 3)) +
             A2 * dsigx * dsigx      /(xd * sigx * sigx * (-rho2 + 1.0)) +
             A2 * dsigy * dsigy      /(xd * sigy * sigy * (-rho2 + 1.0)) +
             dA * dA/(xd * (-rho2 + 1.0)) + dB * dB);
        if (isnan(*peak_err)) {
            *peak_err = -1.;
        }
    }
    if (major) {
        *major *= CPL_MATH_FWHM_SIG;
        if (isnan(*major)) {
            cpl_msg_warning(cpl_func,
                            "2d gaussfit, could not determine major axis");
            *minor = -1.;
        }
    }
    if (minor) {
        *minor *= CPL_MATH_FWHM_SIG;
        if (isnan(*minor)) {
            cpl_msg_warning(cpl_func,
                            "2d gaussfit, could not determine minor axis");
            *minor = -1.;
        }
    }
    if (major_err) {
        *major_err = sqrt(cpl_matrix_get(phys_cov, 1, 1)) * CPL_MATH_FWHM_SIG;
        if (isnan(*major_err)) {
            *major_err = -1.;
        }
    }
    if (minor_err) {
        *minor_err = sqrt(cpl_matrix_get(phys_cov, 2, 2)) * CPL_MATH_FWHM_SIG;
        if (isnan(*minor_err)) {
            *minor_err = -1.;
        }
    }
    if (angle_err) {
        *angle_err = sqrt(cpl_matrix_get(phys_cov, 0, 0));
        if (isnan(*angle_err)) {
            *angle_err = -1.;
        }
    }

cleanup:
    cpl_array_delete(dpar);
    cpl_array_delete(epar);
    cpl_image_delete(err);
    cpl_image_delete(img);
    cpl_matrix_delete(phys_cov);
    cpl_matrix_delete(cov);

    return cpl_error_get_code();
}


/* ---------------------------------------------------------------------------*/
/**
 * @brief fit 1d gaussian to vector
 *
 * @param xv         x positions
 * @param yv         y positions
 * @param dyv        errors in y
 * @param x0         output mean or NULL
 * @param x0_err     output mean error or NULL
 * @param peak       output peak or NULL
 * @param peak_err   output peak error or NULL
 * @param sigma_     output sigma or NULL
 * @param sigma_err  output sigma error or NULL
 */
/* ---------------------------------------------------------------------------*/
cpl_error_code
fit_1d_gauss(const cpl_vector * xv, const cpl_vector * yv, cpl_vector * dyv,
             double * x0, double * x0_err,
             double * peak, double * peak_err,
             double * sigma_, double * sigma_err)
{
    double sigma, area, offset;
    cpl_matrix * cov = NULL;
    skip_if(cpl_vector_fit_gaussian(xv, /*sigma_x*/NULL,
                                    yv, dyv,
                                    CPL_FIT_CENTROID | CPL_FIT_STDEV |
                                    CPL_FIT_AREA | CPL_FIT_OFFSET,
                                    x0, &sigma, &area, &offset,
                                    NULL, NULL,
                                    &cov));
    if (x0 && isnan(*x0)) {
        cpl_msg_warning(cpl_func, "1d gaussfit, could not determine mean");
        *x0 = -1.;
    }
    if (x0_err) {
        *x0_err = sqrt(cpl_matrix_get(cov, 0, 0));
        if (isnan(*x0_err)) {
            *x0_err = -1.;
        }
    }
    if (sigma) {
        *sigma_ = sigma;
        if (isnan(*sigma_)) {
            cpl_msg_warning(cpl_func,
                            "1d gaussfit, could not determine sigma");
            *sigma_ = -1.;
        }
    }
    if (peak) {
        *peak = area / sqrt(2 * CPL_MATH_PI * sigma * sigma) + offset;
        if (isnan(*peak)) {
            cpl_msg_warning(cpl_func, "1d gaussfit, could not determine peak");
            *peak = -1.;
        }
    }
    if (peak_err) {
        double dsig = sqrt(cpl_matrix_get(cov, 1, 1));
        double dA = sqrt(cpl_matrix_get(cov, 2, 2));
        double dB = sqrt(cpl_matrix_get(cov, 3, 3));
        double pi2sig2 = 2 * CPL_MATH_PI * sigma * sigma;
        *peak_err = sqrt(dsig * dsig * area * area /
                             (2 * CPL_MATH_PI * pi2sig2 * sigma * sigma) +
                         dA * dA / pi2sig2 + dB * dB);
        if (isnan(*peak_err)) {
            *peak_err = -1.;
        }
    }
    if (sigma_err) {
        *sigma_err = sqrt(cpl_matrix_get(cov, 1, 1));
        if (isnan(*sigma_err)) {
            *sigma_err = -1.;
        }
    }

cleanup:
    cpl_matrix_delete(cov);

    return cpl_error_get_code();
}
