A EXAMPLE APPLICATIONS

 A.1 SHOW — Display the size of an NDF
 A.2 SETTITLE — Assign a New NDF Title
 A.3 GETMAX — Obtain the Maximum Pixel Value
 A.4 GETSUM — Sum the Pixel Values
 A.5 READIMG — Read an image into an NDF
 A.6 ZAPPIX — “Zap” Prominent Pixels in an Image
 A.7 ADD — Add Two NDF Data Structures
 A.8 NDFTRACE — Trace an NDF Structure

This section contains a few simple example applications which demonstrate the use of NDF_ routines in real-life situations. These bring together many of the facilities which are described in relative isolation in other parts of the document.

All the following applications are written as ADAM A-tasks (see §24 for details of how to compile and link an A-task which calls NDF_ routines) and each may be extracted and used directly from the source of this document if required. On Starlink systems, this can be found in the file /star/docs/sun33.tex.

Readers who require a tutorial introduction to ADAM should consult SUN/101.

A.1 SHOW — Display the size of an NDF

This first example is trivial and simply serves to show the overall structure of an ADAM application which calls the NDF_ library. It outputs a message showing how many pixels there are in an NDF.

        SUBROUTINE SHOW( STATUS )
  *+
  *  Name:
  *     SHOW
  
  *  Purpose:
  *     Show the size of an NDF.
  
  *  Description:
  *     This routine outputs a message showing how many pixels there are
  *     in an NDF.
  
  *  ADAM Parameters:
  *     NDF = NDF (Read)
  *        The NDF whose size is to be displayed.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER INDF               ! NDF identifier
        INTEGER NPIX               ! Number of NDF pixels
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Obtain the input NDF and enquire its size.
        CALL NDF_ASSOC( ’NDF’, ’READ’, INDF, STATUS )
        CALL NDF_SIZE( INDF, NPIX, STATUS )
  
  *  Display the size.
        CALL MSG_SETI( ’NPIX’, NPIX )
        CALL MSG_OUT( ’SHOW_SIZE’, ’This NDF has ^NPIX pixels.’, STATUS )
  
  *  Annul the NDF identifier.
        CALL NDF_ANNUL( INDF, STATUS )
  
        END

The following is an example ADAM interface file (show.ifl) for the application above.

  interface SHOW
  
     parameter NDF                 # NDF to be inspected
        position 1
        prompt   ’NDF data structure’
     endparameter
  
  endinterface

A.2 SETTITLE — Assign a New NDF Title

The following example is a simple application which sets a new title for an existing NDF. Note the use of ‘UPDATE’ access, since an existing NDF is being modified rather than creating a new one.

        SUBROUTINE SETTITLE( STATUS )
  *+
  *  Name:
  *     SETTITLE
  
  *  Purpose:
  *     Set a new title for an NDF data structure.
  
  *  Description:
  *     This routine sets a new value for the title component of an
  *     existing NDF data structure. The NDF is accessed in update mode
  *     and any pre-existing title is over-written with a new value.
  *     Alternatively, if a "null" value (!) is given for the TITLE
  *     parameter, then the NDF’s title will be erased.
  
  *  ADAM Parameters:
  *     NDF = NDF (Read and Write)
  *        The NDF data structure whose title is to be modified.
  *     TITLE = LITERAL (Read)
  *        The value to be assigned to the NDF’s title component. [!]
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER NDF                ! NDF identifier
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Obtain an identifier for the NDF to be modified.
        CALL NDF_ASSOC( ’NDF’, ’UPDATE’, NDF, STATUS )
  
  *  Reset any existing title.
        CALL NDF_RESET( NDF, ’Title’, STATUS )
  
  *  Obtain a new title.
        CALL NDF_CINP( ’TITLE’, NDF, ’Title’, STATUS )
  
  *  Annul the NDF identifier.
        CALL NDF_ANNUL( NDF, STATUS )
  
        END

The following is an example ADAM interface file (settitle.ifl) for the application above.

     interface SETTITLE
  
        parameter NDF                 # NDF to be modified
           position 1
           prompt   ’Data structure’
        endparameter
  
        parameter TITLE               # New title value
           position 2
           type     ’LITERAL’
           prompt   ’New NDF title’
        endparameter
  
     endinterface

A.3 GETMAX — Obtain the Maximum Pixel Value

The following application calculates and displays the maximum pixel value in an NDF’s data array. It is typical of a class of applications which read a single NDF as input, but do not produce any output data structure.

In this example, the choice has been made to handle all values using single-precision (_REAL) arithmetic and not to handle bad pixel values at all. Strictly speaking, the call to NDF_MBAD to check for the presence of bad pixels is not essential, but it does help by producing an error message if someone should inadvertently use this program on data which does contain bad pixels.

        SUBROUTINE GETMAX( STATUS )
  *+
  *  Name:
  *     GETMAX
  
  *  Purpose:
  *     Obtain the maximum pixel value.
  
  *  Description:
  *     This routine finds the maximum pixel value in the data array of
  *     an NDF and displays the result.
  
  *  ADAM Parameters:
  *     NDF = NDF (Read)
  *        The NDF data structure whose data array is to be examined.
  
  *  Implementation Status:
  *     This routine deliberately does not handle NDFs whose data arrays
  *     contain bad pixels. Real arithmetic is used to compute the
  *     maximum.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER EL                 ! Number of mapped pixels
        INTEGER INDF               ! NDF identifier
        INTEGER PNTR( 1 )          ! Pointer to mapped values
        LOGICAL BAD                ! Bad pixels present? (junk variable)
        REAL HIGH                  ! Maximum pixel value
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Obtain the input NDF and map its data array as _REAL values for
  *  reading.
        CALL NDF_ASSOC( ’NDF’, ’READ’, INDF, STATUS )
        CALL NDF_MAP( INDF, ’Data’, ’_REAL’, ’READ’, PNTR, EL, STATUS )
  
  *  Check that there are no bad pixels present.
        CALL NDF_MBAD( .FALSE., INDF, INDF, ’Data’, .TRUE., BAD, STATUS )
  
  *  Find the maximum pixel value and display the result.
        CALL MAXIT( EL, %VAL( PNTR( 1 ) ), HIGH, STATUS )
        CALL MSG_SETR( ’HIGH’, HIGH )
        CALL MSG_OUT( ’GETMAX_HIGH’, ’   Maximum value is ^HIGH’, STATUS )
  
  *  Annul the NDF identifier.
        CALL NDF_ANNUL( INDF, STATUS )
  
        END
  
        SUBROUTINE MAXIT( EL, ARRAY, HIGH, STATUS )
  *+
  *  Name:
  *     MAXIT
  
  *  Purpose:
  *     Find the maximum value in a real array.
  
  *  Invocation:
  *     CALL MAXIT( EL, ARRAY, HIGH, STATUS )
  
  *  Description:
  *     The routine returns the maximum element value in a real array.
  
  *  Arguments:
  *     EL = INTEGER (Given)
  *        Number of array elements.
  *     ARRAY( EL ) = REAL (Given)
  *        The real array.
  *     HIGH = REAL (Returned)
  *        Maximum element value.
  *     STATUS = INTEGER (Given and Returned)
  *        The global status.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
  
  *  Arguments Given:
        INTEGER EL
        REAL ARRAY( * )
  
  *  Arguments Returned:
        REAL HIGH
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER I                  ! Loop counter
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Find the maximum array value.
        HIGH = ARRAY( 1 )
        DO 1 I = 2, EL
           IF ( ARRAY( I ) .GT. HIGH ) HIGH = ARRAY( I )
   1    CONTINUE
  
        END

