File: flames_midas_def.c

package info (click to toggle)
cpl-plugin-uves 5.7.0%2Bdfsg-1
links: PTS, VCS
area: main
in suites: stretch
size: 17,520 kB
sloc: ansic: 130,895; sh: 11,432; python: 2,924; makefile: 1,006
file content (4665 lines) | stat: -rw-r--r-- 164,130 bytes

/*                                                                              *
 *   This file is part of the ESO UVES Pipeline                                 *
 *   Copyright (C) 2004,2005 European Southern Observatory                      *
 *                                                                              *
 *   This library 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, 51 Franklin St, Fifth Floor, Boston, MA  02111-1307  USA  *
 *                                                                              */

/*
 * $Author: amodigli $
 * $Date: 2013-02-12 10:59:25 $
 * $Revision: 1.8 $
 * $Name: not supported by cvs2svn $
 *
 */

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

/*----------------------------------------------------------------------------*/
/**
 * @defgroup flames_midas_def   MIDAS <-> CPL interface
 *
 * This is not intended to be a full implementation of the C->MIDAS interface,
 * but only of the parts that are necessary for the FLAMES pipeline 
 *
 * Error handling: The functions in this module return an integer error code
 * (expected by the FLAMES C-code) and set the cpl_error_code in case of an error
 *
 * Bugs: 
 * 1. table column formats are not handled because CPL table i/o is broken.
 * That is not a problem for the FLAMES code which does not depend on the actual
 * values of the format strings.
 * (But table column units *are* handled (by a workaround, this also didn't work
 *  in CPL))
 *
 * 2. There are no checks for NULL input (which is ok because the FLAMES code
 * always provides non-null pointers)
 */
/*----------------------------------------------------------------------------*/

/*-----------------------------------------------------------------------------
                            Includes
 -----------------------------------------------------------------------------*/
#include <flames_midas_def.h>

#include <uves_utils_cpl.h>
#include <uves_dfs.h>
#include <uves_dump.h>
#include <uves_utils_wrappers.h>
#include <uves_error.h>

#include <uves_msg.h>
#include <uves_pfits.h>
#include <uves_globals.h>
#include <assert.h>

#include <fitsio.h>
#include <string.h>
#include <errno.h>
/*-----------------------------------------------------------------------------
                            Defines
 -----------------------------------------------------------------------------*/

#define MAX_OPEN 1024 /* Maximum number of open images/tables files */

/**@{*/
/*-----------------------------------------------------------------------------
                            Functions prototypes
 -----------------------------------------------------------------------------*/
/*-----------------------------------------------------------------------------
                            Variables
 -----------------------------------------------------------------------------*/

struct frame
{
    const char *filename;      /* NULL: slot not used */

    bool is_image;             /* Image or table? */
    union {
        struct {
            cpl_image *image;  
            cpl_type type;   /* CPL type of image (cannot store this in
                                the CPL image structure, because the image may
                                be logically open before it is actually loaded
                                into memory) */
            int dtype;       /* MIDAS image type */
        } image;
        struct {
            cpl_table *table;  /* The actual table columns *and* an
                                  'internal' column "Select" to record
                                  selections */
            cpl_table *colnames;
            int maxrow;        /* Number of rows actually used
                                  (maybe be less than rows allocated) */
        } table;
    } data;

    uves_propertylist *header;  /* Primary header, also for tables.
                                  NULL: not loaded (yet) */
    bool need_to_save;         /* Need to save to disk when closing? */

    /* Invariants:
       if need_to_save, then image/table is != NULL
       For images:
          if image != NULL, then cpl_image_get_type(image) = type 
       For tables:
          (table == NULL) == (colnames == NULL)
          if table != NULL, then table.ncol-1 == colnames.nrow
          if table != NULL, table has column "Select"
    */

};

#define COLNAME "ColName"

/* There are 3(!) different representations of FITS headers

   1. As seen by the FLAMES code, e.g.

   LHCUTS[3]...
   LHCUTS[4]...
   ORDERLIM[1]...
   ORDERLIM[2]...
   ESO OBS ID...

   2. CPL propertylist
   
   DATAMIN...
   DATAMAX...
   ORDERLIM = x
   ORDERLIM = y
   ESO OBS ID...

   3. The actual FITS file
   
   DATAMIN...
   DATAMAX...
   HISTORY ORDERLIM 
   HISTORY x y
   HISTORY
   HIERARCH ESO OBS ID...

*/

struct frame frames[MAX_OPEN];
const char *current_caller = NULL;

/*-----------------------------------------------------------------------------
                            Implementation
 -----------------------------------------------------------------------------*/
/*----------------------------------------------------------------------------*/
/**
   @brief    Structure invariant
   @param    id          frame id
   @return true if the invariant holds

   This function is used to detect bugs in this member functions.
   Typical usage:

     assert( invariant );

   in the beginning and end of every member function.
*/
/*----------------------------------------------------------------------------*/

