next up previous 231
Next: Accessing multiple images
Up: More advanced image access
Previous: Using ``images'' which are not 2-dimensional


Accessing images using different data types

IMG also allows access to images using data types other than REAL (which is the default). The most useful of these are INTEGER, INTEGER*2, and DOUBLE PRECISION. The subroutine calls needed are almost identical to the normal ones except that you should append a character code to the routine name to indicate the data type you require. The character codes (and their data types) are:
Character code Fortran-77 data type Description
R REAL Single precision
D DOUBLE PRECISION Double precision
I INTEGER Integer
W INTEGER*2 Word
UW INTEGER*2 Unsigned word
B BYTE Byte
UB BYTE Unsigned byte
so among the possibilities are the calls:
      CALL IMG_IND( 'IMAGE', NX, NY, IP, ISTAT )              [1]
      CALL IMG_INI( 'IMAGE', NX, NY, IP, ISTAT )              [2]
      CALL IMG_INR( 'IMAGE', NX, NY, IP, ISTAT )              [3]
The following notes refer to the numbered statements:
1.
Access an image using DOUBLE PRECISION.

2.
Access an image using INTEGER.

3.
Access an image using REAL. Note that this is a synonym for IMG_IN, since it also gets a 2-D REAL image.

You should declare the image array in your program to have the corresponding Fortran data type, as in the following example that accesses and modifies an image using INTEGER format:

*  Access an input image, allowing it to be modified.
      CALL IMG_MODI( 'IN', NX, NY, IP, ISTAT )                [1]

*  Fill the array with zeros.
      CALL DOZERO( %VAL( IP ), NX, NY, ISTAT )

*  Free the image.
      CALL IMG_FREE( 'IN', ISTAT )
      END

      SUBROUTINE DOZERO( IMAGE, NX, NY, ISTAT )
      INCLUDE 'SAE_PAR'
      INTEGER IMAGE( NX, NY )                                 [2]

      IF ( ISTAT .NE. SAI__OK ) RETURN
      DO 1 J = 1, NY
         DO 2 I = 1, NX
            IMAGE( I, J ) = 0
 2       CONTINUE
 1    CONTINUE
      END
The following notes refer to the numbered statements:
1.
An INTEGER input image is accessed for modification

2.
In the subroutine DOZERO the image is declared as an adjustable dimension INTEGER array.

All IMG subroutines that access images have variants that allow you to use different data types. There are also versions that allow these to be mixed with different numbers of data dimensions. Some possibilities are:

      CALL IMG_IN1D( 'SPECTRUM', NX, IP, ISTAT )              [1]
      CALL IMG_MOD2I( 'IMAGE', NX, NY, IP, ISTAT )            [2]
      CALL IMG_NEW3W( 'CUBE', NX, NY, NZ, IP, ISTAT )         [3]
      CALL IMG_IN2R( 'IMAGE', NX, NY, IP, ISTAT )             [4]
The following notes refer to the numbered statements:
1.
This call accesses a 1-D image for reading using DOUBLE PRECISION.

2.
This call accesses a 2-D image for modification using the INTEGER data type.

3.
This call creates a new 3-D data cube with the word (Fortran INTEGER*2) data type.

4.
This call is a synonym for IMG_IN, since it gets a 2-D REAL image.

If your image isn't stored with the type that you ask for, then it will be converted from the stored type (if possible). If you modify the data it will be re-converted to the storage type when the image is freed. New images are stored using the data type you ask for.

The data types unsigned word (UW), signed byte (B) and unsigned byte (UB) are less commonly used. Indeed, the unsigned data types have no equivalents in Fortran and should be manipulated using the PRIMDAT library (SUN/39).



next up previous 231
Next: Accessing multiple images
Up: More advanced image access
Previous: Using ``images'' which are not 2-dimensional

IMG Simple Image Data Access
Starlink User Note 160
P.W. Draper
R.F. Warren-Smith
3 March 2003
E-mail:P.W.Draper@durham.ac.uk

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