The following is an example ADAM interface file (getmax.ifl) for the application above.

  interface GETMAX
  
     parameter NDF                 # NDF to be examined
        position 1
        prompt   ’Data structure’
     endparameter
  
  endinterface

A.4 GETSUM — Sum the Pixel Values

This application is a logical extension of the previous one, except that it sums the pixel values in an NDF’s data array, rather than finding the maximum pixel value. In this example, however, we first check to determine whether or not there may be bad pixel values in the input NDF, and then adapt the algorithm to accommodate either case. Any bad pixels are excluded from the result.

Simple error reporting is also introduced in this example; an error report is generated if the input data array does not contain any good (i.e. non-bad) pixels.

        SUBROUTINE GETSUM( STATUS )
  *+
  *  Name:
  *     GETSUM
  
  *  Purpose:
  *     Sum the pixels in an NDF’s data array.
  
  *  Description:
  *     This routine sums the values of the pixels in an NDF’s data array
  *     and displays the result. Any bad pixels which may be present are
  *     excluded from the sum.
  
  *  ADAM Parameters:
  *     NDF = NDF (Read)
  *        The NDF data structure whose data array is to be examined.
  
  *  Implementation Status:
  *     This routine can handle data with or without bad pixels (and
  *     hence can also handle a quality array if present). Real
  *     arithmetic is used for forming the pixel sum.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER EL                 ! Number of mapped pixels
        INTEGER INDF               ! NDF identifier
        INTEGER NGOOD              ! Number of good pixels
        INTEGER PNTR( 1 )          ! Pointer to mapped values
        LOGICAL BAD                ! Bad pixel present?
        REAL SUM                   ! Pixel sum
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Obtain the input NDF and map its data array as _REAL values for
  *  reading.
        CALL NDF_ASSOC( ’NDF’, ’READ’, INDF, STATUS )
        CALL NDF_MAP( INDF, ’Data’, ’_REAL’, ’READ’, PNTR, EL, STATUS )
  
  *  See if bad pixel values are present.
        CALL NDF_BAD( INDF, ’Data’, .FALSE., BAD, STATUS )
  
  *  Sum the pixel values and display the result.
        CALL SUMIT( BAD, EL, %VAL( PNTR( 1 ) ), SUM, NGOOD, STATUS )
        IF ( NGOOD .GT. 0 ) THEN
           CALL MSG_SETR( ’SUM’, SUM )
           CALL MSG_OUT( ’GETSUM_SUM’,
       :                 ’   Sum of pixels is ^SUM’, STATUS )
  
  *  Report an error if there are no good pixels present.
        ELSE
           STATUS = SAI__ERROR
           CALL NDF_MSG( ’NDF’, INDF )
           CALL ERR_REP( ’GETSUM_ALLBAD’,
       :   ’GETSUM: All the data pixels in the NDF ^NDF are bad.’,
       :   STATUS )
        END IF
  
  *  Annul the NDF identifier.
        CALL NDF_ANNUL( INDF, STATUS )
  
        END
  
        SUBROUTINE SUMIT( BAD, EL, ARRAY, SUM, NGOOD, STATUS )
  *+
  *  Name:
  *     SUMIT
  
  *  Purpose:
  *     Sum the elements of a real array, allowing for bad values.
  
  *  Invocation:
  *     CALL SUMIT( BAD, EL, ARRAY, SUM, NGOOD, STATUS )
  
  *  Description:
  *     The routine returns the sum of the elements of a real array,
  *     excluding any which have the bad value.
  
  *  Arguments:
  *     BAD = LOGICAL (Given)
  *        Whether bad pixel values may be present.
  *     EL = INTEGER (Given)
  *        Number of array elements.
  *     ARRAY( EL ) = REAL (Given)
  *        The real array.
  *     SUM = REAL (Returned)
  *        Sum of the elements.
  *     NGOOD = INTEGER (Returned)
  *        Number of good (non-bad) elements.
  *     STATUS = INTEGER (Given and Returned)
  *        The global status.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
        INCLUDE ’PRM_PAR’          ! Define the VAL__BADR constant
  
  *  Arguments Given:
        LOGICAL BAD
        INTEGER EL
        REAL ARRAY( * )
  
  *  Arguments Returned:
        REAL SUM
        INTEGER NGOOD
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER I                  ! Loop counter
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  If there are no bad values, simply sum the array elements.
        IF ( .NOT. BAD ) THEN
           SUM = 0.0
           NGOOD = EL
           DO 1 I = 1, EL
              SUM = SUM + ARRAY( I )
   1       CONTINUE
  
  *  Otherwise, test each element before using it.
        ELSE
           SUM = 0.0
           NGOOD = 0
           DO 2 I = 1, EL
              IF ( ARRAY( I ) .NE. VAL__BADR ) THEN
                 SUM = SUM + ARRAY( I )
                 NGOOD = NGOOD + 1
              END IF
   2       CONTINUE
        END IF
  
        END

The following is an example ADAM interface file (getsum.ifl) for the application above.

  interface GETSUM
  
     parameter NDF                 # NDF to be examined
        position 1
        prompt   ’Data structure’
     endparameter
  
  endinterface

A.5 READIMG — Read an image into an NDF

The following is a simple example of how to create a new NDF data structure from scratch, in this case starting with image data read from an unformatted sequential Fortran file. This is typical of how the NDF-based half of a format conversion application (designed to read data from another format into an NDF) might look. This example could be modified to read other formats by appropriately replacing the routine which reads the data from the file.

