diff options
Diffstat (limited to 'ast/fintramap.c')
| -rw-r--r-- | ast/fintramap.c | 332 |
1 files changed, 332 insertions, 0 deletions
diff --git a/ast/fintramap.c b/ast/fintramap.c new file mode 100644 index 0000000..cdf3e4e --- /dev/null +++ b/ast/fintramap.c @@ -0,0 +1,332 @@ +/* +*+ +* 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; +} |