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