In this example, use has been made of the FIO_ package (SUN/143) to allocate a Fortran I/O unit. Some moderately elaborate error reporting is also illustrated; this gives helpful error messages in response to I/O errors and a final contextual report at the end of the application.

        SUBROUTINE READIMG( STATUS )
  *+
  *  Name:
  *     READIMG
  
  *  Purpose:
  *     Read an image into an NDF.
  
  *  Description:
  *     This routine reads a 2-dimensional real image into an NDF data
  *     structure from an unformatted sequential Fortran file. The image
  *     data are assumed to be stored one line per record in the file.
  
  *  ADAM Parameters:
  *     FILE = LITERAL (Read)
  *        Name of the input file.
  *     NDF = NDF (Write)
  *        The output NDF data structure.
  *     NX = INTEGER (Read)
  *        Number of pixels per image line.
  *     NY = INTEGER (Read)
  *        Number of lines in the image.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
        INCLUDE ’FIO_PAR’          ! Define FIO__SZFNM constant
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        CHARACTER * ( FIO__SZFNM ) FILE ! Input file name
        INTEGER DIM( 2 )           ! Image dimension sizes
        INTEGER EL                 ! Number of mapped values
        INTEGER INDF               ! NDF identifier
        INTEGER IOERR              ! I/O error status
        INTEGER IOUNIT             ! Fortran I/O unit number
        INTEGER PNTR( 1 )          ! Pointer to mapped values
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Obtain the name of the input file and allocate an I/O unit on which
  *  to open it.
        CALL PAR_GET0C( ’FILE’, FILE, STATUS )
        CALL FIO_GUNIT( IOUNIT, STATUS )
        IF ( STATUS .NE. SAI__OK ) GO TO 99
  
  *  Open the file, trapping and reporting any errors.
        OPEN( FILE = FILE, UNIT = IOUNIT, STATUS = ’OLD’,
       :      FORM = ’UNFORMATTED’, IOSTAT = IOERR )
        IF ( IOERR .NE. 0 ) THEN
           STATUS = SAI__ERROR
           CALL ERR_FIOER( ’MESSAGE’, IOERR )
           CALL FIO_REP( IOUNIT, FILE, IOERR,
       :   ’Unable to open file ^FNAME on Fortran unit ^UNIT - ’ //
       :   ’^MESSAGE’, STATUS )
           GO TO 99
        END IF
  
  *  Obtain the dimension sizes of the image to be read and check the
  *  values obtained for validity.
        CALL PAR_GET0I( ’NX’, DIM( 1 ), STATUS )
        CALL PAR_GET0I( ’NY’, DIM( 2 ), STATUS )
        IF ( STATUS .NE. SAI__OK ) GO TO 99
        IF ( ( DIM( 1 ) .LT. 1 ) .OR. ( DIM( 2 ) .LT. 1 ) ) THEN
           STATUS = SAI__ERROR
           CALL ERR_REP( ’READIMG_BADDIM’,
       :   ’Image dimensions must be positive.’, STATUS )
           GO TO 99
        END IF
  
  *  Create an output NDF of the correct size and map its data array as
  *  _REAL values for writing.
        CALL NDF_CREP( ’NDF’, ’_REAL’, 2, DIM, INDF, STATUS )
        CALL NDF_MAP( INDF, ’Data’, ’_REAL’, ’WRITE’, PNTR, EL, STATUS )
  
  *  Read the image values from the input file into the mapped array.
        CALL READIT( IOUNIT, DIM( 1 ), DIM( 2 ), %VAL( PNTR( 1 ) ),
       :             STATUS )
  
  *  Annul the NDF identifier, close the input file and deallocate the I/O
  *  unit.
   99   CONTINUE
        CALL NDF_ANNUL( INDF, STATUS )
        CLOSE( UNIT = IOUNIT )
        CALL FIO_PUNIT( IOUNIT, STATUS )
  
  *  If an error occurred, then report contextual information.
        IF ( STATUS .NE. SAI__OK ) THEN
           CALL ERR_REP( ’READIMG_ERR’,
       :   ’READIMG: Error reading an image into an NDF from a ’ //
       :   ’Fortran file.’, STATUS )
        END IF
  
        END
  
        SUBROUTINE READIT( IOUNIT, NX, NY, ARRAY, STATUS )
  *+
  *  Name:
  *     READIT
  
  *  Purpose:
  *     Read an image from a file.
  
  *  Invocation:
  *     CALL READIT( IOUNIT, NX, NY, ARRAY, STATUS )
  
  *  Description:
  *     The routine reads a real image from an unformatted sequential
  *     Fortran file, one image line per record.
  
  *  Arguments:
  *     IOUNIT = INTEGER (Given)
  *        The Fortran I/O unit on which to read the (previously opened)
  *        file.
  *     NX = INTEGER (Given)
  *        Number of pixels per image line.
  *     NY = INTEGER (Given)
  *        Number of lines in the image.
  *     ARRAY( NX, NY ) = REAL (Returned)
  *        The image array to be read.
  *     STATUS = INTEGER (Given and Returned)
  *        The global status.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
        INCLUDE ’FIO_PAR’          ! Define FIO__SZFNM constant
  
  *  Arguments Given:
        INTEGER IOUNIT
        INTEGER NX
        INTEGER NY
  
  *  Arguments Returned:
        REAL ARRAY( NX, NY )
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        CHARACTER * ( FIO__SZFNM ) FILE ! File name
        INTEGER IGNORE             ! Enquire status (ignored)
        INTEGER IOERR              ! I/O error status
        INTEGER IX                 ! Loop counter for image pixels
        INTEGER IY                 ! Loop counter for image lines
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Read each line of the image from the file, trapping any errors.
        DO 1 IY = 1, NY
           READ( IOUNIT, IOSTAT = IOERR ) ( ARRAY( IX, IY ), IX= 1, NX )
  
  *  If an error occurred, then make a helpful error report and abort.
           IF ( IOERR .NE. 0 ) THEN
              STATUS = SAI__ERROR
              CALL ERR_FIOER( ’MESSAGE’, IOERR )
              CALL FIO_REP( IOUNIT, ’ ’, IOERR,
       :      ’Error reading file ^FNAME on Fortran unit ’^UNIT - ’ //
       :      ’^MESSAGE’, STATUS )
              GO TO 99
           END IF
   1    CONTINUE
  
  *  Jump to here if an error occurs.
   99   CONTINUE
        END

The following is an example ADAM interface file (readimg.ifl) for the application above.

  interface READIMG
  
     parameter FILE                # Input file name
        position 1
        type     LITERAL
        prompt   ’Input file’
     endparameter
  
     parameter NDF                 # Output NDF
        position 4
        prompt   ’Output NDF’
     endparameter
  
     parameter NX                  # Number of pixels per line
        position 2
        type     _INTEGER
        prompt   ’X dimension of image’
     endparameter
  
     parameter NY                  # Number of lines in image
        position 3
        type     _INTEGER
        prompt   ’Y dimension of image’
     endparameter
  
  endinterface

A.6 ZAPPIX — “Zap” Prominent Pixels in an Image

The following example is based around a simple algorithm which detects prominent pixels (e.g. data spikes) in a 2-dimensional image and replaces them with bad pixels. It is typical of applications which take a single NDF as input and produce a new NDF with the same size as output. It illustrates the use of propagation (NDF_PROP) in producing the new output NDF using the input as a template. Note that this application modifies the data array but does not handle the variance array, which will therefore become invalid and is not propagated.