static bool invariant(int id)
{
    struct frame *frm = &frames[id];

    if (frm->is_image)
        {
            return
                (!frm->need_to_save || frm->data.image.image != NULL) &&
                (frm->data.image.image == NULL
                 || cpl_image_get_type(frm->data.image.image) == frm->data.image.type);
        }
    else
        {
            return (!frm->need_to_save || frm->data.table.table != NULL)
                &&
                ((frm->data.table.table == NULL) == (frm->data.table.colnames == NULL))
                &&
                (frm->data.table.table == NULL || 
                 cpl_table_get_ncol(frm->data.table.table) - 1 ==
                 cpl_table_get_nrow(frm->data.table.colnames)) 
                &&
                (frm->data.table.table == NULL || 
                 cpl_table_has_column(frm->data.table.table, "Select"));

        }
}
/*----------------------------------------------------------------------------*/
/**
   @brief    Tell if frame is open
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
static bool
frame_is_open(int id)
{
    return frames[id].filename != NULL;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Create new image frame
   @param    id         frame id
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
static void 
frame_new_image(int id, const char *filename, 
                uves_propertylist *header,
                bool need_to_save,
                cpl_image *image,
                cpl_type type,
                int dtype)
{
    if (strstr(filename, ".fits") == filename + strlen(filename) - 5) {
        frames[id].filename = uves_sprintf("%s", filename);
    } 
    else if (strstr(filename, ".bdf") == filename + strlen(filename) - 4) {
        /* Replace .bdf -> .fits */
        frames[id].filename = uves_sprintf("%sX", filename);
        ((char *)frames[id].filename)[strlen(filename) - 3] = 'f';
        ((char *)frames[id].filename)[strlen(filename) - 2] = 'i';
        ((char *)frames[id].filename)[strlen(filename) - 1] = 't';
        ((char *)frames[id].filename)[strlen(filename) - 0] = 's';
    }
    else {
        frames[id].filename = uves_sprintf("%s.fits", filename);
    }
    frames[id].is_image = true;
    frames[id].data.image.image = image;
    frames[id].data.image.type  = type;
    frames[id].data.image.dtype = dtype;
    frames[id].header = header;
    frames[id].need_to_save = need_to_save;

    return;
}
/*----------------------------------------------------------------------------*/
/**
   @brief    Create new table frame
   @param    id         frame id
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
static void 
frame_new_table(int id, const char *filename, 
                uves_propertylist *header,
                bool need_to_save,
                cpl_table *table,
                int maxrow,
                cpl_table *colnames)
{
    if (strstr(filename, ".fits") == filename + strlen(filename) - 5) {
        frames[id].filename = uves_sprintf("%s", filename);
    } 
    else if (strstr(filename, ".tfits") == filename + strlen(filename) - 6) {
        frames[id].filename = uves_sprintf("%s", filename);
    } 
    else if (strstr(filename, ".tbl") == filename + strlen(filename) - 4) {
        /* Replace .tbl -> .fits */
        frames[id].filename = uves_sprintf("%sX", filename);
        ((char *)frames[id].filename)[strlen(filename) - 3] = 'f';
        ((char *)frames[id].filename)[strlen(filename) - 2] = 'i';
        ((char *)frames[id].filename)[strlen(filename) - 1] = 't';
        ((char *)frames[id].filename)[strlen(filename) - 0] = 's';
    } else {
        frames[id].filename = uves_sprintf("%s.fits", filename);
    }
    frames[id].is_image = false;
    frames[id].data.table.table = table;
    if (table != NULL) {
        cpl_table_new_column(table, "Select", CPL_TYPE_INT);
        cpl_table_fill_column_window_int(table, "Select",
                                         0, cpl_table_get_nrow(table),
                                         1); /* initialize to all selected */
    }
    else {
        /* Select column will be created when table is loaded from disk */
    }
    frames[id].data.table.maxrow = maxrow;
    frames[id].data.table.colnames = colnames;
    frames[id].header = header;
    frames[id].need_to_save = need_to_save;
    return;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Deallocate frame
   @param    id         frame id
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
static void 
frame_free(int id)
{
    if (frame_is_open(id))
        {
            uves_free_string_const(&frames[id].filename);
            if (frames[id].is_image)
                {
                    uves_free_image(&frames[id].data.image.image);
                }
            else
                {
                    uves_free_table(&frames[id].data.table.table);
                    uves_free_table(&frames[id].data.table.colnames);
                }
            uves_free_propertylist(&frames[id].header);
        }
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Find out if FITS descriptor has a different name from MIDAS
   @param    descr     name
   @return   true if special
*/
/*----------------------------------------------------------------------------*/
static bool
is_special_midas_descr(const char *descr)
{
    return 
        strcmp(descr, "NPIX") == 0 ||
        strcmp(descr, "REFPIX") == 0 ||
        strcmp(descr, "START") == 0 ||
        strcmp(descr, "STEP") == 0 ||
        strcmp(descr, "ROTA") == 0 ||
        strcmp(descr, "CUNIT") == 0 ||
        strcmp(descr, "IDENT") == 0 ||
        strcmp(descr, "O_TIME") == 0 ||
        strcmp(descr, "LHCUTS") == 0 ||
        strcmp(descr, "O_POS") == 0;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Map MIDAS descriptors to FITS equivalents
   @param    descr     MIDAS descriptor name
   @param    indx      counting from 1
   @return   Newly allocated keyword name, which is a copy of the input string
             if not a special MIDAS descriptor.
*/
/*----------------------------------------------------------------------------*/
static const char *
convert_to_fits(const char *descr, int indx)
{
    /* Special MIDAS keywords are:
       (MIDAS manual volume A p. 7-5)    
       NAXISn -> NPIXn
       CRPIXn -> REFPIXn
       CRVALn -> STARTn
       CDELTn -> STEPn
       CROTAn -> ROTAn
       BUNIT  -> CUNIT(1)
       CTYPEn -> CUNIT(n+1)
       OBJECT -> IDENT
       DATE_OBS -> O_TIME(1)

                  LHCUTS(1), LHCUTS(2)
          internal in MIDAS,
          not converted
       DATAMIN -> LHCUTS(3)       (and convert double -> float)
       DATAMAX -> LHCUTS(4)
       EPOCH   -> O_POS(3)
       EQUINOX -> O_POS(3)
    */

    const char *fits_descr = NULL;
    if      (strcmp(descr, "NPIX"  ) == 0) fits_descr = uves_sprintf("NAXIS%d", indx);
    else if (strcmp(descr, "REFPIX") == 0) assure( false, CPL_ERROR_UNSUPPORTED_MODE, "%s", descr);
    else if (strcmp(descr, "START" ) == 0) fits_descr = uves_sprintf("CRVAL%d", indx);
    else if (strcmp(descr, "STEP"  ) == 0) fits_descr = uves_sprintf("CDELT%d", indx);
    else if (strcmp(descr, "ROTA"  ) == 0) assure( false, CPL_ERROR_UNSUPPORTED_MODE, "%s", descr);
    else if (strcmp(descr, "CUNIT" ) == 0) 
        fits_descr = (indx == 1) ? uves_sprintf("BUNIT") : uves_sprintf("CTYPE%d", indx);
    else if (strcmp(descr, "IDENT" ) == 0) fits_descr = uves_sprintf("OBJECT");
    else if (strcmp(descr, "O_TIME") == 0) assure( false, CPL_ERROR_UNSUPPORTED_MODE, "%s", descr);
    else if (strcmp(descr, "LHCUTS") == 0) 
    {
        fits_descr = 
        (indx == 1) ? uves_sprintf("LHCUTS1") :    /* For now, write these keywords for indx 1,2 */
        (indx == 2) ? uves_sprintf("LHCUTS2") :
        (indx == 3) ? uves_sprintf("DATAMIN") : uves_sprintf("DATAMAX");
    }
    else if (strcmp(descr, "O_POS" ) == 0) assure( false, CPL_ERROR_UNSUPPORTED_MODE, "%s", descr);
        
    if (fits_descr == NULL)
    {
        fits_descr = uves_sprintf("%s", descr);
    }

  cleanup:
    return fits_descr;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Convert header for output
   @param    header     to convert


   Sequences of properties like
     (LOONGNAME, value1)
     (LOONGNAME, value2)
     (LOONGNAME, value3)
     (LOONGNAME, value4)
   with name longer than 8 characters are converted to
     (HISTORY, "'LOONGNAME'");
     (HISTORY, "value1");
     (HISTORY, "value2");
     (HISTORY, "value3");
     (HISTORY, "value4");
     (HISTORY, "");
   
   except "ESO [something]" descriptors which should not be converted.

   Also a descriptors with comment 'MIDAS_DESC' are converted, such as
   COEFFI, FIBREPOS

*/
/*----------------------------------------------------------------------------*/
static void
convert_to_history(uves_propertylist **header)
{
    int plist_size, i;
    const char *new_name  = NULL;
    char *v = NULL;
    cpl_table *new_values = NULL;
    cpl_property *new_prop = NULL;
    uves_propertylist *result = NULL;  /* Cannot change type of one property,
                                         need to copy to new list */
    result = uves_propertylist_new();

    plist_size = uves_propertylist_get_size(*header);
    for (i = 0; i < plist_size; i++) {
        cpl_property *p = uves_propertylist_get(*header, i);
        const char *name = cpl_property_get_name(p);
        int j;

        if (cpl_property_get_comment(p) != NULL &&
            strcmp(cpl_property_get_comment(p), "PROCESSED") == 0) {
            /* already processed, ignore */
        }
        else if ((strlen(name) > 8 && strncmp(name, "ESO ", 4) != 0) 
                 ||
                 (cpl_property_get_comment(p) != NULL &&
                  strcmp(cpl_property_get_comment(p), "MIDAS_DESC") == 0)) {

            int n_prop;
            
            uves_free_string_const(&new_name);
            switch (cpl_property_get_type(p)) {
            case CPL_TYPE_STRING:
                new_name = uves_sprintf("'%s','C'", name);
                break;
            case CPL_TYPE_INT:
                new_name = uves_sprintf("'%s','I'", name);
                break;
            case CPL_TYPE_FLOAT:
                new_name = uves_sprintf("'%s','R*4'", name);
                break;
            case CPL_TYPE_DOUBLE:
                new_name = uves_sprintf("'%s','R*8'", name);
                break;
            default:
                assure(false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me %s %s", name,
                       uves_tostring_cpl_type(cpl_property_get_type(p)));
                break;
            }

            uves_free_table(&new_values);
            new_values = cpl_table_new(2);
            cpl_table_new_column(new_values, "Val", CPL_TYPE_STRING);
            n_prop = 0;
            
            /* And collect this and any subsequent properties with same name */
            for (j = i; j < plist_size; j++) {
	      cpl_property *p2;

	      check_nomsg( p2 = uves_propertylist_get(*header, j) );
                if (strcmp(cpl_property_get_name(p2), name) == 0) {
                    uves_msg_debug("Found %s", name);

                    /* Here, we would like to remove p2 from the list
                       in order not to process it again, but uves_propertylists
                       don't support that */
                    cpl_property_set_comment(p2, "PROCESSED");
		    
                    assure( cpl_property_get_type(p2) == cpl_property_get_type(p),
                            CPL_ERROR_TYPE_MISMATCH,
                            "Found property %s with type %s and with type %s",
                            name, 
                            uves_tostring_cpl_type(cpl_property_get_type(p)),
                            uves_tostring_cpl_type(cpl_property_get_type(p2)));
		    
                    uves_free_string(&v);
                    switch (cpl_property_get_type(p2)) {
                    case CPL_TYPE_STRING:
                      if(strlen(cpl_property_get_string(p2)) > 0) {
                        v = uves_sprintf("%s", cpl_property_get_string(p2));
		      } else {
			uves_msg_debug("Empty string descriptor");
			v=cpl_malloc(1);
                        *v='\0';
		      }
		      break;
                    case CPL_TYPE_INT:
		      v = uves_sprintf("%d", cpl_property_get_int(p2));
		      break;
                    case CPL_TYPE_FLOAT:
                      v = uves_sprintf("%g", cpl_property_get_float(p2));
                      break;
                    case CPL_TYPE_DOUBLE:
                      v = uves_sprintf("%g", cpl_property_get_double(p2));
                      break;
                    default:
                      assure(false, CPL_ERROR_UNSUPPORTED_MODE, 
                             "Implement me %s %s", name,
                             uves_tostring_cpl_type(cpl_property_get_type(p2)));
                      break;
                    }


		    assure(v != NULL, CPL_ERROR_UNSPECIFIED,"Allocation failure");
                    assure( strlen(v) <= 80 - strlen("HISTORY "),
                            CPL_ERROR_UNSUPPORTED_MODE,
                            "Value (%s) too long string",
                            v);
          
	             

                    /* Increase table size as necessary */
                    if (n_prop >= cpl_table_get_nrow(new_values))
                        {
                            cpl_table_set_size(new_values, 
                                               2*cpl_table_get_nrow(new_values));
                        }
                        
                    check_nomsg( cpl_table_set_string(new_values, "Val", n_prop, v) );
                    n_prop += 1;
                }
            }
            cpl_table_set_size(new_values, n_prop);

            /* if (strcmp(name, "SIGMAFRAME") == 0) {
               cpl_table_dump(new_values, 0, cpl_table_get_nrow(new_values), stderr);
               uves_print_uves_propertylist(*header, 0, uves_propertylist_get_size(*header));
               } */
                        
            /* Convert to 1+n+1 HISTORY entries */
            uves_propertylist_append_string(result, "HISTORY", new_name);
            for (j = 0; j < cpl_table_get_nrow(new_values); j++)
                {
                    uves_propertylist_append_string(result, "HISTORY",
                                                    cpl_table_get_string(new_values, "Val", j));
                }
            uves_propertylist_append_string(result, "HISTORY", "");


        }
        else {
            uves_free_property(&new_prop);
            new_prop = cpl_property_duplicate(p);
            uves_propertylist_append_property(result, new_prop);
        }

    }

    uves_free_propertylist(header);
    *header = uves_propertylist_duplicate(result);
    
  cleanup:
    uves_free_string_const(&new_name);
    uves_free_string(&v);
    uves_free_table(&new_values);
    uves_free_property(&new_prop);
    uves_free_propertylist(&result);
    return;    
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Load + parse FITS header HISTORY keywords
   @param    filename   to load
   @param    extension  to load
   @return   FITS header

   MIDAS properties like this

   (HISTORY, "'KEYWORDNAME'")
   (HISTORY, "value1 value2 ...")
   :
   (HISTORY, "")

   are converted to properties

   (KEYWORDNAME, value1)
   (KEYWORDNAME, value2)
   :
*/
/*----------------------------------------------------------------------------*/
static uves_propertylist *
load_header(const char *filename,
        int extension)
{
    uves_propertylist *fitsheader = NULL;
    uves_propertylist *result = NULL;
    int plist_size, i;
    const char *new_name = NULL;
    const char *new_value = NULL;

    const char *desc_name = NULL;
    const void *values = NULL;
    
    check( fitsheader = uves_propertylist_load(filename, extension),
       "Could not load extension %d header from file %s", extension, filename);

    result = uves_propertylist_new();
    plist_size = uves_propertylist_get_size(fitsheader);
    for (i = 0; i < plist_size; i++) {
        cpl_property *p = uves_propertylist_get(fitsheader, i);
        const char *name = cpl_property_get_name(p);
        bool convert_from_midas = false;
        
        if (strcmp(name, "HISTORY") == 0)
            {
                

                if (cpl_property_get_type(p) == CPL_TYPE_STRING)
                    {
                        const char* value = cpl_property_get_string(p);
                        
                        /* If a MIDAS descriptor is encoded here.
                           Must match "'.+'"
                        */
                        if ((int)strlen(value) >= 3 && 
                            value[0] == '\'' &&
                            strstr(value+2, "'") != NULL)
                            {
                                /* Get descriptor name. */
                                uves_free_string_const(&desc_name);
                                desc_name = cpl_strdup(value+1);
                                *(strstr(desc_name, "'")) = '\0';
                                
                                convert_from_midas = !is_special_midas_descr(desc_name);
                                
                                /* i.e. don't convert e.g
                                   HISTORY 'LHCUTS'
                                */
                            }
                    }
                else
                    {
                        uves_msg_warning("%s has HISTORY property of non-string type (%s)",
                                         filename, 
                                         uves_tostring_cpl_type(cpl_property_get_type(p)));
                    }
            }
        
        if (convert_from_midas) {
            int length, j;
            int ncards;
            cpl_type type;
            
            uves_free(values); values = NULL;
            check( values = 
                   uves_read_midas_array(fitsheader, desc_name, &length, &type,
                                         &ncards),
                   "Could not get values of HISTORY descriptor '%s'", desc_name);
            
            i += ncards-1;
            
            /* Create new properties */
            for (j = 0; j < ((type == CPL_TYPE_STRING) ? 1 : length); j++) {

                uves_free_string_const(&new_name);
                new_name = uves_sprintf("%s", desc_name);
                
                switch(type) {
                case CPL_TYPE_INT:
                    uves_propertylist_append_c_int(result, new_name, ((int*)values)[j], "MIDAS_DESC");
                    break;
                case CPL_TYPE_FLOAT:
                    uves_propertylist_append_c_float(result, new_name, ((float*)values)[j], "MIDAS_DESC");
                    break;
                case CPL_TYPE_DOUBLE:
                    uves_propertylist_append_c_double(result, new_name, ((double*)values)[j], "MIDAS_DESC");
                    break;
                case CPL_TYPE_STRING:
                    uves_propertylist_append_c_string(result, new_name, (char *)values, "MIDAS_DESC");
                    break;
                default:
                    assure( false, CPL_ERROR_UNSUPPORTED_MODE,
                            "Type is %s", uves_tostring_cpl_type(type));
                }
            }
        }
        else {
            uves_propertylist_append_property(result, p);
        }
    }
    
  cleanup:
    uves_free_string_const(&new_name);
    uves_free_string_const(&new_value);
    uves_free_string_const(&desc_name);
    uves_free_propertylist(&fitsheader);
    uves_free(values); values = NULL;
    if (cpl_error_get_code() != CPL_ERROR_NONE)
    {
        uves_free_propertylist(&result);
    }
    return result;

}
/*----------------------------------------------------------------------------*/
/**
   @brief    Map MIDAS dtypes to CPL types
   @param    dtype       MIDAS type to convert
**/
/*----------------------------------------------------------------------------*/
cpl_type
flames_midas_image_dtype_to_cpltype(int dtype)
{
    cpl_type type = CPL_TYPE_INVALID;

    switch(dtype) {
    case D_OLD_FORMAT: type = CPL_TYPE_FLOAT; break;
    case D_R4_FORMAT: type = CPL_TYPE_FLOAT; break;
    case D_R8_FORMAT: type = CPL_TYPE_DOUBLE; break;
    case D_I1_FORMAT: type = CPL_TYPE_INT; break;
    case D_I2_FORMAT: type = CPL_TYPE_INT; break;
    case D_I4_FORMAT: type = CPL_TYPE_INT; break;
    default:
        assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me %d",
                dtype);
        break;
    }

  cleanup:
    return type;
}
/*----------------------------------------------------------------------------*/
/**
   @brief    Load frame FITS header if not already in memory
   @param    id          frame id
   @return 0 iff okay

   The image/table must already be open (i.e. have legal filename)
*/
/*----------------------------------------------------------------------------*/

static void
load_frame_header(int id)
{
    int extension = 0; /* For tables and images */

    passure( invariant(id), " ");

    passure( frame_is_open(id), " ");

    if (frames[id].header == NULL)
    {
            /* Convert MIDAS HISTORY descriptors to internal format */
            check( frames[id].header = load_header(frames[id].filename,
                                             extension),
                   "Error loading header from %s", frames[id].filename);

            uves_msg_debug("Loaded %s header (%ld FITS cards)",
                           frames[id].filename,
                           uves_propertylist_get_size(frames[id].header));
    }
    
    passure( invariant(id), " ");

  cleanup:
    return;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    CPL workaround DFS03746
   @param    t         table to update
   @param    colname   name of column to update
   @param    theader   table extension header, which contains unit/format info
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
static void
set_column_format_unit_tnull(cpl_table *t, const uves_propertylist *theader)
{
    const char *colname;

    int tfield; /* number of columns */
    char *key_type = NULL;
    char *key_form = NULL;
    char *key_unit = NULL;
    char *key_null = NULL;
    char *val_type = NULL;
    char *val_form = NULL;
    char *val_unit = NULL;
    int val_null;

    check_nomsg( tfield = uves_propertylist_get_int(theader, "TFIELDS"));

    for(colname = cpl_table_get_column_name(t);
        colname != NULL;
        colname = cpl_table_get_column_name(NULL)) {
        bool found = false;
        int i;
        for (i = 1; i <= tfield && !found; i++) {
            uves_free_string(&key_type);
            uves_free_string(&key_form);
            uves_free_string(&key_unit);
            uves_free_string(&key_null);
            uves_free_string(&val_type);
            uves_free_string(&val_form);
            uves_free_string(&val_unit);
            key_type = uves_sprintf("TTYPE%d", i); /* column name */
            key_form = uves_sprintf("TFORM%d", i);
            key_unit = uves_sprintf("TUNIT%d", i);
            key_null = uves_sprintf("TNULL%d", i);
            
            /* remove trailing blanks */
            val_type = cpl_strdup(uves_propertylist_get_string(theader, key_type));
            if (strlen(val_type) > 0) {
                while (val_type[strlen(val_type)-1] == ' ') {
                    val_type[strlen(val_type)-1] = '\0';
                }
            }
            
            if (strcmp(val_type, colname) == 0)  {
                found = true;
                if (uves_propertylist_contains(theader, key_form))  {
                    val_form = cpl_strdup(uves_propertylist_get_string(theader, key_form));
                    if (strlen(val_form) > 0) {
                        while (val_form[strlen(val_form)-1] == ' ') {
                            val_form[strlen(val_form)-1] = '\0';
                        }
                    }
                    
                    cpl_table_set_column_format(t, colname, val_form);
                }
                if (uves_propertylist_contains(theader, key_unit))  {
                    val_unit = cpl_strdup(uves_propertylist_get_string(theader, key_unit));
                    if (strlen(val_unit) > 0) {
                        while (val_unit[strlen(val_unit)-1] == ' ') {
                            val_unit[strlen(val_unit)-1] = '\0';
                        }
                    }
                    
                    cpl_table_set_column_unit(t, colname, val_unit);
                }
                else {
                    /* FLAMES C code expects the unit to be always non-NULL,
                       therefore set it to an empty string. 

                       This was guaranteed by CPL-3.x which always wrote 
                       the TUNIT keyword when saving.

                       But with CPL-4, the TUNIT keyword is not always present.
                    */
                    cpl_table_set_column_unit(t, colname, "        ");
                }

                if (cpl_table_get_column_type(t, colname) == CPL_TYPE_INT &&
                    uves_propertylist_contains(theader, key_null))  {
                    val_null = uves_propertylist_get_int(theader, key_null);

                    cpl_table_fill_invalid_int(t, colname, val_null);
                }
            }
        }
    }
    
  cleanup:
    uves_free_string(&key_type);
    uves_free_string(&key_form);
    uves_free_string(&key_unit);
    uves_free_string(&key_null);
    uves_free_string(&val_type);
    uves_free_string(&val_form);
    uves_free_string(&val_unit);
    return;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Load image/table if not already in memory
   @param    id               frame id
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
static void
load_frame(int id)
{
    uves_propertylist *theader = NULL;
    cpl_imagelist *ilist = NULL;
    fitsfile *fptr = NULL;

    /* doesn't have to hold here: passure( invariant(id), " "); */
    passure( frame_is_open(id), " ");

    if (frames[id].is_image) {
        if (frames[id].data.image.image == NULL) {
            long naxes[4];
            long firstpixel[4] = {1, 1, 1, 1};
            int naxis;
            int fio_status = 0;            
            
            uves_msg_debug("Loading image %s (type %s) to memory", 
                           frames[id].filename, 
                           uves_tostring_cpl_type(frames[id].data.image.type));
            
            /* Use CFITSIO. CPL doesn't handle 4d images */

            fits_open_file(&fptr, frames[id].filename, READONLY, &fio_status);
            
            assure( fio_status == 0, CPL_ERROR_FILE_IO,
                    "Failed to open %s for reading", frames[id].filename );
    
            /* Get the image dimension */
            fits_get_img_dim(fptr, &naxis, &fio_status);
            assure( naxis == 1 || naxis == 2 || naxis == 3 || naxis == 4,
                    CPL_ERROR_ILLEGAL_INPUT, "Illegal dimension: %d", naxis);
            
            /* Get the file size */
            naxes[0] = 1;
            naxes[1] = 1;
            naxes[2] = 1;
            naxes[3] = 1;
            fits_get_img_size(fptr, naxis, naxes, &fio_status);
            assure( fio_status == 0, CPL_ERROR_FILE_IO,
                    "Failed to get %s image size", frames[id].filename);


            frames[id].data.image.image = cpl_image_new(naxes[0] * naxes[1] * naxes[2] * naxes[3], 1,
                                                        frames[id].data.image.type);

            switch(frames[id].data.image.type) {
            case CPL_TYPE_DOUBLE:
                fits_read_pix(fptr, TDOUBLE, firstpixel, naxes[0] * naxes[1] * naxes[2] * naxes[3],
                              NULL, cpl_image_get_data_double(frames[id].data.image.image),
                              NULL, &fio_status);
                break;
            case CPL_TYPE_FLOAT:
                fits_read_pix(fptr, TFLOAT, firstpixel, naxes[0] * naxes[1] * naxes[2] * naxes[3],
                              NULL, cpl_image_get_data_float(frames[id].data.image.image),
                              NULL, &fio_status);
                break;
            case CPL_TYPE_INT:
                fits_read_pix(fptr, TINT, firstpixel, naxes[0] * naxes[1] * naxes[2] * naxes[3],
                              NULL, cpl_image_get_data_int(frames[id].data.image.image),
                              NULL, &fio_status);
                break;
            default:
                assure( false, CPL_ERROR_INVALID_TYPE,
                        "Illegal type %s", uves_tostring_cpl_type(frames[id].data.image.type));

            }
            
            fits_close_file(fptr, &fio_status) ;
            assure( fio_status == 0, CPL_ERROR_FILE_IO,
                    "Failed to load image %s", frames[id].filename);
 
        }
    }
    else
        {
            if (frames[id].data.table.table == NULL)
                {
                    int extension = 1;
                    int mark_invalid_values = 1; /* 1=yes */
                    const char *name;
                    int row;

                    uves_msg_debug("Loading table %s to memory", frames[id].filename);

                    check( frames[id].data.table.table = 
                           cpl_table_load(frames[id].filename,
                                          extension,
                                          mark_invalid_values),
                           "Error loading table from %s", frames[id].filename);
                    
                    if (!cpl_table_has_column(frames[id].data.table.table, "Select")) {
                        cpl_table_new_column(frames[id].data.table.table, "Select", 
                                             CPL_TYPE_INT);
                        cpl_table_fill_column_window_int(
                            frames[id].data.table.table, "Select",
                            0, cpl_table_get_nrow(frames[id].data.table.table),
                            1);
                    }
                    
                    frames[id].data.table.maxrow = cpl_table_get_nrow(frames[id].data.table.table);

                    check( theader = uves_propertylist_load(frames[id].filename, extension),
                           "Error loading table header from %s", frames[id].filename);
                    
                    /* Assign numbers to columns */
                    frames[id].data.table.colnames = 
                        cpl_table_new(cpl_table_get_ncol(frames[id].data.table.table) - 1);
                    cpl_table_new_column(frames[id].data.table.colnames, COLNAME, CPL_TYPE_STRING);
                    
                    for(name = cpl_table_get_column_name(frames[id].data.table.table), row = 0;
                        name != NULL;
                        name = cpl_table_get_column_name(NULL)) {
                        if (strcmp(name, "Select") != 0) {
                            cpl_table_set_string(frames[id].data.table.colnames, COLNAME, row, name);
                            row++;
                        }
                    }
                    
                    /* Workaround here: cpl_table_load ignores the table column
                       units/formats and TNULL, so read + set those manually */
                    check( set_column_format_unit_tnull(frames[id].data.table.table, theader),
                           "Error loading table %s format/units", frames[id].filename);
                }
        }
    
    passure( invariant(id), " ");
           
  cleanup:
    uves_free_imagelist(&ilist);
    uves_free_propertylist(&theader);
    return;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Create descriptors
   @param    header         add new descriptors here
   @param    descr          descriptor name
   @param    type           descriptor type
   @param    length         number of descriptors to create. If type is 'C'
                            only one property is created
   @param    nexist         number of already existing descriptors with this name
   @return   NULL terminated array of pointers to existing descriptors
*/
/*----------------------------------------------------------------------------*/
static cpl_property **
create_descr(uves_propertylist *header,
         const char *descr,
         char type, int length,
         int nexist)
{
    const char *fits_descr = NULL;
    const char *previous_descr = NULL;
    cpl_property **cards = NULL;
    int i;
    cpl_property *new_prop = NULL;

    passure( header != NULL, " ");
    assure( length >= 1, CPL_ERROR_ILLEGAL_INPUT, "Length = %d", length);

    cards = cpl_malloc((length+1) * sizeof(cpl_property *));

    if (nexist > 0)
    {
        i = 0;
        check( previous_descr = convert_to_fits(descr, i + nexist),
           "Could not convert %s to FITS", descr);
    }
    else
    {
        previous_descr = uves_sprintf("----");
    }

    for (i = 1; i <= length; i++)
    {
            const char *comment;

            uves_free_string_const(&fits_descr);
            check( fits_descr = convert_to_fits(descr, i + nexist),
                   "Could not convert %s to FITS", descr);

            uves_msg_debug("Creating property %s (%d of %d, type = '%c')", fits_descr,
                           nexist + i, nexist + length, type);

            if (strcmp(descr, fits_descr) == 0 &&
                strncmp(descr, "CTYPE", 5) != 0 &&
                strncmp(descr, "CDELT", 5) != 0 &&
                strncmp(descr, "CRVAL", 5) != 0 &&
                strncmp(descr, "CRPIX", 5) != 0 &&
                strncmp(descr, "ESO QC", 6) != 0 &&
                strcmp(descr, "BUNIT") != 0 &&
                strcmp(descr, "COLS") != 0 &&
                strcmp(descr, "ROWS") != 0 &&
                strcmp(descr, "PIXMAX") != 0 &&
                strcmp(descr, "STARTX") != 0 &&
                strcmp(descr, "STARTY") != 0 &&
                strcmp(descr, "STEPX") != 0 &&
                strcmp(descr, "STEPY") != 0 &&
                strcmp(descr, "YSHIFT") != 0 &&
                strcmp(descr, "DATAMIN") != 0 &&
                strcmp(descr, "DATAMAX") != 0 &&
                strcmp(descr, "NFLATS") != 0 &&
                strcmp(descr, "RON") != 0 &&
                strcmp(descr, "GAIN") != 0 &&
                strcmp(descr, "FIBRESON") != 0)
                {
                /* Then it is a MIDAS descriptor which must be
                   stored in HISTORY keywords */
                comment = "MIDAS_DESC";
            }
            else {
                /* It is a descriptor recognized by the FITS format
                   (such as NAXIS1), which should not be converted
                   into HISTORY format */
                comment = NULL;
            }
                

            switch(type)
                {
                case 'I': uves_propertylist_append_c_int   (header, fits_descr, 0, comment)  ; break;
                case 'R': uves_propertylist_append_c_float (header, fits_descr, 0.0, comment); break;
                case 'C': uves_propertylist_append_c_string(header, fits_descr, "0", comment); break;
                case 'D': uves_propertylist_append_c_double(header, fits_descr, 0.0, comment); break;
                default: assure( false, CPL_ERROR_UNSUPPORTED_MODE, "%c", type); break;
                }

            /* If name changes with index, get the first occurence */

        cards[i-1] = uves_find_property(header,
                        fits_descr, 
                        strcmp(fits_descr, previous_descr) != 0 ?
                        0 :  i-1 + nexist);
        
        passure( cards[i-1] != NULL, "%s %d %d", fits_descr, i-1, nexist);

        uves_free_string_const(&previous_descr);
        previous_descr = uves_sprintf("%s", fits_descr);
    }

    cards[length] = NULL;

  cleanup:
    uves_free_property(&new_prop);
    uves_free_string_const(&fits_descr);
    uves_free_string_const(&previous_descr);
    return cards;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Get descriptor information
   @param    id             frame number
   @param    descr          descriptor name
   @param    type           (output) descriptor type
   @param    length         (output) descriptor length, if type string the string
                            length
   @param    bytelem        (output) bytes per element
   @return   NULL terminated array of pointers to existing properties, 
             or NULL if error. The array itself must be free'd, but the
         properties pointed to should not be free'd.

   The special MIDAS descriptor arrays are handled, 
   e.g. STEP is mapped to to CRVAL1, not CRVAL2, CRVAL3...

   If the descriptor does not exist, NULL is returned but no error is set

*/
/*----------------------------------------------------------------------------*/
static cpl_property **
get_descr_info(int id, const char *descr, 
               char *type, int *length, int *bytelem)
{


  *bytelem=*bytelem; //to remove compilation warning: this is not used

    cpl_property **cards = NULL;
    cpl_type t;
    const char *fits_descr = NULL;
    const char *previous_fits_descr = NULL;
    *type = ' ';

    passure( invariant(id), " ");

    assure( frame_is_open(id), CPL_ERROR_ILLEGAL_INPUT,
        "Frame no. %d is not open", id);
    
    check( load_frame_header(id),
       "Could not load header of file %s", frames[id].filename);

    cards = cpl_calloc(1, sizeof(cpl_property *));
    assure_mem( cards );
    
    *length = 0;
    do {
        *length += 1;
        cards = cpl_realloc(cards, (*length)*sizeof(cpl_property *));
        
        uves_free_string_const(&previous_fits_descr);
        previous_fits_descr = uves_sprintf("%s", fits_descr != NULL ? fits_descr : "----");
        
        uves_free_string_const(&fits_descr);
        fits_descr = convert_to_fits(descr, *length);
        
        uves_msg_debug("Searching for %d. occurence of %s", 
                       strcmp(fits_descr, previous_fits_descr) == 0 ?
                       *length : 1,
                       fits_descr);
        //uves_msg_debug("prev=%s curr=%s",previous_fits_descr,fits_descr);
        cards[*length-1] =
            uves_find_property(frames[id].header,
                               fits_descr, 
                               strcmp(fits_descr, previous_fits_descr) == 0 ?
                               *length - 1 : 0);
    }
    while (cards[*length-1] != NULL);
    
    *length -= 1;

    if (cards[0] != NULL)
    {
        t = cpl_property_get_type(cards[0]);
       
        switch(t)
        {
        case CPL_TYPE_INT   : *type = 'I'; break;
        case CPL_TYPE_FLOAT : *type = 'R'; break;
        case CPL_TYPE_STRING: *type = 'C'; break;
        case CPL_TYPE_DOUBLE: *type = 'D'; break;
        default: *type = ' '; break;
        }

        uves_msg_debug("Type is %c", *type);
	//AMO: Here the check on the length was *length == 1
        assure( *type != 'C' || *length <= 3, CPL_ERROR_UNSUPPORTED_MODE,
            "Cannot handle string array descriptor %s %s of length %d",
		descr, cpl_property_get_string(cards[0]),*length );
	
        if (*type == 'C')
        {
	//AMO: Here the check on the length was *length == 1
            passure( *length <= 3, "%d", *length );
            /* ... but we must return the string length,
               not the number of cards */
            *length = strlen(cpl_property_get_string(cards[0]));
        }
    }
    else
    {
        uves_msg_debug("%s not found", fits_descr);
        cpl_free(cards); cards = NULL;
        *length = 0;
    }

    passure( invariant(id), " ");
    
  cleanup:
    uves_free_string_const(&fits_descr);
    uves_free_string_const(&previous_fits_descr);
    if (cpl_error_get_code() != CPL_ERROR_NONE)
    {
        cpl_free(cards); cards = NULL;
    }

    return cards;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Get into the MIDAS environment
   @param    name         name of calling program
   @return 0 iff okay

   Read keywords database,
   Initialize file control table,
   Open logfile
*/
/*----------------------------------------------------------------------------*/
int flames_midas_scspro(const char *name)
{
    int i;

    assure( current_caller == NULL, CPL_ERROR_ILLEGAL_INPUT,
        "MIDAS mode already running");

    uves_msg_debug("Initializing %s", name);
    current_caller = uves_sprintf("%s", name);

    assure( strcmp(name, "-1") != 0, CPL_ERROR_UNSUPPORTED_MODE,
        "Running outside MIDAS mode not supported");

    /* Reset all file handles */
    for (i = 0; i < MAX_OPEN; i++)
    {
        frames[i].filename = NULL;
    }

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Deinitialize interface
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/

int flames_midas_scsepi(void)
{
    if (current_caller == NULL)
    {
        uves_msg_warning("MIDAS mode not running, "
                 "nothing to stop");
    }
    else
    {
            /* Check for unallocated resources */
            int i;
            for (i = 0; i < MAX_OPEN; i++)
                {
                    if (frame_is_open(i))
                        {
                            uves_msg_warning("%s: %s no. %d: %s not deallocated",
                                             current_caller,
                                             frames[i].is_image ? "Image" : "Table",
                                             i, frames[i].filename);

                            frame_free(i);
                        }
                }

        uves_msg_debug("Ending %s", current_caller);
        uves_free_string_const(&current_caller);
    }

    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Print debugging info when function returns error
   @param    status      to be returned
   @return   status

   In the original FLAMES C code, low level function failure return statements like

   "return MAREMMA;" 

   are replaced with

   "return flames_midas_error(MAREMMA)"

   to allow tracking the errors
*/
/*----------------------------------------------------------------------------*/
int flames_midas_error_macro(const char *file, const char *function, int line,
                 int status)
{
    uves_msg_debug("%s:%s() execution failed at %s:%s():%d", 
           current_caller != NULL ? current_caller : "???",
           function, file, function, line);
    
    return status;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Deinitialize interface, cleanup and return failure
   @return 0 iff okay

   This function replaces the "exit(1)" calls in the original MIDAS source code
*/
/*----------------------------------------------------------------------------*/

int flames_midas_fail_macro(const char *file, const char *function, int line)
{ 
    const char *f = cpl_strdup(current_caller != NULL ? current_caller : "???");
    uves_msg_error("%s execution failed. Exit from MIDAS mode", f);

    uves_msg_debug("  at %s:%s():%d", file, function, line);

    flames_midas_scsepi();

    assure( false, CPL_ERROR_UNSPECIFIED, "%s failed", f);

  cleanup:
    uves_free_string_const(&f);
    return 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Write data into integer keyword
   @param    key      address of keyword
   @param    values   buffer with data values
   @param    felem    position of 1st element to be written (numbered from 1)
   @param    maxvals  max no. of elements to write
   @param    unit     unit pointer
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckwri(int *key, const int *values, 
            int felem, int maxvals, int *unit)
{
    int i;
    if (unit) {} //to remove compilation warning: this is not used

    assure_nomsg( key != NULL, CPL_ERROR_NULL_INPUT );

    uves_msg_debug("Writing %d elements to integer keyword", maxvals);

    for (i = 0; i < maxvals; i++) {
        key[(felem-1) + i] = values[i];
    }

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Write data into double keyword
   @param    key      address of keyword
   @param    values   buffer with data values
   @param    felem    position of 1st element to be written (numbered from 1)
   @param    maxvals  max no. of elements to write
   @param    unit     unit pointer
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckwrd(double *key, const double *values, 
            int felem, int maxvals, int *unit)
{
    int i;
    if (unit) {} //to remove compilation warning: this is not used
    
    assure_nomsg( key != NULL, CPL_ERROR_NULL_INPUT );

    uves_msg_debug("Writing %d elements to double keyword", maxvals);

    for (i = 0; i < maxvals; i++) {
        key[(felem-1) + i] = values[i];
    }

    //fixme: is unit used? MIDAS doc. says it's unsupported

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}


/*----------------------------------------------------------------------------*/
/**
   @brief    Write data into character keyword
   @param    key      address of keyword
   @param    noelem   number of bytes per data value
   @param    values   buffer with data values
   @param    felem    position of 1st element to be written (numbered from 1)
   @param    maxvals  max no. of elements to write
   @param    unit     unit pointer
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckwrc(char *key, int noelem,
            const char *values, int felem, int maxvals, int *unit)
{
    if (unit) {} //to remove compilation warning: this is not used
    assure_nomsg( noelem == 1, CPL_ERROR_UNSUPPORTED_MODE); 
    //fixme: remove from interface if this is always the case

    uves_msg_debug("Writing %d elements to character keyword", maxvals);

    strncpy(key+(felem-1), values, maxvals);

    //fixme: is unit used?
  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Get data from character keyword
   @param    key      keyword name (max 8 characters)
   @param    felem    position of 1st element (numbered from 1)
   @param    maxvals  max no. of characters to be returned (buffer size
                      including terminating 0)
   @param    actvals  (output) actual number of characters returned
   @param    values   (output) buffer for data values
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckgetc(const char *key, 
             int felem, int maxvals, 
             int *actvals, char *values)
{

    assure_nomsg( key    != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( values != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( actvals!= NULL, CPL_ERROR_NULL_INPUT );

    strncpy(values, key + (felem - 1), maxvals);
    values[strlen(key)+1] = '\0';
    *actvals = strlen(values);

    /*
      uves_msg_warning("Copy %s to %s",
                   key, values);
    
    */

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Get data from character keyword (catalogue)
   @param    key      input catalogue
   @param    felem    position of 1st element (must be 1)
   @param    maxvals  max no. of characters to be returned
   @param    actvals  (output) actual number of characters returned
   @param    values   (output) same as input
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckgetc_fs(const cpl_frameset *key, 
                            int felem, int maxvals, 
                            int *actvals, const cpl_frameset **values)
{
    maxvals=maxvals; //to remove compilation warning: this is not used
    assure_nomsg( key != NULL, CPL_ERROR_NULL_INPUT );
    assure( felem == 1, CPL_ERROR_ILLEGAL_INPUT,
            "felem = %d", felem );
    assure_nomsg( actvals != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( values  != NULL, CPL_ERROR_NULL_INPUT );

    *values = key;

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Get data from character keyword (frame set pointer)
   @param    key      input catalogue
   @param    felem    position of 1st element (must be 1)
   @param    maxvals  max no. of characters to be returned
   @param    actvals  (output) actual number of characters returned
   @param    values   (output) same as input
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckgetc_fsp(cpl_frameset **key, 
                            int felem, int maxvals, 
                            int *actvals, cpl_frameset ***values)
{
    maxvals=maxvals; //to remove compilation warning: this is not used
    assure_nomsg( key != NULL, CPL_ERROR_NULL_INPUT );
    assure( felem == 1, CPL_ERROR_ILLEGAL_INPUT,
            "felem = %d", felem );
    assure_nomsg( actvals != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( values  != NULL, CPL_ERROR_NULL_INPUT );

    *values = key;

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read data from double precision keyword
   @param    key      keyword array
   @param    felem    first data item to be read
   @param    maxvals  no. of elements to get
   @param    actvals  (output) actual number of elements returned
   @param    values   (output) buffer for data values
   @param    unit     (output) address of unit pointer
   @param    null     (output) no. of null values in keyword
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckrdd(const double *key, int felem, int maxvals, 
            int *actvals, double *values, int *unit, int *null)
{
    int i;
    if (unit) {} //to remove compilation warning: this is not used
    if (null) {} //to remove compilation warning: this is not used

    assure_nomsg( key != NULL, CPL_ERROR_NULL_INPUT );

    *actvals = 0;
    for (i = 0; i < maxvals; i++)
    {
        values[i] = key[(felem-1)+i];
        (*actvals)++;
    }

    /* unit, null not implemented in MIDAS */

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read data from real precision keyword
   @param    key      keyword array
   @param    felem    first data item to be read
   @param    maxvals  no. of elements to get
   @param    actvals  (output) actual number of elements returned
   @param    values   (output) buffer for data values
   @param    unit     (output) address of unit pointer
   @param    null     (output) no. of null values in keyword
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckrdr(const float *key, int felem, int maxvals, 
            int *actvals, float *values, int *unit, int *null)
{
    int i;
    if (unit) {} //to remove compilation warning: this is not used
    if (null) {} //to remove compilation warning: this is not used

    assure_nomsg( key != NULL, CPL_ERROR_NULL_INPUT );

    *actvals = 0;
    for (i = 0; i < maxvals; i++)
    {
        values[i] = key[(felem-1)+i];
        (*actvals)++;
    }

    /* unit, null not implemented in MIDAS */

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read data from integer keyword
   @param    key      keyword array
   @param    felem    first data item to be read
   @param    maxvals  no. of elements to get
   @param    actvals  (output) actual number of elements returned
   @param    values   (output) buffer for data values
   @param    unit     (output) address of unit pointer
   @param    null     (output) no. of null values in keyword
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckrdi(const int *key, int felem, int maxvals, 
            int *actvals, int *values, int *unit, int *null)
{
    int i;
    if (unit) {} //to remove compilation warning: this is not used
    if (null) {} //to remove compilation warning: this is not used

    *actvals = 0;
    for (i = 0; i < maxvals; i++)
    {
        values[i] = key[(felem-1)+i];
        (*actvals)++;
    }

    /* unit, null not implemented in MIDAS */

/*  cleanup: */
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read data from string keyword
   @param    key      keyword array
   @param    noelm    no. of bytes per data values
   @param    felem    first data item to be read
   @param    maxvals  no. of elements to get
   @param    actvals  (output) actual number of elements returned
   @param    values   (output) buffer for data values
   @param    unit     (output) address of unit pointer
   @param    null     (output) no. of null values in keyword
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/
int flames_midas_sckrdc(const char *key, int noelm, int felem, int maxvals, 
            int *actvals, char *values, int *unit, int *null)
{
    /* This function is only used in calls, like this
       
         SCKRDC("H_RON_L",16,1,1,&actvals, h_ron_l, &unit, &null)

     where  noelm is the string length and felem = maxvals = 1   */
    if (unit) {} //to remove compilation warning: this is not used
    if (null) {} //to remove compilation warning: this is not used

    assure( felem == 1, CPL_ERROR_UNSUPPORTED_MODE, "Implement me" );
    assure( maxvals == 1, CPL_ERROR_UNSUPPORTED_MODE, "Implement me" );

    strncpy(values, key + (felem - 1), noelm);
    values[noelm] = '\0';
    *actvals = strlen(values);

    /* unit, null not implemented in MIDAS */

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Find keyword and provide info on it
   @param    key      keyword array
   @param    type     (output) keyword type
   @param    noelem   (output) no. of elements
   @param    bytelem  (output) no. of bytes per element
   @return 0 iff okay

   If keyword not found, type is ' ', and no error is set.
*/
/*----------------------------------------------------------------------------*/
static int
sckfnd(const char the_type, const void *key, char *type, int *noelem, int *bytelem)
{
    *noelem=*noelem; //to remove compilation warning: this is not used
    *bytelem=*bytelem; //to remove compilation warning: this is not used
    if (key == NULL)
    {
        uves_msg_debug("Keyword is NULL");   
        *type = ' ';
    }
    else
    {
        *type = the_type;
    }
    /* Fixme: what about noelem  (needs to be passed from the caller) */
    
//  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @see sckfnd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_sckfnd_double(const double *key, char *type, int *noelem, int *bytelem)
{
    return sckfnd('D', key, type, noelem, bytelem);
}
/*----------------------------------------------------------------------------*/
/**
   @see sckfnd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_sckfnd_float(const float *key, char *type, int *noelem, int *bytelem)
{
    return sckfnd('R', key, type, noelem, bytelem);
}

/*----------------------------------------------------------------------------*/
/**
   @see sckfnd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_sckfnd_int(const int *key, char *type, int *noelem, int *bytelem)
{
    return sckfnd('I', key, type, noelem, bytelem);
}

/*----------------------------------------------------------------------------*/
/**
   @see sckfnd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_sckfnd_string(const char *key, char *type, int *noelem, int *bytelem)
{
    return sckfnd('C', key, type, noelem, bytelem);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Display message
   @param    msg       message to display
   @return 0 iff okay
*/
/*----------------------------------------------------------------------------*/

int flames_midas_sctput(const char *msg, 
            const char *function, const char *file, int line)
{
    if (strncmp(msg, "Error", 5) == 0)
    {
        uves_msg_error("%s:%d: %s", file, line, msg);
    }
    else if (strncmp(msg, "Warning", 7) == 0)
    {
        uves_msg_warning("%s: %s", function, msg);
    }
    else
    {
            /* indented */
        uves_msg_low("%s: %s", function, msg);
    }

//  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Open the frame and return file info in buffer up to 5 integers
   @param    name       name of data frame
   @param    fno        flag for requested info
   @param    ibuf       (output) buffer with requested info
   @return 0 iff okay


   fno = 0 for getting the file id (imno) of 'name', i.e. check if the frame
   has been opened already

   fno = 1 for getting version no., file_type, short int, int and floating format

   fno = 2 for getting no_bytes_per_pixel, format, pixels_per_block, startblock
   and lastblock

   fno = 3 for getting file_type, format, file_protect, file_compress

   fno = 4 for getting no_bytes_per_pixel, format, file_type

   fno = 99 to find out if file 'name' exists, no buffer is returned instead the
   status is set to 0 (o.k. = file exists) or not


   The FLAMES code uses only fno = 3, 4, 99

**/
/*----------------------------------------------------------------------------*/
int flames_midas_scfinf(const char *name, int fno, int *ibuf)
{
    FILE *file;
    uves_propertylist *header = NULL;

    uves_msg_debug("fno = %d", fno);

    if (name == NULL) return 1;
    
    /* Test for existence */
    file = fopen(name, "r");
    if (file == NULL)
        {
            uves_msg_debug("File %s could not be opened", name);
            return 1;
        }
    uves_msg_debug("File %s could be opened", name);
    fclose(file);
    
    if (fno == 3) {
        /* The FLAMES code needs only the information about the
           file type which is written to ibuf[0] */
        if (uves_get_nextensions(name) > 0) {
            ibuf[0] = F_TBL_TYPE;
        }
        else {
            ibuf[0] = F_IMA_TYPE;
        }
    }
    else if (fno == 4)
	{
            /* The FLAMES code needs only the data type
               which is written to ibuf[1] */
            int bitpix;

            check( header = uves_propertylist_load(name, 0),
                   "Could not load %s primary header", name);

            check( bitpix = uves_pfits_get_bitpix(header),
                   "Could not get BITPIX from %s", name);

            uves_msg_debug("BITPIX is %d", bitpix);

            switch (bitpix) {
            case  16: ibuf[1] = D_I2_FORMAT; break; /* 16 bit signed integer */
            case  32: ibuf[1] = D_I4_FORMAT; break; /* 32 bit signed integer */
            case -32: ibuf[1] = D_R4_FORMAT; break; /* 32 bit floating point */
            case -64: ibuf[1] = D_R8_FORMAT; break; /* 64 bit floating point */
            default:
                assure( false, CPL_ERROR_UNSUPPORTED_MODE,
                        "Cannot convert BITPIX = %d to DATTYPE",
                        bitpix);
                break;
            }
	}
    else if (fno == 99)
	{
            /* Just test for file existence */
	}
    else
	{
	    assure( false, CPL_ERROR_UNSUPPORTED_MODE,
                    "fno = %d is not needed by FLAMES code", fno);
	}
    
  cleanup:
    uves_free_propertylist(&header);
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Open an existing image and return its internal file no.
   @param    name       name of data frame
   @param    dattype    data types as defined below
   @param    newopn     new open flag. 0: open normally. 1: open same file again
   @param    filtype    file type as defined below
   @param    imno       (output) file id of frame
   @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scfopn(const char *name, int dattype, int newopn, int filtype,
            int *imno)
{
    uves_msg_debug("Trying to open %s", name);

    if (filtype == F_IMA_TYPE) {

        if (newopn == 0) {
            
            /* Find first open slot */
            int i;
            bool found = false;
            for (i = 0; !found && i < MAX_OPEN; i++)
                {
                    if (!frame_is_open(i))
                        {
                            cpl_type type;
                            
                            found = true;
                            *imno = i;
                            
                            type = flames_midas_image_dtype_to_cpltype(dattype);
                            
                            frame_new_image(*imno, name, NULL, false,
                                            NULL, type, dattype);
                            
                            uves_msg_debug("Opened image no. %d: %s as type %s",
                                           i, name, 
                                           uves_tostring_cpl_type(type));
                        }
                }
            
            assure( found, CPL_ERROR_UNSUPPORTED_MODE,
                    "Cannot open more than %d image files",
                    MAX_OPEN);
        }
        else
            {
                
                assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");
            }
    }
    else
    {
            assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");
    }

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Create an image frame with data of given type and return its internal file no.
   @param    name       name of data frame
   @param    dattype    data type
   @param    iomode     opening mode
   @param    filtype    file type number
   @param    size       size of frame (number of values in file). 
                        Images: number of pixels
   @param    imno       (output) file id of frame
   @return 0 iff okay

   @see flames_midas_scfopn for details of different data and file types
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scfcre(const char *name, int dattype, int iomode, int filtype, 
                        int size, int *imno)
{
    if (filtype == F_IMA_TYPE)
    {
        if (iomode == F_O_MODE) /* output: create empty header */
        {

            /* Find first open slot */
            int i;
            bool found = false;
                    cpl_type type;

            for (i = 0; !found && i < MAX_OPEN; i++)
            {

                if (!frame_is_open(i))
                {
                    found = true;
                    *imno = i;
                    
                    uves_msg_debug("Opened image no. %d: %s",
                           i, name);
                }
            }
            
            assure( found, CPL_ERROR_UNSUPPORTED_MODE,
                "Cannot open more than %d image files",
                MAX_OPEN);
            
                    type = flames_midas_image_dtype_to_cpltype(dattype);
                   
                    /* Create Nx1 image, set proper size later */
                    frame_new_image(*imno, name, uves_propertylist_new(), true,
                                    cpl_image_new(size, 1, type), type, dattype);

                }

        else
        {
            assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");
        }
    }
    else
    {
        assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");
    }


    passure( invariant(*imno), " ");

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Close a frame, save to disk if necessary
   @param    id           frame number
   @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
static int
frame_close(int id)
{
    cpl_property **cards = NULL;
    fitsfile *fptr = NULL;
    int fio_status = 0;

    passure( invariant(id), " ");
    if (!frame_is_open(id))  {


        uves_msg_warning("%s number %d is not open, cannot close", 
                         frames[id].is_image ? "Image" : "Table",
                         id);

    }
    else {
        if (frames[id].need_to_save) {
            char type;
            int bytelem;
            int naxis;
            
            uves_msg_debug("Saving frame %s to disk", frames[id].filename);
            
            check( load_frame(id),
                   "Could not load frame %s", frames[id].filename);
                    
            check( load_frame_header(id),
                   "Could not load %s header", frames[id].filename);
                    
            check( cards = get_descr_info(id, "NPIX",
                                          &type, &naxis, &bytelem),
                   "Could not get info on descriptor NPIX");
                    
            check( convert_to_history(&frames[id].header),
                   "Could not convert header");

            /* Note header is free'd below, so changing it is ok */
             if (frames[id].is_image)
                {


                    bool save_as_bitpix16 =
                        (frames[id].data.image.dtype == D_I1_FORMAT ||
                         frames[id].data.image.dtype == D_I2_FORMAT);
                    /* Save D_I1_FORMAT / D_I2_FORMAT  (masks) as 16 bit unsigned, 
                       otherwise 32 bit signed */

                    bool save_as_1d = (naxis == 1);
                    /* Don't save 2d images as 1d, we will loose START/STEP descriptors */

                    assure( naxis == 1 || naxis == 2 || naxis == 3 || naxis == 4,
                            CPL_ERROR_UNSUPPORTED_MODE,
                            "Cannot save image with NAXIS = %d", naxis);

                    uves_msg_debug("Saving %dd image", naxis);
                    
                    check( uves_save_image(frames[id].data.image.image,
                                           frames[id].filename,
                                           frames[id].header,
                                           save_as_bitpix16,
                                           save_as_1d),
                           "Error saving image %s", frames[id].filename);

                    if (naxis == 2 || naxis == 3 || naxis == 4) {
                        int NAXIS[4];
                        int unit, null;
                        int actvals;
                        char dummy[100]; /* More than length of FITS key record */
                        char err_message[81];  /* long enough according to CFITSIO doc. */
                        int current_naxis;   /* As written by the previous uves_save_image()
                                                call */
                        
                        assure( 0 == flames_midas_scdrdi(id, "NPIX",
                                                         1, naxis,
                                                         &actvals, NAXIS,
                                                         &unit, &null), 
                                CPL_ERROR_ILLEGAL_INPUT,
                                "Failed to read NPIX");
                        
                        assure( actvals == naxis, CPL_ERROR_ILLEGAL_INPUT,
                                "naxis = %d but actvals = %d", naxis, actvals);
                                
                        /* CPL and QFITS cannot change a FITS header without 
                           load/saving the data buffer
                           so use CFITSIO for this basic task */

                        fits_open_file(&fptr, frames[id].filename, READWRITE, &fio_status);
                        
                        assure( fio_status == 0, CPL_ERROR_ILLEGAL_OUTPUT,
                                "Failed to open file %s", frames[id].filename);

                        /* Move to beginning of header, then to location of NAXIS (which should already exist) */
                        fits_read_record(fptr, 0, dummy, &fio_status);
                        /* fits_read_card(fptr, (char*)"NAXIS", dummy, &fio_status); */
                        fits_read_key(fptr, TINT, (char*)"NAXIS", &current_naxis, NULL, &fio_status);

                        fits_update_key(fptr, TINT, (char*)"NAXIS", &naxis, (char*)"Empty unit", &fio_status);
                        fits_update_key(fptr, TINT, (char*)"NAXIS1", &NAXIS[0], (char*)"Empty unit", &fio_status);

                        if (current_naxis < 2) {
                            fits_insert_card(fptr, (char*)"NAXIS2", &fio_status);
                        }
                        fits_update_key(fptr, TINT, (char*)"NAXIS2", &NAXIS[1], (char*)"Empty unit", &fio_status);
                        
                        if (naxis >= 3) {
                            fits_insert_card(fptr, (char*)"NAXIS3", &fio_status);
                            fits_update_key(fptr, TINT, (char*)"NAXIS3", &NAXIS[2], (char*)"Empty unit", &fio_status);
                        }
                        
                        if (naxis >= 4) {
                            fits_insert_card(fptr, (char*)"NAXIS4", &fio_status);
                            fits_update_key(fptr, TINT, (char*)"NAXIS4", &NAXIS[3], (char*)"Empty unit", &fio_status);
                        }
                        
                        fits_close_file(fptr, &fio_status);
                        
                        if (fio_status != 0) fits_read_errmsg(err_message);
                        assure( fio_status == 0, CPL_ERROR_ILLEGAL_OUTPUT,
                                "Error '%s' code %d while updating %s FITS header", 
                                err_message, fio_status, frames[id].filename);
                    }

                }
            else
                {
                    cpl_table_set_size(frames[id].data.table.table,
                                       frames[id].data.table.maxrow);
                  
                    check( uves_table_save(frames[id].data.table.table,
                                           frames[id].header, /* Primary header */
                                           NULL,                /* Ext. header */
                                           frames[id].filename,
                                           CPL_IO_DEFAULT),
                           "Error saving table %s", frames[id].filename);
                }
                    
            frames[id].need_to_save = false;

        }
        else
            {
                uves_msg_debug("Closing %s %s (don't save to disk)", 
                               frames[id].is_image ? "image" : "table",
                               frames[id].filename);
            }
            
        frame_free(id);

    }
    
    passure( !frame_is_open(id), " ");
    passure( invariant(id), " ");

  cleanup:
    cpl_free(cards); cards = NULL;
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}
    
/*----------------------------------------------------------------------------*/
/**
   @brief    Close an image frame
   @param    imno       file id of data frame
   @return 0 iff okay

**/
/*----------------------------------------------------------------------------*/
int flames_midas_scfclo(int imno)
{
    return frame_close(imno);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read data from disk frame into memory
   @param    imno       file id of data frame
   @param    felem      1st pixel to be accessed in data space
   @param    size       number of data values (pixels) to be read
   @param    *actsize   (output) actual number of pixels read
   @param    bufadr     (output) data buffer (really a void pointer but implemented as
                        a char pointer) 
   @return 0 iff okay

**/
/*----------------------------------------------------------------------------*/
int flames_midas_scfget(int imno, int felem, int size, int *actsize, char *bufadr)
{
  //cpl_type type;

    passure( invariant(imno), " ");

    assure( frame_is_open(imno) && frames[imno].is_image, CPL_ERROR_ILLEGAL_INPUT,
            "Image no. %d is not open", imno);

    check( load_frame(imno),
       "Could not load image %s", frames[imno].filename);

    assure( (felem-1) + size <=
        cpl_image_get_size_x(frames[imno].data.image.image)*
        cpl_image_get_size_y(frames[imno].data.image.image),
        CPL_ERROR_ACCESS_OUT_OF_RANGE,
        "Cannot read %d bytes of CPL image of size %" CPL_SIZE_FORMAT "x%" CPL_SIZE_FORMAT " position %d",
        size, 
        cpl_image_get_size_x(frames[imno].data.image.image),
        cpl_image_get_size_y(frames[imno].data.image.image),
        felem-1);

    switch(frames[imno].data.image.type) {
    case CPL_TYPE_INT:
    {
        int *buffer;
        int i;
        buffer = cpl_image_get_data_int(frames[imno].data.image.image);
        buffer += (felem-1);
        
        switch(frames[imno].data.image.dtype) {
        case D_I1_FORMAT:
            for (i = 0; i < size; i++)
                {
                    ((char *)bufadr)[i] = buffer[i];
                }
            break;
        case D_I2_FORMAT:
        case D_I4_FORMAT:
            for (i = 0; i < size; i++)
                {
                    ((int32_t *)bufadr)[i] = buffer[i];
                }
            break;
        default:
            assure_nomsg( false, CPL_ERROR_UNSUPPORTED_MODE );
            break;
        }
        *actsize = size;
    }
    break;
    case CPL_TYPE_FLOAT:
    {
        float *buffer;
        int i;
        buffer = cpl_image_get_data_float(frames[imno].data.image.image);
        buffer += (felem-1);
        
        for (i = 0; i < size; i++)
            {
                ((float *)bufadr)[i] = buffer[i];
            }
        *actsize = size;
    }
    break;
    default:
        assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Type is %s",
                uves_tostring_cpl_type(frames[imno].data.image.type));
        break;
    }
    
    passure( invariant(imno), " ");

  cleanup: 
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}


/*----------------------------------------------------------------------------*/
/**
   @brief    Write data from memory into disk frame
   @param    imno       file id of data frame
   @param    felem      1st pixel to be accessed in data space
   @param    size       number of data values (pixels) to be written
   @param    bufadr     data buffer (void pointer)
   @return 0 iff okay

**/
/*----------------------------------------------------------------------------*/
int flames_midas_scfput(int imno, int felem, int size, const char *bufadr)
{
    int i;

    passure( invariant(imno), " ");

    assure( frame_is_open(imno) && frames[imno].is_image, CPL_ERROR_ILLEGAL_INPUT,
        "Image no. %d is not open", imno);

    /* Load image if necessary, then overwrite part, or all of data buffer */
    check( load_frame(imno),
           "Could not load image %s", frames[imno].filename);

    assure( (felem-1) + size <=
        cpl_image_get_size_x(frames[imno].data.image.image)*
        cpl_image_get_size_y(frames[imno].data.image.image),
        CPL_ERROR_ACCESS_OUT_OF_RANGE,
        "Cannot write %d pixels to CPL image of size %" CPL_SIZE_FORMAT "x%" CPL_SIZE_FORMAT " position %d",
        size, 
        cpl_image_get_size_x(frames[imno].data.image.image),
        cpl_image_get_size_y(frames[imno].data.image.image),
        felem-1);

    uves_msg_debug("Writing %d pixels to image %s",
                   size, frames[imno].filename);

    switch(frames[imno].data.image.type) {
    case CPL_TYPE_INT:
    {
        int *buffer;
        buffer = cpl_image_get_data_int(frames[imno].data.image.image);
        buffer += (felem-1);

        switch(frames[imno].data.image.dtype) {
        case D_I1_FORMAT:
            for (i = 0; i < size; i++)
                {
                    buffer[i] = ((char *)bufadr)[i];
                }
            break;
        case D_I2_FORMAT:
        case D_I4_FORMAT:
            for (i = 0; i < size; i++)
                {
                    buffer[i] = ((int *)bufadr)[i];
                }
            break;
        default:
            assure_nomsg( false, CPL_ERROR_UNSUPPORTED_MODE );
            break;
        }
    }
    break;
    case CPL_TYPE_FLOAT:
    {
        float *buffer;
        buffer = cpl_image_get_data_float(frames[imno].data.image.image);
        buffer += (felem-1);
        
        for (i = 0; i < size; i++)
            {
                buffer[i] = ((float *)bufadr)[i];
            }
    }
    break;
    case CPL_TYPE_DOUBLE:
    {
        double *buffer;
        buffer = cpl_image_get_data_double(frames[imno].data.image.image);
        buffer += (felem-1);
        
        for (i = 0; i < size; i++)
            {
                buffer[i] = ((double *)bufadr)[i];
            }
    }
    break;
    default:
        assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Type is %s", 
                uves_tostring_cpl_type(frames[imno].data.image.type));
        break;
    }
    
    frames[imno].need_to_save = true;  /* Memory buffer has changed */

    passure( invariant(imno), " ");

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Provide info about descriptor 
   @param    id         file id of data frame
   @param    descr      descriptor name (max 15 chars)
   @param    type       (output) type of descriptor: 'I', 'R', 'C', 'D' 
                        or ' ' (a blank)
   @param    noelem     (output) number of elements
   @param    bytelem    (output) number of bytes per element
   @return 0 iff okay

   Search descriptor directory, if 'descr' not found, *type is set to blank 

**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdfnd(int id, const char *descr, 
			char *type, int *noelem, int *bytelem)
{
  cpl_property **cards = NULL;

  passure( invariant(id), " ");
  assure_nomsg( descr != NULL, CPL_ERROR_NULL_INPUT );

  if (strcmp(descr, "LHCUTS") == 0)
    {
      int datamin_noelem, datamax_noelem;
      char datamin_type, datamax_type;
                
      *noelem = 2; /* LHCUTS1 and LHCUTS2 always exist */
      *type ='R';
            
      flames_midas_scdfnd(id, "DATAMIN", &datamin_type, &datamin_noelem, bytelem);
      flames_midas_scdfnd(id, "DATAMAX", &datamax_type, &datamax_noelem, bytelem);
            
      assure( datamin_noelem <= 1, CPL_ERROR_ILLEGAL_INPUT,
	      "Multiple (%d) DATAMIN keywords found", datamin_noelem);

      assure( datamax_noelem <= 1, CPL_ERROR_ILLEGAL_INPUT,
	      "Multiple (%d) DATAMIN keywords found", datamax_noelem);

      if (datamin_noelem > 0)
	{
	  *noelem = 3;
	  assure( datamin_type == 'D', CPL_ERROR_TYPE_MISMATCH,
		  "DATAMIN has type %c, %c expected", datamin_type, 'D');

	  if (datamax_noelem > 0)
	    {
	      *noelem = 4;
	      assure( datamax_type == 'D', CPL_ERROR_TYPE_MISMATCH,
		      "DATAMAX has type %c, %c expected", datamax_type, 'D');
	    }
	}

    }
  else
    {
      check( cards = get_descr_info(id, descr,
				    type, noelem, bytelem),
	     "Could not get info on descriptor %s", descr);
            
      if (cards == NULL)
	{
	  *type = ' ';
	  uves_msg_debug("Descriptor %s not found",descr);
	}
      else
	{
	  uves_msg_debug("Found descriptor %s, type = %c, length = %d",
			   descr, *type, *noelem);
	}
    }

  passure( invariant(id), " ");

 cleanup:
  cpl_free(cards); cards = NULL;

  return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}



/*----------------------------------------------------------------------------*/
/**
   @brief    Provide info about descriptor 
   @param    id         file id of data frame
   @param    descr      descriptor name (max 15 chars)
   @param    type       (output) type of descriptor: 'I', 'R', 'C', 'D' 
                        or ' ' (a blank)
   @param    noelem     (output) number of elements
   @param    bytelem    (output) number of bytes per element
   @return 0 iff okay

   Search descriptor directory, if 'descr' not found, *type is set to blank 

**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdprs(int id, const char *descr, 
			char *type, int *noelem, int *bytelem)
{
  cpl_property **cards = NULL;

  passure( invariant(id), " ");
  assure_nomsg( descr != NULL, CPL_ERROR_NULL_INPUT );

  if (strcmp(descr, "LHCUTS") == 0)
    {
      int datamin_noelem, datamax_noelem;
      char datamin_type, datamax_type;
                
      *noelem = 2; /* LHCUTS1 and LHCUTS2 always exist */
      *type ='R';
            
      flames_midas_scdfnd(id, "DATAMIN", &datamin_type, &datamin_noelem, bytelem);
      flames_midas_scdfnd(id, "DATAMAX", &datamax_type, &datamax_noelem, bytelem);
            
      assure( datamin_noelem <= 1, CPL_ERROR_ILLEGAL_INPUT,
	      "Multiple (%d) DATAMIN keywords found", datamin_noelem);

      assure( datamax_noelem <= 1, CPL_ERROR_ILLEGAL_INPUT,
	      "Multiple (%d) DATAMIN keywords found", datamax_noelem);

      if (datamin_noelem > 0)
	{
	  *noelem = 3;
	  assure( datamin_type == 'D', CPL_ERROR_TYPE_MISMATCH,
		  "DATAMIN has type %c, %c expected", datamin_type, 'D');

	  if (datamax_noelem > 0)
	    {
	      *noelem = 4;
	      assure( datamax_type == 'D', CPL_ERROR_TYPE_MISMATCH,
		      "DATAMAX has type %c, %c expected", datamax_type, 'D');
	    }
	}

    }
  else
    {
      check( cards = get_descr_info(id, descr,
				    type, noelem, bytelem),
	     "Could not get info on descriptor %s", descr);
            
      if (cards == NULL)
	{
	  *type = ' ';
	  uves_msg_debug("Descriptor %s not found",descr);
          cpl_free(cards); cards = NULL;
	  return 1;
	}
      else
	{
	  uves_msg_debug("Found descriptor %s, type = %c, length = %d",
			   descr, *type, *noelem);
	}
    }

  passure( invariant(id), " ");

 cleanup:
  cpl_free(cards); cards = NULL;

  return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read contents of integer descriptor 
   @param    id       file id of data frame
   @param    descr      descriptor name (max 15 chars)
   @param    felem      position of 1st element
   @param    maxvals    max no. of elements to be returned
   @param    actvals    (output) actual number of values returned
   @param    values     (output) array for descriptor data
   @param    unit       (output) address of unit pointer
   @param    null       (output) no. of null values in data
   @return 0 iff okay

   actvals will be the actual number of values returned
**/
/*----------------------------------------------------------------------------*/
static int
scdrd(char expected_type, int id, const char *descr, 
      int felem, int maxvals,
      int *actvals, void *values,
      int *unit, int *null)
{
    char type;
    int length;
    int bytelem;
    cpl_property **cards = NULL;
    int i;
    if (unit) {} //to remove compilation warning: this is not used
    if (null) {} //to remove compilation warning: this is not used

    passure( invariant(id), " ");

    check( cards = get_descr_info(id, descr, &type,
                                  &length, &bytelem),
       "Could not get info on descriptor %s", descr);

    assure( cards != NULL, CPL_ERROR_DATA_NOT_FOUND,
        "Descriptor %s not found in file %s", descr, frames[id].filename);

    /* Allow conversion R -> D */
    assure( (expected_type == 'D' && type == 'R') 
            ||
            type == expected_type, CPL_ERROR_TYPE_MISMATCH,
        "Descriptor %s has type %c, %c expected",
        descr, type, expected_type);

    passure( type != 'C' || felem == 1, "'%c' %d", type, felem);

    *actvals = 0;
    //uves_msg_warning("length=%d",length);
    for (i = felem-1; i < length; i++)
    {
        if (*actvals < maxvals)
        {
            uves_msg_debug("Getting %d of %d (max %d) values of descriptor %s",
                   *actvals + 1, length - (felem-1), maxvals, descr);

            switch(type) {
            case 'I': 
                ((int *)values)[i-(felem-1)]    = cpl_property_get_int(cards[i]); 
                uves_msg_debug("Value = %d", ((int *)values)[i-(felem-1)]);
                break;
            case 'D': 
                ((double *)values)[i-(felem-1)] = cpl_property_get_double(cards[i]);
                uves_msg_debug("Value = %g", ((double *)values)[i-(felem-1)]);
                break;
            case 'R': 
                switch(expected_type) {
                case 'R':
                    ((float *)values)[i-(felem-1)]  = cpl_property_get_float(cards[i]); 
                    uves_msg_debug("Value = %g", ((float *)values)[i-(felem-1)]);
                    break;
                case 'D':
                    ((double *)values)[i-(felem-1)]  = cpl_property_get_float(cards[i]); 
                    uves_msg_debug("Value = %g", ((double *)values)[i-(felem-1)]);
                    break;
                default:
                    passure( false, " ");
                    break;
                }
                break;
            case 'C':
                ((char *)values)[i-(felem-1)]   = cpl_property_get_string(cards[0])[i]; 
                uves_msg_debug("Value = %c", ((char *)values)[i-(felem-1)]);
                break;
            default: 
                assure( false, CPL_ERROR_INVALID_TYPE, "Type is %c", type); 
                break;
            }
            *actvals += 1;
        }
    }

    if (type == 'C' && *actvals < maxvals)
    {
        /* length is the string length,
           terminate with 0
           This character does not count in actvals
               but is include in maxvals
        */
        ((char *)values)[length-(felem-1)] = '\0';
    }
    
    /* unit, null not implemented by MIDAS */

    passure( invariant(id), " ");

  cleanup:
    cpl_free(cards); cards = NULL;

    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}
/*----------------------------------------------------------------------------*/
/**
   @brief    Read contents of integer descriptor 

   @see scdrd

**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdrdi(int id, const char *descr, 
            int felem, int maxvals,
            int *actvals, int *values,
            int *unit, int *null)
{
    char *char_values = NULL;

#if 0
    if (strcmp(descr, "MAXFIBRES") == 0)
    {
        char_values = cpl_malloc(maxvals + 1);
        assure_mem( char_values );
        char_values[0] = '\0';

        assure( felem == 1, CPL_ERROR_UNSUPPORTED_MODE,
            "first element no. (%d) is not 1", felem);

        check( scdrd('C', imno, descr, felem, maxvals, actvals, char_values, unit, null),
           "Reading %s as string failed", descr);

        assure( strlen(char_values) == 1, CPL_ERROR_ILLEGAL_INPUT,
            "MAXFIBRES value (%s) has length different from 1",
            char_values);

        /* We have a string of length 1, convert to integer */
        errno = 0;
        values[0] = atoi(char_values);
        assure( errno == 0, CPL_ERROR_ILLEGAL_OUTPUT,
            "Conversion of %s to integer failed", char_values);

        cpl_msg_debug("Got value %s (%d)", char_values, values[0]);
    }
    else
#endif
    {
        /* Ok to return here, nothing alloc'ed */
        return scdrd('I', id, descr, felem, maxvals, actvals, values, unit, null);
    }

/*  cleanup: */
    uves_free_string(&char_values);
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read contents of double descriptor 

   @see scdrd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdrdd(int id, const char *descr, 
            int felem, int maxvals,
            int *actvals, double *values,
            int *unit, int *null)
{
    return scdrd('D', id, descr, felem, maxvals, actvals, values, unit, null);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read contents of double descriptor 

   @see scdrd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdrdr(int id, const char *descr, 
            int felem, int maxvals,
            int *actvals, float *values,
            int *unit, int *null)
{
    if (strcmp("LHCUTS", descr) == 0 && felem < 3)
    {
            int i;
            bool success = true;
            
            for (i = felem; i < felem+maxvals; i++)
                {
                    double val;
                    if (1 <= i && i <= 2)
                        {
                            uves_msg_debug("Do not read LHCUTS%d", i);
                        }
                    else if (i == 3)
                        {
                            success = success &&
                                (flames_midas_scdrdd(id, "DATAMIN", i, 1,
                                                     actvals,
                                                     &val,
                                                     unit, null)) == 0;

                            values[i-felem] = (float) val;
                        }
                    else if (i == 4)
                        {
                            success = success &&
                                (flames_midas_scdrdd(id, "DATAMAX", i, 1,
                                                     actvals,
                                                     &val,
                                                     unit, null)) == 0;
                            values[i-felem] = (float) val;
                        }
                    else
                        {
                            success = false;
                        }
                }
            return success ? 0 : 1;
    }
    else
    {
            return scdrd('R', id, descr, felem, maxvals, actvals, values, unit, null);
    }
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Read contents of string descriptor 
   @param    noelem    no. of bytes per data value

   Note: maxvals in the number of characters, excluding the final terminating
   '\0', i.e. maxvals should usually be one less than the buffer size

   @see scdrd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdrdc(int id, const char *descr, 
            int noelem,
            int felem, int maxvals,
            int *actvals, char *values,
            int *unit, int *null)
{
    int returnvalue = 1;
    
    assure( noelem == sizeof(char), CPL_ERROR_UNSUPPORTED_MODE, "Implement me" );
    assure( felem  == 1, CPL_ERROR_UNSUPPORTED_MODE, "Implement me" );
   
    returnvalue = scdrd('C', id, descr, felem, maxvals, actvals, values, unit, null);
    
  cleanup:
    return returnvalue;    
}



/*----------------------------------------------------------------------------*/
/**
   @brief    Write a descriptor and its data
   @param    type_to_write type
   @param    id         file id of data frame
   @param    descr      descriptor name (max 15 chars)
   @param    values     buffer with descriptor data
   @param    felem      position of 1st descriptor value to be accessed
   @param    nval       no. of data values to write
   @param    unit       unit-pointer
   @return 0 iff okay

   A new descriptor is added to the descriptor area, or data of an existing
   descriptor is modified and extended, if necessary.

   If felem = -1 descriptor values are appended to existing ones

**/
/*----------------------------------------------------------------------------*/
static int
scdwr(char type_to_write, int id, const char *descr, const void *values, 
      int felem, int nval, const int *unit)
{
    char type = '-';
    int length, bytelem, i;
    cpl_property **cards = NULL;
    cpl_property **cards_extra = NULL;


    passure( invariant(id), " ");

    assure( frame_is_open(id), CPL_ERROR_ILLEGAL_INPUT,
        "Frame no. %d is not open", id);

    check( cards = get_descr_info(id, descr, 
                                  &type, &length, &bytelem),
       "Could not get info on descriptor %s", descr);
    
    if (cards == NULL) {
        int number_of_cards = (type_to_write == 'C') ? 1 : (felem-1)+nval;
        int nexisting = 0;
        
        type = type_to_write;
        check( cards = create_descr(frames[id].header, descr, type,
                                    number_of_cards, nexisting),
               "Could not create %d %s descriptors",
               number_of_cards, descr);
    }
    else {
        assure( type == type_to_write ||
                (type == 'D' && type_to_write == 'R'),
                CPL_ERROR_TYPE_MISMATCH,
                "Cannot write type %c data to type %c descriptor %s",
                type_to_write, type, descr);
        
        if (type_to_write != 'C' &&
            (felem-1) + nval > length)
            /* Create additional descriptors */
            {
                int number_of_extra = (felem-1) + nval - length;
                int ncards;
                
                /* Count existing descriptors */
                ncards = 0;
                while(cards[ncards] != NULL) ncards++;
                
                uves_msg_debug("Only %d existing %s descriptor(s), add another %d",
                               ncards, descr, number_of_extra);
                
                check( cards_extra
                       = create_descr(frames[id].header, descr, type,
                                      number_of_extra, ncards),
                       "Could not create %d %s descriptors",
                       number_of_extra, descr);
                
                /* Append to existing */
                cards = cpl_realloc(cards, (ncards + number_of_extra + 1)*sizeof(cpl_property *));
                
                for (i = ncards; i < ncards + number_of_extra; i++)
                    {
                        cards[i] = cards_extra[i-ncards];
                    }
                
                cards[ncards+number_of_extra] = NULL;
            }
        else {
            uves_msg_debug("Do not add new cards for descriptor %s", descr);
        }
    }

    /* Properties now exist in correct number, with correct type */
    for (i = 0; i < ((type_to_write == 'C') ? 1 : nval); i++) {
        if (type_to_write == 'I') {
            uves_msg_debug("Writing %d. of %d values (%d) to cards[%d]",
                           i+1,
                           ((type_to_write == 'C') ? 1 : nval),
                           ((const int *)values)[i],
                           (felem-1) + i);
        }
        else {
            uves_msg_debug("Writing %d. of %d values to cards[%d]", 
                           i+1,
                           ((type_to_write == 'C') ? 1 : nval),
                           (felem-1) + i);
        }
        
        /* Allow conversion float -> double */
        switch(type_to_write) {
        case 'I': cpl_property_set_int (cards[(felem-1) + i], ((const int *)values)[i]); break;
        case 'R': 
            switch(type) {
            case 'R':
                cpl_property_set_float (cards[(felem-1) + i], ((const float *)values)[i]); break;
            case 'D':
                cpl_property_set_double(cards[(felem-1) + i], ((const float *)values)[i]); break;
            default:
                assure( false, CPL_ERROR_UNSUPPORTED_MODE,
                        "Cannot write type '%c' values to type '%c' descriptor",
                        type_to_write, type);
                break;
            }
            break;
        case 'C': cpl_property_set_string(cards[(felem-1) + i], (const char *)values); break;
        case 'D': cpl_property_set_double(cards[(felem-1) + i], ((const double *)values)[i]); break;
        default: 
            assure( false,CPL_ERROR_UNSUPPORTED_MODE, "Implement me"); break;
        }

    }
    
    /* unit not implemented by MIDAS */
    
    frames[id].need_to_save = true;
    /* and in order to be able to save the header with CPL,
       we need to also have the image in memory (if not already) */
    check( load_frame(id),
           "Could not load frame %s", frames[id].filename );

    passure( invariant(id), " ");

  cleanup:
    cpl_free(cards); cards = NULL;
    cpl_free(cards_extra); cards_extra = NULL;
    
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Write a descriptor and its data

   See scdwr
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdwri(int id, const char *descr, const int *values, 
            int felem, int nval, const int *unit)
{
    if (strcmp(descr, "NPIX") == 0)
    /* MIDAS  NPIXi maps to FITS NAXISi */
    {
        cpl_type type;
        int *buffer_int=NULL;
        float *buffer_float=NULL;
        double *buffer_double=NULL;
        int size=0;
        
        assure( nval == 1 || nval == 2 || nval == 3 || nval == 4, 
                CPL_ERROR_UNSUPPORTED_MODE,
                "Only 2d, 3d and 4d (not %dd) images supported", 
                nval);
        
        assure( frames[id].is_image, CPL_ERROR_ILLEGAL_INPUT,
                "Cannot write NPIX to table %s", frames[id].filename);
        
        switch(nval) {
        case 1: size = values[0]; break;
        case 2: size = values[0] * values[1]; break;
        case 3: size = values[0] * values[1] * values[2]; break;
            case 4: size = values[0] * values[1] * values[2] * values[3]; break;
        default:
            passure( false, "Impossible");
            break;
        }

        if (frames[id].data.image.image == NULL) {
            frames[id].data.image.image = 
                cpl_image_new(size, 1, 
                              frames[id].data.image.type);
        }
        
        assure( size == 
                cpl_image_get_size_x(frames[id].data.image.image) *
                cpl_image_get_size_y(frames[id].data.image.image), 
                CPL_ERROR_INCOMPATIBLE_INPUT,
                "Cannot set image %s NAXIS to %d because the "
                "image memory buffer size is %" CPL_SIZE_FORMAT "",
                frames[id].filename, 
                size,
                cpl_image_get_size_x(frames[id].data.image.image) *
                cpl_image_get_size_y(frames[id].data.image.image));
        
        /* Now unwrap + wrap the image structure, but keep
           the buffer unchanged */
        type = cpl_image_get_type(frames[id].data.image.image);
        if (nval == 2) {
            /* This is redundant now that NAXIS is overwritten when closing */
            uves_msg_debug("Setting image %s (type %s) size to %dx%d",
                           frames[id].filename,
                           uves_tostring_cpl_type(type),
                           values[0], values[1]);
            switch(type) {
            case CPL_TYPE_INT   : buffer_int    = cpl_image_get_data_int(frames[id].data.image.image); break;
            case CPL_TYPE_FLOAT : buffer_float  = cpl_image_get_data_float(frames[id].data.image.image); break;
            case CPL_TYPE_DOUBLE: buffer_double = cpl_image_get_data_double(frames[id].data.image.image); break;
            default:
                assure( false, CPL_ERROR_INVALID_TYPE, "Type is %s",
                        uves_tostring_cpl_type(type));
                break;
            }

                
            /* Deallocate, except buffer */
            cpl_image_unwrap(frames[id].data.image.image);
                
            switch(type) {
            case CPL_TYPE_INT   : frames[id].data.image.image = cpl_image_wrap_int   (values[0], values[1], buffer_int); break;
            case CPL_TYPE_FLOAT : frames[id].data.image.image = cpl_image_wrap_float (values[0], values[1], buffer_float); break;
            case CPL_TYPE_DOUBLE: frames[id].data.image.image = cpl_image_wrap_double(values[0], values[1], buffer_double); break;
            default:
                assure( false, CPL_ERROR_INVALID_TYPE, "Type is %s",
                        uves_tostring_cpl_type(type));
                break;
            }

        }
        else {
            /* for 3d, 4d images don't change the CPL
               image axes. NAXISi will be overwritten when saving */
        }
    }
    
    scdwr('I', id, descr, values, felem, nval, unit);
    
  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Write a descriptor and its data
   
   See flames_midas_scdwri()
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdwrd(int id, const char *descr, const double *values, 
                        int felem, int nval, const int *unit)
{
    if (strcmp("CRPIX", descr) == 0 ||
        strcmp("CRVAL", descr) == 0 ||
        strcmp("CDELT", descr) == 0) {
        int i;
        bool success = true;
        
        for (i = felem; i < felem+nval; i++) {
            char descr_i[10];
            
            sprintf(descr_i, "%s%i", descr, i);
            success = success &&
                (flames_midas_scdwrd(id, descr_i, &values[i-felem], 
                                     felem, 1, unit) == 0);
        }

        return success ? 0 : 1;
    }
    
    return scdwr('D', id, descr, values, felem, nval, unit);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Write a descriptor and its data
   
   See flames_midas_scdwri()
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdwrr(int id, const char *descr, const float *values, 
                        int felem, int nval, const int *unit)
{
    if (strcmp("LHCUTS", descr) == 0 && felem < 3) {
        int i;
        bool success = true;
            
        for (i = felem; i < felem+nval; i++)
            {
                if (1 <= i && i <= 2)
                    {
                        uves_msg_debug("Do not write LHCUTS%d", i);
                    }
                else if (i == 3)
                    {
                        double val = (double) values[i-felem-1];
                        success = success &&
                            (flames_midas_scdwrd(id, "DATAMIN", &val, 
                                                 1, 1, unit) == 0);
                    }
                else if (i == 4)
                    {
                        double val = (double) values[i-felem-1];
                        success = success &&
                            (flames_midas_scdwrd(id, "DATAMAX", &val,
                                                 1, 1, unit) == 0);
                    }
                else
                    {
                        success = false;
                    }
            }
        return success ? 0 : 1;
    }
    else
    {
        return scdwr('R', id, descr, values, felem, nval, unit);
    }
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Write a descriptor and its data
   @param    noelm       no. of bytes per data value

   See flames_midas_scdwri()

   'noelm' larger than 1 enables you to use character arrays, where each data
   values is in effect a char. string of 'noelm' bytes
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdwrc(int id, const char *descr, int noelm, const char *values, 
                        int felem, int nval, const int *unit)
{
    int returnvalue = 1;
    char* tmp_string=NULL;

    if (strcmp(descr, "CUNIT") == 0) {
        if (noelm == 1) {
            char val[17];
            int i;

            assure( nval % 16 == 0, CPL_ERROR_UNSUPPORTED_MODE,
                    "nval = %d", nval );
            /* nval used in FLAMES code are 32, 48, 64 and 80 */


            strncpy(val, values, 16);
            val[16] = '\0';
            returnvalue = flames_midas_scdwrc(id, "BUNIT", 1, val, felem, 16, unit);
            
            for (i = 1; i < nval/16; i++) {
                const char *ctype_i;
                
                switch(i) {
                case 1: ctype_i = "CTYPE1"; break;
                case 2: ctype_i = "CTYPE2"; break;
                case 3: ctype_i = "CTYPE3"; break;
                case 4: ctype_i = "CTYPE4"; break;
                default:
                    return 1;
                    break;
                }
                
                strncpy(val, values+i*16, 16);
                val[16] = '\0';
                
                if (returnvalue == 0) {
                    returnvalue = flames_midas_scdwrc(id, ctype_i, 1, val, felem, 16, unit);
                }
            }
        }
        else {
            /* The FLAMES C code has only one call like this.
               Implement it by 3 manual calls.
            */
            assure( nval == 3, CPL_ERROR_UNSUPPORTED_MODE,
                    "noelm = %d, nval = %d", noelm, nval);
            
            /* Yes, here noelm and nval are swapped */
            returnvalue = flames_midas_scdwrc(id, "BUNIT",  1, values+0, felem, noelm, unit);
            if (returnvalue == 0) {
                returnvalue = flames_midas_scdwrc(id, "CTYPE1", 1, values+1, felem, noelm, unit);
            }
            if (returnvalue == 0) {
                returnvalue = flames_midas_scdwrc(id, "CTYPE2", 1, values+2, felem, noelm, unit);
            }
        }
    }
    else {
        assure( noelm == sizeof(char), CPL_ERROR_UNSUPPORTED_MODE, "Implement me" );
        assure( felem == 1, CPL_ERROR_UNSUPPORTED_MODE, "Implement me" );
        
        /* nval is the string length */
        tmp_string=cpl_calloc((nval+1),sizeof(char));
        strncpy(tmp_string,values,nval);    
        returnvalue = scdwr('C', id, descr, tmp_string, felem, nval, unit);
        
    }
    
  cleanup:
    cpl_free(tmp_string);
    return returnvalue;    
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Delete a descriptor
   @param    id          frame number
   @param    descr       descriptor name
   @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scddel(int id, const char *descr)
{
    cpl_property **cards = NULL;
    char type;
    int length, bytelem;
    const char *fits_descr = NULL;
    const char *name_regexp = NULL;

    passure( invariant(id), " ");

    assure( frame_is_open(id), CPL_ERROR_ILLEGAL_INPUT,
        "Frame no. %d is not open", id );

    /* Need to convert from MIDAS names to CPL propertylist names */
    check( cards = get_descr_info(id, descr, &type,
                                  &length, &bytelem),
       "Could not get info on descriptor %s", descr);

    if (cards != NULL)
        {
            int i;
            
            frames[id].need_to_save = true;

            for (i = 1; i <= length; i++)
                {
                    int invert = 0;
                    uves_free_string_const(&fits_descr);        
                    check( fits_descr = convert_to_fits(descr, i),
                           "Could not convert %s to FITS", descr);

                    /* uves_propertylist_erase() will  erase only the first
                       property with the given name. We want to erase all matches
                    */

                    uves_free_string_const(&fits_descr);        
                    name_regexp = uves_sprintf("^%s$", fits_descr);
                    uves_propertylist_erase_regexp(frames[id].header, name_regexp, invert);
                }
    }

    passure( invariant(id), " ");

  cleanup:
    uves_free_string_const(&fits_descr);        
    uves_free_string_const(&name_regexp);
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Copy descriptors from one frame to another
   @param    from     file id of source frame
   @param    to       file id of destination frame
   @param    mask     copy_mask
   @param    copy_naxis  whether or not to propagate NAXIS keywords
   @return 0 iff okay

   Depending on 'mask' the relevant descriptors are read from the source frame
   and written to the destination frame

   1 - copy all descriptors
   2 - copy only standard descriptors (see MIDAS env appendix E)
   3 - copy all but standard descriptors
   4 - copy single descriptor specified by parameter dsc
   5 - copy all but extended list of standard descriptors


   The FLAMES code uses only modes 1 and 3
**/
/*----------------------------------------------------------------------------*/

static int scdcop(int from, int to, int mask, bool copy_naxis)
{
    const char *key = NULL;
    passure( invariant(from), " ");
    passure( invariant(to  ), " ");

    assure( frame_is_open(from), CPL_ERROR_ILLEGAL_INPUT,
            "Image no. %d is not open", from);
    
    assure( frame_is_open(to), CPL_ERROR_ILLEGAL_INPUT,
            "Image no. %d is not open", to);
    
    check( load_frame_header(from),
       "Could not load header of file %s", frames[from].filename);

    check( load_frame_header(to),
       "Could not load header of file %s", frames[to].filename);

    switch (mask) {
    case 1:
        /* copy all */
        if (0)
            {
                /* This would just append */
                uves_propertylist_append(frames[to].header, frames[from].header);
            }
        else
            {
                /* overwrites existing descriptors */
                if (copy_naxis) {
                    uves_propertylist_copy_property_regexp(frames[to].header, 
                                                           frames[from].header,
                                                           ".*", 0);
                }
                else {
                    uves_propertylist_copy_property_regexp(frames[to].header, 
                                                           frames[from].header,
                                                           "^NAXIS", 1);
                }
            }
        uves_msg_debug("%s header now contains %ld descriptors",
                       frames[to].filename, uves_propertylist_get_size(frames[to].header));
        
        break;
    case 3:
        assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");     
        break;
    default:
        /* Not needed for FLAMES code */
        assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");
    }

    /* Need to change size of image */
    if (frames[from].is_image && copy_naxis) {
        int naxis = uves_propertylist_get_int(frames[from].header, "NAXIS");
        int axis;
        int unit;
        int n[2];

        uves_msg_debug("Manually propagating NPIX");

        assure( naxis == 2, CPL_ERROR_UNSUPPORTED_MODE,
                "NAXIS = %d", naxis );

        for (axis = 1; axis <= naxis; axis++) {
            uves_free_string_const(&key);
            key = uves_sprintf("NAXIS%d", axis);
            n[axis-1] = uves_propertylist_get_int(frames[from].header, key);
        }

        check_nomsg( flames_midas_scdwri(to, "NPIX", n,
                                         1, 2, &unit));
    }
    
    frames[to].need_to_save = true;
    check( load_frame(to),
       "Could not load image %s", frames[to].filename);

    passure( invariant(from), " ");
    passure( invariant(to  ), " ");

  cleanup:
    uves_free_string_const(&key);
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Copy descriptors
   @return 0 iff okay

   See scdcop()
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdcop(int from, int to, int mask)
{
    return scdcop(from, to, mask, true);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Copy descriptors
   @return 0 iff okay

   See scdcop()
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scdcop_nonaxis(int from, int to, int mask)
{
    return scdcop(from, to, mask, false);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Show size and type of a catalog
   @param    catfile     catalog file
   @param    noent       (output) number of entries
   @param    last        (output) last entry no.
   @return 0 iff okay

   Read and count active entries of catalog

**/
/*----------------------------------------------------------------------------*/
int flames_midas_sccsho(const cpl_frameset *catfile,
                        int *noent, 
                        int *last)
{
    *last=*last; //to remove compilation warning: this is not used
    assure_nomsg( catfile != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( noent != NULL, CPL_ERROR_NULL_INPUT );

    *noent = cpl_frameset_get_size(catfile);

    //fixme: is 'last' used by any caller? If so, how is it different from 'noent'?
    
  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}


/*----------------------------------------------------------------------------*/
/**
   @brief    Find corresponding frame for given entry number
   @param    catfile     catalog file
   @param    frmno       (output) frame number counting from 1
   @param    frame       (output) frame filename
   @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
int flames_midas_sccfnd(const cpl_frameset *catfile, 
                        int frmno, 
                        char *frame)
{
    const cpl_frame *f;
    
    assure_nomsg( catfile != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( frame != NULL, CPL_ERROR_NULL_INPUT );
    frame[0] = '\0';

    check( f = cpl_frameset_get_frame_const(catfile, frmno-1), /* CPL counts from zero */
           "Could not get frame no. %d from catalog", frmno);

    strcpy(frame, cpl_frame_get_filename(f));

    uves_msg_debug("Returning frame %s", cpl_frame_get_filename(f));

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}
/*----------------------------------------------------------------------------*/
/**
   @brief    Get next sequential entry from frame catalogue
   @param    catfile     catalog file
   @param    flag        0 for name only, 1 for name and identifier (tag)
   @param    name        (output) name of frame in next entry of catalog
   @param    ident       (output) identifier of that frame
   @param    no          (output) current/next entry number as input/output
   @return 0 iff okay

   Return name and identifier of next entry in catalog; return a blank in 
   name[0] if end of frameset.
  
   Parameter 'no' has to be set to 0 in the first call of the routine.

   Note: The returned ident string always has length 40
**/
/*----------------------------------------------------------------------------*/
int flames_midas_sccget(const cpl_frameset *catfile,
                        int flag,
                        char *name, char *ident, 
                        int *no)
{
    const char *fits_descr = NULL;
    uves_propertylist *header = NULL;
    
    assure_nomsg( catfile != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( no      != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( name    != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( flag == 0 || ident != NULL, CPL_ERROR_NULL_INPUT );

    if (*no == cpl_frameset_get_size(catfile))
        {
            *name = ' ';
            *no += 1;

            uves_msg_debug("Returning frame ' '");
        }
    else
        {
            const cpl_frame *f;
            check( f = cpl_frameset_get_frame_const(catfile, *no),
                   "Could not get frame no. %d from catalog", *no);
            
            *no += 1;
            strcpy(name, cpl_frame_get_filename(f));

            if (flag != 0) {
                const char *ident_value;
                
                check( header = uves_propertylist_load(name, 0),
                       "Failed to load %s header", name);

                if (false) {
                    check_nomsg( fits_descr = convert_to_fits(ident, 1) );
                }
                else {
                    fits_descr = uves_sprintf("%s", "OBJECT");
                }

                if (uves_propertylist_contains(header, fits_descr)) {
                    check_nomsg( ident_value = 
                                 uves_propertylist_get_string(header, fits_descr));
                }
                else {
                    ident_value = " ";
                }
                

                /* Unsafe by design of this function */
                strcpy(ident, ident_value);

                /* Pad with blanks until strlen = 40 */
                {
                    int i;
                    i = strlen(ident);
                    while (i <= 39) {
                        ident[i] = ' ';
                        i++;
                    }
                    ident[i] = '\0';
                }
                
                uves_msg_debug("Returning ident '%s'", ident);

                /* previously 
                   strcpy(ident, cpl_frame_get_tag(f));
                */
               }

            uves_msg_debug("Returning frame %s", name);
        }
    

  cleanup: 
    uves_free_propertylist(&header);
    uves_free_string_const(&fits_descr);

    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Create a catalog
   @param    catfile     (output) catalog. Must be deallocated by caller
   @param    type        type of files to use
   @param    flag        = 1 if file dirfile.cat exists
   @return 0 iff okay

   Add an entry with given name and identification field to the catalog

   If flag = 1, read each filename from ASCII file 'dirfile.dat',
   else create an empty catalog
**/
/*----------------------------------------------------------------------------*/
int flames_midas_scccre(cpl_frameset **catfile, 
                        int type,
                        int flag)
{
    assure_nomsg( catfile != NULL, CPL_ERROR_NULL_INPUT );

    /* These parameters always have these values in the FLAMES code */
    assure( type == F_IMA_TYPE, CPL_ERROR_UNSUPPORTED_MODE,
            "Implement me");
    assure(flag == 0, CPL_ERROR_UNSUPPORTED_MODE,
           "Implement me");

    *catfile = cpl_frameset_new();

  cleanup: 
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Add catalog entry
   @param    catfile     catalog file
   @param    name        name of frame to be added
   @param    ident       IDENT info of frame to be added
   @return 0 iff okay

   Add an entry with given name and identification field to the catalog

   If flag = 1, read each filename from ASCII file 'dirfile.dat',
   else create an empty catalog
**/
/*----------------------------------------------------------------------------*/
int flames_midas_sccadd(cpl_frameset *catfile,
            const char *name,
            const char *ident)
{
  //const char *fits_descr = NULL;
    cpl_frame* frame = NULL;
    //uves_propertylist *header = NULL;

    assure_nomsg( catfile != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( name    != NULL, CPL_ERROR_NULL_INPUT );
    assure_nomsg( ident   != NULL, CPL_ERROR_NULL_INPUT );

    frame = cpl_frame_new();
    cpl_frame_set_filename(frame, name);
    cpl_frame_set_tag(frame, "dummy"); /* need for cpl_frameset_insert() */
    cpl_frameset_insert(catfile, frame);

    /* In principle, we should here update the 
       OBJECT fits card with the provided ident string.
       However this ident string is always a blank. 
       Therefore do not update OBJECT which is very difficult to do with CPL */

    {
        int i = 0;
        while(ident[i] != '\0') {
            assure( ident[i] == ' ', CPL_ERROR_UNSUPPORTED_MODE,
                    "Blank ident string expected. Received '%s'",
                    ident);
            i++;
        }
    }

    /* previously
       cpl_frame_set_tag(frame, ident);
    */

  cleanup: 
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Map MIDAS dtypes to CPL types
   @param    dtype       MIDAS type to convert
   @param    alen        number of array elements
**/
/*----------------------------------------------------------------------------*/
static cpl_type
table_dtype_to_cpltype(int dtype, int alen)
{
    cpl_type type = CPL_TYPE_INVALID;

    /* Only these combinations are used in FLAMES code */
    assure( dtype == D_I4_FORMAT ||
            dtype == D_R8_FORMAT ||
            dtype == D_R4_FORMAT ||
            dtype == D_C_FORMAT, CPL_ERROR_UNSUPPORTED_MODE,
            "dtype = %d", dtype);
    
    assure( dtype == D_C_FORMAT || alen == 1, CPL_ERROR_UNSUPPORTED_MODE,
            "dtype = %d, alen = %d", dtype, alen);
    
    switch(dtype) {
    case D_I4_FORMAT: type = CPL_TYPE_INT; break;
    case D_R4_FORMAT: type = CPL_TYPE_FLOAT; break;
    case D_R8_FORMAT: type = CPL_TYPE_DOUBLE; break;
    case D_C_FORMAT: type = CPL_TYPE_STRING; break;
    default:
        /* impossible */
        passure( false, " ");
        break;
    }    

  cleanup:
    return type;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Get sizeof CPL types
   @param    type       CPL type
   @return   size in bytes
**/
/*----------------------------------------------------------------------------*/
static int
sizeof_cpltype(cpl_type type)
{
    switch(type) {
        /* These correspondences are documented in CPL */
    case CPL_TYPE_INT:    return sizeof(int); break;
    case CPL_TYPE_FLOAT:  return sizeof(float); break;
    case CPL_TYPE_DOUBLE: return sizeof(double); break;
    case CPL_TYPE_STRING: return sizeof(char); break;
    default:
        assure( false, CPL_ERROR_UNSUPPORTED_MODE,
                "Cannot convert CPL type %s", uves_tostring_cpl_type(type));
        break;
    }

  cleanup:
    return 0;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Map CPL types to MIDAS dtypes
   @param    type       CPL type to convert
   @return   dtype
**/
/*----------------------------------------------------------------------------*/
static int
table_cpltype_to_dtype(cpl_type type)
{
    int dtype = -1;
    
    switch(type) {
    case CPL_TYPE_INT:    dtype = D_I4_FORMAT; break;
    case CPL_TYPE_FLOAT:  dtype = D_R4_FORMAT; break;
    case CPL_TYPE_DOUBLE: dtype = D_R8_FORMAT; break;
    case CPL_TYPE_STRING: dtype = D_C_FORMAT; break;
    default:
        assure( false, CPL_ERROR_UNSUPPORTED_MODE,
                "Cannot convert CPL type %s", uves_tostring_cpl_type(type));
        break;
    }

  cleanup:
    return dtype;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Convert table numer to name
   @param    tid         table id
   @param    column      column by number (counting from 1)
   @return  column name, or NULL if not found
**/
/*----------------------------------------------------------------------------*/
static const char *
table_colname_from_number(int tid, int column)
{
    const char *name = NULL;

    passure( invariant(tid), " ");
    
    assure( frame_is_open(tid) && !frames[tid].is_image, CPL_ERROR_ILLEGAL_INPUT,
        "Table %d is not open", tid);
    
    check( load_frame(tid), "Could not load table %s", frames[tid].filename);

    assure( 1 <= column && column <= cpl_table_get_nrow(frames[tid].data.table.colnames),
            CPL_ERROR_ACCESS_OUT_OF_RANGE,
            "Illegal column number %d. Table has %" CPL_SIZE_FORMAT " row(s)",
            column, cpl_table_get_nrow(frames[tid].data.table.colnames));

    name = cpl_table_get_string(frames[tid].data.table.colnames, COLNAME,
                                column - 1);

  cleanup:
    return name;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Open table
   @param    name        table name
   @param    mode        opening mode
   @param    allrow      number of rows to allocate, only for F_O_MODE
   @param    tid         (output) table identifier (try to keep it)
   @return 0 iff okay

   Opens table file according to the desired mode. The opening mode can be
   F_I_MODE for input, F_D_MODE for descriptors only, F_IO_MODE for update.

   Open mode can also be F_O_MODE for output.
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tctopn(const char *name, int mode, int allrow, int *tid)
{
    assure( allrow == -1 || mode == F_O_MODE, CPL_ERROR_INCOMPATIBLE_INPUT,
            "allrow = %d, mode = %d", allrow, mode);

    if (mode == F_I_MODE || mode == F_IO_MODE || mode == F_O_MODE)
    {
        /* Find first open slot */
        int i;
        bool found = false;
        for (i = 0; !found && i < MAX_OPEN; i++)
        {
            if (! frame_is_open(i))
            {
                found = true;
                *tid = i;

                if (mode == F_I_MODE || mode == F_IO_MODE)   /* Input */
                    {
                        frame_new_table(i, name, NULL, false,
                                        NULL, 0, NULL);
                    }
                else if (mode == F_O_MODE)   /* Output */
                    {
                        cpl_table *colnames = cpl_table_new(0);
                        cpl_table_new_column(colnames,
                                             COLNAME, CPL_TYPE_STRING);
                        
                        frame_new_table(i, name, uves_propertylist_new(), true,
                                        cpl_table_new(allrow), 0, colnames);
                        
                    }
                
                uves_msg_debug("Opened table no. %d: %s",
                       i, name);
            }
        }
        
        assure( found, CPL_ERROR_UNSUPPORTED_MODE,
            "Cannot open more than %d table files",
            MAX_OPEN);
    }
    else
    {
        assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");
    }

    passure( invariant(*tid), " ");

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Closes a table
   @param    tid         table identifier
   @return 0 iff okay

**/
/*----------------------------------------------------------------------------*/
int flames_midas_tctclo(int tid)
{
    return frame_close(tid);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Search column by reference
   @param    tid         table id
   @param    colref      column reference
   @param    column      (output) column number
   @return 0 iff okay

   The column may *not* be designated as #number
   or :name, only name.

   Sequential search for the column label. The routine returns the column number
   as the last argument or -1 if the column is not found.
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tccser(int tid, const char *colref, int *column)
{
    bool found;
    int i;

    passure( invariant(tid), " ");

    /* The MIDAS interface supports the following, but there is no reason
       to do that for the FLAMES code */
    assure( colref[0] != ':' &&
            colref[0] != '#', CPL_ERROR_UNSUPPORTED_MODE, "Illegal column name: %s",
            colref);

    assure( frame_is_open(tid) && !frames[tid].is_image, CPL_ERROR_ILLEGAL_INPUT,
        "Table %d is not open", tid);

    check( load_frame(tid), "Could not load table %s", frames[tid].filename);

    *column = -1;
    found = false;
    for (i = 0; i < cpl_table_get_nrow(frames[tid].data.table.colnames) && !found; i++)
        {
            const char *name = cpl_table_get_string(frames[tid].data.table.colnames, COLNAME, i);
            if (strcmp(name, colref) == 0)
                {
                    *column = i + 1; /* counting from 1 */
                    found = true;
                }
    }

    if (!found) 
        {
            uves_msg_warning("Table %s has no column %s",
                             frames[tid].filename, colref);
        }

    passure( invariant(tid), " ");

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Reads table size information
   @param    tid         table id
   @param    column      (output) number of columns
   @param    row         (output) number of rows    
   @return 0 iff okay

**/
/*----------------------------------------------------------------------------*/
int flames_midas_tciget(int tid, int *column, int *row)
{
  //const char *name;

    passure( invariant(tid), " ");

    assure( frame_is_open(tid) && !frames[tid].is_image, CPL_ERROR_ILLEGAL_INPUT,
        "Table %d is not open", tid);

    check( load_frame(tid), "Could not load table %s", frames[tid].filename);

    *column = cpl_table_get_ncol(frames[tid].data.table.table) - 1;
    /* Return actual number of rows, not allocated */
    //*row    = cpl_table_get_nrow(frames[tid].data.table.table);
    *row    = frames[tid].data.table.maxrow;

    passure( invariant(tid), " ");

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Reads binary storage characteristics of column
    @param  tid     table id
    @param  column  column number
    @param  dtype   (output) datatype
    @param  items   (output) array size
    @parma  bytes   (output) storage required
    @return 0 iff okay  

    The routine returns the datatype (one of the D_xx_FORMAT), the number of items
    (arrays), and the number of bytes required for the binary storage.
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcbget(int tid, int column, int *dtype, int *items, int *bytes)
{
    const char *colname;

    check_nomsg( colname = table_colname_from_number(tid, column) );

    check_nomsg( *dtype = table_cpltype_to_dtype(
                     cpl_table_get_column_type(frames[tid].data.table.table, 
                                               colname)) );

    /* Note! 
       This function is only used in flames_create_full_ordertable.c,
       so it only has to work in that case.
    */

    *items = 1;

    if (*dtype == D_C_FORMAT) 
        {
            *bytes = 80 * sizeof_cpltype(
                table_dtype_to_cpltype(*dtype, *items) );
        }
    else 
        {
            *bytes = (*items) * sizeof_cpltype(
                table_dtype_to_cpltype(*dtype, *items) );
        }

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Reads table storage format (F_TRANS or F_RECORD)
    @param  tid     table id
    @param  store   (output) physical format on disk
    @return 0 iff okay  
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcdget(int tid, int *store)
{
    tid=tid; //to remove compilation warning: this is not used
    *store=*store; //to remove compilation warning: this is not used
    assure( false, CPL_ERROR_UNSUPPORTED_MODE, "Implement me");
  cleanup: return 1;
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Reads column format
    @param  tid     table id
    @param  column  column number
    @param  form    (output) column format
    @param  dtype   (output) data type
    @return 0 iff okay  
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcfget(int tid, int column, char *form, int *dtype)
{
    const char *colname;
    const char *format;

    check_nomsg( colname = table_colname_from_number(tid, column));
    
    check_nomsg( *dtype = table_cpltype_to_dtype(
                     cpl_table_get_column_type(frames[tid].data.table.table, colname)));

    check_nomsg( format = cpl_table_get_column_format(frames[tid].data.table.table, colname));

    strcpy(form, format);
    
  cleanup: 
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Reads column label
    @param  tid     table id
    @param  column  column number
    @param  label   (output) label name
    @return 0 iff okay  
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tclget(int tid, int column, char *label)
{
    const char *colname;

    label[0] = '\0';
    check_nomsg( colname = table_colname_from_number(tid, column));

    /* It's up to the caller to allocate enough space */
    strcpy(label, colname);
    
  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Reads column unit
    @param  tid     table id
    @param  column  column number
    @param  unit    (output) unit name
    @return 0 iff okay  
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcuget(int tid, int column, char *unit)
{
    const char *colname;
    const char *u;

    unit[0] = '\0';
    //uves_msg("column=%s \n",column);
    check_nomsg( colname = table_colname_from_number(tid, column));
    check_nomsg( u = cpl_table_get_column_unit(frames[tid].data.table.table, colname));
    assure( u != NULL, CPL_ERROR_ILLEGAL_INPUT, "Column %s unit not set", colname);
    
    strcpy(unit, u);
    
  cleanup: 
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}
/*----------------------------------------------------------------------------*/
/**
    @brief  Searches the sequential number of the column having the given label,
            case insensitive.
    @param  tid     table id
    @param  label   (output) label name
    @param  column  (output) column number (-1 if column not found)
    @return 0 iff okay  
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tclser(int tid, const char *label, int *column)
{
    /* This function seems to be the same as flames_midas_tccser(),
       except that
       flames_midas_tccser() is case sensitive and allows prefixing
       the column name with : or #

       But these subtle differences are not used by the FLAMES code, so
       just call that other function */
    return flames_midas_tccser(tid, label, column);
}

/*----------------------------------------------------------------------------*/
/**
  @brief  Initializes table column
  @param  tid     table id
  @param  dtype   column data type (one of the D_xx_FORMAT)
  @param  alen    number of array elements
  @param  form    column format  (is not used by FLAMES code)
  @param  unit    column unit
  @param  label   column label
  @param  column  (output) column number
  @return 0 iff okay 

  Elements in the column are initialized as undefined (null values).

  Checks if column has been already defined, otherwise add the new column
  descriptors. The routine provides an overflow mechanism when the new column
  exceeds the allocated space
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tccini(int tid, int dtype, int alen, 
                        const char *form, const char *unit, const char *label, 
                        int *column)
{
    cpl_type type;

    passure( invariant(tid), " ");
    
    assure( frame_is_open(tid) && !frames[tid].is_image, CPL_ERROR_ILLEGAL_INPUT,
        "Table %d is not open", tid);
    
    check( load_frame(tid), "Could not load table %s", frames[tid].filename);
    
    check_nomsg( type = table_dtype_to_cpltype(dtype, alen) );

    uves_msg_debug("Creating column %s (unit = %s, format = %s)",
                   label, unit, form);

    /* Create the column */
    assure( !cpl_table_has_column(frames[tid].data.table.table, label),
            CPL_ERROR_ILLEGAL_OUTPUT,
            "Column %s already exists", label);
    cpl_table_new_column       (frames[tid].data.table.table, label, type);
    cpl_table_set_column_format(frames[tid].data.table.table, label, form);
    cpl_table_set_column_unit  (frames[tid].data.table.table, label, unit);

    /* Initialize column to avoid garbage (CPL doesn't initialize NULL elements) */
    switch(type) {
    case CPL_TYPE_INT   : cpl_table_fill_invalid_int   (frames[tid].data.table.table, label, -1); break;
    case CPL_TYPE_FLOAT : cpl_table_fill_invalid_float (frames[tid].data.table.table, label, -1); break;
    case CPL_TYPE_DOUBLE: cpl_table_fill_invalid_double(frames[tid].data.table.table, label, -1); break;
    case CPL_TYPE_STRING: /* Do nothing, already NULL */ break;
    default:
        passure( false, " " );
        break;
    }

    /* Update description of columns */
    *column = cpl_table_get_ncol(frames[tid].data.table.table) - 1;
    cpl_table_set_size  (frames[tid].data.table.colnames, *column);  /* This is O(n^2) in the number of 
                                                             columns (i.e. slow if there are
                                                             many columns, but the CPL table 
                                                             handling is like that anyway. */
    cpl_table_set_string(frames[tid].data.table.colnames, COLNAME, *column-1, label);

    passure( invariant(tid), " ");

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Reads table element
   @param    type        column type
   @param    tid         table id
   @param    row         row number counting from 1
   @param    column      column number
   @param    value       (output) actual values
   @param    null        (output) if non-NULL, null flag
   @return 0 status, error and non-selected. The FLAMES C-code uses the return value
   only to test for error. Therefore only the error status is returned

   Finds the element position and convert data type if required. Only the FIRST
   value is read for arrays
**/
/*----------------------------------------------------------------------------*/
static int
tcerd(cpl_type type, int tid, int row, int column,
      void *value, int *null)
{
    const char *colname;
    const char *val_str;

    check_nomsg( colname = table_colname_from_number(tid, column));

    /* Check disabled, allow type conversion 
    assure( cpl_table_get_column_type(frames[tid].data.table.table, colname)
            == type, CPL_ERROR_TYPE_MISMATCH, "Column %s type is %s, type %s expected",
            colname, uves_tostring_cpl_type(cpl_table_get_column_type(frames[tid].data.table.table, colname)),
            uves_tostring_cpl_type(type) );
    */

    assure( 1 <= row && row <= cpl_table_get_nrow(frames[tid].data.table.table),
            CPL_ERROR_ACCESS_OUT_OF_RANGE,
            "Cannot read row %d of %" CPL_SIZE_FORMAT " row table",
            row, cpl_table_get_nrow(frames[tid].data.table.table));

    switch(type) {
    case CPL_TYPE_INT:
        ((int *)value)[0] = cpl_table_get(frames[tid].data.table.table,
                                          colname, row - 1,
                                          null);
        break;
    case CPL_TYPE_FLOAT:
        ((float *)value)[0] = cpl_table_get(frames[tid].data.table.table,
                                            colname, row - 1,
                                            null);
        break;
    case CPL_TYPE_DOUBLE:
        ((double *)value)[0] = cpl_table_get(frames[tid].data.table.table,
                                             colname, row - 1,
                                             null);
        break;
    case CPL_TYPE_STRING:
        val_str = cpl_table_get_string(frames[tid].data.table.table,
                                       colname, row - 1);
        if (val_str == NULL)
            {
                if (null != NULL) *null = 1;
                ((char *)value)[0] = '\0';
            }
        else
            {
                if (null != NULL) *null = 0;
                strcpy((char *)value, val_str);
            }
        break;
    default:
        assure( false, CPL_ERROR_INVALID_TYPE, "Type is %s", uves_tostring_cpl_type(type));
        break;
    }

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @see tcerd

   Finds the element position and convert data type if required. Arrays are
   edited with a comma between elements.
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcerdc(int tid, int row, int column, char *values, int *null)
{
    return tcerd(CPL_TYPE_STRING, tid, row, column, values, null);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcerd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcerdi(int tid, int row, int column, int *value, int *null)
{
    return tcerd(CPL_TYPE_INT, tid, row, column, value, null);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcerd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcerdr(int tid, int row, int column, float *value, int *null)
{
    return tcerd(CPL_TYPE_FLOAT, tid, row, column, value, null);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcerd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcerdd(int tid, int row, int column,
            double *value, int *null)
{
    return tcerd(CPL_TYPE_DOUBLE, tid, row, column, value, null);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Write table element
   @param    type    column type
   @param    tid     table id
   @param    row     row number
   @param    column  column number
   @param    value   actual value

   Finds the element position and convert data type if required. Only the FIRST
   value is written for arrays
**/
/*----------------------------------------------------------------------------*/
static int tcewr(cpl_type type, int tid, int row, int column, const void *value)
{
    const char *colname;
    
    check_nomsg( colname = table_colname_from_number(tid, column));
    
    /* Check disabled, allow type mismatch and conversion (as in MIDAS)
    assure( cpl_table_get_column_type(frames[tid].data.table.table, colname)
            == type, CPL_ERROR_TYPE_MISMATCH, "Column %s has type %s; %s expected",
            colname, uves_tostring_cpl_type(cpl_table_get_column_type(frames[tid].data.table.table, colname)),
            uves_tostring_cpl_type(type) );
    */

    assure( row <= cpl_table_get_nrow(frames[tid].data.table.table),
            CPL_ERROR_ACCESS_OUT_OF_RANGE,
            "Cannot write row %d from %" CPL_SIZE_FORMAT " row table",
            row, cpl_table_get_nrow(frames[tid].data.table.table));

    if (row > frames[tid].data.table.maxrow) {
        frames[tid].data.table.maxrow = row;
    }

    switch(type) {
    case CPL_TYPE_INT:    
        cpl_table_set(frames[tid].data.table.table, colname, row - 1, ((const int *)value)[0]); 
        break;
    case CPL_TYPE_FLOAT:
        cpl_table_set(frames[tid].data.table.table, colname, row - 1, ((const float *)value)[0]); 
        break;
    case CPL_TYPE_DOUBLE: 
        cpl_table_set(frames[tid].data.table.table, colname, row - 1, ((const double *)value)[0]); 
        break;
    case CPL_TYPE_STRING:
        cpl_table_set_string(frames[tid].data.table.table, colname, row - 1, (const char *)value); 
        break;
    default:
        assure( false, CPL_ERROR_INVALID_TYPE, "Type is %s", uves_tostring_cpl_type(type));
        break;
    }

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @see tcewr

   Finds the element position and convert data type if required. Element in an
   array must be separated by comma
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcewrc(int tid, int row, int column, const char *value)
{
    /* Write full string, including commas */
    return tcewr(CPL_TYPE_STRING, tid, row, column, value);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcewr
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcewrd(int tid, int row, int column, const double *value)
{
    return tcewr(CPL_TYPE_DOUBLE, tid, row, column, value);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcewr
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcewri(int tid, int row, int column, const int *value)
{
    return tcewr(CPL_TYPE_INT, tid, row, column, value);
}
/*----------------------------------------------------------------------------*/
/**
   @see tcewr
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcewrr(int tid, int row, int column, const float *value)
{
    return tcewr(CPL_TYPE_FLOAT, tid, row, column, value);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcerd
**/
/*----------------------------------------------------------------------------*/
static int
tcard(cpl_type type, int tid, int row, int column,
      int index, int items, void *value)
{
    assure( index == 1 && (
                type == CPL_TYPE_STRING ||
                items == 1),
            CPL_ERROR_UNSUPPORTED_MODE,
            "index, items = %d, %d", index, items);

    return tcerd(type, tid, row, column, value, NULL);

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Reads table elements as a character string. Arrays are edited with
             a comma between elements
   @param    tid         table id
   @param    row         row number
   @param    col         column number
   @param    index       index number
   @param    items       how many
   @param    value       (out) actual values
   @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcardc(int tid, int row, int col, int index, int items, char *value)
{
    return tcard(CPL_TYPE_STRING, tid, row, col, index, items, value);
}

/*----------------------------------------------------------------------------*/
/**
   @brief    Reads table elements as a double precision value
   @param    tid         table id
   @param    row         row number
   @param    col         column number
   @param    index       index number
   @param    items       how many
   @param    value       (out) actual values
   @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcardd(int tid, int row, int col, int index, int items, double *value)
{
    return tcard(CPL_TYPE_DOUBLE, tid, row, col, index, items, value);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcardd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcardi(int tid, int row, int col, int index, int items, int *value)
{
    return tcard(CPL_TYPE_INT, tid, row, col, index, items, value);
}

/*----------------------------------------------------------------------------*/
/**
   @see tcardd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcardr(int tid, int row, int col, int index, int items, float *value)
{
    return tcard(CPL_TYPE_FLOAT, tid, row, col, index, items, value);
}


/*----------------------------------------------------------------------------*/
/**
   @see tcewr
**/
/*----------------------------------------------------------------------------*/
static int
tcawr(cpl_type type, int tid, int row, int col, int index, int items, const void *value)
{
    assure( index == 1 && (
                type == CPL_TYPE_STRING ||
                items == 1),
            CPL_ERROR_UNSUPPORTED_MODE,
            "index, items = %d, %d", index, items);
    
    return tcewr(type, tid, row, col, value);
    
  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Writes table element, character string format
    @param    tid         table id
    @param    row         row number
    @param    col         column number
    @param    index       index number
    @param    items       how many
    @param    value       (out) actual value
    @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcawrc(int tid, int row, int col, int index, int items, const char *value)
{
    return tcawr(CPL_TYPE_STRING, tid, row, col, index, items, value);
}
/*----------------------------------------------------------------------------*/
/**
    @brief   Writes table element, double precision argument
    @param    tid         table id
    @param    row         row number
    @param    col         column number
    @param    index       index number
    @param    items       how many
    @param    value       (out) actual value
    @return 0 iff okay
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcawrd(int tid, int row, int col, int index, int items, const double *value)
{
    return tcawr(CPL_TYPE_DOUBLE, tid, row, col, index, items, value);
}
/*----------------------------------------------------------------------------*/
/**
    @see tcawrd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcawri(int tid, int row, int col, int index, int items, const int *value)
{
    return tcawr(CPL_TYPE_INT, tid, row, col, index, items, value);
}

/*----------------------------------------------------------------------------*/
/**
    @see tcawrd
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcawrr(int tid, int row, int col, int index, int items, const float *value)
{
    return tcawr(CPL_TYPE_FLOAT, tid, row, col, index, items, value);
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Reads row selection flag
    @param  tid     table id
    @param  row     row number
    @param  value   (output) selection flag (1 if selected)
    @return 0 iff okay 
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcsget(int tid, int row, int *value)
{
    passure( invariant(tid), " ");
    
    assure( frame_is_open(tid) && !frames[tid].is_image, CPL_ERROR_ILLEGAL_INPUT,
        "Table %d is not open", tid);
    
    check( load_frame(tid), "Could not load table %s", frames[tid].filename);

    assure( 1 <= row && row <= cpl_table_get_nrow(frames[tid].data.table.table),
            CPL_ERROR_ACCESS_OUT_OF_RANGE,
            "Cannot read row %d  of %" CPL_SIZE_FORMAT " row table %s", row,
            cpl_table_get_nrow(frames[tid].data.table.table),
            frames[tid].filename);

    *value = cpl_table_get_int(frames[tid].data.table.table,
                               "Select",
                               row - 1, NULL);

  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/*----------------------------------------------------------------------------*/
/**
    @brief  Writes row selection flag
    @param  tid     table id
    @param  row     row number
    @param  value   selection flag (1 if selected)
    @return 0 iff okay 
**/
/*----------------------------------------------------------------------------*/
int flames_midas_tcsput(int tid, int row, const int *value)
{
    passure( invariant(tid), " ");
    
    assure( frame_is_open(tid) && !frames[tid].is_image, CPL_ERROR_ILLEGAL_INPUT,
        "Table %d is not open", tid);
    
    check( load_frame(tid), "Could not load table %s", frames[tid].filename);

    assure( 1 <= row && row <= cpl_table_get_nrow(frames[tid].data.table.table),
            CPL_ERROR_ACCESS_OUT_OF_RANGE,
            "Cannot write to row %d of %" CPL_SIZE_FORMAT " row table %s", row,
            cpl_table_get_nrow(frames[tid].data.table.table),
            frames[tid].filename);

    cpl_table_set_int(frames[tid].data.table.table, "Select", row - 1, *value);


    if (row > frames[tid].data.table.maxrow) {
        frames[tid].data.table.maxrow = row;
    }
  cleanup:
    return (cpl_error_get_code() == CPL_ERROR_NONE) ? 0 : 1;
}

/**@}*/