Fortran-90 access to images

Fortran-90 allows definition of data structures (derived types) which are convenient to handle images. The Fortran-90 module image_def defines two derived type corresponding to GILDAS images: the type GILDAS and the type SIC.

MODULE IMAGE_DEF
  INTEGER CODE_READ_DATA
  INTEGER CODE_READ_HEADER
  INTEGER CODE_UPDATE_HEADER
  INTEGER CODE_WRITE_HEADER
  INTEGER CODE_WRITE_DATA
  INTEGER CODE_READ_IMAGE
  INTEGER CODE_FREE_IMAGE
  INTEGER CODE_CREATE_IMAGE
  !
  PARAMETER (CODE_READ_DATA=-1)
  PARAMETER (CODE_READ_HEADER=-2)
  PARAMETER (CODE_UPDATE_HEADER=-3)
  PARAMETER (CODE_WRITE_HEADER=-4)
  PARAMETER (CODE_WRITE_DATA=-5)
  PARAMETER (CODE_READ_IMAGE=-6)
  PARAMETER (CODE_FREE_IMAGE=-7)
  PARAMETER (CODE_CREATE_IMAGE=-8)
  !
  INTEGER FATALE
  PARAMETER (FATALE=44) 
  !
  ! /XIPAR/
  TYPE LOCATION
     SEQUENCE
     INTEGER*4 AL64
     INTEGER*4 SIZE
     INTEGER(KIND=4) ADDR
     INTEGER ISLO
     INTEGER MSLO
     LOGICAL READ
     LOGICAL GETVM
  END TYPE LOCATION
  ! /XCPAR/
  TYPE STRINGS
     SEQUENCE
     CHARACTER*12 TYPE
     CHARACTER*12 UNIT                  ! 56
     CHARACTER*12 CODE(4)               ! 59
     CHARACTER*12 SYST                  ! 71
     CHARACTER*12 NAME                  ! 75,76,77
     CHARACTER*12 LINE
  END TYPE STRINGS
  ! /XPAR/
  TYPE GILDAS_HEADER
     SEQUENCE
     INTEGER*4 ITYP(3)                  !  1
     INTEGER*4 FORM                     !  4
     INTEGER*4 NVB                      !  5
     INTEGER*4 FILL(5)                  !  6
     INTEGER*4 GENE                     ! 11
     INTEGER*4 NDIM                     ! 12
     INTEGER*4 DIM(4)                   ! 13
     REAL*8 REF1                        ! 17
     REAL*8 VAL1                        ! 19
     REAL*8 INC1                        ! 21
     REAL*8 REF2                        ! 23
     REAL*8 VAL2                        ! 25
     REAL*8 INC2                        ! 27
     REAL*8 REF3                        ! 29
     REAL*8 VAL3                        ! 31
     REAL*8 INC3                        ! 33
     REAL*8 REF4                        ! 35
     REAL*8 VAL4                        ! 37
     REAL*8 INC4                        ! 39
     !
     INTEGER*4 BLAN                     ! 41
     REAL*4 BVAL                        ! 42
     REAL*4 EVAL                        ! 43
     !
     INTEGER*4 EXTR                     ! 44
     REAL*4 RMIN                        ! 45
     REAL*4 RMAX                        ! 46
     INTEGER*4 MIN1                     ! 47
     INTEGER*4 MAX1                     ! 48
     INTEGER*4 MIN2                     ! 49
     INTEGER*4 MAX2                     ! 50
     INTEGER*4 MIN3                     ! 51
     INTEGER*4 MAX3                     ! 52
     INTEGER*4 MIN4                     ! 53
     INTEGER*4 MAX4                     ! 54
     !
     INTEGER*4 DESC                     ! 55
     INTEGER*4 IUNI(3)                  ! 56
     INTEGER*4 ICOD(3,4)                ! 59
     INTEGER*4 ISYS(3)                  ! 71
     INTEGER*4 DUM1                     ! Void
     !
     INTEGER*4 POSI                     ! 74
     INTEGER*4 ISOU(3)                  ! 75
     REAL*8 RA                          ! 78
     REAL*8 DEC                         ! 80
     REAL*8 LII                         ! 82
     REAL*8 BII                         ! 84
     REAL*4 EPOC                        ! 86
     INTEGER*4 DUM2                     ! Void
     !
     INTEGER*4 PROJ                     ! 87
     INTEGER*4 PTYP                     ! 88
     REAL*8 A0                          ! 89
     REAL*8 D0                          ! 91
     REAL*8 PANG                        ! 93
     INTEGER*4 XAXI                     ! 95
     INTEGER*4 YAXI                     ! 96
     !
     INTEGER*4 SPEC                     ! 97
     INTEGER*4 ILIN(3)                  ! 98
     REAL*8 FRES                        !101
     REAL*8 FIMA                        !103
     REAL*8 FREQ                        !105
     REAL*4 VRES                        !107
     REAL*4 VOFF                        !108
     INTEGER*4 FAXI                     !109
     !
     INTEGER*4 RESO                     !110
     REAL*4 MAJO                        !111
     REAL*4 MINO                        !112
     REAL*4 POSA                        !113
     !
     INTEGER*4 SIGM                     ! 114
     REAL*4 NOISE                       ! 115
     REAL*4 RMS                         ! 116
  END TYPE GILDAS_HEADER
  !
  TYPE SIC_HEADER
     SEQUENCE
     INTEGER*4 ITYP(3)                  !  1
     INTEGER*4 FORM                     !  4
     INTEGER*4 NVB                      !  5
     INTEGER*4 FILL(5)                  !  6
     INTEGER*4 GENE                     ! 11
     INTEGER*4 NDIM                     ! 12
     INTEGER*4 DIM(4)                   ! 13
     REAL*8 CONVERT(3,4)                ! 17-40
     !
     INTEGER*4 BLAN                     ! 41
     REAL*4 BLANK(2)                    ! 42-43
     !
     INTEGER*4 EXTREMA                  ! 44
     REAL*4 MIN                         ! 45
     REAL*4 MAX                         ! 46
     INTEGER*4 WHERE(2,4)               ! 47-54
     !
     INTEGER*4 DESC                     ! 55
     INTEGER*4 IUNI(3)                  ! 56 Unit
     INTEGER*4 ICOD(3,4)                ! 59 Unit1,2,3,4
     INTEGER*4 ISYS(3)                  ! 71 System
     INTEGER*4 DUM1                     ! Void
     !
     INTEGER*4 POSI                     ! 74
     INTEGER*4 ISOU(3)                  ! 75  Source
     REAL*8 RA                          ! 78
     REAL*8 DEC                         ! 80
     REAL*8 LII                         ! 82
     REAL*8 BII                         ! 84
     REAL*4 EPOC                        ! 86
     INTEGER*4 DUM2                     ! Void
     !
     INTEGER*4 PROJ                     ! 87
     INTEGER*4 PTYP                     ! 88
     REAL*8 A0                          ! 89
     REAL*8 D0                          ! 91
     REAL*8 ANGLE                       ! 93
     INTEGER*4 X_AXIS                   ! 95
     INTEGER*4 Y_AXIS                   ! 96
     !
     INTEGER*4 SPEC                     ! 97
     INTEGER*4 ILIN(3)                  ! 98 Line
     REAL*8 FREQRES                     ! 101
     REAL*8 FREQOFF                     ! 103
     REAL*8 RESTFRE                     ! 105
     REAL*4 VELRES                      ! 107
     REAL*4 VELOFF                      ! 108
     INTEGER*4 F_AXIS                   ! 109
     !
     INTEGER*4 BEAM                     ! 110
     REAL*4 MAJOR                       ! 111
     REAL*4 MINOR                       ! 112
     REAL*4 PA                          ! 113
     !
     INTEGER*4 SIGMA                    ! 114
     REAL*4 NOISE                       ! 115
     REAL*4 RMS                         ! 116
  END TYPE SIC_HEADER
  !
  ! Gildas X,Y,Z version
  TYPE GILDAS
     SEQUENCE
     CHARACTER*256 FILE                 ! File name
     TYPE (STRINGS) :: CHAR
     TYPE (LOCATION) :: LOCA
     TYPE (GILDAS_HEADER) :: GIL
     INTEGER*4 BLC(4)
     INTEGER*4 TRC(4)
     INTEGER*4 HEADER                   ! Defined / Undefined
     INTEGER*4 STATUS                   ! Last error code
     REAL, POINTER :: R1D(:)
     REAL(KIND=8), POINTER :: D1D(:)
     INTEGER, POINTER :: I1D(:)
     REAL, POINTER :: R2D(:,:)
     REAL(KIND=8), POINTER :: D2D(:,:)
     INTEGER, POINTER :: I2D(:,:)
     REAL, POINTER :: R3D(:,:,:)
     REAL(KIND=8), POINTER :: D3D(:,:,:)
     INTEGER, POINTER :: I3D(:,:,:)
     REAL, POINTER :: R4D(:,:,:,:)
     REAL(KIND=8), POINTER :: D4D(:,:,:,:)
     INTEGER, POINTER :: I4D(:,:,:,:)
  END TYPE GILDAS
  !
  ! SIC Variable version
  TYPE SIC
     SEQUENCE
     CHARACTER*256 FILE                 ! File name
     TYPE (STRINGS) :: CHAR
     TYPE (LOCATION) :: LOCA
     TYPE (SIC_HEADER) :: SIC
     INTEGER*4 BLC(4)
     INTEGER*4 TRC(4)
     INTEGER*4 HEADER
     INTEGER*4 STATUS
     REAL, POINTER :: R1D(:)
     REAL(KIND=8), POINTER :: D1D(:)
     INTEGER, POINTER :: I1D(:)
     REAL, POINTER :: R2D(:,:)
     REAL(KIND=8), POINTER :: D2D(:,:)
     INTEGER, POINTER :: I2D(:,:)
     REAL, POINTER :: R3D(:,:,:)
     REAL(KIND=8), POINTER :: D3D(:,:,:)
     INTEGER, POINTER :: I3D(:,:,:)
     REAL, POINTER :: R4D(:,:,:,:)
     REAL(KIND=8), POINTER :: D4D(:,:,:,:)
     INTEGER, POINTER :: I4D(:,:,:,:)
  END TYPE SIC
