/*===========================================================================
  Copyright (C) 2001 European Southern Observatory (ESO)
 
  This program is free software; you can redistribute it and/or 
  modify it under the terms of the GNU General Public License as 
  published by the Free Software Foundation; either version 2 of 
  the License, or (at your option) any later version.
 
  This program is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.
 
  You should have received a copy of the GNU General Public 
  License along with this program; if not, write to the Free 
  Software Foundation, Inc., 675 Massachusetss Ave, Cambridge, 
  MA 02139, USA.
 
  Corresponding concerning ESO-MIDAS should be addressed as follows:
    Internet e-mail: midas@eso.org
    Postal address: European Southern Observatory
            Data Management Division 
            Karl-Schwarzschild-Strasse 2
            D 85748 Garching bei Muenchen 
            GERMANY
===========================================================================*/
/* Program  : writeallff.c                                                 */
/* Author   : G. Mulas  -  ITAL_FLAMES Consortium                          */
/* Date     :                                                              */
/*                                                                         */
/* Purpose  : Missing                                                      */
/*                                                                         */
/*                                                                         */
/* Input:  see interface                                                   */ 
/*                                                                      */
/* Output:                                                              */
/*                                                                         */
/* DRS Functions called:                                                   */
/* none                                                                    */ 
/*                                                                         */ 
/* Pseudocode:                                                             */
/* Missing                                                                 */ 
/*                                                                         */ 
/* Version  :                                                              */
/* Last modification date: 2002/08/05                                      */
/* Who     When        Why                Where                            */
/* AMo     02-08-05   Add header         header                            */
/*-------------------------------------------------------------------------*/

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

#include <stdlib.h>
#include <string.h>
#include <stdio.h>
#include <math.h>
#include <flames_writeallff.h>
#include <flames_midas_def.h>
#include <flames_uves.h>
#include <flames_newmatrix.h>