This example also illustrates how bad pixels might be handled in a reasonably realistic image-processing algorithm. No attempt is made here to distinguish cases where bad pixels are present from those where they are not, and we do not really know afterwards if there are any bad pixels in the output image (although a check for this could easily be added). The output bad-pixel flag is therefore left with its default value of .TRUE..

        SUBROUTINE ZAPPIX( STATUS )
  *+
  *  Name:
  *     ZAPPIX
  
  *  Purpose:
  *     Zap prominent pixels.
  
  *  Description:
  *     This routine "zaps" prominent pixels in a 2-dimensional image
  *     (stored in the data array of an NDF). It searches for pixels
  *     which deviate by more than a specified amount from the mean of
  *     their nearest neighbours, and replaces them with bad pixels.
  
  *  ADAM Parameters:
  *     IN = NDF (Read)
  *        Input NDF data structure.
  *     OUT = NDF (Write)
  *        The output NDF data structure.
  *     THRESH = _REAL (Read)
  *        Threshold for zapping pixels; pixels will be set bad if they
  *        deviate by more than this amount from the mean of their
  *        nearest neighbours (the absolute value of THRESH is used).
  
  *  Implementation Status:
  *     This routine correctly handles bad pixels but does not handle NDF
  *     variance arrays. Real arithmetic is used.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER DIM( 2 )           ! Image dimension sizes
        INTEGER EL                 ! Number of mapped values
        INTEGER INDF1              ! Input NDF identifier
        INTEGER INDF2              ! Output NDF identifier
        INTEGER NDIM               ! Number of NDF dimensions (junk)
        INTEGER PNTR1( 1 )         ! Pointer to mapped input values
        INTEGER PNTR2( 1 )         ! Pointer to mapped output values
        REAL THRESH                ! Threshold for zapping pixels
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Begin an NDF context.
        CALL NDF_BEGIN
  
  *  Obtain the input NDF and obtain its first two dimension sizes.
        CALL NDF_ASSOC( ’IN’, ’READ’, INDF1, STATUS )
        CALL NDF_DIM( INDF1, 2, DIM, NDIM, STATUS )
  
  *  Obtain a threshold value.
        CALL PAR_GET0R( ’THRESH’, THRESH, STATUS )
  
  *  Create an output NDF based on the input one. Propagate the AXIS,
  *  QUALITY and UNITS components.
        CALL NDF_PROP( INDF1, ’Axis,Quality,Units’, ’OUT’, INDF2, STATUS )
  
  *  Map the input and output data arrays for reading and writing
  *  respectively.
        CALL NDF_MAP( INDF1, ’Data’, ’_REAL’, ’READ’, PNTR1, EL, STATUS )
        CALL NDF_MAP( INDF2, ’Data’, ’_REAL’, ’WRITE’, PNTR2, EL, STATUS )
  
  *  Process the input array, writing the new values to the output array.
        CALL ZAPIT( ABS( THRESH ), DIM( 1 ), DIM( 2 ), %VAL( PNTR1( 1 ) ),
       :            %VAL( PNTR2( 1 ) ), STATUS )
  
  *  End the NDF context (this cleans everything up).
        CALL NDF_END( STATUS )
  
  *  If an error occurred, then report a contextual message.
        IF ( STATUS .NE. SAI__OK ) THEN
           CALL ERR_REP( ’ZAPPIX_ERR’,
       :   ’ZAPPIX: Error zapping prominent pixels in an image.’,
       :   STATUS )
        END IF
  
        END
  
        SUBROUTINE ZAPIT( THRESH, NX, NY, A, B, STATUS )
  *+
  *  Name:
  *     ZAPIT
  
  *  Purpose:
  *     Zap prominent pixels in an image.
  
  *  Invocation:
  *     CALL ZAPIT( THRESH, NX, NY, A, B, STATUS )
  
  *  Description:
  *     The routine finds all pixels in a 2-dimensional image which
  *     deviate by more than a specified amount from the mean of their
  *     nearest neighbours and replaces them with the bad pixel value.
  *     Bad pixels in the input image are correctly handled.
  
  *  Arguments:
  *     THRESH = REAL (Given)
  *        The threshold for zapping pixels.
  *     NX = INTEGER (Given)
  *        X dimension of image.
  *     NY = INTEGER (Given)
  *        Y dimension of image.
  *     A( NX, NY ) = REAL (Given)
  *        The input image.
  *     B( NX, NY ) = REAL (Returned)
  *        The output image.
  *     STATUS = INTEGER (Given and Returned)
  *        The global status.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
        INCLUDE ’PRM_PAR’          ! Define VAL__BADR constant
  
  *  Arguments Given:
        REAL THRESH
        INTEGER NX
        INTEGER NY
        REAL A( NX, NY )
  
  *  Arguments Returned:
        REAL B( NX, NY )
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        INTEGER IIX                ! Loop counter for neighbours
        INTEGER IIY                ! Loop counter for neighbours
        INTEGER IX                 ! Loop counter for image pixels
        INTEGER IY                 ! Loop counter for image pixels
        INTEGER N                  ! Number of good neighbours
        REAL DIFF                  ! Deviation from mean of neighbours
        REAL S                     ! Sum of good neighbours
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Loop through all the pixels in the image.
        DO 4 IY = 1, NY
           DO 3 IX = 1, NX
  
  *  If the input pixel is bad, then so is the output pixel.
              IF ( A( IX, IY ) .EQ. VAL__BADR ) THEN
                 B( IX, IY ) = VAL__BADR
  
  *  Otherwise, loop to find the average of the nearest neighbours.
              ELSE
                 S = 0.0
                 N = 0
                 DO 2 IIY = MAX( 1, IY - 1 ), MIN( NY, IY + 1 )
                    DO 1 IIX = MAX( 1, IX - 1 ), MIN( NX, IX + 1 )
  
  *  Only count neighbours which are not bad themselves.
                       IF ( A( IIX, IIY ) .NE. VAL__BADR ) THEN
                          S = S + A( IIX, IIY )
                          N = N + 1
                       END IF
   1                CONTINUE
   2             CONTINUE
  
  *  If all the neighbours were bad, then just copy the central pixel.
                 IF ( N .EQ. 0 ) THEN
                    B( IX, IY ) = A( IX, IY )
  
  *  Otherwise, see if the central pixel deviates by more than THRESH from
  *  the average. If not, copy it. If so, set it bad.
                 ELSE
                    DIFF = A( IX, IY ) - ( S / REAL( N ) )
                    IF ( ABS( DIFF ) .LE. THRESH ) THEN
                       B( IX, IY ) = A( IX, IY )
                    ELSE
                       B( IX, IY ) = VAL__BADR
                    END IF
                 END IF
              END IF
   3       CONTINUE
   4    CONTINUE
  
        END

