/* $Id: casu_utils.c,v 1.9 2015/11/27 12:06:41 jim Exp $
 *
 * This file is part of the CASU Pipeline utilities
 * Copyright (C) 2015 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., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 */

/*
 * $Author: jim $
 * $Date: 2015/11/27 12:06:41 $
 * $Revision: 1.9 $
 * $Name:  $
 */

/* Includes */

#ifdef HAVE_CONFIG_H
#include <config.h>
#endif

#define _XOPEN_SOURCE
#include <sys/time.h>
#include <time.h>
#include <libgen.h>
#include <string.h>
#include <unistd.h>

#include <cpl.h>
#include <math.h>

#include "casu_utils.h"
#include "casu_fits.h"
#include "imcore.h"

#define SZKEY 32
#define SZVAL 64

static void casu_substr(char *in, int ist, int len, char *out);
static int casu_mjdcompare(const cpl_frame *f1, const cpl_frame *f2);

/**
    \defgroup casu_utils casu_utils
    \ingroup casu_routines

    \brief
    These miscellaneous utilitiy routines

    \author
    Jim Lewis, CASU
*/


/**@{*/

/*---------------------------------------------------------------------------*/
/**
    \brief Compare input tags

    \par Name:
        casu_compare_tags
    \par Purpose:
        Comparison function to identify different input frames
    \par Description:
        The tags for two frames are compared to see whether they are
        the same. An error occurs if either frame is missing its tag.
    \par Language:
        C
    \param frame1
        The first frame 
    \param frame2 
        The second frame 
    \retval 0 
        if frame1 != frame2 
    \retval 1 
        if frame1 == frame2
    \retval -1 
        if either frame is missing its tag
    \author
        Jim Lewis, CASU
 */
/*---------------------------------------------------------------------------*/

