summaryrefslogtreecommitdiffstats
path: root/ast/fintramap.c
diff options
context:
space:
mode:
Diffstat (limited to 'ast/fintramap.c')
-rw-r--r--ast/fintramap.c332
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;
+}