- ←Prev
- NDF
Routines for Accessing the
Extensible N-Dimensional Data Format - Next→
- TOC ↑
A EXAMPLE APPLICATIONS
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
- ←Prev
- NDF
Routines for Accessing the
Extensible N-Dimensional Data Format - Next→
- TOC ↑