extern int casu_compare_tags(const cpl_frame *frame1, const cpl_frame *frame2) {
    char *v1,*v2;

    /* Test entries */

    if (frame1 == NULL || frame2 == NULL) 
        return(-1);

    /* Get the tags */

    if ((v1 = (char *)cpl_frame_get_tag(frame1)) == NULL) 
        return(-1);
    if ((v2 = (char *)cpl_frame_get_tag(frame2)) == NULL) 
        return(-1);

    /* Compare the tags */

    if (strcmp(v1,v2)) 
        return(0);
    else 
        return(1);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Extract a frameset from another frameset

    \par Name:
        casu_frameset_subgroup
    \par Purpose:
        Extract a frameset of a given label from a master frameset
    \par Description:
        For each label in an input frameset a frameset with that label 
        is extracted. The tag for the first frame in the extracted set is
        compared to an input tag. If they match, then the extracted frameset
        is returned. If none of the frames match the input tag then a NULL
        frameset is returned
    \par Language:
        C
    \param frameset
        The input frameset
    \param labels
        The labels for the input frameset
    \param nlab
        The number of labels for the input frameset
    \param tag
        The tag for the frames in the output frameset
    \return The set of all frames matching input tag or NULL if none match
    \author
        Jim Lewis, CASU
 */
/*---------------------------------------------------------------------------*/

extern cpl_frameset *casu_frameset_subgroup(cpl_frameset *frameset, 
                                            cpl_size *labels, cpl_size nlab, 
                                            const char *tag) {
    int i;
    cpl_frameset *cur_set,*ret_set;
    cpl_frame *cur_frame;
    char *cur_tag;


    ret_set = NULL;
    for (i = 0; i < nlab; i++) {
        cur_set = cpl_frameset_extract(frameset,labels,(cpl_size)i);
        if (cur_set == NULL)
            break;
        cur_frame = cpl_frameset_get_position(cur_set,0);
        cur_tag = (char *)cpl_frame_get_tag(cur_frame);
        if (!strcmp(cur_tag,tag)) {
            ret_set = cur_set;
            cpl_frameset_sort(ret_set,casu_mjdcompare);
            break;
        }
        cpl_frameset_delete(cur_set);
    }
    return(ret_set);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Extract a frame of a given label from a frameset

    \par Name:
        casu_frameset_subgroup_1
    \par Purpose:
        Extract a frameset of a given label from a master frameset and 
        return the first frame only.
    \par Description:
        For each label in an input frameset a frameset with that label 
        is extracted. The tag for the first frame in the extracted set is
        compared to an input tag. If they match, then the first frame from
        the extracted frameset is returned. If none of the frames match the 
        input tag then a NULL frame is returned
    \par Language:
        C
    \param frameset
        The input frameset
    \param labels
        The labels for the input frameset
    \param nlab
        The number of labels for the input frameset
    \param tag
        The tag for the frames in the output frameset
    \return The first of all frames matching input tag or NULL if none match
    \author
        Jim Lewis, CASU
 */
/*---------------------------------------------------------------------------*/

extern cpl_frame *casu_frameset_subgroup_1(cpl_frameset *frameset, 
                                           cpl_size *labels, cpl_size nlab, 
                                           const char *tag) {
    cpl_frameset *cur_set;
    cpl_frame *cur_frame,*new_frame;

    if ((cur_set = casu_frameset_subgroup(frameset,labels,nlab,tag)) == NULL) {
        return(NULL);
    } else {
        cur_frame = cpl_frameset_get_position(cur_set,0);
        new_frame = cpl_frame_duplicate(cur_frame);
        cpl_frameset_delete(cur_set);
        return(new_frame);
    }
}

/*---------------------------------------------------------------------------*/
/**
    \brief Get the number of pixels in a 2d image

    \par Name:
        casu_getnpts
    \par Purpose:
        Get the number of pixels in an image
    \par Description:
        The number of pixels in an image is returned.
    \par Language:
        C
    \param in
        The input image
    \return
        The total number of pixels in the image
    \author
        Jim Lewis
 */
/*---------------------------------------------------------------------------*/

extern long casu_getnpts(cpl_image *in) {
    int nx,ny;
    long npts;
    const char *fctid = "casu_getnpts";

    if ((nx = (int)cpl_image_get_size_x(in)) == -1) {
        cpl_msg_error(fctid,"NULL image input");
        return(0);
    }
    if ((ny = (int)cpl_image_get_size_y(in)) == -1) {
        cpl_msg_error(fctid,"NULL image input");
        return(0);
    }
    npts = (long)nx*ny;
    return(npts);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Write provenance keywords

    \par Name:
        casu_prov
    \par Purpose:
        Write provenance cards to a header
    \par Description:
        A list of file names and extensions is written to the DRS extension
        to a header to indicate the provenance of the file. This is useful for
        output files that are formed from a list of input files.
    \par Language:
        C
    \param p
        The combined image propertylist
    \param inlist
        The list of images that went into ifile.
    \param n
        The number of images in the input list
    \param isextn
        Set if this is an extension rather than the primary
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_prov(cpl_propertylist *p, casu_fits **inlist, int n, 
    int isextn) {
    int i;
    char keyword[SZKEY],value[SZVAL],*fn,*base;

    /* Delete all the provenance keywords that might already exist */

    if (isextn)
        cpl_propertylist_erase_regexp(p,"ESO DRS PROV[0-9]*",0);
    else
        cpl_propertylist_erase_regexp(p,"PROV[0-9]*",0);

    /* Add the new provenance keywords */

    for (i = 0; i < n; i++) {
        if (isextn) {
            (void)snprintf(keyword,SZKEY,"ESO DRS PROV%d",i+1);
            fn = cpl_strdup(casu_fits_get_fullname(inlist[i]));
            base = basename(fn);
            (void)snprintf(value,SZVAL,"%s",base);
            cpl_free(fn);
        } else {
            (void)snprintf(keyword,SZKEY,"PROV%d",i+1);
            fn = cpl_strdup(casu_fits_get_filename(inlist[i]));
            base = basename(fn);
            (void)snprintf(value,SZVAL,"%s",base);
            cpl_free(fn);
        }
        cpl_propertylist_update_string(p,keyword,value);
        (void)snprintf(value,SZVAL,"Input file # %d",i+1);
        cpl_propertylist_set_comment(p,keyword,value);
    }
}

/*---------------------------------------------------------------------------*/
/**
    \brief Sort a 2d array by the first column and co-sort the rest

    \par Name:
        casu_sort
    \par Purpose:
        Sort a 2d array by the first column and co-sort the rest. 
    \par Description:
        Basic Shell sorting routine that sorts a 2d array by its first
        column and cosorts the rest. The storage of the array is 
        basically backwards to what is intuitive and this probably 
        should be changed soon.
    \par Language:
        C
    \param a
        The input 2d array (a[m][n])
    \param n
        The number of rows in the array
    \param m
        The number of columns in the array
    \return   
        Nothing
    \author
        Jim Lewis, CASU
 */
/*---------------------------------------------------------------------------*/

extern void casu_sort(float **a, int n, int m) {
    int increment,i,j,k;
    float *t;

    t = cpl_malloc(m*sizeof(*t));

    increment = n/2;
    while (increment > 0) {
        for (i = increment; i < n; i++) {
            j = i;
            for (k = 0; k < m; k++)
                t[k] = a[k][i];
            while ((j >= increment) && (a[0][j-increment] > t[0])) {
                for (k = 0; k < m; k++) 
                    a[k][j] = a[k][j-increment];
                j = j - increment;
            }
            for (k = 0; k < m; k++) 
                a[k][j] = t[k];
        }
        if (increment == 2) 
            increment = 1;
        else
            increment = (int)((float)increment/2.2);
    }
    cpl_free(t);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Merge two propertylists

    \par Name:
        casu_merge_propertylists
    \par Purpose:
        Merge the properties from a propertylist into another one
    \par Description:
        All of the properties from a second propertylist are copied into
        the first one.
    \par Language:
        C
    \param p1
        The first propertylist
    \param p2
        The second propertylist
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_merge_propertylists(cpl_propertylist *p1, 
                                     cpl_propertylist *p2) {
    int i;
    const char *name;
    
    /* Return if either propertylist is NULL */

    if (p1 == NULL || p2 == NULL)
        return;

    /* Erase any common properties so that you don't get a clash with
       data types. Then copy each property from the second list into 
       the first one */

    for (i = 0; i < cpl_propertylist_get_size(p2); i++) {
        name = cpl_property_get_name(cpl_propertylist_get(p2,i));
        if (cpl_propertylist_has(p1,name)) 
            cpl_propertylist_erase(p1,name);
    }
    cpl_propertylist_append(p1,p2);

}

/*---------------------------------------------------------------------------*/
/**
    \brief Set dummy property keyword

    \par Name:
        casu_dummy_property
    \par Purpose:
        Set a keyword in the property list of a dummy product
    \par Description:
        The key ESO DRS IMADUMMY is set in the input property list
    \par Language:
        C
    \param p
        The input propertylist
    \par DRS headers:
        The following DRS keywords are written to the propertylist
        - \b IMADUMMY
            Boolean value set to T to indicate a dummy data product
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_dummy_property(cpl_propertylist *p) {

    /* Check for silly input */

    if (p == NULL)
        return;

    /* Add the property now */

    cpl_propertylist_update_bool(p,"ESO DRS IMADUMMY",TRUE);
    cpl_propertylist_set_comment(p,"ESO DRS IMADUMMY",
                                 "This is a dummy product");
    return;
}

/*---------------------------------------------------------------------------*/
/**
    \brief Rename a property in a given propertylist

    \par Name:
        casu_rename_property
    \par Purpose:
        Rename a property in a propertylist
    \par Description:
        Rename a property in a propertylist
    \par Language:
        C
    \param p
        The input propertylist for the table
    \param oldname
        The old property name
    \param newname
        The new property name
    \returns
        Nothing
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_rename_property(cpl_propertylist *p, const char *oldname,
                                 char *newname) {
    cpl_propertylist *temp;
    cpl_property *property;

    /* First get the old property. Note that we have to do this in a 
       particularly silly way since you cannot reference an individual property
       in a propertylist by its name. You can only do it by its index 
       number. Remeber to change this when CPL comes to it's senses... */

    if (! cpl_propertylist_has(p,oldname))
        return;
    temp = cpl_propertylist_new();
    cpl_propertylist_copy_property(temp,p,oldname);
    property = cpl_propertylist_get(temp,0);

    /* Now change its name */

    cpl_property_set_name(property,newname);

    /* Now insert this into the propertylist and delete the old one */

    cpl_propertylist_append(p,temp);
    cpl_propertylist_erase(p,oldname);
    cpl_propertylist_delete(temp);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Create a dummy image of zeros based on a model

    \par Name:
        casu_dummy_image
    \par Purpose:
        Create a dummy image based on another one.
    \par Description:
        Use an input image to create a new image full of zeros.
    \par Language:
        C
    \param model
        The model on which the new image will be based.
    \returns
        A new dummy image
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern cpl_image *casu_dummy_image(casu_fits *model) {
    cpl_image *im;

    /* Copy the input model image */

    im = cpl_image_duplicate(casu_fits_get_image(model));

    /* Now change it all to zeros */

    cpl_image_multiply_scalar(im,0.0);

    /* Return the result */

    return(im);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Create a dummy catalogue of a given type with no rows

    \par Name:
        casu_dummy_catalogue
    \par Purpose:
        Create a dummy catalogue with no rows
    \par Description:
        Create a dummy catalogue with no rows
    \par Language:
        C
    \param type
        The type of catalogue to create
    \returns
        A new dummy catalogue
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern cpl_table *casu_dummy_catalogue(int type) {
    int xcol,ycol;
    cpl_table *tab;
    
    imcore_tabinit(NULL,&xcol,&ycol,type,&tab);
    return(tab);
}

/*---------------------------------------------------------------------------*/
/**
    \brief See if the header of an image or table says its a dummy

    \par Name:
        casu_is_dummy
    \par Purpose:
        See if an image or table is a dummy output product
    \par Description:
        The input propertylist is searched for the key ESO DRS IMADUMMY.
        If it exists, then this header is part of a dummy image or table.
    \par Language:
        C
    \param p
        The input propertylist
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern int casu_is_dummy(cpl_propertylist *p) {

    /* Check for silly input */

    if (p == NULL)
        return(0);

    /* Check the propertylist and return the result */

    return(cpl_propertylist_has(p,"ESO DRS IMADUMMY"));
}

/*---------------------------------------------------------------------------*/
/**
    \brief Remove over- or under-exposed images from a list

    \par Name:
        casu_overexp
    \par Purpose:
        Sort out a list of fits images to remove those that are either 
        over or under exposed.
    \par Description:
        A list of fits images is examined to locate images that are either
        over or under exposed.
    \par Language:
        C
    \param fitslist
        The input fits list. This will be replaced by another list that 
        has the rejected images removed.
    \param n
        The number of fits images in the input list. This will be changed 
        if any of these get rejected.
    \param ndit
        The number of coadds
    \param lthr
        The lower threshold for underexposed images
    \param hthr
        The upper threshold for overexposed images
    \param ditch
        If set, then the bad casu_fits image descriptors will be 
        explicitly deleted.
    \param minv
        Output value with the lowest flux in the sample
    \param maxv
        Output value with the highest flux in the sample
    \param avev
        Output value with the average flux in the sample
    \returns
        Nothing
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_overexp(casu_fits **fitslist, int *n, int ndit, float lthr, 
                         float hthr, int ditch, float *minv, float *maxv,
                         float *avev) {
    int i,m;
    cpl_image *im;
    double val,dndit,sum;

    /* Loop for each of the fits items */

    dndit = (double)ndit;
    m = 0;
    *minv = 1.0e10;
    *maxv = -1.0e10;
    sum = 0.0;
    for (i = 0; i < *n; i++) {
        im = casu_fits_get_image(fitslist[i]);
        val = cpl_image_get_median_window(im,500,500,1000,1000);
        val /= dndit;
        *minv = min(*minv,val);
        *maxv = max(*maxv,val);
        sum += val;
        if (val > lthr && val < hthr) {
            fitslist[m++] = fitslist[i];
        } else {
            if (ditch) 
                casu_fits_delete(fitslist[i]);
        }
    }
    for (i = m; i < *n; i++)
        fitslist[i] = NULL;
    *avev = sum/(double)*n;
    *n = m;
}

/*---------------------------------------------------------------------------*/
/**
    \brief Compare dimensions of two 2d images

    \par Name:
        casu_compare_dims
    \par Purpose:
        Compare dimensions of data arrays of two images
    \par Description:
        The dimensions of two different images are compared. If they are
        not the same, then an fatal error status is returned. Otherwise
        a good status is returned
    \par Language:
        C
    \param im1
        The first image
    \param im2
        The second image
    \retval CASU_OK
        If the dimensions are the same
    \retval CASU_FATAL
        If the dimensions are different
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern int casu_compare_dims(cpl_image *im1, cpl_image *im2) {
    
    if (cpl_image_get_size_x(im1) != cpl_image_get_size_x(im2) ||
        cpl_image_get_size_y(im1) != cpl_image_get_size_y(im2))
        return(CASU_FATAL);
    else
        return(CASU_OK);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Work out gain corrections

    \par Name:
        casu_gaincor_calc
    \par Purpose:
        Work out gain corrections
    \par Description:
        The headers of an input twilight flat frame are searched to find the
        relative flux of each of the MEF images before they were normalised.
        A gain correction is calculated by scaling the medians to a common
        value, which is the ensemble median of the good images in the input
        frame.
    \par Language:
        C
    \param frame
        The input twilight frame
    \param n
        The number of image extensions
    \param cors
        An array of output corrections
    \param status
        The input/output status variable
    \retval CASU_OK 
        if everything is ok
    \par QC headers:
        None
    \par DRS headers:
        None
    \author
        Jim Lewis, CASU
 */
/*---------------------------------------------------------------------------*/

extern int casu_gaincor_calc(cpl_frame *frame, int *n, float **cors,
                             int *status) {
    float sum,val;
    int i,ngood;
    unsigned char *iflag;
    cpl_propertylist *p;

    /* Inherited status */

    if (*status != CASU_OK)
        return(*status);

    /* Find the number of extensions in the file and allocate some workspace
       to hold the results. Allocate a small workspace to flag dummy 
       extensions */

    *n = cpl_frame_get_nextensions(frame);
    *cors = cpl_malloc(*n*sizeof(float));
    iflag = cpl_calloc(*n,sizeof(iflag));

    /* Ok, loop through the extensions and read the propertylists */

    sum = 0.0;
    ngood = 0;
    for (i = 0; i < *n; i++) {
        p = cpl_propertylist_load(cpl_frame_get_filename(frame),(cpl_size)(i+1));
        if (cpl_propertylist_has(p,"ESO DRS IMADUMMY")) {
            iflag[i] = 1;
        } else if (! cpl_propertylist_has(p,"ESO DRS MEDFLAT")) {
            iflag[i] = 1;
        } else {
            val = cpl_propertylist_get_double(p,"ESO DRS MEDFLAT");
            if (val == 0.0) {
                iflag[i] = 1;
            } else {
                sum += val;
                (*cors)[i] = val;
                ngood++;
            }
        }
        cpl_propertylist_delete(p);
    }

    /* If any of them are good, then work out what the average is and
       create the correction factors. If the image was a dummy or
       there was no MEDFLAT keyword in the header, then just give it
       a factor of 1 */

    if (ngood > 0)
        sum /= (float)ngood;
    for (i = 0; i < *n; i++) {
        if (iflag[i] == 0) {
            (*cors)[i] = sum/(*cors)[i];
        } else {
            (*cors)[i] = 1.0;
        }
    }
    cpl_free(iflag);

    /* Get out of here */

    GOOD_STATUS
}

/*---------------------------------------------------------------------------*/
/**
    \brief Create a timestamp string

    \par Name:
        casu_timestamp
    \par Purpose:
        Create a timestamp string
    \par Description:
        Create a timestamp string similar to DATE-OBS. This can be used
        to associate files together.
    \par Language:
        C
    \param out
        The output string. It should be at least 25 characters long. NB:
        if it isn't at least 25 characters long (and provided you haven't
        done something stupid like pass in a value of n which is larger
        than the size of the string) then the output value will truncated
        to n characters
    \param n
        The maximum size of the string.
    \returns
        Nothing
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_timestamp(char *out, int n) {
    struct timeval tv;
    struct tm *tm;
    float sec;
    struct tm result;
    /* Get the Greenwich Mean Time */

    (void)gettimeofday(&tv,NULL);

    tm = gmtime_r(&(tv.tv_sec), &result);
    sec = (float)tm->tm_sec + 1.0e-6*(float)tv.tv_usec;

    /* Now format it */

    (void)snprintf(out,n,"%04d-%02d-%02dT%02d:%02d:%07.4f",1900+tm->tm_year,
                   tm->tm_mon+1,tm->tm_mday,tm->tm_hour,tm->tm_min,sec);
}
   
/*---------------------------------------------------------------------------*/
/**
    \brief Find the name of the standard catalogue and its location

    \par Name:
        casu_catpars
    \par Purpose:
        Find the name of the standard catalogue being used and its location
    \par Description:
        Find the name of the standard catalogue being used and its location.
        The former should be in a header keyword in the specified FITS
        file. The latter is the full path of the FITS file. Both values
        need to be deallocated when you're finished with them.
    \par Language:
        C
    \param indx
        The frame for the index FITS file
    \param catpath
        The full path to the catalgoue FITS files
    \param catname
        The name of the catalogue
    \retval CASU_OK 
        if everything is ok
    \retval CASU_WARN
        if the catalogue isn't identified in the header
    \retval CASU_FATAL
        if the index file is missing or if there is missing header info
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern int casu_catpars(cpl_frame *indx, char **catpath, char **catname) {
    cpl_propertylist *p;
    int status;
    const char *fctid = "casu_catpars",*unk = "unknown";

    /* Initialise a few things */

    *catpath = NULL;
    *catname = NULL;

    /* First get the full path to the indx file and make sure it exists */

    *catpath = cpl_strdup(cpl_frame_get_filename(indx));
    if (access((const char *)*catpath,R_OK) != 0) {
        cpl_msg_error(fctid,"Can't access index file %s",*catpath);
        freespace(*catpath);
        return(CASU_FATAL);
    }

    /* Load the propertylist if you can. If you can't then signal a fatal
       error since this probably means the whole file is messed up */

    if ((p = cpl_propertylist_load(cpl_frame_get_filename(indx),0)) == NULL) {
        freespace(*catpath);
        cpl_msg_error(fctid,"Can't load index file header %s",
                      cpl_frame_get_filename(indx));
        return(CASU_FATAL);
    }
        
    /* If there is a catalogue name in the header then send it back. If there
       isn't then give a default name and send a warning */

    if (cpl_propertylist_has(p,"CATNAME")) {
        *catname = cpl_strdup(cpl_propertylist_get_string(p,"CATNAME"));
        status = CASU_OK;
    } else {
        *catname = cpl_strdup(unk);
        cpl_msg_warning(fctid,"Property CATNAME not in index file header %s",
                        cpl_frame_get_filename(indx));
        status = CASU_WARN;
    }
    freepropertylist(p);

    /* Get out of here */

    return(status);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Match the x,y coordinates of an object to one from a list 

    \par Name:
        casu_fndmatch
    \par Purpose:
        Match the x,y coordinates of an object to one of list of coordinates
    \par Description:
        The routine is given the coordinates of an object (x,y) and a list
        of x,y coordinates. If one of the list matches the coordinates of the
        given object, the index Of the matching entry is returned. If none 
        match then -1 is returned.
    \par Language:
        C
    \param x
        The X coordinate of the object
    \param y
        The Y coordinate of the object
    \param xlist
        The list of catalogue X coordinates
    \param ylist
        The list of catalogue Y coordinates
    \param nlist
        The number of entries in the lists
    \param err
        The maximum error radius for a match
    \return
        The index of the list object that matches the given coordinates. If 
        none match, then -1 is returned.
    \author
        Jim Lewis
 */
/*---------------------------------------------------------------------------*/

extern int casu_fndmatch(float x, float y, float *xlist, float *ylist, 
                         int nlist, float err) {
    int isp,ifp,indx,i;
    float errsq,errmin,dx,dy,poserr;

    /* Find lower limit index */

    isp = 0;
    ifp = nlist - 1;
    errsq = err*err;
    indx = (isp + ifp)/2;
    while (ifp-isp >= 2) {
        if (ylist[indx] < y - err) {
            isp = indx;
            indx = (indx+ifp)/2;
        } else if (ylist[indx] > y - err) {
            ifp = indx;
            indx = (indx+isp)/2;
        } else {
            isp = indx;
            break;
        }
    }

    /* Now find nearest one within limit */

    indx = -1;
    errmin = errsq;
    for (i = isp; i < nlist; i++) {
        if (ylist[i] > y+err)
            break;
        dx = x - xlist[i];
        dy = y - ylist[i];
        poserr = dx*dx + dy*dy;
        if (poserr < errsq) {
            if (poserr <= errmin) {
                indx = i;
                errmin = poserr;
            }
        }
    }
    return(indx);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Find from catalogue header which are x,y columns
 
   \par Name:
        casu_findcol
    \par Purpose:
        Find which column in a catalogue is the x or y position
    \par Description:
        Find which column in a catalogue is the x or y position
    \par Language:
        C
    \param p
        The input propertylist for the table
    \param col
        The column you want to find
    \returns
        The column number that matches the column name. If no match is found
        then -1 is returned.
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern int casu_findcol(cpl_propertylist *p, const char *col) {

    if (!strcmp(col,"X")) {
        if (cpl_propertylist_has(p,"ESO DRS XCOL"))
            return(cpl_propertylist_get_int(p,"ESO DRS XCOL"));
        else 
            return(-1);
    } else if (!strcmp(col,"Y")) {
        if (cpl_propertylist_has(p,"ESO DRS YCOL"))
            return(cpl_propertylist_get_int(p,"ESO DRS YCOL"));
        else 
            return(-1);
    }
    return(-1);
}

/*---------------------------------------------------------------------------*/
/**
    \brief Use the dateobs value to work out the night of an observation

    \par Name:
        casu_night_from_dateobs
    \par Purpose:
        Find the night of an observation from the date-obs value
    \par Description:
        Find the 'night' of an observation. This is the date of the observation
        but starting at noon.
    \par Language:
        C
    \param dateobs
        The value of DATE-OBS for the observation
    \returns
        An 8 digit integer with the night expressed as yyyymmdd
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern int casu_night_from_dateobs(char *dateobs) {
    int days[] = {31,28,31,30,31,30,31,31,30,31,30,31};
    int offs[] = {0,5,8,11,14,17};
    int lns[] = {4,2,2,2,2,7};
    int info[5],i,night;
    double ss;
    double utc,civil;
    char test[8];

    /* Format of dateobs: 2013-01-01T06:29:34.1397  
       Start by getting the information from the input string */

    for (i = 0; i < 5; i++) {
        casu_substr(dateobs,offs[i],lns[i],test);
        info[i] = atoi(test);
    }
    casu_substr(dateobs,offs[5],lns[5],test);
    ss = atof(test);

    /* Form the UTC as a decimal. Subtract 16 hours to see where we are relative
       to noon on the advertised day. If it's negative, then this dateobs 
       belongs to the previous night. */

    utc = info[3] + (double)info[4]/60.0 + ss/3600.0;
    civil = utc - 16.0;
    if (civil < 0.0) {
        info[2] -= 1;
        if (info[2] == 0) {
            info[1] -= 1;
            if (info[1] == 0) {
                info[1] = 12;
                info[0] -= 1;
                info[2] = days[info[1] - 1];
            } else if (info[1] == 2) {
                info[2] = days[1];
                if (info[0] % 4 == 0) 
                    info[2] += 1;
            } else {
                info[2] = days[info[1] - 1];
            }
        }
    }

    /* Now format the night...*/

    night = 10000*info[0] + 100*info[1] + info[2];
    return(night);
}

/*---------------------------------------------------------------------------*/
/**
    \par Name:
        casu_propertylist_update_float
    \par Purpose:
        Update a floating point property to a propertylist
    \par Description:
        Update a floating point property to a propertylist. If a floating
        point property is written by hand to the propertylist as a float, then
        it remains a float and can be updated as such. However if it's read
        from a FITS header, then it defaults to double and any attempt to
        update it using cpl_propertylist_update_float fails. Very annoying!
        This routine attempts to fix this...
    \par Language:
        C
    \param plist
        The input propertylist
    \param  name
        The name of the property to be updated
    \param val
        The value of the property
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_propertylist_update_float(cpl_propertylist *plist, 
                                           const char *name, float val) {
    char *comment;
    
    /* First check whether the property exists. If it doesn't then just
       update it using the standard cpl_ routine and get out of here */

    if (cpl_propertylist_has(plist,name) == 0) {
        cpl_propertylist_update_float(plist,name,val);
        return;
    } else if (cpl_propertylist_get_type(plist,name) == CPL_TYPE_FLOAT) {
        cpl_propertylist_update_float(plist,name,val);
        return;
    }        

    /* OK, it already has the property. So delete it and write a new one */

    comment = cpl_strdup(cpl_propertylist_get_comment(plist,name));
    cpl_propertylist_erase(plist,name);
    cpl_propertylist_update_float(plist,name,val);
    cpl_propertylist_set_comment(plist,name,comment);
    freespace(comment);
}

