next up previous 264
Next: Registering a Transformation Routine
Up: Creating Your Own Private Mappings (IntraMaps)
Previous: Limitations of IntraMaps


Writing a Transformation Routine

The first stage in creating an IntraMap is to write the coordinate transformation routine. This should have a calling interface like the AST_TRANN function provided by AST (q.v.). Here is a simple example of a suitable transformation routine which transforms coordinates by squaring them:

      SUBROUTINE SQRTRAN( THIS, NPOINT, NCOORD_IN, INDIM, IN, FORWARD,
    :                     NCOORD_OUT, OUTDIM, OUT, STATUS )
      INTEGER THIS, NPOINT, NCOORD_IN, INDIM, NCOORD_OUT, OUTDIM, STATUS
      DOUBLE PRECISION IN( INDIM, NCOORD_IN ), OUT( OUTDIM, NCOORD_OUT )
      LOGICAL FORWARD

      INCLUDE 'AST_PAR'
      DOUBLE PRECISION X
      INTEGER COORD, POINT

*  Forward transformation.
      IF ( FORWARD ) THEN
         DO 2 POINT = 1, NPOINT
            DO 1 COORD = 1, NCOORD_IN
               X = IN( POINT, COORD )
               IF ( X .EQ. AST__BAD ) THEN
                  OUT( POINT, COORD ) = AST__BAD
               ELSE
                  OUT( POINT, COORD ) = X * X
               ENDIF
 1          CONTINUE
 2       CONTINUE

*  Inverse transformation.
      ELSE
         DO 4 POINT = 1, NPOINT
            DO 3 COORD = 1, NCOORD_IN
               X = IN( POINT, COORD )
               IF ( X .LT. 0.0D0 .OR. X .EQ. AST__BAD ) THEN
                  OUT( POINT, COORD ) = AST__BAD
               ELSE
                  OUT( POINT, COORD ) = SQRT( X )
               ENDIF
 3          CONTINUE
 4       CONTINUE
      ENDIF
      END

As you can see, the routine comes in two halves which implement the forward and inverse coordinate transformations. The number of points to be transformed (NPOINT) and the numbers of input and output coordinates per point (NCOORD_IN and NCOORD_OUT--in this case both are assumed equal) are passed to the routine. A pair of loops then accesses all the coordinate values. Note that it is legitimate to omit one or other of the forward/inverse transformations and simply not to implement it, if it will not be required. It is also permissible to require that the numbers of input and output coordinates be fixed (e.g. at 2), or to write the routine so that it can handle arbitrary dimensionality, as here.

Before using an incoming coordinate, the routine must first check that it is not set to the value AST__BAD, which indicates missing data ([*]). If it is, the same value is also assigned to any affected output coordinates. The value AST__BAD is also generated if any coordinates cannot be transformed. In this example, this can happen with the inverse transformation if negative values are encountered, so that the square root cannot be taken.

There are very few restrictions on what a coordinate transformation routine may do. For example, it may freely perform I/O to access any external data needed, it may invoke other AST facilities (but beware of unwanted recursion), etc. Typically, you may also want to pass information to it via global variables held in common blocks. Remember, however, that whatever facilities the transformation routine requires must be available in every program which uses it.

Generally, it is not a good idea to retain context information within a transformation routine. That is, it should transform each set of coordinates as a single point and retain no memory of the points it has transformed before. This is in order to conform with the AST model of a Mapping.

If an error occurs within a transformation routine, it should set its STATUS argument to an error value before returning. This will alert AST to the error, causing it to abort the current operation. The error value AST__ITFER is available for this purpose, but other values may also be used (e.g. if you wish to distinguish different types of error). The AST__ITFER error value is defined in the AST_ERR include file.


next up previous 264
Next: Registering a Transformation Routine
Up: Creating Your Own Private Mappings (IntraMaps)
Previous: Limitations of IntraMaps

AST A Library for Handling World Coordinate Systems in Astronomy
Starlink User Note 210
R.F. Warren-Smith & D.S. Berry
24th May 2011
E-mail:ussc@star.rl.ac.uk

Copyright (C) 2009 Science \& Technology Facilities Council