path: root/ast/fintramap.c

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