/*---------------------------------------------------------------------------*/
/**
    \par Name:
        casu_propertylist_update_double
    \par Purpose:
        Update a double property to a propertylist
    \par Description:
        Update a double property to a propertylist. It's not possible to
        write a double to a floating point property, which really is
        incredibly unhelpful. This is especially annoying as it's almost
        impossible to predict whether a property is going to be float or
        double
    \par Language:
        C
    \param plist
        The input propertylist
    \param  name
        The name of the property to be updated
    \param val
        The value of the property
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

extern void casu_propertylist_update_double(cpl_propertylist *plist, 
                                            const char *name, double val) {
    char *comment;
    
    /* First check whether the property exists. If it doesn't then just
       update it using the standard cpl_ routine and get out of here */

    if (cpl_propertylist_has(plist,name) == 0) {
        cpl_propertylist_update_double(plist,name,val);
        return;
    } else if (cpl_propertylist_get_type(plist,name) == CPL_TYPE_DOUBLE) {
        cpl_propertylist_update_double(plist,name,val);
        return;
    }

    /* OK, it already has the property, but it's the wrong type. So 
       delete it and write a new one */

    comment = cpl_strdup(cpl_propertylist_get_comment(plist,name));
    cpl_propertylist_erase(plist,name);
    cpl_propertylist_update_double(plist,name,val);
    cpl_propertylist_set_comment(plist,name,comment);
    freespace(comment);
}

