Processing math: 100%

2 GENERIC Fortran Subroutines—an Example

 2.1 Using the GENERIC utilty to process generic C files

A generic subroutine is one which has an argument (or arguments) which may be one of a number of different Fortran data types.

As an example, consider a subroutine which initialises every element in an array to zero. One might want a different version of the routine for initializing a double precision array, an integer array and a real array. The following subroutines would need to be written:

        ZEROD( N, DARR )   Zero every element in a DOUBLE PRECISION array
        ZEROI( N, IARR )   Zero every element in an INTEGER array
        ZEROR( N, RARR )   Zero every element in a REAL array

The integer routine might contain the following code (in a file called zeroi.f):

            SUBROUTINE ZEROI( N, ARRAY )
      *+
      *  Name:
      *     ZEROI
      *  Purpose:
      *     Zero all the elements of an4 INTEGER array
      *  Invocation :
      *     CALL ZEROI( N, ARRAY )
      *  Description :
      *     This sets all the elements of an INTEGER array to zero
      *  Arguments:
      *     N = INTEGER( Given )
      *        Dimension of array
      *     ARRAY( N ) = INTEGER( Given and Returned )
      *        The array to be zeroed
      *                   "
      *     (the rest of the standard prologue)
      *                   "
      *  Type Definitions:
            IMPLICIT NONE
      *  Arguments Given:
            INTEGER N
      *  Arguments Given and Returned:
            INTEGER ARRAY( N )
      *  Local Variables:
            INTEGER I                   ! Array index
      *-
  
            DO I = 1, N
               ARRAY( I ) = 0
            END DO
            END

The REAL and DOUBLE PRECISION versions of the routine would have to be written in a similar way, and this obviously involves a lot of duplication of effort. The situation gets even worse if other versions of the routine (such as BYTE, INTEGER*2) are needed. Also, it is very difficult and tedious to keep all the versions in step if they have to be edited individually when the routines are changed.

The GENERIC utility is a labour-saving device which enables all the various types of routines to be constructed automatically from one master routine. If any changes become necessary, only this one master routine needs to be edited.

To use the GENERIC utility, the routine listed above is replaced by the following (in a file called zero.gen):

            SUBROUTINE ZERO<T>( N, ARRAY )
      *+
      *  Name:
      *     ZERO<T>
      *  Purpose:
      *     Zero all the elements of a <COMM> array
      *  Invocation :
      *     CALL ZERO<T>( N, ARRAY )
      *  Description :
      *     This sets all the elements of a <COMM> array to zero
      *  Argument:
      *     N = INTEGER( Given )
      *        Dimension of array
      *     ARRAY( N ) = <TYPE>( Given and Returned )
      *        The array to be zeroed
      *                   "
      *     (the rest of the standard prologue)
      *                   "
      *  Type Definitions:
            IMPLICIT NONE
      *  Arguments Given:
            INTEGER N
      *  Arguments Given and Returned:
            <TYPE> ARRAY( N )
      *  Local Variables:
            INTEGER I                  ! Array index
      *-
  
            DO I = 1, N
               ARRAY( I ) = 0<CONST>
            END DO
            END

This is a “generic routine.” Other examples of generic routines include the DAT_ routines in the Hierarchical Data System (SUN/92) and the PAR_ routines of the ADAM parameter system (SSN/29).

The items in angle brackets, <> , are “tokens” which the GENERIC utility replaces when it converts the routine into one of a given type. In the above example, the tokens would be replaced as follows.

         Token       Double precision    Integer       Real
                     replacement         replacement   replacement
  
         <T>         D                   I             R
         <TYPE>      DOUBLE PRECISION    INTEGER       REAL
         <COMM>      DOUBLE PRECISION    INTEGER       REAL
         <CONST>     .0D0                (blank)       .0E0

The types are generated by issuing the following command.

  % generic -t dir zero.gen

More details on the use of the GENERIC utility, and a full list of tokens and types, are given in the rest of this document.

2.1 Using the GENERIC utilty to process generic C files

If the source files supplied to the GENERIC utility have a file type that starts with “.c”, then they are assumed to contain C source code for functions that are designed to be called from Fortran using the macros in the f77.h header file provided by the CNF package. The same rules apply regarding the interpretation of the file types as for Fortran source code, except that “.cgen” is used in place of “.gen” and the initial “.g” used in other Fortran files type (for instance “.gdr”) becomes “.c” (for instance “.cdr”). The output text is written to a file with type “.c” rather than “.f”, and no text wrapping is performed in the output files.

