/*===========================================================================
  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);

}

