next up previous
Next: NDFTRACE Trace an NDF Structure
Up: EXAMPLE APPLICATIONS
Previous: ZAPPIX ``Zap'' Prominent Pixels in an Image

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 §[*].

      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



next up previous
Next: NDFTRACE Trace an NDF Structure
Up: EXAMPLE APPLICATIONS
Previous: ZAPPIX ``Zap'' Prominent Pixels in an Image


Starlink User Note 33
R.F. Warren-Smith
11th January 2000
E-mail:rfws@star.rl.ac.uk

Copyright © 2000 Council for the Central Laboratory of the Research Councils