next up previous
Next: READIMG Read an image into an NDF
Up: EXAMPLE APPLICATIONS
Previous: GETMAX Obtain the Maximum Pixel Value

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



next up previous
Next: READIMG Read an image into an NDF
Up: EXAMPLE APPLICATIONS
Previous: GETMAX Obtain the Maximum Pixel Value


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