The following is an example ADAM interface file (zappix.ifl) for the application above.

  interface ZAPPIX
  
     parameter IN                  # Input NDF
        position 1
        prompt   ’Input NDF’
     endparameter
  
     parameter OUT                 # Output NDF
        position 3
        prompt   ’Output NDF’
     endparameter
  
     parameter THRESH              # Zapping threshold
        position 2
        type     _REAL
        prompt   ’Threshold’
     endparameter
  
  endinterface

A.7 ADD — Add Two NDF Data Structures

The following application adds two NDF data structures pixel-by-pixel. It is a fairly sophisticated “add” application, which will handle both the data and variance components, as well as coping with NDFs of any shape and data type. A much simpler example is given in §2.4.

        SUBROUTINE ADD( STATUS )
  *+
  *  Name:
  *     ADD
  
  *  Purpose:
  *     Add two NDF data structures.
  
  *  Description:
  *     This routine adds two NDF data structures pixel-by-pixel to produce
  *     a new NDF.
  
  *  ADAM Parameters:
  *     IN1 = NDF (Read)
  *        First NDF to be added.
  *     IN2 = NDF (Read)
  *        Second NDF to be added.
  *     OUT = NDF (Write)
  *        Output NDF to contain the sum of the two input NDFs.
  *     TITLE = LITERAL (Read)
  *        Value for the title of the output NDF. A null value will cause
  *        the title of the NDF supplied for parameter IN1 to be used
  *        instead. [!]
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
        INCLUDE ’NDF_PAR’          ! NDF_ public constants
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        CHARACTER * ( 13 ) COMP    ! NDF component list
        CHARACTER * ( NDF__SZFTP ) DTYPE ! Type for output components
        CHARACTER * ( NDF__SZTYP ) ITYPE ! Numeric type for processing
        INTEGER EL                 ! Number of mapped elements
        INTEGER IERR               ! Position of first error (dummy)
        INTEGER NDF1               ! Identifier for 1st NDF (input)
        INTEGER NDF2               ! Identifier for 2nd NDF (input)
        INTEGER NDF3               ! Identifier for 3rd NDF (output)
        INTEGER NERR               ! Number of errors
        INTEGER PNTR1( 2 )         ! Pointers to 1st NDF mapped arrays
        INTEGER PNTR2( 2 )         ! Pointers to 2nd NDF mapped arrays
        INTEGER PNTR3( 2 )         ! Pointers to 3rd NDF mapped arrays
        LOGICAL BAD                ! Need to check for bad pixels?
        LOGICAL VAR1               ! Variance component in 1st input NDF?
        LOGICAL VAR2               ! Variance component in 2nd input NDF?
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Begin an NDF context.
        CALL NDF_BEGIN
  
  *  Obtain identifiers for the two input NDFs.
        CALL NDF_ASSOC( ’IN1’, ’READ’, NDF1, STATUS )
        CALL NDF_ASSOC( ’IN2’, ’READ’, NDF2, STATUS )
  
  *  Trim their pixel-index bounds to match.
        CALL NDF_MBND( ’TRIM’, NDF1, NDF2, STATUS )
  
  *  Create a new output NDF based on the first input NDF. Propagate the
  *  axis and quality components, which are not changed. This program
  *  does not support the units component.
        CALL NDF_PROP( NDF1, ’Axis,Quality’, ’OUT’, NDF3, STATUS )
  
  *  See if a variance component is available in both input NDFs and
  *  generate an appropriate list of input components to be processed.
        CALL NDF_STATE( NDF1, ’Variance’, VAR1, STATUS )
        CALL NDF_STATE( NDF2, ’Variance’, VAR2, STATUS )
        IF ( VAR1 .AND. VAR2 ) THEN
           COMP = ’Data,Variance’
        ELSE
           COMP = ’Data’
        END IF
  
  *  Determine which numeric type to use to process the input arrays and
  *  set an appropriate type for the corresponding output arrays. This
  *  program supports integer, real and double-precision arithmetic.
        CALL NDF_MTYPE( ’_INTEGER,_REAL,_DOUBLE’,
       :                NDF1, NDF2, COMP, ITYPE, DTYPE, STATUS )
        CALL NDF_STYPE( DTYPE, NDF3, COMP, STATUS )
  
  *  Map the input and output arrays.
        CALL NDF_MAP( NDF1, COMP, ITYPE, ’READ’, PNTR1, EL, STATUS )
        CALL NDF_MAP( NDF2, COMP, ITYPE, ’READ’, PNTR2, EL, STATUS )
        CALL NDF_MAP( NDF3, COMP, ITYPE, ’WRITE’, PNTR3, EL, STATUS )
  
  *  Merge the bad pixel flag values for the input data arrays to see if
  *  checks for bad pixels are needed.
        CALL NDF_MBAD( .TRUE., NDF1, NDF2, ’Data’, .FALSE., BAD, STATUS )
  
  *  Select the appropriate routine for the data type being processed and
  *  add the data arrays.
        IF ( STATUS .EQ. SAI__OK ) THEN
           IF ( ITYPE .EQ. ’_INTEGER’ ) THEN
              CALL VEC_ADDI( BAD, EL, %VAL( PNTR1( 1 ) ),
       :                     %VAL( PNTR2( 1 ) ), %VAL( PNTR3( 1 ) ),
       :                     IERR, NERR, STATUS )
  
           ELSE IF ( ITYPE .EQ. ’_REAL’ ) THEN
              CALL VEC_ADDR( BAD, EL, %VAL( PNTR1( 1 ) ),
       :                     %VAL( PNTR2( 1 ) ), %VAL( PNTR3( 1 ) ),
       :                     IERR, NERR, STATUS )
  
           ELSE IF ( ITYPE .EQ. ’_DOUBLE’ ) THEN
              CALL VEC_ADDD( BAD, EL, %VAL( PNTR1( 1 ) ),
       :                     %VAL( PNTR2( 1 ) ), %VAL( PNTR3( 1 ) ),
       :                     IERR, NERR, STATUS )
           END IF
  
  *  Flush any messages resulting from numerical errors.
           IF ( STATUS .NE. SAI__OK ) CALL ERR_FLUSH( STATUS )
        END IF
  
  *  See if there may be bad pixels in the output data array and set the
  *  output bad pixel flag value accordingly.
        BAD = BAD .OR. ( NERR .NE. 0 )
        CALL NDF_SBAD( BAD, NDF3, ’Data’, STATUS )
  
  *  If variance arrays are also to be processed (i.e. added), then see
  *  if bad pixels may be present.
        IF ( VAR1 .AND. VAR2 ) THEN
           CALL NDF_MBAD( .TRUE., NDF1, NDF2, ’Variance’, .FALSE., BAD,
       :                  STATUS )
  
  *  Select the appropriate routine to add the variance arrays.
           IF (STATUS .EQ. SAI__OK ) THEN
              IF ( ITYPE .EQ. ’_INTEGER’ ) THEN
                 CALL VEC_ADDI( BAD, EL, %VAL( PNTR1( 2 ) ),
       :                        %VAL( PNTR2( 2 ) ), %VAL( PNTR3( 2 ) ),
       :                        IERR, NERR, STATUS )
  
              ELSE IF ( ITYPE .EQ. ’_REAL’ ) THEN
                 CALL VEC_ADDR( BAD, EL, %VAL( PNTR1( 2 ) ),
       :                        %VAL( PNTR2( 2 ) ), %VAL( PNTR3( 2 ) ),
       :                        IERR, NERR, STATUS )
  
              ELSE IF ( ITYPE .EQ. ’_DOUBLE’ ) THEN
                 CALL VEC_ADDD( BAD, EL, %VAL( PNTR1( 2 ) ),
       :                        %VAL( PNTR2( 2 ) ), %VAL( PNTR3( 2 ) ),
       :                        IERR, NERR, STATUS )
              END IF
  
  *  Flush any messages resulting from numerical errors.
              IF ( STATUS .NE. SAI__OK ) CALL ERR_FLUSH( STATUS )
           END IF
  
  *  See if bad pixels may be present in the output variance array and
  *  set the bad pixel flag accordingly.
           BAD = BAD .OR. ( NERR .NE. 0 )
           CALL NDF_SBAD( BAD, NDF3, ’Variance’, STATUS )
        END IF
  
  *  Obtain a new title for the output NDF.
        CALL NDF_CINP( ’TITLE’, NDF3, ’Title’, STATUS )
  
  *  End the NDF context.
        CALL NDF_END( STATUS )
  
  *  If an error occurred, then report context information.
        IF ( STATUS .NE. SAI__OK ) THEN
           CALL ERR_REP( ’ADD_ERR’,
       :   ’ADD: Error adding two NDF data structures.’, STATUS )
        END IF
  
        END