END MODULE IMAGE_DEF

Types GILDAS and SIC can be used indifferently to represent the same object. Type GILDAS mimics the old Fortran-77 commons which were used to hanlde image headers, while type SIC mimics the SIC header variables.

Access to images is very simple. It requires only 3 steps: i) to read the header from an existing file, or to create a new header, ii) to allocate the data, iii) to read or write the data. An example is given below.

PROGRAM IMAGE_EXAMPLE
  USE IMAGE_DEF                                       ! 1
  LOGICAL ERROR
  INTEGER IER
  CHARACTER*32 NAME1,NAME2
  !
  TYPE (GILDAS) :: INPUT_IMAGE, OUTPUT_IMAGE          ! 2
  REAL, ALLOCATABLE :: DINPUT(:,:), DOUTPUT(:,:,:)    ! 3
  !
  CALL GILDAS_OPEN
  CALL GILDAS_CHAR('INPUT$',NAME1)
  CALL GILDAS_CHAR('OUTPUT$',NAME2)
  CALL GILDAS_CLOSE
  !
  CALL GILDAS_NULL(INPUT_IMAGE)                       ! 4
  CALL SIC_PARSEF (NAME1,INPUT_IMAGE%FILE,' ','.gdf') ! 5
  CALL GDF_READ_HEADER (INPUT_IMAGE,ERROR)            ! 6
  IF (ERROR) THEN
    CALL GAGOUT('E-IMAGE_EXAMPLE, Error opening input file')
    STOP
  ENDIF
  ALLOCATE(DINPUT(INPUT_IMAGE%GIL%DIM(1),INPUT_IMAGE%GIL%DIM(2), &
	STAT=IER)                                     ! 7
  IF (IER.NE.0) THEN
    CALL GAGOUT('E-IMAGE_EXAMPLE, Error allocating memory')
    STOP
  ENDIF
  CALL GDF_READ_DATA (INPUT_IMAGE, DINPUT, ERROR)     ! 8  
  IF (ERROR) THEN
    CALL GAGOUT('E-IMAGE_EXAMPLE, Error reading input file')
    STOP
  ENDIF
  !
  ! Create an output image
  !-----------------------
  CALL GDF_COPY_HEADER (INPUT_IMAGE, OUTPUT_IMAGE)    ! 9
  CALL SIC_PARSEF (NAME2,OUTPUT_IMAGE%FILE,' ','.gdf')! 10
  OUTPUT_IMAGE%GIL%NDIM = 3                           ! 11
  OUTPUT_IMAGE%GIL%DIM(1) = INPUT_IMAGE%GIL%DIM(1)    ! 11
  OUTPUT_IMAGE%GIL%DIM(2) = INPUT_IMAGE%GIL%DIM(2)    ! 11
  OUTPUT_IMAGE%GIL%DIM(3) = 4                         ! 11
  ALLOCATE(DOUTPUT(OUTPUT_IMAGE%GIL%DIM(1), &
    OUTPUT_IMAGE%GIL%DIM(2),OUTPUT_IMAGE%GIL%DIM(3), &
    STAT=IER)                                         ! 12
  IF (IER.NE.0) THEN
    CALL GAGOUT('E-IMAGE_EXAMPLE, Error allocating memory')
    STOP
  ENDIF
  !
  ! Do something with the data
  DOUTPUT(:,:,3) = DINPUT
  !
  ! Write the output image
  CALL GDF_WRITE_IMAGE(OUTPUT_IMAGE,DOUTPUT,ERROR)    ! 13
  IF (ERROR) THEN
    CALL GAGOUT('E-IMAGE_EXAMPLE, Error writing output file')
    STOP
  ENDIF
  !
  DEALLOCATE(DINPUT,DOUTPUT)
  END

1.

USE the module containing the GILDAS derived type definitions

2.

Define the input and output image headers

3.

Define the input and output data as allocatable arrays

4.

Reset the input image header to ``default''

5.

Prepare the input file name, INPUT_IMAGE%FILE

6.

Read the header to initialize the INPUT_IMAGE structure.

7.

Allocate the data. Note that it is assumed here to be a 2-D array.

8.

Read the data, using the information provided in the header structure (in particular the file name).

9.

Define the output header, here by making a copy of the input header

10.

Setup the output file name

11.

Change the output header parameters as needed

12.

Allocate the output image data

13.

Create and write the output image

The subroutines using GILDAS headers are:

• SUBROUTINE GILDAS_NULL(HEADER)
  Reset a header to default values
• SUBROUTINE GDF_COMPARE_SHAPE(FIRST,SECOND,EQUAL)
  Compare the shape of the two images defined by the two headers
• SUBROUTINE GDF_READ_HEADER(IMAG,ERROR)
  Read the image header. IMAG%FILE must have been initialized before.
• SUBROUTINE GDF_UPDATE_HEADER(IMAG,ERROR)
  Update an image header: write the modified header to the image file.
• SUBROUTINE GDF_COPY_HEADER(INPUT,OUTPUT)
  Copy an input header structure to an output header structure
• SUBROUTINE GDF_TRANSPOSE_HEADER(INPUT,OUTPUT,ORDER,ERROR)
  Tranpose a header according to given transposition code. This routine transposes the axes information, but not the data.