/**@}*/

/*---------------------------------------------------------------------------*/
/**
    \par Name:
        casu_substr
    \par Purpose:
        Get a sub-string from an input string
    \par Description:
        A substring is extracted from an input string. The calling routine
        is expected to check that the starting place and extent of the
        substring fits within the confines of the input string and that the
        output string is big enough to hold the substring.
    \par Language:
        C
    \param in
        The input string
    \param  ist
        The starting location in the input string (starting with 0)
    \param len
        The length of the sub-string
    \param out
        The output character sub-string
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

static void casu_substr(char *in, int ist, int len, char *out) {
    char *c;

    /* Get the starting place. Then do a copy of the correct number of
       characters */

    c = in + ist;
    (void)strncpy(out,c,len);
    out[len] = '\0';
}

/*---------------------------------------------------------------------------*/
/**
    \par Name:
        casu_mjdcompare
    \par Purpose:
        Compare the MJD of two frames
    \par Description:
        Strings containing the MJD of two frames are compared. The
        result of a strcmp of the two strings is passed back
    \par Language:
        C
    \param f1
        The first input frame
    \param  f2
        The second input frame
    \retval
        -1 if the first mjd is less than the second, 0 if they're equal
        and 1 if the first is greater than the second.
    \author
        Jim Lewis, CASU
*/
/*---------------------------------------------------------------------------*/