The following is an example ADAM interface file (add.ifl) for the application above.

     interface ADD
  
        parameter IN1                 # First input NDF
           position 1
           prompt   ’First input NDF’
        endparameter
  
        parameter IN2                 # Second input NDF
           position 2
           prompt   ’Second input NDF’
        endparameter
  
        parameter OUT                 # Output NDF
           position 3
           prompt   ’Output NDF’
        endparameter
  
        parameter TITLE               # Title for output NDF
           type     ’LITERAL’
           prompt   ’Title for output NDF’
           vpath    ’DEFAULT’
           default  !
        endparameter
  
     endinterface

A.8 NDFTRACE — Trace an NDF Structure

The following rather long example is an application to display the attributes of an NDF data structure. It is probably not typical of the use to which the NDF_ routines will be put, but it demonstrates the use of most of the enquiry routines and provides a “guided tour” of the NDF components.

        SUBROUTINE NDFTRACE( STATUS )
  *+
  *  Name:
  *     NDFTRACE
  
  *  Purpose:
  *     Display the attributes of an NDF data structure.
  
  *  Description:
  *     This routine displays the attributes of an NDF data structure
  *     including its name, the values of its character components, its
  *     shape and the attributes of its data array and of any other array
  *     components present. A list of any extensions present, together
  *     with their HDS data types, is also included.
  
  *  ADAM Parameters:
  *     NDF = NDF (Read)
  *        The NDF data structure whose attributes are to be displayed.
  
  *-
  
  *  Type Definitions:
        IMPLICIT NONE              ! No implicit typing
  
  *  Global Constants:
        INCLUDE ’SAE_PAR’          ! Standard SAE constants
        INCLUDE ’DAT_PAR’          ! DAT_ public constants
        INCLUDE ’NDF_PAR’          ! NDF_ public constants
        INCLUDE ’PRM_PAR’          ! PRIMDAT primitive data constants
  
  *  Status:
        INTEGER STATUS             ! Global status
  
  *  Local Variables:
        BYTE BADBIT                ! Bad-bits mask
        CHARACTER * ( 35 ) APPN    ! Last recorded application name
        CHARACTER * ( 8 ) BINSTR   ! Binary bad-bits mask string
        CHARACTER * ( DAT__SZLOC ) XLOC ! Extension locator
        CHARACTER * ( DAT__SZTYP ) TYPE ! Extension type
        CHARACTER * ( NDF__MXDIM * ( 2 * VAL__SZI + 3 ) - 2 ) BUF
                                   ! Text buffer for shape information
        CHARACTER * ( NDF__SZFRM ) FORM ! Storage form
        CHARACTER * ( NDF__SZFTP ) FTYPE ! Full data type
        CHARACTER * ( NDF__SZHDT ) CREAT ! History component creation date
        CHARACTER * ( NDF__SZHDT ) DATE ! Date of last history update
        CHARACTER * ( NDF__SZHUM ) HMODE ! History update mode
        CHARACTER * ( NDF__SZXNM ) XNAME ! Extension name
        INTEGER BBI                ! Bad-bits value as an integer
        INTEGER DIGVAL             ! Binary digit value
        INTEGER DIM( NDF__MXDIM )  ! Dimension sizes
        INTEGER I                  ! Loop counter for dimensions
        INTEGER IAXIS              ! Loop counter for axes
        INTEGER IDIG               ! Loop counter for binary digits
        INTEGER INDF               ! NDF identifier
        INTEGER LBND( NDF__MXDIM ) ! Lower pixel-index bounds
        INTEGER N                  ! Loop counter for extensions
        INTEGER NC                 ! Character count
        INTEGER NDIM               ! Number of dimensions
        INTEGER NEXTN              ! Number of extensions
        INTEGER NREC               ! Number of history records
        INTEGER SIZE               ! Total number of pixels
        INTEGER UBND( NDF__MXDIM ) ! Upper pixel-index bounds
        LOGICAL BAD                ! Bad pixel flag
        LOGICAL THERE              ! Whether NDF component is defined
  
  *  Internal References:
        INCLUDE ’NUM_DEC_CVT’      ! NUM_ type conversion routines
        INCLUDE ’NUM_DEF_CVT’
  
  *.
  
  *  Check inherited global status.
        IF ( STATUS .NE. SAI__OK ) RETURN
  
  *  Obtain an identifier for the NDF structure to be examined.
        CALL NDF_ASSOC( ’NDF’, ’READ’, INDF, STATUS )
  
  *  Display the NDF’s name.
        CALL MSG_BLANK( STATUS )
        CALL NDF_MSG( ’NDF’, INDF )
        CALL MSG_OUT( ’HEADER’, ’   NDF structure ^NDF:’, STATUS )
  
  *  Character components:
  *  ====================
  *  See if the title component is defined. If so, then display its
  *  value.
        CALL NDF_STATE( INDF, ’Title’, THERE, STATUS )
        IF ( THERE ) THEN
           CALL NDF_CMSG( ’TITLE’, INDF, ’Title’, STATUS )
           CALL MSG_OUT( ’TITLE’, ’      Title:  ^TITLE’, STATUS )
        END IF
  
  *  See if the label component is defined. If so, then display its
  *  value.
        CALL NDF_STATE( INDF, ’Label’, THERE, STATUS )
        IF ( THERE ) THEN
           CALL NDF_CMSG( ’LABEL’, INDF, ’Label’, STATUS )
           CALL MSG_OUT( ’LABEL’, ’      Label:  ^LABEL’, STATUS )
        END IF
  
  *  See if the units component is defined. If so, then display its
  *  value.
        CALL NDF_STATE( INDF, ’Units’, THERE, STATUS )
        IF ( THERE ) THEN
           CALL NDF_CMSG( ’UNITS’, INDF, ’Units’, STATUS )
           CALL MSG_OUT( ’UNITS’, ’      Units:  ^UNITS’, STATUS )
        END IF
  
  *  NDF shape:
  *  =========
  *  Obtain the dimension sizes.
        CALL NDF_DIM( INDF, NDF__MXDIM, DIM, NDIM, STATUS )
  
  *  Display a header for this information.
        CALL MSG_BLANK( STATUS )
        CALL MSG_OUT( ’SHAPE_HEADER’, ’   Shape:’, STATUS )
  
  *  Display the number of dimensions.
        CALL MSG_SETI( ’NDIM’, NDIM )
        CALL MSG_OUT( ’DIMENSIONALITY’,
       : ’      No. of dimensions:  ^NDIM’, STATUS )
  
  *  Construct a string showing the dimension sizes.
        NC = 0
        DO 1 I = 1, NDIM
            IF ( I .GT. 1 ) CALL CHR_PUTC( ’ x ’, BUF, NC )
            CALL CHR_PUTI( DIM( I ), BUF, NC )
   1    CONTINUE
        CALL MSG_SETC( ’DIMS’, BUF( : NC ) )
  
  *  Display the dimension size information.
        CALL MSG_OUT( ’DIMENSIONS’,
       : ’      Dimension size(s):  ^DIMS’, STATUS )
  
  *  Obtain the pixel-index bounds.
        CALL NDF_BOUND( INDF, NDF__MXDIM, LBND, UBND, NDIM, STATUS )
  
  *  Construct a string showing the pixel-index bounds.
        NC = 0
         DO 2 I = 1, NDIM
           IF ( I .GT. 1 ) CALL CHR_PUTC( ’, ’, BUF, NC )
           CALL CHR_PUTI( LBND( I ), BUF, NC )
           CALL CHR_PUTC( ’:’, BUF, NC )
           CALL CHR_PUTI( UBND( I ), BUF, NC )
   2    CONTINUE
        CALL MSG_SETC( ’BNDS’, BUF( : NC ) )
  
  *  Display the pixel-index bounds information.
        CALL MSG_OUT( ’BOUNDS’,
       : ’      Pixel bounds     :  ^BNDS’, STATUS )
  
  *  Obtain the NDF size and display this information.
        CALL NDF_SIZE( INDF, SIZE, STATUS )
        CALL MSG_SETI( ’SIZE’, SIZE )
        CALL MSG_OUT( ’SIZE’,
       : ’      Total pixels     :  ^SIZE ’, STATUS )
  
  *  Axis component:
  *  ==============
  *  See if the axis coordinate system is defined. If so then output a header
  *  for it.
        CALL NDF_STATE( INDF, ’Axis’, THERE, STATUS )
        IF ( THERE ) THEN
           CALL MSG_BLANK( STATUS )
           CALL MSG_OUT( ’AXIS_HEADER’, ’   Axes:’, STATUS )
  
  *  Loop to obtain the label and units for each axis and display them.
           DO 3 IAXIS = 1, NDIM
              CALL MSG_SETI( ’IAXIS’, IAXIS )
              CALL NDF_ACMSG( ’LABEL’, INDF, ’Label’, IAXIS, STATUS )
              CALL NDF_ACMSG( ’UNITS’, INDF, ’Units’, IAXIS, STATUS )
              CALL MSG_OUT( ’AXIS_LABEL’,
       :      ’      ^IAXIS: ^LABEL (^UNITS)’, STATUS )
   3       CONTINUE
        END IF
  
  *  Data component:
  *  ==============
  *  Obtain the data component attributes.
        CALL NDF_FTYPE( INDF, ’Data’, FTYPE, STATUS )
        CALL NDF_FORM( INDF, ’Data’, FORM, STATUS )
  
  *  Display the data component attributes.
        CALL MSG_BLANK( STATUS )
        CALL MSG_OUT( ’DATA_HEADER’, ’   Data Component:’, STATUS )
        CALL MSG_SETC( ’FTYPE’, FTYPE )
        CALL MSG_OUT( ’DATA_TYPE’, ’      Type        :  ^FTYPE’, STATUS )
        CALL MSG_SETC( ’FORM’, FORM )
        CALL MSG_OUT( ’DATA_FORM’, ’      Storage form:  ^FORM’, STATUS )
  
  *  Determine if the data values are defined. Issue a warning message if
  *  they are not.
        CALL NDF_STATE( INDF, ’Data’, THERE, STATUS )
        IF ( .NOT. THERE ) THEN
           CALL MSG_OUT( ’DATA_UNDEF’,
       :   ’      WARNING: the Data component values are not defined’,
       :                 STATUS )
  
  *  Disable automatic quality masking and see if the data component may
  *  contain bad pixels. If so, then display an appropriate message.
        ELSE
           CALL NDF_SQMF( .FALSE., INDF, STATUS )
           CALL NDF_BAD( INDF, ’Data’, .FALSE., BAD, STATUS )
           IF ( BAD ) THEN
              CALL MSG_OUT( ’DATA_ISBAD’,
       :      ’      Bad pixels may be present’, STATUS )
  
  *  If there were no bad pixels present, then re-enable quality masking
  *  and test again. Issue an appropriate message.
           ELSE
              CALL NDF_SQMF( .TRUE., INDF, STATUS )
              CALL NDF_BAD( INDF, ’Data’, .FALSE., BAD, STATUS )
              IF ( .NOT. BAD ) THEN
                 CALL MSG_OUT( ’DATA_NOBAD’,
       :         ’      There are no bad pixels present’, STATUS )
              ELSE
                 CALL MSG_OUT( ’DATA_QBAD’,
       :         ’      Bad pixels may be introduced via the Quality ’ //
       :         ’component’, STATUS )
              END IF
           END IF
        END IF
  
  *  Variance component:
  *  ==================
  *  See if the variance component is defined.  If so, then obtain its
  *  attributes.
        CALL NDF_STATE( INDF, ’Variance’, THERE, STATUS )
        IF ( THERE ) THEN
           CALL NDF_FTYPE( INDF, ’Variance’, FTYPE, STATUS )
           CALL NDF_FORM( INDF, ’Variance’, FORM, STATUS )
  
  *  Display the variance component attributes.
           CALL MSG_BLANK( STATUS )
           CALL MSG_OUT( ’VAR_HEADER’, ’   Variance Component:’, STATUS )
           CALL MSG_SETC( ’FTYPE’, FTYPE )
           CALL MSG_OUT( ’VAR_TYPE’, ’      Type        :  ^FTYPE’,
       :                 STATUS )
           CALL MSG_SETC( ’FORM’, FORM )
           CALL MSG_OUT( ’VAR_FORM’, ’      Storage form:  ^FORM’,
       :                 STATUS )
  
  *  Disable automatic quality masking and see if the variance component
  *  may contain bad pixels. If so, then display an appropriate message.
           CALL NDF_SQMF( .FALSE., INDF, STATUS )
           CALL NDF_BAD( INDF, ’Variance’, .FALSE., BAD, STATUS )
           IF ( BAD ) THEN
              CALL MSG_OUT( ’VAR_ISBAD’,
       :      ’      Bad pixels may be present’, STATUS )
  
  *  If there were no bad pixels present, then re-enable quality masking
  *  and test again. Issue an appropriate message.
           ELSE
              CALL NDF_SQMF( .TRUE., INDF, STATUS )
              CALL NDF_BAD( INDF, ’Variance’, .FALSE., BAD, STATUS )
              IF ( .NOT. BAD ) THEN
                 CALL MSG_OUT( ’VAR_NOBAD’,
       :         ’      There are no bad pixels present’, STATUS )
              ELSE
                 CALL MSG_OUT( ’VAR_QBAD’,
       :         ’      Bad pixels may be introduced via the Quality ’ //
       :         ’component’, STATUS )
              END IF
           END IF
        END IF
  
  *  Quality component:
  *  =================
  *  See if the quality component is defined. If so, then obtain its
  *  attributes.
        CALL NDF_STATE( INDF, ’Quality’, THERE, STATUS )
        IF ( THERE ) THEN
           CALL NDF_FORM( INDF, ’Quality’, FORM, STATUS )
  
  *  Display the quality component attributes.
           CALL MSG_BLANK( STATUS )
           CALL MSG_OUT( ’QUALITY_HEADER’, ’   Quality Component:’,
       :                 STATUS )
           CALL MSG_SETC( ’FORM’, FORM )
           CALL MSG_OUT( ’QUALITY_FORM’, ’      Storage form :  ^FORM’,
       :                  STATUS )
  
  *  Obtain the bad-bits mask value.
           CALL NDF_BB( INDF, BADBIT, STATUS )
  
  *  Generate a binary representation in a character string.
           BBI = NUM_UBTOI( BADBIT )
           DIGVAL = 2 ** 7
           DO 4 IDIG = 1, 8
              IF ( BBI .GE. DIGVAL ) THEN
                 BINSTR( IDIG : IDIG ) = ’1’
                 BBI = BBI - DIGVAL
              ELSE
                 BINSTR( IDIG : IDIG ) = ’0’
              END IF
              DIGVAL = DIGVAL / 2
   4       CONTINUE
  
  *  Display the bad-bits mask information.
           CALL MSG_SETI( ’BADBIT’, NUM_UBTOI( BADBIT ) )
           CALL MSG_SETC( ’BINARY’, BINSTR )
           CALL MSG_OUT( ’QUALITY_BADBIT’,
       :   ’      Bad-bits mask:  ^BADBIT (binary ^BINARY)’, STATUS )
        END IF
  
  *  Extensions:
  *  ==========
  *  Determine how many extensions are present.
        CALL NDF_XNUMB( INDF, NEXTN, STATUS )
  
  *  Display a heading for the extensions.
        IF ( NEXTN .GT. 0 ) THEN
           CALL MSG_BLANK( STATUS )
           CALL MSG_OUT( ’EXTN_HEADER’, ’   Extensions:’, STATUS )
  
  *  Loop to obtain the name and HDS data type of each extension.
           DO 5 N = 1, NEXTN
              CALL NDF_XNAME( INDF, N, XNAME, STATUS )
              CALL NDF_XLOC( INDF, XNAME, ’READ’, XLOC, STATUS )
              CALL DAT_TYPE( XLOC, TYPE, STATUS )
              CALL DAT_ANNUL( XLOC, STATUS )
  
  *  Display the information for each extension.
              CALL MSG_SETC( ’TYPE’, TYPE )
              CALL MSG_OUT( ’EXTN’,
       :      ’      ’ // XNAME // ’  <^TYPE>’, STATUS )
   5       CONTINUE
        END IF
  
  *  History:
  *  =======
  *  See if a history component is present.
        CALL NDF_STATE( INDF, ’History’, THERE, STATUS )
  
  *  If so, then obtain its attributes.
        IF ( THERE ) THEN
           CALL NDF_HINFO( INDF, ’CREATED’, 0, CREAT, STATUS )
           CALL NDF_HNREC( INDF, NREC, STATUS )
           CALL NDF_HINFO( INDF, ’MODE’, 0,  HMODE, STATUS )
           CALL NDF_HINFO( INDF, ’DATE’, NREC, DATE, STATUS )
           CALL NDF_HINFO( INDF, ’APPLICATION’, NREC, APPN, STATUS )
  
  *  Display the history component attributes.
           CALL MSG_BLANK( STATUS )
           CALL MSG_OUT( ’HISTORY_HEADER’, ’   History Component:’,
       :                 STATUS )
           CALL MSG_SETC( ’CREAT’, CREAT( : 20 ) )
           CALL MSG_OUT( ’HISTORY_CREAT’,
       :                 ’      Created    :  ^CREAT’, STATUS )
           CALL MSG_SETI( ’NREC’, NREC )
           CALL MSG_OUT( ’HISTORY_NREC’,
       :                 ’      No. records:  ^NREC’, STATUS )
           CALL MSG_SETC( ’DATE’, DATE( : 20 ) )
           CALL MSG_SETC( ’APPN’, APPN )
           CALL MSG_OUT( ’HISTORY_DATE’,
       :                 ’      Last update:  ^DATE (^APPN)’, STATUS )
           CALL MSG_SETC( ’HMODE’, HMODE )
           CALL MSG_OUT( ’HISTORY_HMODE’,
       :                 ’      Update mode:  ^HMODE’, STATUS )
        END IF
        CALL MSG_BLANK( STATUS )
  
  *  Clean up:
  *  ========
  *  Annul the NDF identifier.
        CALL NDF_ANNUL( INDF, STATUS )
  
  *  If an error occurred, then report context information.
        IF ( STATUS .NE. SAI__OK ) THEN
           CALL ERR_REP( ’NDFTRACE_ERR’,
       :   ’NDFTRACE: Error displaying the attributes of an NDF ’ //
       :   ’data structure.’, STATUS )
        END IF
  
        END

The following is an example ADAM interface file (ndftrace.ifl) for the application above.

     interface NDFTRACE
  
        parameter NDF                 # NDF to be inspected
           position 1
           prompt   ’Data structure’
        endparameter
  
     endinterface