upgrade ast 8.7.1

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;
+}