flames_err writeallff(allflats *myflats, 
                      const char *basename, 
                      cpl_frameset ** catname)
{

    int status=0;
    int unit=0;
    int null=0;
    int oldfileid=0;
    int dataid=0;
    int sigmaid=0;
    int badid=0;
    int commid=0;
    int normid=0;
    int nsigid=0;
    int32_t iframe=0;
    int32_t ifibre=0;
    int32_t ****longarray=0;
    char filename[CATREC_LEN+1];
    char dummychar[CATREC_LEN+1];
    float lhcuts[4]={0,0,0,0};
    int ibuf[4]={0,0,0,0};
    int *fibres=0;
    double dbuf[4]={0,0,0,0};
    char blank[]="     ";
    char cunit[81];

    frame_data *fdvecbuf1=0;
    frame_mask *fmvecbuf1=0;
    int32_t *lvecbuf1=0;
    int32_t iyixend=0;
    int32_t iorderifibreixend=0;
    int32_t iiorderifibreixend=0;
    int32_t iyixindex=0;
    int32_t iorderifibreixindex=0;
    int32_t iiorderifibreixindex=0;


    singleflat *currentflat=0;

    memset(filename, '\0', CATREC_LEN+1);
    memset(dummychar, '\0', CATREC_LEN+1);
    memset(cunit, '\0', 81);

    iyixend = myflats->subrows*myflats->subcols-1;
    iorderifibreixend = ((myflats->lastorder-myflats->firstorder+1)*
                    myflats->maxfibres*myflats->subcols)-1;
    iiorderifibreixend = (3*(myflats->lastorder-myflats->firstorder+1)*
                    myflats->maxfibres*myflats->subcols)-1;

    fibres = ivector(0,(int32_t)myflats->maxfibres-1);
    /* create the empty catalog catname */
    if ((status = SCCCRE(catname, F_IMA_TYPE, 0)) != 0) {
        /* could not create the catalog: complain... */
        return(MAREMMA);
    }

    /* run a loop over the flat frames */
    for(iframe=0; iframe<=myflats->nflats-1; iframe++) {
        currentflat = myflats->flatdata+iframe;
        /* open the old frame from which the descriptors must be copied */
        if ((status = SCFOPN(currentflat->framename, FLAMESDATATYPE,
                        0, F_IMA_TYPE, &oldfileid)) != 0) {
            /* could not open the file */
            return(MAREMMA);
        }

        /* data frame */
        /* create the filename */
        sprintf(filename,"%s_data%02d.fits",basename,iframe+1);
        /* create the normalised data frame on disk */
        if ((status = SCFCRE(filename, FLAMESDATATYPE, F_O_MODE, F_IMA_TYPE,
                        myflats->subrows*myflats->subcols, &dataid))
                        != 0) {
            /* could not create the file */
            return(MAREMMA);
        }
        /* copy the descriptors from the old frame to the normalised frame */
        if ((status = SCDCOP(oldfileid, dataid, 1)) != 0) {
            /* I could not copy the descriptors: complain... */
            return(MAREMMA);
        }
        /* find out and write LHCUTS */
        fdvecbuf1 = currentflat->data[0];
        lhcuts[0] = lhcuts[1] = 0;
        lhcuts[2] = lhcuts[3] = (float) fdvecbuf1[0];
        for (iyixindex=1; iyixindex<=iyixend; iyixindex++) {
            if (fdvecbuf1[iyixindex] < lhcuts[2]) {
                lhcuts[2] = (float) fdvecbuf1[iyixindex];
            }
            if (fdvecbuf1[iyixindex] > lhcuts[3]) {
                lhcuts[3] = (float) fdvecbuf1[iyixindex];
            }
        }
        if ((status = SCDWRR(dataid, "LHCUTS", lhcuts, 1, 4, &unit)) != 0) {
            /* error writing LHCUTS */
            return(MAREMMA);
        }
        /* write the IDENT descriptor */
        if ((status = SCDWRC(dataid, "IDENT", 1, "Cleaned fibre FF", 1,
                        CATREC_LEN+1, &null)) != 0) {
            /* I could not write the descriptor: complain... */
            return(MAREMMA);
        }
        /* add the name of this frame to the catalog */
        if ((status = SCCADD(*catname, filename, blank)) != 0) {
            /* coud not add filename to the catalog: complain */
            return(MAREMMA);
        }
        /* actually write the data frame to the new file*/
        if ((status = SCFPUT(dataid, 1, myflats->subrows*myflats->subcols,
                        (char *)fdvecbuf1)) != 0) {
            /* I could not write the data to disk: complain... */
            return(MAREMMA);
        }
        ibuf[0] = myflats->flatdata[iframe].numfibres;
        /* write the descriptors which are specific to each fibre FF frame */
        if ((status = SCDWRD(dataid, "YSHIFT", &(currentflat->yshift),
                        1, 1, &unit)) != 0) {
            /* error writing YSHIFT */
            return(MAREMMA);
        }
        if ((status = SCDWRI(dataid, "NUMFIBRES", ibuf, 1, 1, &unit)) != 0) {
            /* error writing NUMFIBRES */
            return(MAREMMA);
        }
        for(ifibre=0; ifibre<=(currentflat->numfibres-1); ifibre++){
            fibres[ifibre] = (int) currentflat->fibres[ifibre];
        }
        for(; ifibre<=myflats->maxfibres-1; ifibre++){
            fibres[ifibre] = 0;
        }
        if ((status = SCDWRI(dataid, "FIBRES", fibres, 1, myflats->maxfibres,
                        &unit)) != 0) {
            /* error writing NUMFIBRES */
            return(MAREMMA);
        }

        /* sigma frame */
        /* create the filename */
        sprintf(filename,"%s_sigma%02d.fits",basename,iframe+1);
        /* create the new sigma frame on disk */
        if ((status = SCFCRE(filename, FLAMESDATATYPE, F_O_MODE, F_IMA_TYPE,
                        myflats->subrows*myflats->subcols, &sigmaid))
                        != 0) {
            /* could not create the file */
            return(MAREMMA);
        }
        /* write the name of the sigma file as a descriptor of the data frame */
        if ((status = SCDWRC(dataid, "SIGMAFILE", 1, filename, 1, CATREC_LEN+1,
                        &null)) != 0) {
            /* I could not write the descriptor: complain... */
            return(MAREMMA);
        }
        /* copy the descriptors from the old frame to the sigma frame */
        if ((status = SCDCOP(oldfileid, sigmaid, 1)) != 0) {
            /* I could not copy the descriptors: complain... */
            return(MAREMMA);
        }
        /* find out and write LHCUTS */
        fdvecbuf1 = currentflat->sigma[0];
        lhcuts[0] = lhcuts[1] = 0;
        lhcuts[2] = lhcuts[3] = (float) fdvecbuf1[0];
        for (iyixindex=1; iyixindex<=iyixend; iyixindex++) {
            if (fdvecbuf1[iyixindex] < lhcuts[2]) {
                lhcuts[2] = (float) fdvecbuf1[iyixindex];
            }
            if (fdvecbuf1[iyixindex] > lhcuts[3]) {
                lhcuts[3] = (float) fdvecbuf1[iyixindex];
            }
        }
        if ((status = SCDWRR(sigmaid, "LHCUTS", lhcuts, 1, 4, &unit)) != 0) {
            /* error writing LHCUTS */
            return(MAREMMA);
        }
        /* actually write the sigma frame to the new file*/
        if ((status = SCFPUT(sigmaid, 1, myflats->subrows*myflats->subcols,
                        (char*) fdvecbuf1)) != 0) {
            /* I could not write the data to disk: complain... */
            return(MAREMMA);
        }
        /* close the sigma frame */
        if ((status = SCFCLO(sigmaid)) != 0) {
            /* I could not close the data file: complain... */
            return(MAREMMA);
        }

        /* badpixel frame */
        /* create the filename */
        sprintf(filename,"%s_badpixel%02d.fits",basename,iframe+1);
        /* create the badpixel frame on disk */
        if ((status = SCFCRE(filename, FLAMESMASKTYPE, F_O_MODE, F_IMA_TYPE,
                        myflats->subrows*myflats->subcols, &badid))
                        != 0) {
            /* could not create the file */
            return(MAREMMA);
        }
        /* write the name of the badpixel file as a descriptor of the data frame */
        if ((status = SCDWRC(dataid, "BADPIXELFILE", 1, filename, 1, CATREC_LEN+1,
                        &null)) != 0) {
            /* I could not write the descriptor: complain... */
            return(MAREMMA);
        }
        /* copy the descriptors from the old frame to the badpixel frame */
        if ((status = SCDCOP(oldfileid, badid, 1)) != 0) {
            /* I could not copy the descriptors: complain... */
            return(MAREMMA);
        }
        /* find out and write LHCUTS */
        lhcuts[0] = lhcuts[1] = lhcuts[2] = 0;
        lhcuts[3] = 1;
        if ((status = SCDWRR(badid, "LHCUTS", lhcuts, 1, 4, &unit)) != 0) {
            /* error writing LHCUTS */
            return(MAREMMA);
        }
        /* actually write the badpixel frame to the new file*/
        if ((status = SCFPUT(badid, 1, myflats->subrows*myflats->subcols,
                        currentflat->badpixel[0])) != 0) {
            /* I could not write the data to disk: complain... */
            return(MAREMMA);
        }
        /* close the badpixel frame */
        if ((status = SCFCLO(badid)) != 0) {
            /* I could not close the data file: complain... */
            return(MAREMMA);
        }

        /* additional data should be already present as descriptors of the
       data frame, since all old descriptors were copied */

        /* close the data frame */
        if ((status = SCFCLO(dataid)) != 0) {
            /* I could not close the data file: complain... */
            return(MAREMMA);
        }

        /* close the old frame */
        if ((status = SCFCLO(oldfileid)) != 0) {
            /* I could not close the old file: complain... */
            return(MAREMMA);
        }
    }

    /* now proceed to the data which are not in the slit member of the
     structure */
    /* I will need to separate the normalisation factors, as they are of
     double type*/
    sprintf(filename,"%s_norm.fits",basename);
    /* create the frame on disk */
    if ((status =
                    SCFCRE(filename, FLAMESDATATYPE, F_O_MODE, F_IMA_TYPE,
                                    (myflats->lastorder-myflats->firstorder+1)*myflats->maxfibres*
                                    myflats->subcols, &normid)) != 0) {
        /* could not create the file */
        return(MAREMMA);
    }
    /* write the 3D array to file */
    fdvecbuf1 = myflats->normfactors[0][0];
    if ((status =
                    SCFPUT(normid, 1,
                                    (myflats->lastorder-myflats->firstorder+1)*myflats->maxfibres*
                                    myflats->subcols,
                                    (char *) fdvecbuf1)) != 0) {
        /* I could not write this big frame to disk: complain... */
        return(MAREMMA);
    }
    /* write the standard descriptors */
    ibuf[0] = 3;
    if ((status = SCDWRI(normid, "NAXIS", ibuf, 1, 1, &unit)) != 0) {
        /* error writing NAXIS */
        return(MAREMMA);
    }
    ibuf[0] = (int) myflats->subcols;
    ibuf[1] = (int) myflats->maxfibres;
    ibuf[2] = (int) (myflats->lastorder-myflats->firstorder+1);
    if ((status = SCDWRI(normid, "NPIX", ibuf, 1, 3, &unit)) != 0) {
        /* error writing NPIX */
        return(MAREMMA);
    }
    dbuf[0] = myflats->substartx;
    dbuf[1] = (double) 0;
    dbuf[2] = (double) myflats->firstorder;
    if ((status = SCDWRD(normid, "START", dbuf, 1, 3, &unit)) != 0) {
        /* error writing START */
        return(MAREMMA);
    }
    dbuf[0] = myflats->substepx;
    dbuf[1] = 1;
    dbuf[2] = 1;
    if ((status = SCDWRD(normid, "STEP", dbuf, 1, 3, &unit)) != 0) {
        /* error writing START */
        return(MAREMMA);
    }
    /* initialise CUNIT an LHCUTS, otherwise MIDAS will complain*/
    memset(cunit, ' ', 16);
    cunit[16] = '\0';
    strncat(cunit, "PIXEL           ", 16);
    strncat(cunit, "FIBRE           ", 16);
    strncat(cunit, "ORDER           ", 16);
    /* write the CUNIT descriptor */
    if ((status = SCDWRC(normid, "CUNIT", 1, cunit, 1, 64, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    lhcuts[0] = lhcuts[1] = 0;
    lhcuts[2] = lhcuts[3] = fdvecbuf1[0];
    for (iorderifibreixindex=1; iorderifibreixindex<=iorderifibreixend;
                    iorderifibreixindex++) {
        if (fdvecbuf1[iorderifibreixindex]<lhcuts[2]) {
            lhcuts[2] = fdvecbuf1[iorderifibreixindex];
        }
        if (fdvecbuf1[iorderifibreixindex]>lhcuts[3]) {
            lhcuts[3] = fdvecbuf1[iorderifibreixindex];
        }
    }
    /* write the LHCUTS descriptor */
    if ((status = SCDWRR(normid, "LHCUTS", lhcuts, 1, 4, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    /* write the IDENT descriptor */
    if ((status = SCDWRC(normid, "IDENT", 1, "Normalisation data for fibre FF",
                    1, CATREC_LEN+1, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    /* write the name of this file to the output catalog */
    if ((status = SCCADD(*catname, filename, blank)) != 0) {
        /* coud not add filename to the catalog: complain */
        return(MAREMMA);
    }

    /* close this frame */
    if ((status = SCFCLO(normid)) != 0) {
        /* error closing common frame: complain */
        return(MAREMMA);
    }

    /* now the normsigma factors, this is almost the same as the normfactors */
    sprintf(filename,"%s_nsigma.fits",basename);
    /* create the frame on disk */
    if ((status =
                    SCFCRE(filename, FLAMESDATATYPE, F_O_MODE, F_IMA_TYPE,
                                    (myflats->lastorder-myflats->firstorder+1)*myflats->maxfibres*
                                    myflats->subcols, &nsigid)) != 0) {
        /* could not create the file */
        return(MAREMMA);
    }
    fdvecbuf1 = myflats->normsigmas[0][0];
    /* write the 3D array to file */
    if ((status = SCFPUT(nsigid, 1, (myflats->lastorder-myflats->firstorder+1)*
                    myflats->maxfibres*myflats->subcols,
                    (char *) fdvecbuf1)) != 0) {
        /* I could not write this big frame to disk: complain... */
        return(MAREMMA);
    }
    /* write the standard descriptors */
    ibuf[0] = 3;
    if ((status = SCDWRI(nsigid, "NAXIS", ibuf, 1, 1, &unit)) != 0) {
        /* error writing NAXIS */
        return(MAREMMA);
    }
    ibuf[0] = (int) myflats->subcols;
    ibuf[1] = (int) myflats->maxfibres;
    ibuf[2] = (int) (myflats->lastorder-myflats->firstorder+1);
    if ((status = SCDWRI(nsigid, "NPIX", ibuf, 1, 3, &unit)) != 0) {
        /* error writing NPIX */
        return(MAREMMA);
    }
    dbuf[0] = myflats->substartx;
    dbuf[1] = (double) 0;
    dbuf[2] = (double) myflats->firstorder;
    if ((status = SCDWRD(nsigid, "START", dbuf, 1, 3, &unit)) != 0) {
        /* error writing START */
        return(MAREMMA);
    }
    dbuf[0] = myflats->substepx;
    dbuf[1] = 1;
    dbuf[2] = 1;
    if ((status = SCDWRD(nsigid, "STEP", dbuf, 1, 3, &unit)) != 0) {
        /* error writing START */
        return(MAREMMA);
    }
    /* initialise CUNIT an LHCUTS, otherwise MIDAS will complain*/
    memset(cunit, ' ', 16);
    cunit[16] = '\0';
    strncat(cunit, "PIXEL           ", 16);
    strncat(cunit, "FIBRE           ", 16);
    strncat(cunit, "ORDER           ", 16);
    /* write the CUNIT descriptor */
    if ((status = SCDWRC(nsigid, "CUNIT", 1, cunit, 1, 64, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    lhcuts[0] = lhcuts[1] = 0;
    lhcuts[2] = lhcuts[3] = fdvecbuf1[0];
    for (iorderifibreixindex=1; iorderifibreixindex<=iorderifibreixend;
                    iorderifibreixindex++) {
        if (fdvecbuf1[iorderifibreixindex] < lhcuts[2]) {
            lhcuts[2] = fdvecbuf1[iorderifibreixindex];
        }
        if (fdvecbuf1[iorderifibreixindex] > lhcuts[3]) {
            lhcuts[3] = fdvecbuf1[iorderifibreixindex];
        }
    }
    /* write the LHCUTS descriptor */
    if ((status = SCDWRR(nsigid, "LHCUTS", lhcuts, 1, 4, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    /* write the IDENT descriptor */
    if ((status = SCDWRC(nsigid, "IDENT", 1,
                    "Normalisation sigmas for fibre FF",
                    1, CATREC_LEN+1, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    /* write the name of this file to the output catalog */
    if ((status = SCCADD(*catname, filename, blank)) != 0) {
        /* coud not add filename to the catalog: complain */
        return(MAREMMA);
    }

    /* close this frame */
    if ((status = SCFCLO(nsigid)) != 0) {
        /* error closing common frame: complain */
        return(MAREMMA);
    }

    /* now proceed to the last part, the data which are contained in
     goodfibres, lowfibrebounds and highfibrebounds */
    /* concoct a name for this pixel-order-fibre frame which will hold
     lowfibrebounds (first layer), highfibrebounds (second layer) and
     goodfibres (third layer) */
    sprintf(filename,"%s_common.fits",basename);
    /* create this frame on disk */
    if ((status =
                    SCFCRE(filename, D_I4_FORMAT, F_O_MODE, F_IMA_TYPE,
                                    3*(myflats->lastorder-myflats->firstorder+1)*
                                    myflats->maxfibres*myflats->subcols, &commid)) != 0) {
        /* could not create the file */
        return(MAREMMA);
    }
    /* build the 4D array to be dumped to disk */
    /* allocate the memory */
    longarray = l4tensor(0, 2, 0, myflats->lastorder-myflats->firstorder,
                    0, myflats->maxfibres-1, 0, myflats->subcols-1);
    /* fill the 4D array: use memcpy for the fibre bounds, which are already
     of the right data type, and a linearised loop for the mask, which needs
     to be cast into a int32_t before copying */
    memcpy(longarray[0][0][0], myflats->lowfibrebounds[0][0],
           (myflats->lastorder-myflats->firstorder+1)*myflats->maxfibres*
           myflats->subcols*sizeof(int32_t));
    memcpy(longarray[1][0][0], myflats->highfibrebounds[0][0],
           (myflats->lastorder-myflats->firstorder+1)*myflats->maxfibres*
           myflats->subcols*sizeof(int32_t));
    lvecbuf1 = longarray[2][0][0];
    fmvecbuf1 = myflats->goodfibres[0][0];
    for (iorderifibreixindex=0; iorderifibreixindex<=iorderifibreixend;
                    iorderifibreixindex++) {
        lvecbuf1[iorderifibreixindex] = (int32_t) fmvecbuf1[iorderifibreixindex];
    }
    /* write the 4D array to file */
    lvecbuf1 = longarray[0][0][0];
    if ((status =
                    SCFPUT(commid, 1, 3*(1+myflats->lastorder-myflats->firstorder)*
                                    myflats->maxfibres*myflats->subcols,
                                    (char *) lvecbuf1)) != 0) {
        /* I could not write this big frame to disk: complain... */
        return(MAREMMA);
    }
    /* initialise LHCUTS */
    lhcuts[0] = lhcuts[1] = 0;
    lhcuts[2] = lhcuts[3] = (float) lvecbuf1[0];
    for (iiorderifibreixindex=1; iiorderifibreixindex<=iiorderifibreixend;
                    iiorderifibreixindex++) {
        if ((float)lvecbuf1[iiorderifibreixindex] < lhcuts[2]) {
            lhcuts[2] = (float)lvecbuf1[iiorderifibreixindex];
        }
        if ((float)lvecbuf1[iiorderifibreixindex] > lhcuts[3]) {
            lhcuts[3] = (float)lvecbuf1[iiorderifibreixindex];
        }
    }
    /* free the 4D array */
    free_l4tensor(longarray, 0, 2, 0, myflats->lastorder-myflats->firstorder,
                  0, myflats->maxfibres-1, 0, myflats->subcols-1);
    /* write the standard descriptors */
    ibuf[0] = 4;
    if ((status = SCDWRI(commid, "NAXIS", ibuf, 1, 1, &unit)) != 0) {
        /* error writing NAXIS */
        return(MAREMMA);
    }
    ibuf[0] = (int) (myflats->subcols);
    ibuf[1] = (int) (myflats->maxfibres);
    ibuf[2] = (int) (myflats->lastorder-myflats->firstorder+1);
    ibuf[3] = 3;
    if ((status = SCDWRI(commid, "NPIX", ibuf, 1, 4, &unit)) != 0) {
        /* error writing NPIX */
        return(MAREMMA);
    }
    dbuf[0] = myflats->substartx;
    dbuf[1] = 0;
    dbuf[2] = (double) myflats->firstorder;
    dbuf[3] = 0;
    if ((status = SCDWRD(commid, "START", dbuf, 1, 4, &unit)) != 0) {
        /* error writing START */
        return(MAREMMA);
    }
    dbuf[0] = myflats->substepx;
    dbuf[1] = 1;
    dbuf[2] = 1;
    dbuf[3] = 1;
    if ((status = SCDWRD(commid, "STEP", dbuf, 1, 4, &unit)) != 0) {
        /* error writing START */
        return(MAREMMA);
    }
    /* initialise CUNIT */
    memset(cunit, ' ', 16);
    cunit[16] = '\0';
    strncat(cunit, "PIXEL           ", 16);
    strncat(cunit, "FIBRE           ", 16);
    strncat(cunit, "ORDER           ", 16);
    strncat(cunit, "TYPE            ", 16);
    /* write the CUNIT descriptor */
    if ((status = SCDWRC(commid, "CUNIT", 1, cunit, 1, 80, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    /* write LHCUTS */
    if ((status = SCDWRR(commid, "LHCUTS", lhcuts, 1, 4, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    /* write the IDENT descriptor */
    if ((status = SCDWRC(commid, "IDENT", 1, "Common data for fibre FF", 1,
                    CATREC_LEN+1, &null)) != 0) {
        /* I could not write the descriptor: complain... */
        return(MAREMMA);
    }
    /* write the name of this file to the output catalog */
    if ((status = SCCADD(*catname, filename, blank)) != 0) {
        /* coud not add filename to the catalog: complain */
        return(MAREMMA);
    }
    /* write the other scalars in the slitflats structure to descriptors
     in the common frame */
    ibuf[0] = (int) myflats->nflats;
    if ((status = SCDWRI(commid, "NFLATS", &ibuf[0], 1, 1, &unit))
                    != 0) {
        /* error writing NFLATS */
        return(MAREMMA);
    }
    ibuf[0] = (int) myflats->subrows;
    if ((status = SCDWRI(commid, "ROWS", &ibuf[0], 1, 1, &unit))
                    != 0) {
        /* error writing ROWS */
        return(MAREMMA);
    }
    ibuf[0] = (int) myflats->subcols;
    if ((status = SCDWRI(commid, "COLS", &ibuf[0], 1, 1, &unit))
                    != 0) {
        /* error writing COLS */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "STARTX", &myflats->substartx, 1, 1, &unit))
                    != 0) {
        /* error writing STARTX */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "STARTY", &myflats->substarty, 1, 1, &unit))
                    != 0) {
        /* error writing STARTY */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "STEPX", &myflats->substepx, 1, 1, &unit))
                    != 0) {
        /* error writing STEPX */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "STEPY", &myflats->substepy, 1, 1, &unit))
                    != 0) {
        /* error writing STEPY */
        return(MAREMMA);
    }
    if ((status = SCDWRC(commid, "CHIPCHOICE", 1, &myflats->chipchoice, 1, 1,
                    &unit)) != 0) {
        /* error writing chipchoice */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "RON", &myflats->ron, 1, 1, &unit)) != 0) {
        /* error writing RON */
        return(MAREMMA);
    }

    if ((status = SCDWRD(commid, "GAIN", &myflats->gain, 1, 1, &unit)) != 0) {
        /* error writing GAIN */
        return(MAREMMA);
    }

    ibuf[0] = (int)myflats->firstorder;
    if ((status = SCDWRI(commid, "ORDERLIM", ibuf, 1, 1, &unit)) != 0) {
        /* error writing FIRSTORDER */
        return(MAREMMA);
    }
    ibuf[0] = (int)myflats->lastorder;
    if ((status = SCDWRI(commid, "ORDERLIM", ibuf, 2, 1, &unit)) != 0) {
        /* error writing LASTORDER */
        return(MAREMMA);
    }
    if ((status = SCDWRI(commid, "TAB_IN_OUT_OSHIFT", &myflats->tab_io_oshift,
                    1, 1, &unit)) != 0) {
        /* error writing TAB_IN_OUT_OSHIFT */
        return(MAREMMA);
    }
    ibuf[0] = (int)myflats->maxfibres;
    if ((status = SCDWRI(commid, "MAXFIBRES", ibuf, 1, 1, &unit)) != 0) {
        /* error writing MAXFIBRES */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "PIXMAX", &myflats->pixmax, 1, 1, &unit))
                    != 0) {
        /* error writing PIXMAX */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "HALFIBREWIDTH", &myflats->halfibrewidth,
                    1, 1, &unit)) != 0) {
        /* error writing HALFIBREWIDTH */
        return(MAREMMA);
    }
    if ((status = SCDWRD(commid, "MINFIBREFRAC", &myflats->minfibrefrac,
                    1, 1, &unit)) != 0) {
        /* error writing MINFIBREFRAC */
        return(MAREMMA);
    }
    ibuf[0] = (int)myflats->numfibres;
    if ((status = SCDWRI(commid, "NUMFIBRES", ibuf, 1, 1, &unit)) != 0) {
        /* error writing NUMFIBRES */
        return(MAREMMA);
    }
    if ((status = SCDWRI(commid, "FIBREMASK", myflats->fibremask, 1,
                    myflats->maxfibres, &unit)) != 0) {
        /* error writing FIBREMASK */
        return(MAREMMA);
    }
    if ((status = SCDWRI(commid, "FIBRE2FRAME", myflats->fibre2frame, 1,
                    myflats->maxfibres, &unit)) != 0) {
        /* error writing FIBRE2FRAME */
        return(MAREMMA);
    }
    if ((status = SCDWRC(commid, "SHIFTABLE", 1, &myflats->shiftable, 1,
                    1, &unit)) != 0) {
        /* error writing SHIFTABLE */
        return(MAREMMA);
    }
    if ((status = SCDWRC(commid, "NORMALISED", 1, &myflats->normalised, 1,
                    1, &unit)) != 0) {
        /* error writing NORMALISED */
        return(MAREMMA);
    }

    /* that's all folks! close the common frame */
    if ((status = SCFCLO(commid)) != 0) {
        /* error closing common frame: complain */
        return(MAREMMA);
    }

    free_ivector(fibres, 0,(int32_t)myflats->maxfibres-1);

    return(NOERR);

}