An example generic C source file is shown below (ccg8_um3.cdr from KAPLIBS ):

  
  #include <stdint.h>
  #include "sae_par.h"
  #include "prm_par.h"
  #include "f77.h"
  
  F77_SUBROUTINE(ccg8_um3<TLC>)( INTEGER8(NPIX), INTEGER8(NLINES),
                                 <CNFTYPE>_ARRAY(STACK), INTEGER8(MINPIX),
                                 <CNFTYPE>_ARRAY(RESULT), DOUBLE_ARRAY(NCON),
                                 INTEGER8(NBAD), INTEGER(STATUS) ){
  /*
  *+
  *  Name:
  *     CCG8_UM3<T>
  
  *  Purpose:
  *     Combines data lines using an unweighted mean.
  
  *  Language:
  *     C (designed to be called from Fortran 77)
  
  *  Invocation:
  *     CALL CCG8_UM3<T>( NPIX, NLINES, STACK, MINPIX, RESULT, NCON,
  *                       NBAD, STATUS )
  
  *  Description:
  *     This routine accepts an array consisting a series of (vectorised)
  *     lines of data.  The data values in the lines are then combined to
  *     form an unweighted mean.  The output means are returned in the
  *     array RESULT.
  
  *  Arguments:
  *     NPIX = INTEGER*8 (Given)
  *        The number of pixels in a line of data.
  *     NLINES = INTEGER*8 (Given)
  *        The number of lines of data in the stack.
  *     STACK( NPIX, NLINES ) = <TYPE> (Given)
  *        The array of lines which are to be combined into a single line.
  *     MINPIX = INTEGER*8 (Given)
  *        The minimum number of pixels required to contribute to an
  *        output pixel.
  *     RESULT( NPIX ) = <TYPE> (Returned)
  *        The output line of data.
  *        to the output line.
  *     NCON( NLINES ) = DOUBLE PRECISION (Returned)
  *        The actual number of contributing pixels from each input line
  *        to the output line.
  *     NBAD = INTEGER*8 (Returned)
  *        The number of bad values in the output array created while
  *        forming the statistics.  It excludes those bad values whose
  *        corresponding values along the collapse axis are all bad.
  *     STATUS = INTEGER (Given and Returned)
  *        The global status.
  
  *-
  */
  
  /* Local Variables: */
     double sumd;          /* Sum of values */
     double sumw;          /* Sum of weights */
     double value;         /* Output value */
     int64_t i;            /* Loop variable */
     int64_t j;            /* Loop variable */
     int64_t ngood;        /* Number of good pixels */
     const <CTYPE> *pstack; /* Pointer to next input value */
  
  /* Initialise returned values. */
     *NBAD = 0;
     for( i = 0; i < *NLINES; i++ ){
        NCON[ i ] = 0.0;
     }
  
  /* Check inherited global status. */
     if( *STATUS != SAI__OK ) return;
  
  /* Loop over for all possible output pixels.  */
     for( i = 0; i < *NPIX; i++ ){
  
  /* Initialise sums. */
        sumw = 0.0;
        sumd = 0.0;
  
  /* Set good pixel count. */
        ngood = 0;
  
  /* Loop over all possible contributing pixels forming weighted mean
     sums. */
        pstack = STACK + i;
        for( j = 0; j < *NLINES; j++ ){
           if( *pstack != VAL__BAD<T> ) {
  
  /* Conversion increment good value counter. */
              ngood++;
  
  /* Sum weights. */
              sumw += 1.0;
  
  /* Form weighted mean sum. */
              sumd += (double)( *pstack );
  
  /* Update the contribution buffer---all values contribute when forming
     mean. */
              NCON[ j ] += 1.0;
  
  /* Move the input pointer on to the value in the next input line. */
           pstack += *NPIX;
        }
  
  /* If there are sufficient good pixels output the result. */
        if( ngood >= *MINPIX ) {
           value = sumd/sumw;
           RESULT[ i ] = (<CTYPE>) value;
  
  /* Trap numeric errors. */
           if( RESULT[ i ] != (<CTYPE>) value ) {
              RESULT[ i ] = VAL__BAD<T>;
              (*NBAD)++;
           }
  
  /* Not enough contributing pixels, set output invalid unless all of them
     are bad. */
        } else {
           RESULT[ i ] = VAL__BAD<T>;
           if( ngood > 0 ) (*NBAD)++;
        }
     }
  }
  

The above file could be processed using tyhe command:

  % generic ccg8_um3.cdr

to create output file ccg8_um3.c containing expanded versions of the above code for HDS data types _DOUBLE and _REAL.