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
§.
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