static int casu_mjdcompare(const cpl_frame *f1, const cpl_frame *f2) {
    double mjd1,mjd2;
    cpl_propertylist *p;
    
    p = cpl_propertylist_load(cpl_frame_get_filename(f1),0);
    if (cpl_propertylist_has(p,"MJD-OBS") == 0) {
        cpl_propertylist_delete(p);
        p = cpl_propertylist_load(cpl_frame_get_filename(f1),1);
    }
    mjd1 = cpl_propertylist_get_double(p,"MJD-OBS");
    cpl_propertylist_delete(p);
    p = cpl_propertylist_load(cpl_frame_get_filename(f2),0);
    if (cpl_propertylist_has(p,"MJD-OBS") == 0) {
        cpl_propertylist_delete(p);
        p = cpl_propertylist_load(cpl_frame_get_filename(f1),1);
    }
    mjd2 = cpl_propertylist_get_double(p,"MJD-OBS");
    cpl_propertylist_delete(p);
    if (mjd1 < mjd2) 
        return(-1);
    else if (mjd1 > mjd2) 
        return(1);
    else
        return(0);
}

/*

$Log: casu_utils.c,v $
Revision 1.9  2015/11/27 12:06:41  jim
Detabbed a few things

Revision 1.8  2015/11/25 10:27:04  jim
modified casu_catpars so that the catpath always contains a file
name along with the full path

Revision 1.7  2015/10/07 10:57:39  jim
Modified casu_mjdcompare to look for the mjd keyword in the first extension
if it's not present in the primary

Revision 1.6  2015/09/22 13:12:41  jim
fixed data type error in mjdcompare

Revision 1.5  2015/09/22 09:37:44  jim
casu_frameset_subgroup now sorts output by MJD

Revision 1.4  2015/09/11 09:27:53  jim
Fixed some problems with the docs

Revision 1.3  2015/08/12 11:22:12  jim
Modified calls to imcore procedures where necessary

Revision 1.2  2015/08/07 13:06:54  jim
Fixed copyright to ESO

Revision 1.1.1.1  2015/06/12 10:44:32  jim
Initial import

Revision 1.12  2015/05/13 11:47:21  jim
Added casu_propertylist_update_double and fixed some regular expressions

Revision 1.11  2015/03/12 09:16:51  jim
Modified to remove some compiler moans

Revision 1.10  2015/02/14 12:34:15  jim
Added casu_propertylist_update_float

Revision 1.9  2015/01/29 11:56:27  jim
modified comments

Revision 1.8  2015/01/09 12:13:15  jim
*** empty log message ***

Revision 1.7  2014/12/11 12:23:33  jim
new version

Revision 1.6  2014/04/27 10:10:10  jim
fixed catpars so that if something other than the 2mass or ppmxl index
files is passed, then you get the full path to the one FITS catalogue

Revision 1.5  2014/03/26 16:01:01  jim
Removed calls to deprecated cpl routine

Revision 1.4  2013/11/21 09:38:14  jim
detabbed

Revision 1.3  2013-10-24 09:27:45  jim
Added casu_night_from_dateobs

Revision 1.2  2013-09-30 18:13:53  jim
Added casu_dummy_catalogue

Revision 1.1.1.1  2013-08-27 12:07:48  jim
Imported


*/
