Ejemplo n.º 1
0
void smf_obsmap_fill( const smfData * data, AstKeyMap * obsmap, AstKeyMap * objmap,
                      int * status ) {

  double dateobs = 0.0;    /* MJD UTC of start of observation */
  char object[SZFITSTR];   /* Object name */
  char obsid[SZFITSTR];    /* Observation ID */
  char instrume[SZFITSTR]; /* instrument name */
  AstKeyMap * obsinfo = NULL; /* observation information */


  if (*status != SAI__OK) return;

  /* if there is no hdr we can not index it in the reported summary */
  if (data->hdr && data->hdr->fitshdr) {

    /* Get observation ID and see if we already have an entry in the map */
    (void)smf_getobsidss( data->hdr->fitshdr, obsid, sizeof(obsid), NULL, 0, status );
    /* As of 20080718 OBSID is not unique per obs so chop off date*/
    obsid[22] = '\0';

    if (!astMapHasKey(obsmap, obsid )) {
      int itemp;

      /* Create a sub keymap and populate it */
      obsinfo = astKeyMap( " " );
      /* fill with default value in case undefined */
      one_strlcpy( object, "<undefined>", sizeof(object), status );
      smf_getfitss( data->hdr, "OBJECT", object, sizeof(object),
                    status );
      astMapPut0C( obsinfo, "OBJECT", object, NULL );
      astMapPut0I( obsinfo, "OBSMODE", data->hdr->obsmode, NULL );
      astMapPut0I( obsinfo, "OBSTYPE", data->hdr->obstype, NULL );
      astMapPut0I( obsinfo, "SWMODE", data->hdr->swmode, NULL );
      astMapPut0I( obsinfo, "INBEAM", data->hdr->inbeam, NULL );
      smf_fits_getI( data->hdr, "OBSNUM", &itemp, status );
      astMapPut0I( obsinfo, "OBSNUM", itemp, NULL );
      smf_fits_getI( data->hdr, "UTDATE", &itemp, status );
      astMapPut0I( obsinfo, "UTDATE", itemp, NULL );
      smf_fits_getL( data->hdr, "SIMULATE", &itemp, status );
      astMapPut0I( obsinfo, "SIMULATE", itemp, NULL );
      smf_getfitss( data->hdr, "INSTRUME", instrume, sizeof(instrume),
                    status);
      astMapPut0C( obsinfo, "INSTRUME", instrume, NULL );

      /* store the MJD of observation for sorting purposes */
      smf_find_dateobs( data->hdr, &dateobs, NULL, status );
      astMapPut0D( obsinfo, "MJD-OBS", dateobs, NULL );

      /* store information in the global observation map
         and also track how many distinct objects we have */
      astMapPut0A( obsmap, obsid, obsinfo, NULL );
      astMapPut0I( objmap, object, 0, NULL );

      obsinfo = astAnnul( obsinfo );
    } else {
      int curbeam = 0;

      astMapGet0A( obsmap, obsid, &obsinfo );

      /* INBEAM is interesting since technically each sequence can involve
         different hardware being in the beam so we have to retrieve the
         current value from the keymap and OR it with the current value
         from the data header. */

      /* we know that the value has been filled in previously so no
         need to check */
      astMapGet0I( obsinfo, "INBEAM", &curbeam );
      curbeam |= data->hdr->inbeam;
      astMapPut0I( obsinfo, "INBEAM", curbeam, NULL );

      obsinfo = astAnnul( obsinfo );

    }
  }

  return;
}
Ejemplo n.º 2
0
HDSLoc *cupidReinhold( int type, int ndim, int *slbnd, int *subnd, void *ipd,
                     double *ipv, double rms, AstKeyMap *config, int velax,
                     double beamcorr[ 3 ], int *status ){
/*
*+
*  Name:
*     cupidReinhold

*  Purpose:
*     Identify clumps of emission within a 1, 2 or 3 dimensional NDF using
*     the REINHOLD algorithm.

*  Language:
*     Starlink C

*  Synopsis:
*     HDSLoc *cupidReinhold( int type, int ndim, int *slbnd, int *subnd,
*                          void *ipd, double *ipv, double rms,
*                          AstKeyMap *config, int velax,
*                          double beamcorr[ 3 ], int *status )

*  Description:
*     This function identifies clumps within a 1, 2 or 3 dimensional data
*     array using the REINHOLD algorithm, developed by Kim Reinhold at
*     JAC. This algorithm identifies the boundaries between clumps by
*     looking for minima in 1D sections through the data. No a priori clump
*     profile is assumed. In this algorithm, clumps never overlap.

*  Parameters:
*     type
*        An integer identifying the data type of the array values pointed to
*        by "ipd". Must be either CUPID__DOUBLE or CUPID__FLOAT (defined in
*        cupid.h).
*     ndim
*        The number of dimensions in the data array. Must be 2 or 3.
*     slbnd
*        Pointer to an array holding the lower pixel index bound of the
*        data array on each axis.
*     subnd
*        Pointer to an array holding the upper pixel index bound of the
*        data array on each axis.
*     ipd
*        Pointer to the data array. The elements should be stored in
*        Fortran order. The data type of this array is given by "itype".
*     ipv
*        Pointer to the input Variance array, or NULL if there is no Variance
*        array. The elements should be stored in Fortran order. The data
*        type of this array is "double".
*     rms
*        The default value for the global RMS error in the data array.
*     config
*        An AST KeyMap holding tuning parameters for the algorithm.
*     velax
*        The index of the velocity axis in the data array (if any). Only
*        used if "ndim" is 3.
*     beamcorr
*        An array in which is returned the FWHM (in pixels) describing the
*        instrumental smoothing along each pixel axis. The clump widths
*        stored in the output catalogue are reduced to correct for this
*        smoothing.
*     status
*        Pointer to the inherited status value.

*  Returned Value:
*     A locator for a new HDS object which is an array of NDF structures.
*     Each NDF will hold the data values associated with a single clump
*     and will be the smallest possible NDF that completely contains the
*     corresponding clump. Pixels not in the clump will be set bad. The
*     pixel origin is set to the same value as the supplied NDF.

*  Copyright:
*     Copyright (C) 2009 Science & Technology Facilities Council.
*     Copyright (C) 2006 Particle Physics & Astronomy Research Council.
*     All Rights Reserved.

*  Licence:
*     This program is free software; you can redistribute it and/or
*     modify it under the terms of the GNU General Public License as
*     published by the Free Software Foundation; either version 2 of
*     the License, or (at your option) any later version.
*
*     This program is distributed in the hope that it will be
*     useful, but WITHOUT ANY WARRANTY; without even the implied
*     warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
*     PURPOSE. See the GNU General Public License for more details.
*
*     You should have received a copy of the GNU General Public License
*     along with this program; if not, write to the Free Software
*     Foundation, Inc., 51 Franklin Street,Fifth Floor, Boston, MA
*     02110-1301, USA

*  Authors:
*     DSB: David S. Berry
*     TIMJ: Tim Jenness (JAC, Hawaii)
*     {enter_new_authors_here}

*  History:
*     16-JAN-2006 (DSB):
*        Original version.
*     14-JAN-2009 (TIMJ):
*        Use MERS for message filtering.
*     {enter_further_changes_here}

*  Bugs:
*     {note_any_bugs_here}

*-
*/

/* Local Variables: */

   AstKeyMap *rconfig;  /* Configuration parameters for this algorithm */
   HDSLoc *ret;         /* Locator for the returned array of NDFs */
   double *pd;          /* Pointer to next element of data array */
   double *peakvals;    /* Pointer to array holding clump peak values */
   double cathresh;     /* Threshold for second cellular automata */
   double flatslope;    /* Minimum significant slope at edge of a peak */
   double noise;        /* Noise level */
   double pv;           /* Pixel value */
   double thresh;       /* Minimum peak value to be considered */
   float *pf;           /* Pointer to next element of data array */
   int *clbnd;          /* Array holding lower axis bounds of all clumps */
   int *cubnd;          /* Array holding upper axis bounds of all clumps */
   int *igood;          /* Pointer to array holding usable clump indices */
   int *m1;             /* Pointer to mask array */
   int *m2;             /* Pointer to mask array */
   int *m3;             /* Pointer to mask array */
   int *mask2;          /* Pointer to array marking out edge pixels */
   int *mask;           /* Pointer to array marking out edge pixels */
   int *nrem;           /* Pointer to array marking out edge pixels */
   int *pa;             /* Pointer to next element in the pixel assignment array */
   int caiter;          /* The number of CA iterations to perform */
   int dims[3];         /* Pointer to array of array dimensions */
   int el;              /* Number of elements in array */
   int fixiter;         /* The number of CA iterations to perform */
   int i;               /* Loop count */
   int ii;              /* Loop count */
   int ix;              /* Grid index on 1st axis */
   int iy;              /* Grid index on 2nd axis */
   int iz;              /* Grid index on 3rd axis */
   int j;               /* Loop count */
   int maxid;           /* Largest id for any peak (smallest is zero) */
   int minlen;          /* Minimum size of a clump in pixels along one dimension*/
   int minpix;          /* Minimum total size of a clump in pixels */
   int more;            /* Continue looping?*/
   int ngood;           /* Number of good clumps */
   int nsmall;          /* Number of clumps that are too small */
   int nthin;           /* Number of clumps that span only a single pixel */
   int peakval;         /* Minimum value used to flag peaks */
   int skip[3];         /* Pointer to array of axis skips */

/* Initialise */
   ret = NULL;

/* Abort if an error has already occurred. */
   if( *status != SAI__OK ) return ret;

/* Say which method is being used. */
   msgBlankif( MSG__NORM, status );
   msgOutif( MSG__NORM, "", "Reinhold:", status );

/* Get the AST KeyMap holding the configuration parameters for this
   algorithm. */
   if( !astMapGet0A( config, "REINHOLD", (AstObject *) &rconfig ) ) {
      rconfig = astKeyMap( " " );
      astMapPut0A( config, "REINHOLD", rconfig, " " );
   }

/* The configuration file can optionally omit the algorithm name. In this
   case the "config" KeyMap may contain values which should really be in
   the "rconfig" KeyMap. Add a copy of the "config" KeyMap into "rconfig"
   so that it can be searched for any value which cannot be found in the
   "rconfig" KeyMap. */
   astMapPut0A( rconfig, CUPID__CONFIG, astCopy( config ), NULL );

/* Return the instrumental smoothing FWHMs */
   beamcorr[ 0 ] = cupidConfigD( rconfig, "FWHMBEAM", 2.0, status );
   beamcorr[ 1 ] = beamcorr[ 0 ];
   if( ndim == 3 ) {
      beamcorr[ 2 ] = beamcorr[ 0 ];
      beamcorr[ velax ]= cupidConfigD( rconfig, "VELORES", 2.0, status );
   }

/* Find the size of each dimension of the data array, and the total number
   of elements in the array, and the skip in 1D vector index needed to
   move by pixel along an axis. We use the memory management functions of the
   AST library since they provide greater security and functionality than
   direct use of malloc, etc. */
   el = 1;
   for( i = 0; i < ndim; i++ ) {
      dims[ i ] = subnd[ i ] - slbnd[ i ] + 1;
      el *= dims[ i ];
      skip[ i ] = ( i == 0 ) ? 1 : skip[ i - 1 ]*dims[ i - 1 ];
   }
   for( ; i < 3; i++ ) {
      dims[ i ] = 1;
      skip[ i ] = 0;
   }

/* Get various configuration parameters. */
   rms = cupidConfigD( rconfig, "RMS", rms, status );
   minlen = cupidConfigI( rconfig, "MINLEN", 4, status );
   noise = cupidConfigRMS( rconfig, "NOISE", rms, 2*rms, status );
   thresh = cupidConfigRMS( rconfig, "THRESH", rms, noise + 2*rms, status );
   flatslope = cupidConfigRMS( rconfig, "FLATSLOPE", rms, rms, status );
   cathresh = pow( 3, ndim ) - 1.0;
   cathresh = cupidConfigI( rconfig, "CATHRESH", (int) cathresh, status );
   caiter = cupidConfigI( rconfig, "CAITERATIONS", 1, status );
   fixiter = cupidConfigI( rconfig, "FIXCLUMPSITERATIONS", 1, status );

/* Get the minimum allowed number of pixels in a clump. */
   minpix = cupidDefMinPix( ndim, beamcorr, noise, thresh, status );
   minpix = cupidConfigI( rconfig, "MINPIX", minpix, status );

/* Convert CATHRESH from a number of pixels to a fraction. */
   cathresh = cathresh/pow( 3, ndim );
   if( cathresh > 0.98 ) cathresh = 0.98;
   if( cathresh < 0 ) cathresh = 0.0;
   cathresh += 0.01;

/* Get a mask which is the same size and shape as the data array and which
   holds CUPID__KEDGE at every pixel thought to be on the edge of a clump.
   This is done by scanning the data cube using sets of parallel lines in
   different directions. Peaks are searched for in each line, and then the
   edges found by following the curve down from each peak until the
   gradient becomes zero or positive, or until the data value drops below a
   threshold value. Pixels which correspond to peaks in the data cube
   are flagged with the value greater than or equal to the returned
   "*peakval" value. All other pixels are set to some other value (which
   will usually be CUPID__KBACK but will be something else at positions of
   peaks which were not peaks in all scan directions). */
   msgOutif( MSG__DEBUG, "", "Finding clump edges...", status );
   mask = cupidRInitEdges( type, ipd, el, ndim, dims, skip, minlen, thresh,
                           noise, rms, flatslope, &peakval, status );

/* Dilate the edge regions using a cellular automata. This creates a new
   mask array in which a pixel is marked as an edge pixel if any of its
   neighbours are marked as edge pixels in the mask array created above. */
   msgOutif( MSG__DEBUG, "", "Dilating clump edges...", status );
   mask2 = cupidRCA( mask, NULL, el, dims, skip, 0.0, peakval, CUPID__KEDGE,
                     CUPID__KBACK, 0, status );

/* Erode the edge regions using a second cellular automata. This over-writes
   the original mask array so that a pixel is marked as an edge pixel if a
   fraction greater than "cathresh" of neighbouring pixels are marked as edge
   pixels in "mask2". We loop doing this "CAiteration" times. */
   if( caiter > 0 ) msgOutif( MSG__DEBUG,"", "Eroding clump edges...", status );
   m1 = mask;
   m2 = mask2;
   for( i = 0; i < caiter; i++ ) {
      m1 = cupidRCA( m2, m1, el, dims, skip, cathresh, peakval, CUPID__KEDGE,
                     CUPID__KBACK, 0, status );
      m3 = m1;
      m1 = m2;
      m2 = m3;
   }

/* Fill the volume around each peak with integer values which indicate
   which peak they are close to. All the pixels around one peak form one
   clump. */
   msgOutif( MSG__DEBUG, "", "Filling clumps...", status );
   maxid = cupidRFillClumps( m2, m1, el, ndim, skip, dims, peakval, status );

/* Abort if no clumps found. */
   if( maxid < 0 ) {
      msgOutif( MSG__NORM, "", "No usable clumps found.", status );
      msgBlankif( MSG__NORM, status );
      goto L10;
   }

/* Smooth the boundaries between the clumps. This cellular automata replaces
   each output pixel by the most commonly occuring value within a 3x3x3
   cube of input pixels centred on the output pixel. Put the smoothed
   results back into the supplied "m1" array. */
   if( fixiter >0 ) msgOutif( MSG__DEBUG, "", "Smoothing clump boundaries...", status );
   for( i = 0; i < fixiter; i++ ) {
      m2 = cupidRCA2( m1, m2, el, dims, skip, status );
      m3 = m2;
      m2 = m1;
      m1 = m3;
   }

/* Allocate an array used to store the number of pixels remaining in each
   clump. */
   nrem = astMalloc( sizeof( int )*( maxid + 1 ) );

/* Allocate an array used to store the peak value in every clump. */
   peakvals = astMalloc( sizeof( double )*( maxid + 1 ) );

/* Determine the bounding box of every clump. First allocate memory to
   hold the bounding boxes. */
   clbnd = astMalloc( sizeof( int )*( maxid + 1 )*3 );
   cubnd = astMalloc( sizeof( int )*( maxid + 1 )*3 );
   igood = astMalloc( sizeof( int )*( maxid + 1 ) );
   if( igood ) {

/* Initialise a list to hold zero for every clump id. These values are
   used to count the number of pixels remaining in each clump. Also
   initialise the peak values to a very negative value. */
      for( i = 0; i <= maxid; i++ ) {
         nrem[ i ] = 0;
         peakvals[ i ] = VAL__MIND;
      }

/* Initialise the bounding boxes. */
      for( i = 0; i < 3*( maxid + 1 ); i++ ) {
         clbnd[ i ] = VAL__MAXI;
         cubnd[ i ] = VAL__MINI;
      }

/* Loop round every pixel in the final pixel assignment array. */
      if( type == CUPID__DOUBLE ) {
         pd = (double *) ipd;
         pf = NULL;
      } else {
         pf = (float *) ipd;
         pd = NULL;
      }
      pa = m1;
      for( iz = 1; iz <= dims[ 2 ]; iz++ ){
         for( iy = 1; iy <= dims[ 1 ]; iy++ ){
            for( ix = 1; ix <= dims[ 0 ]; ix++, pa++ ){

/* Get the data value at this pixel */
               if( type == CUPID__DOUBLE ) {
                  pv = *(pd++);
               } else {
                  pv = (double) *(pf++);
               }

/* Skip pixels which are not in any clump. */
               if( *pa >= 0 ) {

/* Increment the number of pixels in this clump. */
                  ++( nrem[ *pa ] );

/* If this pixel value is larger than the current peak value for this
   clump, record it. */
                  if( pv > (double) peakvals[ *pa ] ) peakvals[ *pa ] = pv;

/* Get the index within the clbnd and cubnd arrays of the current bounds
   on the x axis for this clump. */
                  i = 3*( *pa );

/* Update the bounds for the x axis, then increment to get the index of the y
   axis bounds. */
                  if( ix < clbnd[ i ] ) clbnd[ i ] = ix;
                  if( ix > cubnd[ i ] ) cubnd[ i ] = ix;
                  i++;

/* Update the bounds for the y axis, then increment to get the index of the z
   axis bounds. */
                  if( iy < clbnd[ i ] ) clbnd[ i ] = iy;
                  if( iy > cubnd[ i ] ) cubnd[ i ] = iy;
                  i++;

/* Update the bounds for the z axis. */
                  if( iz < clbnd[ i ] ) clbnd[ i ] = iz;
                  if( iz > cubnd[ i ] ) cubnd[ i ] = iz;
               }
            }
         }
      }

/* Loop round counting the clumps which are too small or too low. Put the
   indices of usable clumps into another array. */
      nsmall = 0;
      ngood = 0;
      nthin = 0;
      for( i = 0; i <= maxid; i++ ) {
         j = 3*i;

         if( nrem[ i ] <= minpix ) {
            nsmall++;

         } else if( clbnd[ j ] == cubnd[ j ] ||
                  ( clbnd[ j + 1 ] == cubnd[ j + 1 ] && ndim > 1 ) ||
                  ( clbnd[ j + 2 ] == cubnd[ j + 2 ] && ndim > 2 ) ) {
            nthin++;

         } else {
            igood[ ngood++ ] = i;
         }
      }

      if( ngood == 0 ) msgOutif( MSG__NORM,"", "No usable clumps found.", status );

      if( nsmall == 1 ){
        msgOutif( MSG__NORM, "", "One clump rejected because it contains too few pixels.", status );
      } else if( nsmall > 1 ) {
        msgSeti( "N", nsmall );
        msgOutif( MSG__NORM, "", "^N clumps rejected because they contain too few pixels.", status );
      }
      if( nthin == 1 ) {
        msgOutif( MSG__NORM, "", "1 clump rejected because it spans only a single "
                  "pixel along one or more axes.", status );

      } else if( nthin > 1 ) {
        msgSeti( "N", nthin );
        msgOutif( MSG__NORM, "", "^N clumps rejected because they spans only a single "
                  "pixel along one or more axes.", status );
      }

/* Sort the clump indices into descending order of peak value. */
      j = ngood;
      more = 1;
      while( more ) {
         j--;
         more = 0;
         for( i = 0; i < j; i++ ) {
            if( peakvals[ igood[ i ] ] < peakvals[ igood[ i + 1 ] ] ) {
               ii = igood[ i + 1 ];
               igood[ i + 1 ] = igood[ i ];
               igood[ i ] = ii;
               more = 1;
            }
         }
      }

/* Loop round creating an NDF describing each usable clump. */
      for( j = 0; j < ngood; j++ ) {
         i = igood[ j ];
         ret = cupidNdfClump( type, ipd, m1, el, ndim, dims, skip, slbnd,
                              i, clbnd + 3*i, cubnd + 3*i, NULL, ret,
                              cupidConfigD( rconfig, "MAXBAD", 0.05, status ),
                              status );
      }

/* Free resources */
      clbnd = astFree( clbnd );
      cubnd = astFree( cubnd );
      igood = astFree( igood );
   }

   peakvals = astFree( peakvals );
   nrem = astFree( nrem );

L10:;

/* Remove the secondary KeyMap added to the KeyMap containing configuration
   parameters for this algorithm. This prevents the values in the secondary
   KeyMap being written out to the CUPID extension when cupidStoreConfig is
   called. */
   astMapRemove( rconfig, CUPID__CONFIG );

/* Free resources */
   rconfig = astAnnul( rconfig );
   mask = astFree( mask );
   mask2 = astFree( mask2 );

/* Return the list of clump NDFs. */
   return ret;

}
Ejemplo n.º 3
0
static AstTable *ReadNextTable( FILE *fd, const char *fname, int *iline,
                                int *status ) {
    /*
    *  Name:
    *     ReadOneTable

    *  Purpose:
    *     Reads a single Table from a text file.

    *  Description:
    *     This function reads text from the supplied file descriptor until it
    *     reaches the end of file or encounters an end-of-table marker (a line
    *     consisting just of two or more minus signs with no leading spaces).
    *     It creates an AstTable from the text and returns a pointer to it.

    *  Arguments:
    *     fd
    *        The file descriptor.
    *     fname
    *        The file name - used for error messages.
    *     iline
    *        Pointer to an int holding the number of lines read from the
    *        file so far. Updated on exit to include the lines read by the
    *        invocation of this function.
    *     status
    *        Pointer to the global status variable.

    *  Returned Value:
    *     A pointer to the Table read from the file, or NULL if an error occurs.

    */

    /* Local Variables: */
    AstTable *result;
    AstTable *subtable;
    char **cols;
    char **words;
    char *last_com;
    char *line;
    char *p;
    char *tname;
    char key[ 200 ];
    const char *cval;
    const char *oldname;
    const char *newname;
    double dval;
    int *types;
    int blank;
    int c;
    int com;
    int eot;
    int first;
    int icol;
    int irow;
    int ival;
    int iword;
    int line_len;
    int max_line_len;
    int more;
    int nc;
    int ncol;
    int nrow;
    int nword;
    int skip;
    size_t len;

    /* Initialise */
    result = NULL;

    /* Check the inherited status. */
    if( *status != SAI__OK ) return result;

    /* Create an empty Table. */
    result = astTable( " " );

    /* Allocate a buffer for one one line of text. This will be increased in
       size as required. */
    max_line_len = 80;
    line = astMalloc( max_line_len*sizeof( *line ) );

    /* Read each line of text from the file. */
    eot = 0;
    skip = 1;
    line_len = 0;
    more = 1;
    last_com = NULL;
    cols = NULL;
    first = 1;
    irow = 0;
    types = NULL;

    while( more && *status == SAI__OK ) {
        (*iline)++;
        line_len = 0;

        /* Loop reading characters from the file until a newline or the end of file is
           reached. */
        while( ( c = fgetc( fd ) ) != EOF && c != '\n' ) {

            /* Increment the current line length, and double the size of the line buffer
               if it is full. */
            if( ++line_len >= max_line_len ) {
                max_line_len *= 2;
                line = astRealloc( line, max_line_len*sizeof( *line ) );
                if( *status != SAI__OK ) break;
            }

            /* Store the character. Ignore leading white space. */
            if( skip ) {
                if( ! isspace( c ) ) {
                    line[ line_len - 1 ] = c;
                    skip = 0;
                } else {
                    line_len--;
                }
            } else {
                line[ line_len - 1 ] = c;
            }

        }

        /* If the end-of-file was reached indicate that we should leave the main
           loop after processing the current line. */
        if( c == EOF ) more = 0;

        /* Terminate the line. */
        line[ line_len ] = 0;

        /* Terminate it again to exclude trailing white space. */
        line[ astChrLen( line ) ] = 0;

        /* Assume the line is a blank non-comment, and store a pointer to the first
           character to use. */
        blank = 1;
        com = 0;
        p = line;

        /* Skip blank lines. */
        if( line[ 0 ] ) {

            /* If the line starts with a comment character... */
            if( line[ 0 ] == '#' || line[ 0 ] == '!' ) {
                com = 1;

                /* Get a pointer to the first non-space/tab character after the comment
                   character. */
                p = line + 1;
                while( *p == ' ' || *p == '\t' ) p++;

                /* Note if it is blank. */
                if( *p ) blank = 0;

                /* If it is not a comment line, then the line is not blank. */
            } else {
                blank = 0;

                /* See if it is the end-of-table marker - a line containing just two or
                   more minus signs with no leading spaces. */
                eot = ( strspn( line, "-" ) > 1 );
            }
        }

        /* Skip blank lines, whether comment or not. */
        if( ! blank ) {

            /* First handle comment lines. */
            if( com ) {

                /* Does it look like a  parameter assignment... */
                words = astChrSplitRE( p, "^\\s*(\\w+)\\s*=\\s*(.*)$", &nword, NULL );
                if( words ) {

                    /* Add a parameter declaration to the Table. */
                    astAddParameter( result, words[ 0 ] );

                    /* Store the parameter value, using an appropriate data type. */
                    len = strlen( words[ 1 ] );
                    if( nc = 0, ( 1 == astSscanf( words[ 1 ], "%d%n", &ival, &nc ) )
                            && ( nc >= len ) ) {
                        astMapPut0I( result, words[ 0 ], ival, NULL );

                    } else if( nc = 0, ( 1 == astSscanf( words[ 1 ], "%lg%n", &dval, &nc ) )
                               && ( nc >= len ) ) {
                        astMapPut0D( result, words[ 0 ], dval, NULL );

                    } else {
                        astMapPut0C( result, words[ 0 ], words[ 1 ], NULL );

                    }

                    /* Free the words returned by astChrSplitRE. */
                    for( iword = 0; iword < nword; iword++ ) {
                        words[ iword ] = astFree( words[ iword ] );
                    }
                    words = astFree( words );

                    /* If it does not look like a parameter assignment... */
                } else {

                    /* Save a copy of it in case it turns out to be the last non-blank comment
                       line before the first row of data values (in which case it should
                       contain the column names). */
                    last_com = astStore( last_com, p, strlen( p ) + 1 );
                }

                /* If the line is not a comment see if it is an end of table marker. If so
                   indicate that we should leave the loop. */
            } else if( eot ) {
                more = 0;

                /* If the line is not a comment or an end of table marker ... */
            } else {

                /* Get the words from the row. */
                words = astChrSplit( p, &nword );

                /* If this is the first non-blank non-comment line, get the column names from
                   the previous non-blank comment line. */
                if( first ) {
                    if( last_com ) {
                        first = 0;
                        cols = astChrSplit( last_com, &ncol );

                        /* Create an array to hold the data type for each colum, and initialise
                           them to "integer". */
                        types = astMalloc( ncol*sizeof( int ) ) ;
                        for( iword = 0; iword < nword && astOK; iword++ ) {
                            if( iword < ncol ) {
                                types[ iword ] = AST__INTTYPE;

                                /* The columns are stored initially using interim names which have "T_"
                                   prepended to the names given in the file. */
                                tname = NULL;
                                nc = 0;
                                tname = astAppendString( tname, &nc, "T_" );
                                tname = astAppendString( tname, &nc, cols[ iword ] );
                                astFree( cols[ iword ] );
                                cols[ iword ] = tname;

                                /* Create the column definition within the returned Table. We store them
                                   initially as strings and then convert to the appropriate column data type
                                   later (once all rows have been read and the the data types are known). */
                                astAddColumn( result, cols[ iword ], AST__STRINGTYPE,
                                              0, NULL, " " );
                            }
                        }

                    } else if( *status == SAI__OK ) {
                        *status = SAI__ERROR;
                        msgSetc( "F", fname );
                        errRep( " ", "No column headers found in file ^F.", status );
                    }
                }

                /* Report an error if the line has the wrong number of values. */
                if( nword != ncol ) {
                    if( *status == SAI__OK ) {
                        *status = SAI__ERROR;
                        msgSeti( "N", nword );
                        msgSeti( "I", (*iline) );
                        msgSeti( "M", ncol );
                        msgSetc( "F", fname );
                        errRep( " ", "Wrong number of values (^N) at line ^I in "
                                "file ^F (should be ^M).", status );
                    }

                    /* Otherwise increment the number of rows read. */
                } else {
                    irow++;

                    /* Store each string value in the table, excluding "null" strings. Also check
                       the data type of each string an dupdate the column data types if necessary. */
                    for( iword = 0; iword < nword && *status == SAI__OK; iword++ ) {
                        if( strcmp( words[ iword ], "null" ) ) {
                            sprintf( key, "%s(%d)", cols[ iword ], irow );
                            astMapPut0C( result, key, words[ iword ], NULL );

                            /* If the column is currently thought to hold integers, check that the
                               current word looks like an integer. If not, down-grade the column type
                               to double. */
                            len = strlen( words[ iword ] );
                            if( types[ iword ] == AST__INTTYPE ) {
                                if( nc = 0, ( 1 != astSscanf( words[ iword ], "%d%n",
                                                              &ival, &nc ) ) ||
                                        ( nc < len ) ) {
                                    types[ iword ] = AST__DOUBLETYPE;
                                }
                            }

                            /* If the column is currently thought to hold doubles, check that the
                               current word looks like an doubler. If not, down-grade the column type
                               to string. */
                            if( types[ iword ] == AST__DOUBLETYPE ) {
                                if( nc = 0, ( 1 != astSscanf( words[ iword ], "%lg%n",
                                                              &dval, &nc ) ) ||
                                        ( nc < len ) ) {
                                    types[ iword ] = AST__STRINGTYPE;
                                }
                            }
                        }
                    }
                }

                /* Free the words returned by astChrSplit. */
                for( iword = 0; iword < nword; iword++ ) {
                    words[ iword ] = astFree( words[ iword ] );
                }
                words = astFree( words );

            }
        }
    }

    /* The entire file has now been read, and a Table created in which every
       column holds strings. We also have flags indicating whether the values
       in each column are all integers or doubles. Modify the type of the
       column within the Table to match these flags. */
    nrow = astGetI( result, "Nrow" );
    for( icol = 0; icol < ncol && *status == SAI__OK; icol++ ) {

        /* The column will be re-named from "T_<name>" to "<name>". */
        oldname = cols[ icol ];
        newname = oldname + 2;

        /* First convert string columns to integer columns if all the values in
           the column look like integers. */
        if( types[ icol ] == AST__INTTYPE ) {

            /* Create the new column */
            astAddColumn( result, newname, AST__INTTYPE, 0, NULL, " " );

            /* Copy each cell of the current column, converting from string to integer. */
            for( irow = 1; irow <= nrow; irow++ ) {
                sprintf( key, "%s(%d)", oldname, irow );
                if( astMapGet0I( result, key, &ival ) ) {
                    sprintf( key, "%s(%d)", newname, irow );
                    astMapPut0I( result, key, ival, NULL );
                }
            }

            /* Now do double columns in the same way. */
        } else if( types[ icol ] == AST__DOUBLETYPE ) {
            astAddColumn( result, newname, AST__DOUBLETYPE, 0, NULL, " " );
            for( irow = 1; irow <= nrow; irow++ ) {
                sprintf( key, "%s(%d)", oldname, irow );
                if( astMapGet0D( result, key, &dval ) ) {
                    sprintf( key, "%s(%d)", newname, irow );
                    astMapPut0D( result, key, dval, NULL );
                }
            }

            /* Copy string values without change. */
        } else {
            astAddColumn( result, newname, AST__STRINGTYPE, 0, NULL, " " );
            for( irow = 1; irow <= nrow; irow++ ) {
                sprintf( key, "%s(%d)", oldname, irow );
                if( astMapGet0C( result, key, &cval ) ) {
                    sprintf( key, "%s(%d)", newname, irow );
                    astMapPut0C( result, key, cval, NULL );
                }
            }
        }

        /* Remove the old column. */
        astRemoveColumn( result, oldname );

    }

    /* Free resources. */
    line = astFree( line );
    last_com = astFree( last_com );
    types = astFree( types );
    if( cols ) {
        for( icol = 0; icol < ncol; icol++ ) {
            cols[ icol ] = astFree( cols[ icol ] );
        }
        cols = astFree( cols );
    }

    /* If the table ended with an end-of-table marker, there may be another
       Table in the file. Call this function recursively to read it. */
    if( eot ) {
        subtable = ReadNextTable( fd, fname, iline, status );

        /* Store the subtable as a table parameter in the returned table. */
        if( subtable ) {
            astAddParameter( result, "SubTable" );
            astMapPut0A( result, "SubTable", subtable, NULL );

            /* The Table clones the pointer, so we must annull our local copy of it. */
            subtable = astAnnul( subtable );
        }
    }

    /* Return the Table pointer. */
    return result;
}
Ejemplo n.º 4
0
HDSLoc *cupidGaussClumps( int type, int ndim, int *slbnd, int *subnd, void *ipd,
                          double *ipv, double rms, AstKeyMap *config, int velax,
                          double beamcorr[ 3 ], int *status ){
/*
*+
*  Name:
*     cupidGaussClumps

*  Purpose:
*     Identify clumps of emission within a 1, 2 or 3 dimensional NDF using
*     the GAUSSCLUMPS algorithm.

*  Language:
*     Starlink C

*  Synopsis:
*     HDSLoc *cupidGaussClumps( int type, int ndim, int *slbnd, int *subnd,
*                               void *ipd, double *ipv, double rms,
*                               AstKeyMap *config, int velax,
*                               double beamcorr[ 3 ], int *status )

*  Description:
*     This function identifies clumps within a 1, 2 or 3 dimensional data
*     array using the GAUSSCLUMPS algorithm, described by Stutski & Gusten
*     (1990, ApJ 356, 513). This algorithm proceeds by fitting a Gaussian
*     profile to the brightest peak in the data. It then subtracts the fit
*     from the data and iterates, fitting a new ellipse to the brightest peak
*     in the residuals. This continues until a termination criterion is
*     reached. The main termination criterion in this implementation is
*     not quite the same as in the Stutski & Gusten paper. They had two main
*     termination criteria; 1) the total data sum of the fitted gaussians
*     is close to the total data sum of the original data, and 2) the peak
*     residual is less than a given multiple of the RMS noise in the data.
*     However, 1) is very sensitive to errors in the estimation of the
*     background level in the data, and 2) may never be achieved because
*     the expected residuals depend not only on the RMS noise in the data
*     but also on how accurately gaussian the clumps are, which is not
*     known. Therefore, this implementation instead terminates when the
*     peak amplitude of the fitted clumps falls below a given fraction of
*     the first (i.e. largest) fitted peak.
*
*     Two additional termination criteria are used; 1) If there are many
*     failed attempts to fit a clump to the peak residual or if 2) a
*     specified maximum number of clumps are found, then the process
*     terminates early.

*  Parameters:
*     type
*        An integer identifying the data type of the array values pointed to
*        by "ipd". Must be either CUPID__DOUBLE or CUPID__FLOAT (defined in
*        cupid.h).
*     ndim
*        The number of dimensions in the data array. Must be 1, 2 or 3.
*     slbnd
*        Pointer to an array holding the lower pixel index bound of the
*        data array on each axis.
*     subnd
*        Pointer to an array holding the upper pixel index bound of the
*        data array on each axis.
*     ipd
*        Pointer to the data array. The elements should be stored in
*        Fortran order. The data type of this array is given by "itype".
*     ipv
*        Pointer to the input Variance array, or NULL if there is no Variance
*        array. The elements should be stored in Fortran order. The data
*        type of this array is "double".
*     rms
*        The default value for the global RMS error in the data array.
*     config
*        An AST KeyMap holding tuning parameters for the algorithm.
*     velax
*        The index of the velocity axis in the data array (if any). Only
*        used if "ndim" is 3.
*     beamcorr
*        An array in which is returned the FWHM (in pixels) describing the
*        instrumental smoothing along each pixel axis. The clump widths
*        stored in the output catalogue are reduced to correct for this
*        smoothing.
*     status
*        Pointer to the inherited status value.

*  Notes:
*     - The specific form of algorithm used here is informed by a Fortran
*     implementation of GaussClumps obtained on 27/9/05 from
*     ftp.astro.uni-bonn.de/pub/heith/gaussclumps.
*     - Most of the "cupid..." functions used in this file which start
*     with a "type" parameter (e.g. cupidFindMax, cupidUpdateArrays, etc) are
*     actually not functions at all, but macros defined in cupid.h. These
*     macros are wrappers which invoke a type-specific function (e.g.
*     cupidFindMaxD, cupidFindMaxF) appropriate to the specific data type
*     being used (as indicated by the "type" parameter). Macros are used in
*     order to simplify the code here, and thus make the flow of the
*     algorithm clearer. The source code for the type-specific functions
*     are generated automatically at build time from equivalent files which
*     have file type ".cupid". For instance, the files cupidfindmaxD.c and
*     cupidfindmaxF.c are generated automatically from cupidfindmax.cupid.
*     Also, the rlevant macros definitions and prototypes within cupid.h
*     are generated automatically at build time from these ".cupid" files.

*  Returned Value:
*     A locator for a new HDS object which is an array of NDF structures.
*     Each NDF will hold the data values associated with a single clump and
*     will be the smallest possible NDF that completely contains the
*     corresponding clump. Pixels not in the clump will be set bad. The
*     pixel origin is set to the same value as the supplied NDF.

*  Copyright:
*     Copyright (C) 2009 Science & Technology Facilities Council.
*     Copyright (C) 2005 Particle Physics & Astronomy Research Council.
*     All Rights Reserved.

*  Licence:
*     This program is free software; you can redistribute it and/or
*     modify it under the terms of the GNU General Public License as
*     published by the Free Software Foundation; either version 2 of
*     the License, or (at your option) any later version.
*
*     This program is distributed in the hope that it will be
*     useful, but WITHOUT ANY WARRANTY; without even the implied
*     warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
*     PURPOSE. See the GNU General Public License for more details.
*
*     You should have received a copy of the GNU General Public License
*     along with this program; if not, write to the Free Software
*     Foundation, Inc., 51 Franklin Street,Fifth Floor, Boston, MA
*     02110-1301, USA

*  Authors:
*     DSB: David S. Berry
*     TIMJ: Tim Jenness (JAC, Hawaii)
*     {enter_new_authors_here}

*  History:
*     29-SEP-2005 (DSB):
*        Original version.
*     7-MAR-2007 (DSB):
*        Use VELORES instead of FWHMBEAM if the data is 1D.
*     7-MAR-2007 (DSB):
*        Guard against segvio caused by use of null pointers that are
*        returned by astMalloc if an error has occurred.
*     14-JAN-2009 (TIMJ):
*        Use MERS for message filtering.
*     {enter_further_changes_here}

*  Bugs:
*     {note_any_bugs_here}

*-
*/

/* Local Variables: */
   AstKeyMap *gcconfig; /* Configuration parameters for this algorithm */
   char buf[30];        /* File name buffer */
   HDSLoc *ret;         /* Locator for the returned array of NDFs */
   double *peaks;       /* Holds the "npeak" most recently fitted peak values */
   double chisq;        /* Chi-squared value of most recently fitted Gaussian */
   double mean_peak;    /* The mean of the values within "peaks" */
   double mlim;         /* Truncation level for Gaussians */
   double new_peak;     /* The value most recently added to "peaks" */
   double nsig;         /* No.of standard deviations at which to reject peaks */
   double old_peak;     /* The oldest value within "peaks" */
   double peak_thresh;  /* The lower threshold for clump peak values */
   double sigma_peak;   /* The standard deviation of the values within "peaks" */
   double sumdata;      /* Sum of the supplied data values */
   double sum_peak2;    /* Sum of the squares of the values in "peaks" */
   double sum_peak;     /* Sum of the values in "peaks" */
   double sumclumps;    /* Sum of the values in all the used clumps so far */
   double x[ CUPID__GCNP3 ]; /* Parameters describing new Gaussian clump */
   int *dims;           /* Pointer to array of array dimensions */
   int allbad;          /* Are all the residuals bad? */
   int area;            /* Number of pixels contributing to the clump */
   int area_thresh;     /* The lower threshold for clump areas */
   int excols;          /* Are extra output columns required? */
   int el;              /* Number of elements in array */
   size_t i;            /* Loop count */
   size_t iclump;       /* Number of clumps found so far */
   int imax;            /* Index of element with largest residual */
   size_t ipeak;        /* Index within "peaks" at which to store the new peak */
   int iter;            /* Continue finding more clumps? */
   double maxbad;       /* Max fraction of bad pixels allowed in a clump */
   size_t maxclump;     /* Max no. of clumps */
   int maxskip;         /* Max no. of failed fits between good fits */
   size_t nclump;       /* Number of usable clumps */
   int niter;           /* Iterations performed so far */
   int npad;            /* No. of peaks below threshold for temination */
   size_t npeak;        /* The number of elements in the "peaks" array. */
   int nskip;           /* No. of failed fits since last good fit */
   int area_below;      /* Count of consecutive clump areas below the threshold */
   int peaks_below;     /* Count of consecutive peaks below the threshold */
   void *res;           /* Pointer to residuals array */

/* Initialise */
   ret = NULL;

/* Abort if an error has already occurred. */
   if( *status != SAI__OK ) return ret;

/* Initialise things to avoid compiler warnings. */
   mean_peak = 0.0;
   sigma_peak = 0.0;
   new_peak = 0.0;

/* Say which method is being used. */
   msgBlankif( MSG__NORM, status );
   msgOutif( MSG__NORM,  "", "GaussClumps:", status );
   msgBlankif( MSG__VERB, status );

/* Get the AST KeyMap holding the configuration parameters for this
   algorithm. */
   if( !astMapGet0A( config, "GAUSSCLUMPS", (AstObject *) &gcconfig ) ) {
      gcconfig = astKeyMap( " " );
      astMapPut0A( config, "GAUSSCLUMPS", gcconfig, " " );
   }

/* The configuration file can optionally omit the algorithm name. In this
   case the "config" KeyMap may contain values which should really be in
   the "gcconfig" KeyMap. Add a copy of the "config" KeyMap into "gcconfig"
   so that it can be searched for any value which cannot be found in the
   "gcconfig" KeyMap. */
   astMapPut0A( gcconfig, CUPID__CONFIG, astCopy( config ), NULL );

/* Return the instrumental smoothing FWHMs. For 1D data, we assume the
   axis is spectral and so use VELORES instead of FWHMBEAM.  */
   if( ndim == 1 ) {
      beamcorr[ 0 ] = cupidConfigD( gcconfig, "VELORES", 2.0, status );
   } else {
      beamcorr[ 0 ]= cupidConfigD( gcconfig, "FWHMBEAM", 2.0, status );
      beamcorr[ 1 ] = beamcorr[ 0 ];
      if( ndim == 3 ) {
         beamcorr[ 2 ] = beamcorr[ 0 ];
         beamcorr[ velax ]= cupidConfigD( gcconfig, "VELORES", 2.0, status );
      }
   }

/* See if extra diagnostic info is required. */
   excols = cupidConfigI( gcconfig, "EXTRACOLS", 0, status );

/* Get the maximum allowed number of failed fits between succesful fits. */
   maxskip = cupidConfigI( gcconfig, "MAXSKIP", 10, status );

/* Get the maximum allowed number of failed fits between succesful fits. */
   maxclump = cupidConfigI( gcconfig, "MAXCLUMPS", VAL__MAXI, status );

/* The iterative process ends when "npad" consecutive clumps all had peak
   values below "peak_thresh" or all had areas below "area_thresh". */
   npad = cupidConfigI( gcconfig, "NPAD", 10, status );

/* Get the RMS noise level to use. */
   rms = cupidConfigD( gcconfig, "RMS", rms, status );

/* Find the size of each dimension of the data array, and the total number
   of elements in the array. We use the memory management functions of the
   AST library since they provide greater security and functionality than
   direct use of malloc, etc. */
   dims = astMalloc( sizeof( *dims )*(size_t) ndim );
   el = 1;
   if( dims ) {
     for( i = 0; i < (size_t)ndim; i++ ) {
         dims[ i ] = subnd[ i ] - slbnd[ i ] + 1;
         el *= dims[ i ];
      }
   }

/* Copy the supplied data array into a work array which will hold the
   residuals remaining after subtraction of the fitted Gaussians. The
   cupidStore macro is a wrapper around the astStore function. */
   res = cupidStore( NULL, ipd, el, type, "cupidGaussClumps" );
   if( res ) {

/* Set the lower threshold for clump peaks to a user-specified multiple
   of the RMS noise. */
      peak_thresh = cupidConfigD( gcconfig, "THRESH", 2.0, status );

/* Set the lower threshold for clump area to a user-specified number of
   pixels. */
      area_thresh = cupidConfigI( gcconfig, "MINPIX", 3, status );

/* Get the lowest value (normalised to the RMS noise level) at which
   model Gaussians should be evaluated. */
      mlim = cupidConfigD( gcconfig, "MODELLIM", 0.5, status );

/* Get the max allowed fraction of bad pixels in a clump. */
      maxbad = cupidConfigD( gcconfig, "MAXBAD", 0.05, status );

/* Initialise the number of clumps found so far. */
      iclump = 0;

/* Indicate that no peaks have been found below the lower threshold for clump
   peak values, or below the lower area threshold. */
      peaks_below = 0;
      area_below = 0;

/* Initialise the variables used to keep track of the mean and standard
   deviation of the most recent "npeak" fitted peak values. */
      nsig = cupidConfigD( gcconfig, "NSIGMA", 3.0, status );
      npeak = cupidConfigI( gcconfig, "NPEAK", 9, status );
      ipeak = 0;
      sum_peak = 0.0;
      sum_peak2 = 0.0;
      iter = 1;
      niter = 0;
      nskip = 0;
      sumclumps = 0.0;
      sumdata = VAL__BADD;
      peaks = astMalloc( sizeof( *peaks )*npeak );
      if( peaks ) {
         for( i = 0; i < npeak; i++ ) peaks[ i ] = 0.0;


/* Use the setjmp function to define here to be the place to which the
   signal handling function will jump when a signal is detected. Zero is
   returned on the first invocation of setjmp. If a signal is detected,
   a jump is made into setjmp which then returns a positive signal
   identifier. */
         if( setjmp( CupidGCHere ) ) {
            iter = 0;
            msgBlankif( MSG__QUIET, status );
            msgOutif( MSG__QUIET, "",
                      "Interupt detected. Clumps found so far will be saved",
                      status );
            msgBlankif( MSG__QUIET, status );
         }
      }

/* Set up a signal handler for the SIGINT (interupt) signal. If this
   signal occurs, the function "cupidGCHandler" will be called. */
      signal( SIGINT, cupidGCHandler );

/* Loop round fitting a gaussian to the largest remaining peak in the
   residuals array. */
      while( iter && *status == SAI__OK ) {

/* Report the iteration number to the user if required. */
         ++niter;
         msgBlankif( MSG__DEBUG1, status );
         msgOutiff( MSG__DEBUG1, "", "Iteration %d:", status, niter );

/* Find the 1D vector index of the elements with the largest value in the
   residuals array. */
         allbad = cupidGCFindMax( type, res, el, &imax, &sumdata, status );

/* Finish iterating if all the residuals are bad, or if too many iterations
   have been performed since the last succesfully fitted clump. */
         if( allbad ) {
            iter = 0;
            niter--;
            msgBlankif( MSG__DEBUG, status );
            msgOutif( MSG__DEBUG1, "",
                      "There are no good pixels left to be fitted.",
                      status );
            msgBlankif( MSG__DEBUG1, status );
         } else if( nskip > maxskip ){
            iter = 0;
            niter--;
            msgBlankif( MSG__DEBUG, status );
            msgOutiff( MSG__DEBUG1, "",
                       "The previous %d fits were unusable.", status, maxskip );
            msgBlankif( MSG__DEBUG1, status );
         }

/* If not, make an initial guess at the Gaussian clump parameters centred
   on the current peak. */
         if( iter ) {
            cupidGCSetInit( type, res, ipv, ndim, dims, imax, rms, gcconfig,
                            ( niter == 1 ), velax, x, slbnd, status );

/* Find the best fitting parameters, starting from the above initial guess.
   This returns a function value of zero if no fit could be performed. */
            if( cupidGCFit( type, res, imax, x, &chisq, status ) ) {

/* Skip this fit if we have an estimate of the standard deviation of the
   "npeak" most recent clump peak values, and the peak value of the clump
   just fitted is a long way (more than NSIGMA standard deviations) from the
   peak value of the previously fitted clump. Also skip it if the peak
   value is less than the "mlim" value. */
               if( ( npeak == 0 || iclump < npeak ||
                     fabs( x[ 0 ] - new_peak ) < nsig*sigma_peak ) &&
                    x[ 0 ] > mlim ) {

/* Record the new peak value for use with the next peak, and update the
   standard deviation of the "npeak" most recent peaks. These values are
   stored cyclically in the "peaks" array. */
                  if( npeak > 0 ) {
                     new_peak = x[ 0 ];
                     old_peak = peaks[ ipeak ];
                     peaks[ ipeak ] = new_peak;
                     if( ++ipeak == npeak ) ipeak = 0;
                     sum_peak += new_peak - old_peak;
                     sum_peak2 += new_peak*new_peak - old_peak*old_peak;
                     if( sum_peak2 < 0.0 ) sum_peak2 = 0.0;
                     mean_peak = sum_peak/npeak;
                     sigma_peak = sqrt( sum_peak2/npeak - mean_peak*mean_peak );
                  }

/* Increment the number of peaks found. */
                  iclump++;

/* Reset the number of failed fits since the last good fit. */
                  nskip = 0;

/* Remove the model fit (excluding the background) from the residuals
   array. This also creates an NDF containing the data values associated
   with the clump. This NDF is stored in the HDS array of NDFs in the
   returned HDS object. The standard deviation of the new residuals is
   returned. */
                  cupidGCUpdateArrays( type, res, ipd, el, ndim, dims,
                                       x, rms, mlim, imax, peak_thresh, slbnd,
                                       &ret, iclump, excols, mean_peak,
                                       maxbad, &area, &sumclumps, status );

/* Dump the modified residuals if required. */
                  sprintf( buf, "residuals%lu", iclump );
                  cupidGCDump( type, MSG__DEBUG3, res, ndim, dims, buf,
                               status );

/* Display the clump parameters on the screen if required. */
                  cupidGCListClump( iclump, ndim, x, chisq, slbnd,
                                    rms, status );

/* If this clump has a peak value which is below the threshold, increment
   the count of consecutive clumps with peak value below the threshold.
   Otherwise, reset this count to zero. */
                  if( x[ 0 ] < peak_thresh ) {
                     peaks_below++;
                  } else {
                     peaks_below = 0;
                  }

/* If this clump has an area which is below the threshold, increment
   the count of consecutive clumps with area below the threshold.
   Otherwise, reset this count to zero. */
                  if( area < area_thresh ) {
                     area_below++;
                  } else {
                     area_below = 0;
                  }

/* If the maximum number of clumps have now been found, exit.*/
                  if( iclump == maxclump ) {
                     iter = 0;

                     msgBlankif( MSG__DEBUG, status );
                     msgOutiff( MSG__DEBUG1, "",
                                "The specified maximum number of "
                                "clumps (%lu) have been found.", status,
                                maxclump );
                     msgBlankif( MSG__DEBUG1, status );

/* If the integrated data sum in the fitted gaussians exceeds or equals
   the integrated data sum in th einput, exit. */
                  } else if( sumclumps >= sumdata ) {
                     iter = 0;

                     msgBlankif( MSG__DEBUG, status );
                     msgOutiff( MSG__DEBUG1,"",
                                "The total data sum of the fitted "
                                "Gaussians (%g) has reached the total "
                                "data sum in the supplied data (%g).",
                                status, (float)sumclumps, (float)sumdata );
                     msgBlankif( MSG__DEBUG1, status );

/* If the count of consecutive peaks below the threshold has reached
   "Npad", terminate. */
                  } else if( peaks_below == npad ) {
                     iter = 0;

                     msgBlankif( MSG__DEBUG, status );
                     msgOutiff( MSG__DEBUG1, "",
                                "The previous %d clumps all had peak "
                                "values below the threshold.", status,
                                npad );
                     msgBlankif( MSG__DEBUG1, status );

/* If the count of consecutive clumps with area below the threshold has reached
   "Npad", terminate. */
                  } else if( area_below == npad ) {
                     iter = 0;

                     msgBlankif( MSG__DEBUG, status );
                     msgOutiff( MSG__DEBUG1, "",
                                "The previous %d clumps all had areas "
                                "below the threshold.", status, npad );
                     msgBlankif( MSG__DEBUG1, status );
                  }

/* If the peak value fitted is very different from the previous fitted peak
   value, set the residuals array element bad in order to prevent the
   algorithm from trying to fit a peak to the same pixel again. */
               } else {
                  if( type == CUPID__DOUBLE ) {
                     ((double *)res)[ imax ] = VAL__BADD;
                  } else {
                     ((float *)res)[ imax ] = VAL__BADR;
                  }

                  new_peak = 0.5*( new_peak + x[ 0 ] );

                  nskip++;
                  msgOutif( MSG__DEBUG1, "", "   Clump rejected due to "
                            "aberrant peak value.", status );
               }

/* Tell the user if no clump could be fitted around the current peak
   pixel value */
            } else {
               nskip++;
               msgOutif( MSG__DEBUG1, "", "   No clump fitted.", status );

/* Set the specified element of the residuals array bad if no fit was
   performed. This prevents the any subsequent attempt to fit a Gaussian
   to the same peak value.*/
               if( type == CUPID__DOUBLE ) {
                  ((double *)res)[ imax ] = VAL__BADD;
               } else {
                  ((float *)res)[ imax ] = VAL__BADR;
               }
            }

/* Tell the user if one of the trmination criteria has ben met. */
         } else {
           msgOutif( MSG__DEBUG1, "",
                     "   At least one termination criterion has been reached.",
                     status );
           msgBlankif( MSG__DEBUG1, status );
         }
      }

/* Tell the user how clumps are being returned. */
      if( ret ) {
        datSize( ret, &nclump, status );
      } else {
        nclump = 0;
      }

      if( nclump == 0 ) msgOutif( MSG__NORM, "", "No usable clumps found.", status );

      if( iclump - nclump == 1 ) {
        msgOutif( MSG__NORM, "",
                  "1 clump rejected because it touches an edge of "
                  "the data array.", status );
      } else if( iclump - nclump > 1 ) {
        msgOutiff( MSG__NORM, "",
                   "%d clumps rejected because they touch an edge of "
                   "the data array.", status, (int)( iclump - nclump ) );
      }

/* Tell the user how many iterations have been performed (i.e. how many
   attempts there have been to fit a Gaussian peak). */
      if( niter == 1 ){
        msgOutif( MSG__DEBUG1, "", "No fit attempted.", status );
      } else {
        msgOutiff( MSG__DEBUG1, "",
                   "Fits attempted for %d candidate clumps (%d failed).",
                   status, (int)( niter - iclump ), niter );
      }

/* Free resources */
      peaks = astFree( peaks );

   }

/* Remove the secondary KeyMap added to the KeyMap containing configuration
   parameters for this algorithm. This prevents the values in the secondary
   KeyMap being written out to the CUPID extension when cupidStoreConfig is
   called. */
   astMapRemove( gcconfig, CUPID__CONFIG );

/* Free resources */
   res = astFree( res );
   dims = astFree( dims );

   cupidGC.data = astFree( cupidGC.data );
   cupidGC.weight = astFree( cupidGC.weight );
   cupidGC.res = astFree( cupidGC.res );
   cupidGC.resu = astFree( cupidGC.resu );
   cupidGC.initmodel = astFree( cupidGC.initmodel );
   cupidGC.model = astFree( cupidGC.model );
   cupidGC.resids = astFree( cupidGC.resids );

   gcconfig = astAnnul( gcconfig );

/* Return the list of clump NDFs. */
   return ret;

}
Ejemplo n.º 5
0
void smf_grp_related( const Grp *igrp, const size_t grpsize,
                      const int grouping, const int checksubinst,
                      double maxlen_s, double *srate_maxlen,
                      AstKeyMap *keymap, dim_t *maxconcatlen,
                      dim_t *maxfilelen, smfGroup **group,
                      Grp **basegrp, dim_t *pad, int *status ) {

  /* Local variables */
  size_t *chunk=NULL;         /* Array of flags for continuous chunks */
  dim_t * chunklen = NULL;    /* Length of continuous chunk */
  size_t currentindex = 0;    /* Counter */
  char cwave[10];             /* String containing wavelength */
  smfData *data = NULL;       /* Current smfData */
  double downsampscale=0;     /* Angular scale downsampling size */
  double downsampfreq=0;      /* Target downsampling frequency */
  AstKeyMap * grouped = NULL; /* Primary AstKeyMap for grouping */
  size_t i;                   /* Loop counter for index into Grp */
  int isFFT=0;                /* Set if data are 4d FFT */
  size_t j;                   /* Loop counter */
  int *keepchunk=NULL;        /* Flag for chunks that will be kept */
  dim_t maxconcat=0;          /* Longest continuous chunk length */
  dim_t maxflen=0;            /* Max file length in time steps */
  dim_t maxlen=0;             /* Maximum concat length in samples */
  int maxlen_scaled=0;        /* Set once maxlen has been scaled, if needed */
  dim_t maxpad=0;             /* Maximum padding neeed for any input file */
  size_t maxrelated = 0;      /* Keep track of max number of related items */
  size_t *new_chunk=NULL;     /* keeper chunks associated with subgroups */
  dim_t *new_tlen=NULL;       /* tlens for new_subgroup */
  size_t ngroups = 0;         /* Counter for subgroups to be stored */
  size_t nkeep = 0;           /* Number of chunks to keep */
  dim_t * piecelen = NULL;    /* Length of single file */
  smf_subinst_t refsubinst;   /* Subinst of first file */
  size_t **subgroups = NULL;  /* Array containing index arrays to parent Grp */
  smf_subinst_t subinst;      /* Subinst of current file */

  if ( *status != SAI__OK ) return;

  if( maxlen_s < 0 ) {
    *status = SAI__ERROR;
    errRep( "", FUNC_NAME ": maxlen_s cannot be < 0!", status );
    return;
  }

  /* Get downsampling parameters */

  if( keymap ) {
    smf_get_cleanpar( keymap, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
                      NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
                      NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL, NULL,
                      NULL, NULL, NULL, NULL, &downsampscale, &downsampfreq,
                      NULL, NULL, NULL, NULL, status );

    if( downsampscale && downsampfreq ) {
      *status = SAI__ERROR;
      errRep( "", FUNC_NAME ": both downsampscale and downsampfreq are set",
              status );
      return;
    }
  }

  /* Initialize refcwave */
  refsubinst = SMF__SUBINST_NONE;

  /* Loop over files in input Grp: remember Grps are indexed from 1 */
  grouped = astKeyMap( "SortBy=KeyUp" );
  for (i=1; i<=grpsize; i++) {
    char newkey[128];
    char dateobs[81];
    char subarray[10];
    size_t nrelated = 0;
    AstKeyMap * filemap = NULL;
    AstKeyMap * indexmap = NULL;

    /* First step: open file and harvest metadata */
    smf_open_file( NULL, igrp, i, "READ", SMF__NOCREATE_DATA, &data, status );
    if (*status != SAI__OK) break;

    if( i==1 ) {
      isFFT = smf_isfft( data, NULL, NULL, NULL, NULL, NULL, status );
    } else if( smf_isfft(data, NULL, NULL, NULL, NULL, NULL, status) != isFFT ){
      *status = SAI__ERROR;
      errRep( "", FUNC_NAME
              ": mixture of time-series and FFT data encountered!",
              status );
      break;
    }

    /* If maxlen has not been set, do it here */
    if( !maxlen && maxlen_s && data->hdr->steptime) {
      maxlen = (dim_t) (maxlen_s / data->hdr->steptime );
    }

    /* Return srate_maxlen if requested: may want to know this number
       even if maxlen_s is not set. Only calculate once, although it
       gets overwritten once later if down-sampling. */

    if( (i==1) && srate_maxlen && data->hdr->steptime ) {
      *srate_maxlen = 1. / (double) data->hdr->steptime;
    }


    /* If requested check to see if we are mixing wavelengths */
    if( checksubinst ) {
      if( refsubinst == SMF__SUBINST_NONE ) {
        refsubinst = smf_calc_subinst( data->hdr, status );
      }

      subinst = smf_calc_subinst( data->hdr, status );

      if( subinst != refsubinst ) {
        const char *refsubstr = smf_subinst_str( refsubinst, status );
        const char *substr = smf_subinst_str( subinst, status );

        *status = SAI__ERROR;
        smf_smfFile_msg( data->file, "FILE", 1, "<unknown>" );
        msgSetc( "REFSUB", refsubstr );
        msgSetc( "SUB", substr );
        errRep( "", FUNC_NAME
                ": ^FILE uses sub-instrument ^SUB which doesn't match "
                "reference ^REFSUB", status );
      }
    }

    /* Want to form a key that will be unique for a particular subscan
       We know that DATE-OBS will be set for SCUBA-2 files and be the same
       for a single set. Prefix by wavelength if we are grouping by wavelength.
     */
    newkey[0] = '\0';

    smf_find_subarray( data->hdr, subarray, sizeof(subarray), NULL, status );

    if( grouping == 1 ) {
      /* Group different wavelengths separately */
      smf_fits_getS( data->hdr, "WAVELEN", cwave, sizeof(cwave), status);
      one_strlcat( newkey, cwave, sizeof(newkey), status );
      one_strlcat( newkey, "_", sizeof(newkey), status );
    }

    if( grouping == 2 ) {
      /* Group different subarrays separately */
      one_strlcat( newkey, subarray, sizeof(newkey), status );
    }

    smf_fits_getS( data->hdr, "DATE-OBS", dateobs, sizeof(dateobs), status );
    one_strlcat( newkey, dateobs, sizeof(newkey), status );

    /* Include the dimentionality of the time series in the primary key
       so that we do not end up doing something confusing like relating
       a truncated file with a full length file */
    if (*status == SAI__OK) {
      dim_t dims[3];
      char formatted[32];
      smf_get_dims( data, &dims[0], &dims[1], NULL, &dims[2], NULL, NULL, NULL,
                    status );
      sprintf(formatted, "_%" DIM_T_FMT "_%" DIM_T_FMT "_%" DIM_T_FMT, dims[0], dims[1], dims[2]);
      one_strlcat( newkey, formatted, sizeof(newkey), status );
    }

    /* May want to read the dimensionality of the file outside of loop
       so that we can compare values when storing in the keymap */

    /* Now we want to create a keymap based on this key */
    if (!astMapGet0A( grouped, newkey, &filemap ) ) {
      int itemp = 0;
      double steptime = data->hdr->steptime;
      dim_t ntslice = 0;
      dim_t thispad;              /* Padding neeed for current input file */

      filemap = astKeyMap( " " );
      astMapPut0A( grouped, newkey, filemap, NULL );

      /* Fill up filemap with general information on this file */
      smf_find_seqcount( data->hdr, &itemp, status );
      astMapPut0I( filemap, "SEQCOUNT", itemp, NULL );

      smf_fits_getI( data->hdr, "NSUBSCAN", &itemp, status );
      astMapPut0I( filemap, "NSUBSCAN", itemp, NULL );

      /* Number of time slices */
      smf_get_dims( data, NULL, NULL, NULL, &ntslice, NULL, NULL, NULL,
                    status );

      /* Find length of down-sampled data, new steptime and maxlen */
      if( (downsampscale || downsampfreq) && data->hdr && (*status==SAI__OK) ) {
        double scalelen;

        if( downsampscale ) {
          if( data->hdr->scanvel != VAL__BADD ) {
             double oldscale = steptime * data->hdr->scanvel;
             scalelen = oldscale / downsampscale;
          } else if( *status == SAI__OK ) {
             *status = SAI__ERROR;
            scalelen = VAL__BADD;
            smf_smfFile_msg( data->file, "FILE", 1, "" );
            errRep( "", FUNC_NAME ": can't resample ^FILE because it has "
                    "unknown scan velocity", status );
          }
        } else {
          if( steptime ) {
            double oldsampfreq = 1./steptime;
            scalelen = downsampfreq / oldsampfreq;
          } else {
            *status = SAI__ERROR;
            scalelen = VAL__BADD;
            smf_smfFile_msg( data->file, "FILE", 1, "" );
            errRep( "", FUNC_NAME ": can't resample ^FILE because it has "
                    "unknown sample rate", status );
          }
        }

        /* only down-sample if it will be a reasonable factor */
        if( (*status==SAI__OK) && (scalelen <= SMF__DOWNSAMPLIMIT) ) {
          smf_smfFile_msg(data->file, "FILE", 1, "" );
          msgOutiff( MSG__VERB, "", FUNC_NAME
                     ": will down-sample file ^FILE from %5.1lf Hz to "
                     "%5.1lf Hz", status, (1./steptime), (scalelen/steptime) );

          ntslice = round(ntslice * scalelen);

          /* If maxlen has been requested, and we have not already worked
             out a scaled version (just uses the sample rates for the first
             file... should be close enough -- the alternative is a 2-pass
             system). */

          if( !maxlen_scaled ) {
            maxlen = round(maxlen*scalelen);
            maxlen_scaled = 1;
            msgOutiff( MSG__VERB, "", FUNC_NAME
                       ": requested maxlen %g seconds = %" DIM_T_FMT " down-sampled "
                       "time-slices", status, maxlen_s, maxlen );

            /* Return updated srate_maxlen for down-sampling if requested */
            if( srate_maxlen ) {
              *srate_maxlen = scalelen/steptime;
            }
          }
        }
      }

      /* Check that an individual file is too long (we assume related
         files are all the same) */
      if( maxlen && (ntslice > maxlen) && *status == SAI__OK) {
        *status = SAI__ERROR;
        msgSeti("NTSLICE",ntslice);
        msgSeti("MAXLEN",maxlen);
        smf_smfFile_msg( data->file, "FILE", 1, "" );
        errRep(FUNC_NAME,
               "Number of time steps in file ^FILE time exceeds maximum "
               "(^NTSLICE>^MAXLEN)", status);
      }

      /* Scaled values of ntslice and maximum length */
      astMapPut0I( filemap, "NTSLICE", ntslice, NULL );

      /* Work out the padding needed for this file including downsampling. */
      if( keymap ) {
        thispad = smf_get_padding( keymap, 0, data->hdr, VAL__BADD, status );
        if( thispad > maxpad ) maxpad = thispad;
      } else {
        thispad = 0;
      }
      astMapPut0I( filemap, "PADDING", thispad, NULL );

      /* Update maxflen */
      if( ntslice > maxflen ) {
        maxflen = ntslice;
      }

      /* Store OBSID or OBSIDSS depending on whether we are grouping by wavelength */
      if (grouping) {
        astMapPut0C( filemap, "OBSID", data->hdr->obsidss, NULL );
      } else {
        char obsid[81];
        smf_getobsidss( data->hdr->fitshdr, obsid, sizeof(obsid), NULL, 0, status );
        astMapPut0C( filemap, "OBSID", obsid, NULL );
      }
    }

    /* Store the file index in another keymap indexed by subarray */
    if ( !astMapGet0A( filemap, "GRPINDICES", &indexmap ) ) {
      indexmap = astKeyMap( "SortBy=KeyUp" );
      astMapPut0A( filemap, "GRPINDICES", indexmap, NULL );
    }

    astMapPut0I( indexmap, subarray, i, NULL );

    /* Need to track the largest number of related subarrays in a single slot */
    nrelated = astMapSize( indexmap );
    if (nrelated > maxrelated) maxrelated = nrelated;

    /* Free resources */
    filemap = astAnnul( filemap );
    indexmap = astAnnul( indexmap );
    smf_close_file( NULL, &data, status );
  }

  /* We now know how many groups there are */
  ngroups = astMapSize( grouped );

  /* Sort out chunking. The items are sorted by date and then by wavelength.
     We define a continuous chunk if it has the same OBSID, the same SEQCOUNT
     and NSUBSCAN increments by one from the previous entry.

     Also count number of related items in each slot.
   */
  if (*status == SAI__OK) {
    typedef struct { /* somewhere to store the values easily */
      char obsid[81];
      char related[81];  /* for concatenated subarrays */
      int nsubscan;
      int seqcount;
    } smfCompareSeq;
    smfCompareSeq current;
    smfCompareSeq previous;
    dim_t totlen = 0;
    size_t thischunk;

    /* Get the chunk flags and also store the size of the chunk */
    chunk = astCalloc( ngroups, sizeof(*chunk) );
    chunklen = astCalloc( ngroups, sizeof(*chunklen) );
    piecelen = astCalloc( ngroups, sizeof(*piecelen) );

    thischunk = 0;  /* The current chunk */
    for (i=0; i<ngroups; i++) {
      AstKeyMap * thismap = NULL;
      AstKeyMap * grpindices = NULL;
      const char * tempstr = NULL;
      int thistlen = 0;
      size_t nsubarrays = 0;

      /* Get the keymap entry for this slot */
      astMapGet0A( grouped, astMapKey(grouped, i), &thismap );

      /* Get info for length limits */
      astMapGet0I( thismap, "NTSLICE", &thistlen );
      piecelen[i] = thistlen;

      if (isFFT) {
        /* Never concatenate FFT data */
        thismap = astAnnul(thismap);
        chunk[i] = i;
        chunklen[i] = thistlen;
        continue;
      }

      /* Get indices information and retrieve the sub-instrument names
         in sort order to concatenate for comparison. We only store in
         a continuous chunk if we have the same subarrays for the whole
         chunk. */
      astMapGet0A( thismap, "GRPINDICES", &grpindices );
      nsubarrays = astMapSize( grpindices );
      (current.related)[0] = '\0';
      for (j = 0; j < nsubarrays; j++ ) {
        one_strlcat( current.related, astMapKey(grpindices, j), sizeof(current.related), status );
      }
      grpindices = astAnnul( grpindices );

      /* Fill in the current struct */
      astMapGet0I( thismap, "SEQCOUNT", &(current.seqcount) );
      astMapGet0I( thismap, "NSUBSCAN", &(current.nsubscan) );
      astMapGet0C( thismap, "OBSID", &tempstr );
      one_strlcpy( current.obsid, tempstr, sizeof(current.obsid), status );

      /* First chunk is special, else compare */
      if (i == 0) {
        totlen = thistlen;
      } else {
        if (  ( current.seqcount == previous.seqcount  ) &&
              ( current.nsubscan - previous.nsubscan == 1 ) &&
              ( strcmp( current.obsid, previous.obsid ) == 0 ) &&
              ( strcmp( current.related, previous.related ) == 0 ) ) {
          /* continuous - check length */
          totlen += thistlen;
          if ( maxlen && totlen > maxlen ) {
            thischunk++;
            totlen = thistlen; /* reset length */
          } else {
            /* Continuous */
          }
        } else {
          /* discontinuity */
          thischunk++;
          totlen = thistlen;  /* Update length of current chunk */
        }
      }

      chunklen[thischunk] = totlen;
      chunk[i] = thischunk;
      memcpy( &previous, &current, sizeof(current) );

      thismap = astAnnul( thismap );
    }
  }

  /* Decide if we are keeping a chunk by looking at the length. */
  maxconcat = 0;
  nkeep = 0;
  keepchunk = astMalloc( ngroups*sizeof(*keepchunk) );
  for (i=0; i<ngroups; i++) {
    size_t thischunk;

    thischunk = chunk[i];
    if ( chunklen[thischunk] < SMF__MINCHUNKSAMP ) {
      /* Warning message */
      msgSeti("LEN",chunklen[thischunk]);
      msgSeti("MIN",SMF__MINCHUNKSAMP);
      msgOut( " ", "SMF_GRP_RELATED: ignoring short chunk (^LEN<^MIN)",
              status);
      keepchunk[i] = 0;
    } else {
      keepchunk[i] = 1;
      if (maxconcat < chunklen[thischunk]) maxconcat = chunklen[thischunk];
      nkeep++;
    }

  }

  /* If no useful chunks generate an error */
  if( (*status==SAI__OK) && (!nkeep) ) {
    *status = SAI__ERROR;
    errRep( "", FUNC_NAME ": No useful chunks.", status );
    goto CLEANUP;
  }

  /* Allocate a subgroup array of the right size and fill it. They keymap
     is sorted by date (and wavelength) so we can always index into it by using
     indices from the subgroup. */
  subgroups = astCalloc( nkeep, sizeof(*subgroups) );
  new_chunk = astCalloc( nkeep, sizeof(*new_chunk) );
  new_tlen  = astCalloc( nkeep, sizeof(*new_tlen) );

  currentindex = 0;
  for (i=0;i<ngroups;i++) {
    AstKeyMap * thismap = NULL;
    AstKeyMap * grpindices = NULL;
    size_t nsubarrays = 0;
    size_t *indices = astCalloc( maxrelated, sizeof(*indices) );

    /* skip if we are dropping this chunk */
    if (!keepchunk[i]) continue;

    /* Get the keymap entry for this slot */
    astMapGet0A( grouped, astMapKey(grouped, i), &thismap );

    /* Get the indices keymap */
    astMapGet0A( thismap, "GRPINDICES", &grpindices );
    nsubarrays = astMapSize( grpindices );
    for (j=0; j<nsubarrays; j++) {
      int myindex;
      astMapGet0I( grpindices, astMapKey(grpindices, j), &myindex );
      indices[j] = myindex;
    }
    grpindices = astAnnul( grpindices );
    thismap = astAnnul( thismap );

    subgroups[currentindex] = indices;
    new_chunk[currentindex] = chunk[i];
    new_tlen[currentindex]  = piecelen[i];
    currentindex++;

  }

  /* Create the smfGroup */
  *group = smf_construct_smfGroup( igrp, subgroups, new_chunk, new_tlen,
                                   nkeep, maxrelated, 0, status );

  /* Return maxfilelen if requested */
  if( maxfilelen ) {
    *maxfilelen = maxflen;
  }

  /* Return maxconcatlen if requested */
  if( maxconcatlen ) {
    *maxconcatlen = maxconcat;
  }

  /* Create a base group for output files if required */
  /* Create a base group of filenames */
  if (*status == SAI__OK && basegrp ) {
    *basegrp = smf_grp_new( (*group)->grp, "Base Group", status );

    /* Loop over time chunks */
    for( i=0; (*status==SAI__OK)&&(i<(*group)->ngroups); i++ ) {
      size_t idx;
      /* Check for new continuous chunk */
      if( i==0 || ( (*group)->chunk[i] != (*group)->chunk[i-1]) ) {
        /* Loop over subarray */
        for( idx=0; idx<(*group)->nrelated; idx++ ) {
          size_t grpindex = (*group)->subgroups[i][idx];
          if ( grpindex > 0 ) {
            ndgCpsup( (*group)->grp, grpindex, *basegrp, status );
          }
        }
      }
    }
  }

 CLEANUP:
  keepchunk = astFree( keepchunk );
  chunk = astFree( chunk );
  chunklen = astFree( chunklen );
  piecelen = astFree( piecelen );
  grouped = astAnnul( grouped );

  if( *status != SAI__OK ) {
    /* free the group */
    if (basegrp && *basegrp) grpDelet( basegrp, status );
    if (group && *group) {
      smf_close_smfGroup( group, status );
    } else {
      /* have to clean up manually */
      new_chunk = astFree( new_chunk );
      new_tlen = astFree( new_tlen );
      if( subgroups ) {
        size_t isub;
        for( isub=0; isub<nkeep; isub++ ) {
          subgroups[isub] = astFree( subgroups[isub] );
        }
        subgroups = astFree( subgroups );
      }
    }
  }

  /* Return the maximum padding if required. */
  if( pad ) *pad = maxpad;
}