/*
*+
* Name:
* fintramap.c
* Purpose:
* Define a FORTRAN 77 interface to the AST IntraMap class.
* Type of Module:
* C source file.
* Description:
* This file defines FORTRAN 77-callable C functions which provide
* a public FORTRAN 77 interface to the IntraMap class.
* Routines Defined:
* AST_INTRAMAP
* AST_INTRAREG
* AST_ISAINTRAMAP
* Copyright:
* Copyright (C) 1997-2006 Council for the Central Laboratory of the
* Research Councils
* Licence:
* This program is free software: you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation, either
* version 3 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 Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General
* License along with this program. If not, see
* <http://www.gnu.org/licenses/>.
* Authors:
* RFWS: R.F. Warren-Smith (Starlink)
* History:
* 18-MAR-1998 (RFWS):
* Original version.
* 15-SEP-1999 (RFWS):
* Added a THIS pointer to the external transformation function
* used by an IntraMap.
*/
/* Define the astFORTRAN77 macro which prevents error messages from
AST C functions from reporting the file and line number where the
error occurred (since these would refer to this file, they would
not be useful). */
#define astFORTRAN77
/* Header files. */
/* ============= */
#include "f77.h" /* FORTRAN <-> C interface macros (SUN/209) */
#include "c2f77.h" /* F77 <-> C support functions/macros */
#include "error.h" /* Error reporting facilities */
#include "memory.h" /* Memory handling facilities */
#include "intramap.h" /* C interface to the IntraMap class */
#include <stddef.h>
#include <string.h>
/* Prototypes for private functions. */
/* ================================= */
static void TranWrap( void (*)( AstMapping *, int, int, const double *[], int, int, double *[] ), AstMapping *, int, int, const double *[], int, int, double *[], int * );
/* Transformation function interface. */
/* ================================== */
/* This is concerned with allowing FORTRAN implementations of
transformation functions to be passed to the IntraMap class and
invoked when necessary by C code in the main class
implementation. All FORTRAN-specific aspects of this interface are
encapsulated here. */
static void TranWrap( void (* tran)( AstMapping *, int, int, const double *[],
int, int, double *[] ),
AstMapping *this, int npoint, int ncoord_in,
const double *ptr_in[], int forward, int ncoord_out,
double *ptr_out[], int *status ) {
/*
* Name:
* TranWrap
* Purpose:
* Wrapper function to invoke a FORTRAN transformation function.
* Type:
* Private function.
* Synopsis:
* void TranWrap( void (* tran)( AstMapping *, int, int, const double *[],
* int, int, double *[] ),
* AstMapping *this, int npoint, int ncoord_in,
* const double *ptr_in[], int forward, int ncoord_out,
* double *ptr_out[], int *status )
* Description:
* This function invokes a FORTRAN implementation of a
* transformation function (which resembles AST_TRANN from the
* Mapping class FORTRAN interface) in order to make it callable by
* C code which would prefer to call a C function that resembles
* astTranP (from the Mapping class C interface).
* Parameters:
* tran
* Pointer to the FORTRAN transformation function to be invoked.
* This should result from a cast applied to a pointer to a
* function that resembles AST_TRANN (but with the first
* argument omitted).
* this
* An external Mapping ID associated with the internal (true C) pointer
* for the IntraMap whose transformation is being evaluated.
* npoint
* The number of points to be transformed.
* ncoord_in
* The number of coordinates being supplied for each input point
* (i.e. the number of dimensions of the space in which the
* input points reside).
* ptr_in
* An array of pointers to double, with "ncoord_in"
* elements. Element "ptr_in[coord]" should point at the first
* element of an array of double (with "npoint" elements) which
* contain the values of coordinate number "coord" for each
* input (untransformed) point. The value of coordinate number
* "coord" for input point number "point" is therefore given by
* "ptr_in[coord][point]".
* forward
* A non-zero value indicates that the forward coordinate
* transformation is to be applied, while a zero value indicates
* that the inverse transformation should be used.
* ncoord_out
* The number of coordinates being generated for each output
* point (i.e. the number of dimensions of the space in which
* the output points reside). This need not be the same as
* "ncoord_in".
* ptr_out
* An array of pointers to double, with "ncoord_out"
* elements. Element "ptr_out[coord]" should point at the first
* element of an array of double (with "npoint" elements) into
* which the values of coordinate number "coord" for each output
* (transformed) point will be written. The value of coordinate
* number "coord" for output point number "point" will therefore
* be found in "ptr_out[coord][point]".
* status
* Pointer to the inherited status value.
*/
/* Local Variables; */
DECLARE_INTEGER(INDIM); /* First dimension size of input array */
DECLARE_INTEGER(NCOORD_IN); /* Number of input coordinates */
DECLARE_INTEGER(NCOORD_OUT); /* Number of output coordinates */
DECLARE_INTEGER(NPOINT); /* Number of points */
DECLARE_INTEGER(OUTDIM); /* First dimension size of output array */
DECLARE_INTEGER(STATUS); /* FORTRAN error status variable */
DECLARE_INTEGER(THIS); /* External ID for the IntraMap */
DECLARE_LOGICAL(FORWARD); /* Use forward transformation? */
F77_DOUBLE_TYPE *IN; /* Input coordinate array for FORTRAN */
F77_DOUBLE_TYPE *OUT; /* Output coordinate array for FORTRAN */
int coord; /* Loop counter for coordinates */
int i; /* Index into FORTRAN arrays */
/* Check the global error status. */
if ( !astOK ) return;
/* Assign input values to the arguments for the FORTRAN transformation
function. */
THIS = astP2I( this );
NPOINT = npoint;
NCOORD_IN = ncoord_in;
INDIM = npoint;
FORWARD = forward ? F77_TRUE : F77_FALSE;
NCOORD_OUT = ncoord_out;
OUTDIM = npoint;
/* Since the input/output coordinate values may be stored in separate
arrays, we must move them temporarily into new 2-dimensional
arrays, as required by the FORTRAN transformation function
interface. Allocate memory for these arrays. */
IN = astMalloc( (size_t) ( npoint * ncoord_in ) *
sizeof( F77_DOUBLE_TYPE ) );
OUT = astMalloc( (size_t) ( npoint * ncoord_out ) *
sizeof( F77_DOUBLE_TYPE ) );
/* If OK, fill the input array with coordinate values. Use "memcpy" to
avoid numerical errors if the data contain junk - this allows the
transformation function to produce the appropriate error instead of
it happening here. */
if ( astOK ) {
i = 0;
for ( coord = 0; coord < ncoord_in; coord++ ) {
(void) memcpy( IN + i, ptr_in[ coord ],
(size_t) npoint * sizeof( F77_DOUBLE_TYPE ) );
i += npoint;
}
}
/* Cast the transformation function pointer to a pointer to the
FORTRAN subroutine and then invoke it. Transfer the AST error
status to and from the subroutine's error status argument. */
if ( astOK ) {
STATUS = astStatus;
( *(void (*)()) tran )( INTEGER_ARG(&THIS),
INTEGER_ARG(&NPOINT),
INTEGER_ARG(&NCOORD_IN),
INTEGER_ARG(&INDIM),
DOUBLE_ARRAY_ARG(IN),
LOGICAL_ARG(&FORWARD),
INTEGER_ARG(&NCOORD_OUT),
INTEGER_ARG(&OUTDIM),
DOUBLE_ARRAY_ARG(OUT),
INTEGER_ARG(&STATUS) );
astSetStatus( STATUS );
}
/* If OK, transfer the transformed coordinate values to the output
arrays. */
if ( astOK ) {
i = 0;
for ( coord = 0; coord < ncoord_out; coord++ ) {
(void) memcpy( ptr_out[ coord ], OUT + i,
(size_t) npoint * sizeof( F77_DOUBLE_TYPE ) );
i += npoint;
}
}
/* Free the temporary arrays. */
astFree( IN );
astFree( OUT );
}
/* FORTRAN interface functions. */
/* ============================ */
/* These functions implement the remainder of the FORTRAN interface. */
F77_SUBROUTINE(ast_intrareg)( CHARACTER(NAME),
INTEGER(NIN),
INTEGER(NOUT),
void (* TRAN)(),
INTEGER(FLAGS),
CHARACTER(PURPOSE),
CHARACTER(AUTHOR),
CHARACTER(CONTACT),
INTEGER(STATUS)
TRAIL(NAME)
TRAIL(PURPOSE)
TRAIL(AUTHOR)
TRAIL(CONTACT) ) {
GENPTR_CHARACTER(NAME)
GENPTR_INTEGER(NIN)
GENPTR_INTEGER(NOUT)
GENPTR_INTEGER(FLAGS)
GENPTR_CHARACTER(PURPOSE)
GENPTR_CHARACTER(AUTHOR)
GENPTR_CHARACTER(CONTACT)
char *name;
void (* tran)( AstMapping *, int, int, const double *[], int, int,
double *[] );
char *purpose;
char *author;
char *contact;
astAt( "AST_INTRAREG", NULL, 0 );
astWatchSTATUS(
name = astString( NAME, NAME_length );
tran =
(void (*)( AstMapping *, int, int, const double *[], int, int,
double *[] )) TRAN;
purpose = astString( PURPOSE, PURPOSE_length );
author = astString( AUTHOR, AUTHOR_length );
contact = astString( CONTACT, CONTACT_length );
astIntraRegFor( name, *NIN, *NOUT, tran, TranWrap, *FLAGS, purpose,
author, contact );
astFree( name );
astFree( purpose );
astFree( author );
astFree( contact );
)
}
F77_INTEGER_FUNCTION(ast_intramap)( CHARACTER(NAME),
INTEGER(NIN),
INTEGER(NOUT),
CHARACTER(OPTIONS),
INTEGER(STATUS)
TRAIL(NAME)
TRAIL(OPTIONS) ) {
GENPTR_CHARACTER(NAME)
GENPTR_INTEGER(NIN)
GENPTR_INTEGER(NOUT)
GENPTR_CHARACTER(OPTIONS)
F77_INTEGER_TYPE(RESULT);
char *name;
char *options;
int i;
astAt( "AST_INTRAMAP", NULL, 0 );
astWatchSTATUS(
name = astString( NAME, NAME_length );
options = astString( OPTIONS, OPTIONS_length );
/* Truncate the options string to exlucde any trailing spaces. */
astChrTrunc( options );
/* Change ',' to '\n' (see AST_SET in fobject.c for why). */
if ( astOK ) {
for ( i = 0; options[ i ]; i++ ) {
if ( options[ i ] == ',' ) options[ i ] = '\n';
}
}
RESULT = astP2I( astIntraMap( name, *NIN, *NOUT, "%s", options ) );
astFree( name );
astFree( options );
)
return RESULT;
}
F77_LOGICAL_FUNCTION(ast_isaintramap)( INTEGER(THIS),
INTEGER(STATUS) ) {
GENPTR_INTEGER(THIS)
F77_LOGICAL_TYPE(RESULT);
astAt( "AST_ISAINTRAMAP", NULL, 0 );
astWatchSTATUS(
RESULT = astIsAIntraMap( astI2P( *THIS ) ) ? F77_TRUE : F77_FALSE;
)
return RESULT;
}