void fts2_getmirrorpositions(smfData* data, double* positions, int* size, int* status)
{
if(*status != SAI__OK) { return; }
char ftsMode[SZFITSTR];
size_t count = 0; /* Size */
HDSLoc* hdsLoc = NULL; /* Pointer to HDS location */
HDSLoc* hdsLocPos = NULL; /* Pointer to mirror positions */
smf_fits_getS(data->hdr, "FTS_MODE", ftsMode, sizeof(ftsMode), status);
if(strncmp(ftsMode, "FSCAN", 5) == 0 ) {
hdsLoc = smf_get_xloc(data, "JCMTSTATE", "EXT", "READ", 0, 0, status);
datFind(hdsLoc, "FTS_POS", &hdsLocPos, status);
datSize(hdsLocPos, &count, status);
datGetVD(hdsLocPos, count, positions, &count, status);
*size = (int) count;
} else if(strncmp(ftsMode, "STEPINT", 7) == 0 ) {
*status = SAI__ERROR;
errRep(FUNC_NAME, "STEPINT mode is NOT supported!", status);
} else {
*status = SAI__ERROR;
errRep(FUNC_NAME, "Unknown Scan Mode is found!", status);
}
if(hdsLoc) { datAnnul(&hdsLoc, status); }
if(hdsLocPos) { datAnnul(&hdsLocPos, status); }
}
/*===============================*/
int
datMapV(HDSLoc *locator,
const char *type_str,
const char *mode_str,
void **pntr,
size_t *actval,
int *status )
{
#undef context_name
#undef context_message
#define context_name "DAT_MAPV_ERR"
#define context_message\
"DAT_MAPV: Error mapping an HDS vectorized primitive."
/* Local variables */
hdsdim dims[DAT__MXDIM];
int ndim;
/* Initialise return values */
*pntr = NULL;
*actval = 0;
datSize( locator, actval, status );
datShape( locator, DAT__MXDIM, dims, &ndim, status );
datMap( locator, type_str, mode_str, ndim, dims,
pntr, status );
return *status;
}
int
datPut1L( const HDSLoc * locator,
size_t nval,
const hdsbool_t values[],
int * status ) {
size_t size;
hdsdim dim[1];
if ( *status != SAI__OK ) return *status;
datSize( locator, &size, status );
if ( *status == SAI__OK && size != nval ) {
*status = DAT__BOUND;
emsSeti( "IN", (int)nval );
emsSeti( "SZ", (int)size );
emsRep( "DAT_PUT1L_ERR", "Bounds mismatch: ^IN != ^SZ", status);
} else {
dim[0] = (hdsdim)size;
datPutL( locator, 1, dim, values, status );
}
return *status;
}
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;
}
void cupidGCNdfClump( HDSLoc **obj, double sum, double *par, double rms,
int ndim, int *lbox, int *ubox, int list_size,
double *mlist, int *plist, int *lbnd, int iclump,
int *dax, AstKeyMap *extra, int bad, int *status ){
/*
*+
* Name:
* cupidGCNdfClump
* Purpose:
* Create an NDF containing a description of a single clump.
* Language:
* Starlink C
* Synopsis:
* void cupidGCNdfClump( HDSLoc **obj, double sum, double *par, double rms,
* int ndim, int *lbox, int *ubox, int list_size,
* double *mlist, int *plist, int *lbnd, int iclump,
* int *dax, AstKeyMap *extra, int bad,
* int *status )
* Description:
* This function creates a temporary NDF and stores the integrated
* intensity of the clump in its Data component. The bounds of the NDF
* will be the smallest possible which still encompass the clump. In
* addition, if required it will create a Cupid extension in the NDF
* containing
*
* - The parameters of a Gaussian approximation to the clump (if supplied).
* - Any supplied extra information.
* Parameters:
* obj
* A pointer to a locator for an HDS array of NDF objects. The array
* will be extended to accomodate the new NDF. If NULL is supplied a
* new temporary HDS object is created, and the locator stored at the
* given address.
* sum
* The integrated intensity in the clump. Note, unlike par[0] and
* par[1], this value should not be normalised to the RMS noise.
* par
* Pointer to an array holding the parameters of a Gaussian
* approximation to the clump, or NULL. How many of these are used
* depends on the value of "ndim": if "ndim" is 1 only elements 0 to
* 3 are used, if "ndim" is 2 only elements 0 to 6 are used, if "ndim"
* is 3 all elements are used. All axis values are represented in GRID
* pixels:
*
* par[0]: Peak intensity of clump (in units of the RMS noise level).
* par[1]: Constant intensity offset (in units of the RMS noise level).
* par[2]: Model centre on internal axis 0 (in pixels)
* par[3]: Intrinsic FWHM on axis 0 (in pixels)
* par[4]: Model centre on internal axis 1 (in pixels)
* par[5]: Intrinsic FWHM on axis 1 (in pixels)
* par[6]: Spatial orientation angle (in radians, positive from
* +ve GRID1 axis to +ve GRID2 axis).
* par[7]: Model centre on internal axis 3 (velocity) (in pixels)
* par[8]: Intrinsic FWHM on velocity axis (in pixels)
* par[9]: Axis 0 of internal velocity gradient vector (in velocity
* pixels per spatial pixel).
* par[10]: Axis 1 of internal velocity gradient vector (in
* velocity pixels per spatial pixel).
* rms
* The RMS noise level.
* ndim
* The number of pixel axes in the array.
* lbox
* The lower grid index bounds of the area containing the clump
* (using internal axis numbering).
* ubox
* The upper grid index bounds of the area containing the clump
* (using internal axis numbering).
* list_size
* The number of values supplied in mlist and plist.
* mlist
* An array of "list_size" elements containing the clump values at
* each pixel.
* plist
* An array of "ndim*list_size" elements in which each group of
* "ndim" adjacent values forms the grid indices of the corresponding
* value in "mlist". This uses external axis ordering.
* lbnd
* Pointer to array holding the pixel indices of the first pixel in
* the user-supplied NDF (using external axis numbering).
* iclump
* The index of the current clump.
* dax
* Array holding external axis number indexed by internal axis number.
* extra
* An AstKeyMap holding extra diagnositic information to add to the
* clump structure.
* bad
* Set the Unit component of the NDF to "BAD". This is used as a
* flag to indicate that the clump touches too many areas of bad
* pixels.
* status
* Pointer to the inherited status value.
* Copyright:
* Copyright (C) 2009 Science and Technology Facilities Council.
* Copyright (C) 2005,2007 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:
* 10-NOV-2005 (DSB):
* Original version.
* 5-MAR-2007 (DSB):
* Initiaslise "exloc" locator to NULL before calling datFind.
* 13-JAN-2009 (TIMJ):
* DO NOT CAST int* to size_t* since that is not going to work for long.
* 26-JAN-2011 (DSB):
* Ensure the "m" pointer is incremented even if the currrent model pixel
* is off the edge of the NDF. Previously, this bug caused a stripey
* "aliasing" type effect if the supplied model data extends outside the
* bounds of the NDF.
* 25-MAY-2017 (DSB):
* Switch off group history and provenance recording during this
* function. This is because it can inflate the time taken to run
* findclumps enormously if there are many thousands of clumps.
* {enter_further_changes_here}
* Bugs:
* {note_any_bugs_here}
*-
*/
/* Local Variables: */
const char *cen[] = { "CENTRE1", "CENTRE2", "CENTRE3" };
const char *fwhm[] = { "FWHM1", "FWHM2", "FWHM3" };
const char *vgrad[] = { "VGRAD1", "VGRAD2", "VGRAD3" };
HDSLoc *cloc; /* Cell locator */
HDSLoc *dloc; /* Component locator */
HDSLoc *xloc; /* Extension locator */
HDSLoc *exloc; /* Locator for structure holding extra info */
const char *key; /* KeyMap key name */
double *ipd; /* Pointer to Data array */
double *m; /* Pointer to next data value */
double dval; /* Double value to store */
int *p; /* Pointer to next grid axis value */
int el; /* Number of elements mapped */
int elb[ 3 ]; /* The lower NDF limit on each external axis */
int elbox[ 3 ]; /* The lower box limit on each external axis */
int estep[ 3 ]; /* The step size on each external axis */
int eub[ 3 ]; /* The upper NDF limit on each external axis */
int eubox[ 3 ]; /* The upper box limit on each external axis */
int i; /* Point index */
int indf; /* NDF identifier */
int iv; /* 1D vector index for current data value */
int j; /* Axis index */
int lb[ 3 ]; /* Lower pixel index bounds of NDF */
int nex; /* No. of extra items of information */
int ok; /* Pixel within clump NDF? */
int old_ghstate; /* Non-zero if group history recording is switched on */
int old_pvstate; /* Non-zero if provenance recording is switched on */
int place; /* NDF place holder */
int pv; /* Pixel offset */
size_t oldsize; /* Size of original NDF */
hdsdim size[1]; /* No of elements in NDF array */
int step[ 3 ]; /* The step size on each internal axis */
int ub[ 3 ]; /* Upper pixel index bounds of NDF */
/* Abort if an error has already occurred. */
if( *status != SAI__OK ) return;
/* If no array was supplied create one of length 1. */
if( !(*obj) ) {
size[0] = 1;
datTemp( "NDF", 1, size, obj, status );
/* Otherwise, get the number of NDFs already in the supplied array of
NDFs, and increase it by 1. */
} else {
datSize( *obj, &oldsize, status );
size[0] = oldsize + 1;
datAlter( *obj, 1, size, status );
}
/* Get a locator for the new cell. */
cloc = NULL;
datCell( *obj, 1, size, &cloc, status );
/* Begin an NDF context */
ndfBegin();
/* Temporaily switch off group history and provenance recording since there
can be thousands of clump NDFs. */
ndgHltgh( 0, &old_ghstate, status );
ndgHltpv( 0, &old_pvstate, status );
/* Find the pixel index bounds of the NDF and the step between adjacent
pixels on each axis. */
lb[ 0 ] = lbox[ 0 ] - 1 + lbnd[ dax[ 0 ] ];
ub[ 0 ] = ubox[ 0 ] - 1 + lbnd[ dax[ 0 ] ];
step[ 0 ] = 1;
for( i = 1; i < ndim; i++ ) {
lb[ i ] = lbox[ i ] - 1 + lbnd[ dax[ i ] ];
ub[ i ] = ubox[ i ] - 1 + lbnd[ dax[ i ] ];
step[ i ] = ( ub[ i - 1 ] - lb[ i - 1 ] + 1 )*step[ i - 1 ];
}
/* Convert lbox, lb, ub and step from internal axis numbering to external axis
numbering. */
for( i = 0; i < ndim; i++ ) {
elbox[ dax[ i ] ] = lbox[ i ];
eubox[ dax[ i ] ] = ubox[ i ];
elb[ dax[ i ] ] = lb[ i ];
eub[ dax[ i ] ] = ub[ i ];
estep[ dax[ i ] ] = step[ i ];
}
/* Create a place holder for the new NDF within the new cell. The NDF will be
copied to its final resting place before the program exits. */
ndfPlace( cloc, " ", &place, status );
/* Create the NDF to receive the clump values. The size of this NDF is the
minimum needed to contain the clump. */
ndfNew( "_DOUBLE", ndim, elb, eub, &place, &indf, status );
/* Map the NDFs Data array, filling it with bad values. */
ndfMap( indf, "DATA", "_DOUBLE", "WRITE/BAD", (void *) &ipd, &el, status );
if( ipd ) {
/* Store every supplied model value in the NDF data array. */
m = mlist;
p = plist;
for( i = 0; i < list_size; i++,m++ ) {
/* Find the 1D vector index into the NDF data array corresponding to the
grid indices (within the user supplied NDF) of the current point.*/
pv = *(p++);
iv = pv - elbox[ 0 ];
ok = ( pv >= elbox[ 0 ] && pv <= eubox[ 0 ] );
for( j = 1; j < ndim; j++ ) {
pv = *(p++);
iv += ( pv - elbox[ j ] )*estep[ j ];
if( pv < elbox[ j ] || pv > eubox[ j ] ) ok = 0;
}
/* Store the value. */
if( ok ) ipd[ iv ] = *m;
}
/* Unmap the NDFs Data array. */
ndfUnmap( indf, "DATA", status );
}
/* If required, create a Cupid extension in the NDF. */
if( par || extra ) {
xloc = NULL;
ndfXnew( indf, "CUPID", "CUPID_EXT", 0, NULL, &xloc, status );
/* First do Gaussian parameters. */
if( par ) {
/* Store the integrated intensity in the clump. */
dloc = NULL;
datNew( xloc, "SUM", "_DOUBLE", 0, NULL, status );
datFind( xloc, "SUM", &dloc, status );
datPutD( dloc, 0, NULL, &sum, status );
datAnnul( &dloc, status );
/* Store the parameters of the Gaussian approximation, taking out the
normalisation by the RMS noise level.*/
datNew( xloc, "PEAK", "_DOUBLE", 0, NULL, status );
datFind( xloc, "PEAK", &dloc, status );
dval = rms*par[ 0 ];
datPutD( dloc, 0, NULL, &dval, status );
datAnnul( &dloc, status );
datNew( xloc, "OFFSET", "_DOUBLE", 0, NULL, status );
datFind( xloc, "OFFSET", &dloc, status );
dval = rms*par[ 1 ];
datPutD( dloc, 0, NULL, &dval, status );
datAnnul( &dloc, status );
datNew( xloc, cen[ dax[ 0 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, cen[ dax[ 0 ] ], &dloc, status );
dval = par[ 2 ] + lbnd[ dax[ 0 ] ] - 1.5;
datPutD( dloc, 0, NULL, &dval, status );
datAnnul( &dloc, status );
datNew( xloc, fwhm[ dax[ 0 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, fwhm[ dax[ 0 ] ], &dloc, status );
datPutD( dloc, 0, NULL, par + 3, status );
datAnnul( &dloc, status );
if( ndim > 1 ) {
datNew( xloc, cen[ dax[ 1 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, cen[ dax[ 1 ] ], &dloc, status );
dval = par[ 4 ] + lbnd[ dax[ 1 ] ] - 1.5;
datPutD( dloc, 0, NULL, &dval, status );
datAnnul( &dloc, status );
datNew( xloc, fwhm[ dax[ 1 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, fwhm[ dax[ 1 ] ], &dloc, status );
datPutD( dloc, 0, NULL, par + 5, status );
datAnnul( &dloc, status );
datNew( xloc, "ANGLE", "_DOUBLE", 0, NULL, status );
datFind( xloc, "ANGLE", &dloc, status );
dval = par[ 6 ]*AST__DR2D;
datPutD( dloc, 0, NULL, &dval, status );
datAnnul( &dloc, status );
if( ndim > 2 ) {
datNew( xloc, cen[ dax[ 2 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, cen[ dax[ 2 ] ], &dloc, status );
dval = par[ 7 ] + lbnd[ dax[ 2 ] ] - 1.5;
datPutD( dloc, 0, NULL, &dval, status );
datAnnul( &dloc, status );
datNew( xloc, fwhm[ dax[ 2 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, fwhm[ dax[ 2 ] ], &dloc, status );
datPutD( dloc, 0, NULL, par + 8, status );
datAnnul( &dloc, status );
datNew( xloc, vgrad[ dax[ 0 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, vgrad[ dax[ 0 ] ], &dloc, status );
datPutD( dloc, 0, NULL, par + 9, status );
datAnnul( &dloc, status );
datNew( xloc, vgrad[ dax[ 1 ] ], "_DOUBLE", 0, NULL, status );
datFind( xloc, vgrad[ dax[ 1 ] ], &dloc, status );
datPutD( dloc, 0, NULL, par + 10, status );
datAnnul( &dloc, status );
}
}
}
/* Now store any extra diagnostic information. */
if( extra ) {
datNew( xloc, "EXTRA", "EXTRA", 0, NULL, status );
exloc = NULL;
datFind( xloc, "EXTRA", &exloc, status );
nex = astMapSize( extra );
for( i = 0; i < nex; i++ ) {
key = astMapKey( extra, i );
if( astMapGet0D( extra, key, &dval ) ) {
datNew( exloc, key, "_DOUBLE", 0, NULL, status );
datFind( exloc, key, &dloc, status );
datPutD( dloc, 0, NULL, &dval, status );
datAnnul( &dloc, status );
}
}
datAnnul( &exloc, status );
}
/* Release the extension locator. */
datAnnul( &xloc, status );
}
/* If required set the Unit component to "BAD". */
if( bad ) ndfCput( "BAD", indf, "Unit", status );
/* Switch group history and provenance recording back to their original
states. */
ndgHltgh( old_ghstate, NULL, status );
ndgHltpv( old_pvstate, NULL, status );
/* End the NDF context */
ndfEnd( status );
/* Release the cell locator. */
datAnnul( &cloc, status );
}
void clumpinfo( int *status ) {
/*
*+
* Name:
* CLUMPINFO
* Purpose:
* Obtain information about one or more previously identified clumps.
* Language:
* C
* Type of Module:
* ADAM A-task
* Description:
* This application returns various items of information about a
* single clump, or a collection of clumps, previously identified
* using FINDCLUMPS or EXTRACTCLUMPS.
* Usage:
* clumpinfo ndf clumps quiet
* ADAM Parameters:
* CLUMPS = LITERAL (Read)
* Specifies the indices of the clumps to be included in the
* returned information. It can take any of the following values:
*
* - "ALL" or "*" -- All clumps.
*
* - "xx,yy,zz" -- A list of clump indices.
*
* - "xx:yy" -- Clump indices between xx and yy inclusively. When
* xx is omitted the range begins from one; when yy is omitted the
* range ends with the final clump index.
*
* - Any reasonable combination of above values separated by
* commas.
* FLBND( ) = _DOUBLE (Write)
* The lower bounds of the bounding box enclosing the selected
* clumps in the current WCS Frame of the input NDF. Celestial axis
* values are always in units of radians, but spectral axis units
* will be in the spectral units used by the current WCS Frame.
* FUBND( ) = _DOUBLE (Write)
* The upper bounds of the bounding box enclosing the selected
* clumps. See parameter FLBND for more details.
* LBOUND( ) = _INTEGER (Write)
* The lower pixel bounds of bounding box enclosing the selected
* clumps.
* NCLUMPS = _INTEGER (Write)
* The total number of clumps descrriptions stored within the supplied
* NDF.
* NDF = NDF (Read)
* The NDF defining the previously identified clumps. This
* should contain a CUPID extension describing all the identified
* clumps, in the format produced by FINDCLUMPS or EXTRACTCLUMPS.
* QUIET = _LOGICAL (Read)
* If TRUE, then no information is written out to the screen,
* although the output parameters are still assigned values. [FALSE]
* UBOUND( ) = _INTEGER (Write)
* The upper pixel bounds of bounding box enclosing the selected
* clumps.
* Notes:
* - It is hoped to extend the range of information reported by this
* application as new requirements arise.
* Synopsis:
* void clumpinfo( int *status );
* Copyright:
* Copyright (C) 2007 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
* {enter_new_authors_here}
* History:
* 22-MAR-2007 (DSB):
* Original version.
* {enter_further_changes_here}
* Bugs:
* {note_any_bugs_here}
*-
*/
/* Local Variables: */
AstFrame *cfrm; /* Pointer to current WCS Frame */
AstMapping *cmap; /* Pointer to PIXEL->current Frame Mapping */
CupidClumpInfo info; /* Structure holding returned information */
Grp *grp = NULL; /* GRP group holding input NDF name */
HDSLoc *aloc = NULL; /* Locator for CLUMPS array in CUPID extension */
HDSLoc *cloc = NULL; /* Locator for a single CLUMP structure */
HDSLoc *xloc = NULL; /* Locator for CUPID extension */
char *p; /* Pointer into tmpstr string */
char tmpstr[ 100 ]; /* Buffer for temporary strings */
const char *dom; /* Pointer to axis Domain name */
double flbnd[ NDF__MXDIM ]; /* Lower bounds of WCS bounding box */
double fubnd[ NDF__MXDIM ]; /* Upper bounds of WCS bounding box */
double plbnd[ NDF__MXDIM ]; /* Lower bounds of PIXEL bounding box */
double pubnd[ NDF__MXDIM ]; /* Upper bounds of PIXEL bounding box */
int *clump_flags = NULL; /* Flags indicating if each clump is to be used */
int *clump_indices = NULL;/* List of indices of clumps to be used */
int i; /* Loop count */
int iclump; /* One-based clump index */
int indf; /* NDF identifier for input NDF */
int ipix; /* Index of PIXEL Frame */
size_t nclumps; /* No. of clump descriptions within the supplied NDF */
int nuse; /* Number of clumps to be used */
int primary; /* Value for locator primary flag */
int quiet; /* Supress screen output? */
size_t size; /* Number of values in group "*grp" */
int there; /* Does the enquired object exist? */
/* Abort if an error has already occurred. */
if( *status != SAI__OK ) return;
/* Begin an AST context */
astBegin;
/* Start an NDF context */
ndfBegin();
/* Obtain the input NDF and get a locator for the array of clump
descriptions within it.
----------------------------------------------------------------- */
/* Get an identifier for the input NDF. We use NDG (via kpg1_Rgndf)
instead of calling ndfAssoc directly since NDF/HDS has problems with
file names containing spaces, which NDG does not have. */
kpg1Rgndf( "NDF", 1, 1, "", &grp, &size, status );
ndgNdfas( grp, 1, "READ", &indf, status );
grpDelet( &grp, status );
/* Check the NDF has a suitable CUPID extension containing an array of
clump cut-outs. Get an HDS locator for the array. */
ndfXstat( indf, "CUPID", &there, status );
if( !there ) {
if( *status == SAI__OK ) {
*status = SAI__ERROR;
ndfMsg( "NDF", indf );
errRep( "", "The NDF \"^NDF\" does not contain a CUPID extension "
"such as created by FINDCLUMPS or EXTRACTCLUMPS.", status );
}
} else {
ndfXloc( indf, "CUPID", "READ", &xloc, status );
datThere( xloc, "CLUMPS", &there, status );
if( !there ) {
if( *status == SAI__OK ) {
*status = SAI__ERROR;
ndfMsg( "NDF", indf );
errRep( "", "The CUPID extension within NDF \"^NDF\" does not "
"contain an array of clumps such as created by "
"FINDCLUMPS or EXTRACTCLUMPS.", status );
}
} else {
datFind( xloc, "CLUMPS", &aloc, status );
primary = 1;
datPrmry( 1, &aloc, &primary, status );
}
datAnnul( &xloc, status );
}
/* Abort if we have no clumps array locator, or if an error occurred. */
if( !aloc || *status != SAI__OK ) goto L999;
/* Calculate the required clump information, and store it in the "info"
structure.
----------------------------------------------------------------- */
/* Indicate that the structure holding the returned information has not
yet been initialised. */
info.init = 0;
/* Get the WCS FrameSet from the input NDF, and store a pointer to it in
the "info" structure. */
kpg1Gtwcs( indf, &(info.iwcs), status );
/* Get the number of clumps defined within the input NDF. */
datSize( aloc, &nclumps, status );
/* Get the list of clump indices to iclude in the returned information. */
clump_flags = astMalloc( sizeof( int )*nclumps );
clump_indices = astMalloc( sizeof( int )*nclumps );
kpg1Gilst( 1, (int) nclumps, (int) nclumps, "CLUMPS", clump_flags, clump_indices,
&nuse, status );
/* Loop round all clumps that are to be used. */
for( i = 0; i < nuse && *status == SAI__OK; i++ ) {
iclump = clump_indices[ i ];
/* Get a locator for this clump. */
datCell( aloc, 1, &iclump, &cloc, status );
/* Update the returned information to include this clump. */
cupidClumpInfo1( cloc, &info, status );
/* Annul the clump structure locator. */
datAnnul( &cloc, status );
}
/* Write out the information to the screen and to appropriate output
parameters.
----------------------------------------------------------------- */
/* See if screen output is required. */
parGet0l( "QUIET", &quiet, status );
if( !quiet ) msgBlank( status );
/* The number of clumps defined within the input NDF... */
parPut0i( "NCLUMPS", (int) nclumps, status );
if( ! quiet ) {
msgSeti( "NCLUMPS", (int) nclumps );
msgOut( "", " Total no. of clumps: ^NCLUMPS", status );
}
/* Pixel index bounding box... */
parPut1i( "LBOUND", info.npix, info.lbnd, status );
parPut1i( "UBOUND", info.npix, info.ubnd, status );
if( !quiet ) {
p = tmpstr + sprintf( tmpstr, "( " );
for( i = 0; i < info.npix; i++) {
p += sprintf( p, "%d:%d", info.lbnd[ i ], info.ubnd[ i ] );
if( i < info.npix - 1 ) p += sprintf( p, ", " );
}
p += sprintf( p, " )" );
msgSetc( "SECTION", tmpstr );
msgOut( "", " Pixel index bounding box: ^SECTION", status );
}
/* WCS bounding box (first convert the pixel index bounding box into WCS
coords)... */
cfrm = astGetFrame( info.iwcs, AST__CURRENT );
kpg1Asffr( info.iwcs, "PIXEL", &ipix, status );
cmap = astGetMapping( info.iwcs, ipix, AST__CURRENT );
for( i = 0; i < info.npix; i++ ) {
plbnd[ i ] = info.lbnd[ i ] - 1.0;
pubnd[ i ] = info.ubnd[ i ];
}
for( i = 0; i < info.nwcs; i++ ) {
astMapBox( cmap, plbnd, pubnd, 1, i + 1, flbnd + i, fubnd + i,
NULL, NULL);
}
astNorm( cfrm, flbnd );
astNorm( cfrm, fubnd );
parPut1d( "FLBND", info.nwcs, flbnd, status );
parPut1d( "FUBND", info.nwcs, fubnd, status );
if( !quiet ) {
msgOut( "", " WCS bounding box:", status );
for( i = 0; i < info.nwcs; i++) {
msgSetc( "L", astFormat( cfrm, i + 1, flbnd[ i ] ) );
msgSetc( "U", astFormat( cfrm, i + 1, fubnd[ i ] ) );
sprintf( tmpstr, "Domain(%d)", i + 1 );
dom = astGetC( cfrm, tmpstr );
if( dom && strcmp( dom, "SKY" ) ) {
sprintf( tmpstr, "Unit(%d)", i + 1 );
msgSetc( "UNT", astGetC( cfrm, tmpstr ) );
} else {
msgSetc( "UNT", "" );
}
sprintf( tmpstr, "Label(%d)", i + 1 );
msgSetc( "LAB", astGetC( cfrm, tmpstr ) );
msgOut( "", " ^LAB: ^L -> ^U ^UNT", status );
}
}
if( !quiet ) msgBlank( status );
/* Tidy up.
-------- */
L999:
;
/* Free resources. */
clump_flags = astFree( clump_flags );
clump_indices = astFree( clump_indices );
if( aloc ) datAnnul( &aloc, status );
/* End the NDF context */
ndfEnd( status );
/* End the AST context */
astEnd;
/* If an error has occurred, issue another error report identifying the
program which has failed (i.e. this one). */
if( *status != SAI__OK ) {
errRep( "CLUMPINFO_ERR", "CLUMPINFO: Failed to obtain information "
"about one or more previously identified clumps.", status );
}
}
int main (void) {
/* Local Variables: */
const char path[] = "hds_ctest";
int status = DAT__OK;
hdsdim dim[] = { 10, 20 };
hdsdim dimd[1];
const char * chararr[] = { "TEST1", "TEST2", "Longish String" };
char *retchararr[4];
char buffer[1024]; /* plenty large enough */
double darr[] = { 4.5, 2.5 };
double retdarr[2];
void *mapv; /* Mapped void* */
double *mapd; /* Mapped _DOUBLE */
float *mapf; /* Mapped _REAL */
int *mapi; /* Mapped _INTEGER */
int64_t *mapi64; /* Mapped _INT64 */
HDSLoc * loc1 = NULL;
HDSLoc * loc2 = NULL;
HDSLoc * loc3 = NULL;
size_t actval;
size_t nel;
size_t nelt;
size_t nbytes;
size_t i;
int n;
double sumd;
int sumi;
int64_t sumi64;
int64_t test64;
int64_t testin64;
const int64_t VAL__BADK = (-9223372036854775807 - 1);
emsBegin(&status);
/* Force 64-bit mode */
hdsTune( "64BIT", 1, &status );
/* Create a new container file */
hdsNew( path, "HDS_TEST", "NDF", 0, dim, &loc1, &status );
/* Some components */
datNew( loc1, "DATA_ARRAY", "_INTEGER", 2, dim, &status );
datNew1C( loc1, "ONEDCHAR", 14, 3, &status );
datNew1D( loc1, "ONEDD", 2, &status );
datNew0K( loc1, "TESTI64", &status );
datNew0K( loc1, "TESTBADI64", &status );
/* Populate */
testin64 = 9223372036854775800;
datFind( loc1, "TESTI64", &loc2, &status );
datPut0K( loc2, testin64, &status );
datGet0K( loc2, &test64, &status );
datAnnul( &loc2, &status );
if (status == DAT__OK) {
if ( test64 != testin64 ) {
status = DAT__FATAL;
emsRepf( "TESTI64", "Test _INT64 value %" PRIi64 " did not match expected %"PRIi64,
&status, test64, testin64 );
}
}
datFind( loc1, "TESTBADI64", &loc2, &status );
datPut0K( loc2, VAL__BADK, &status );
datGet0K( loc2, &test64, &status );
datAnnul( &loc2, &status );
if (status == DAT__OK) {
if ( test64 != VAL__BADK ) {
status = DAT__FATAL;
emsRepf( "TESTBADI64", "Test _INT64 value %" PRIi64 " did not match expected VAL__BADK",
&status, test64 );
}
}
datFind( loc1, "ONEDCHAR", &loc2, &status );
datPutVC( loc2, 3, chararr, &status );
/* Check contents */
datGetVC(loc2, 3, 1024, buffer, retchararr, &actval, &status);
if (status == DAT__OK) {
if (actval == 3) {
for (i = 0; i < 3; i++ ) {
if (strncmp( chararr[i], retchararr[i], strlen(chararr[i]) ) ) {
status = DAT__DIMIN;
emsSetc( "IN", chararr[i]);
emsSetc( "OUT", retchararr[i] );
emsRep( "GET1C","Values from Get1C differ (^IN != ^OUT)", &status);
break;
}
}
} else {
status = DAT__DIMIN;
emsRep( "GET1C","Did not get back as many strings as put in", &status);
}
}
datAnnul( &loc2, &status );
datFind( loc1, "ONEDD", &loc2, &status );
datPutVD( loc2, 2, darr, &status );
/* Check contents */
datGetVD( loc2, 2, retdarr, &actval, &status);
if (status == DAT__OK) {
if (actval == 2) {
for (i = 0; i < 2; i++ ) {
if (darr[i] != retdarr[i]) {
status = DAT__DIMIN;
emsRep( "GETVD","Values from getVD differ", &status);
break;
}
}
} else {
status = DAT__DIMIN;
emsRep( "GETVD","Did not get back as many values as put in", &status);
}
}
/* Try mapping - _DOUBLE */
dimd[0] = 2;
datMapD(loc2, "READ", 1, dimd, &mapd, &status);
if (status == DAT__OK) {
for (i = 0; i < 2; i++ ) {
if (darr[i] != mapd[i]) {
status = DAT__DIMIN;
emsRep( "MAPD","Values from MapD differ", &status);
break;
}
}
}
datUnmap(loc2, &status);
/* Try mapping - _FLOAT */
datMapR(loc2, "READ", 1, dimd, &mapf, &status);
if (status == DAT__OK) {
for (i = 0; i < 2; i++ ) {
if ( (float)darr[i] != mapf[i]) {
status = DAT__DIMIN;
emsRep( "MAPR","Values from MapR differ", &status);
break;
}
}
}
datUnmap(loc2, &status);
/* Annul */
datAnnul( &loc2, &status );
/* Find and map DATA_ARRAY */
datFind( loc1, "DATA_ARRAY", &loc2, &status );
datMapV( loc2, "_REAL", "WRITE", &mapv, &nel, &status );
mapf = mapv;
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements originally (^NORI) not the same as now (^NEL)", &status);
}
}
sumd = 0.0;
for (i = 1; i <= nel; i++) {
mapf[i-1] = (float)i;
sumd += (double)i;
}
datUnmap( loc2, &status );
datAnnul( &loc2, &status );
hdsClose( &loc1, &status );
/* Re-open */
hdsOpen( path, "UPDATE", &loc1, &status );
/* Look for the data array and map it */
datFind( loc1, "DATA_ARRAY", &loc2, &status );
datVec( loc2, &loc3, &status );
datSize( loc3, &nel, &status);
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements before (^NORI) not the same as now (^NEL)", &status);
}
}
datPrec( loc3, &nbytes, &status );
if (status == DAT__OK) {
if ( nbytes != 4) {
status = DAT__FATAL;
emsSeti( "NB", nbytes );
emsRep( "PREC","Precision for _REAL not 4 bytes but ^NB", &status);
}
}
/* Try hdsShow */
hdsShow("LOCATORS", &status);
hdsShow("FILES", &status);
hdsInfoI(NULL, "LOCATORS", "!HDS_TEST.,YYY", &n, &status );
hdsInfoI(NULL, "FILES", NULL, &n, &status );
datAnnul( &loc3, &status );
datMapV( loc2, "_INTEGER", "READ", &mapv, &nel, &status );
mapi = mapv;
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements originally (^NORI) not the same as now (^NEL)", &status);
}
}
sumi = 0;
for (i = 0; i < nel; i++) {
sumi += mapi[i];
}
datUnmap( loc2, &status );
if (status == DAT__OK) {
if (sumi != (int)sumd) {
status = DAT__FATAL;
emsSeti( "I", sumi );
emsSeti( "D", (int)sumd );
emsRep("SUM","Sum was not correct. Got ^I rather than ^D", &status );
}
}
/* _INT64 test */
datMapV( loc2, "_INT64", "READ", &mapv, &nel, &status );
mapi64 = mapv;
if (status == DAT__OK) {
nelt = dim[0] * dim[1];
if ( nelt != nel) {
status = DAT__FATAL;
emsSeti( "NEL", (int)nel );
emsSeti( "NORI", (int)nelt );
emsRep( "SIZE","Number of elements originally (^NORI) not the same as now (^NEL)", &status);
}
}
sumi64 = 0;
for (i = 0; i < nel; i++) {
sumi64 += mapi64[i];
}
datUnmap( loc2, &status );
if (status == DAT__OK) {
if (sumi64 != (int)sumd) {
status = DAT__FATAL;
emsSeti( "I", (int)sumi64 );
emsSeti( "D", (int)sumd );
emsRep("SUM","Sum was not correct. Got ^I rather than ^D", &status );
}
}
/* Tidy up and close */
hdsErase( &loc1, &status );
if (status == DAT__OK) {
printf("HDS C installation test succeeded\n");
emsEnd(&status);
return EXIT_SUCCESS;
} else {
printf("HDS C installation test failed\n");
emsEnd(&status);
return EXIT_FAILURE;
}
}
