next up previous contents index
Next: Obsolescent Fortran-77 access routines Up: Task Programming Manual Previous: General Outline and Data   Contents   Index

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
  use gildas_def
  !
  integer, parameter :: code_read_data     =-1
  integer, parameter :: code_read_header   =-2
  integer, parameter :: code_update_header =-3
  integer, parameter :: code_write_header  =-4
  integer, parameter :: code_write_data    =-5
  integer, parameter :: code_read_image    =-6
  integer, parameter :: code_free_image    =-7
  integer, parameter :: code_create_image  =-8
  !
  ! /XIPAR/
  type :: location
    sequence
    integer(kind=4) :: al64               ! Padding to align ADDR
    integer(kind=4) :: size               ! Size of image
    integer(kind=address_length) :: addr  ! Address of image
    integer :: islo                       ! Image Slot number
    integer :: mslo                       ! Memory Slot number
    logical :: read                       ! ReadOnly status
    logical :: getvm                      ! Memory / File indicator
  end type location
  ! /XCPAR/
  type :: strings
    sequence
    character(len=12) :: type             !     Image Type (see ITYP)
    character(len=12) :: unit             !     Data Units (see IUNI)
    character(len=12) :: code(4)          ! 59  Axis codes (see ICOD)
    character(len=12) :: syst             ! 71  Coordinate system (see ISYS)
    character(len=12) :: name             ! 75  Source name (see ISOU)
    character(len=12) :: line             !     Line name (see ILIN)
  end type strings
  ! /XPAR/
  type :: gildas_header
    sequence
    integer(kind=4) :: ityp(3)            !  1  Image Type
    integer(kind=4) :: form               !  4  Data format (FMT_xx)
    integer(kind=4) :: nvb                !  5  Number of blocks
    integer(kind=4) :: fill(5)            !  6  Reserved space
    integer(kind=4) :: gene               ! 11  General section length
    integer(kind=4) :: ndim               ! 12  Number of dimensions
    integer(kind=4) :: dim(4)             ! 13  Dimensions
    real(kind=8) :: ref1                  ! 17  Reference pixel
    real(kind=8) :: val1                  ! 19  Value at reference pixel
    real(kind=8) :: inc1                  ! 21  Increment per pixel
    real(kind=8) :: ref2                  ! 23  idem for axis 2
    real(kind=8) :: val2                  ! 25
    real(kind=8) :: inc2                  ! 27
    real(kind=8) :: ref3                  ! 29  idem for axis 3
    real(kind=8) :: val3                  ! 31
    real(kind=8) :: inc3                  ! 33
    real(kind=8) :: ref4                  ! 35  idem for axis 4
    real(kind=8) :: val4                  ! 37
    real(kind=8) :: inc4                  ! 39
    !
    integer(kind=4) :: blan               ! 41  Blanking section length
    real(kind=4) :: bval                  ! 42  Blanking value
    real(kind=4) :: eval                  ! 43  Tolerance
    !
    integer(kind=4) :: extr               ! 44  Extrema section length
    real(kind=4) :: rmin                  ! 45  Minimum
    real(kind=4) :: rmax                  ! 46  Maximum
    integer(kind=4) :: min1               ! 47  Pixel of min on axis 1
    integer(kind=4) :: max1               ! 48  Pixel of max ......
    integer(kind=4) :: min2               ! 49  idem for axis 2
    integer(kind=4) :: max2               ! 50
    integer(kind=4) :: min3               ! 51           axis 3
    integer(kind=4) :: max3               ! 52
    integer(kind=4) :: min4               ! 53           axis 4
    integer(kind=4) :: max4               ! 54
    !
    integer(kind=4) :: desc               ! 55  Description section length
    integer(kind=4) :: iuni(3)            ! 56  Data Unit
    integer(kind=4) :: icod(3,4)          ! 59  Axis names
    integer(kind=4) :: isys(3)            ! 71  Coordinate System
    integer(kind=4) :: dum1               ! Void for padding
    !
    integer(kind=4) :: posi               ! 74  Position section length
    integer(kind=4) :: isou(3)            ! 75  Source name
    real(kind=8) :: ra                    ! 78  Right Ascension
    real(kind=8) :: dec                   ! 80  Declination
    real(kind=8) :: lii                   ! 82  Galactic longitude
    real(kind=8) :: bii                   ! 84           latitude
    real(kind=4) :: epoc                  ! 86  Epoch of coordinates
    integer(kind=4) :: dum2               ! Void for padding
    !
    integer(kind=4) :: proj               ! 87  Projection section length
    integer(kind=4) :: ptyp               ! 88  Projection type
    real(kind=8) :: a0                    ! 89  X of projection center
    real(kind=8) :: d0                    ! 91  Y of projection center
    real(kind=8) :: pang                  ! 93  Projection angle
    integer(kind=4) :: xaxi               ! 95  X axis
    integer(kind=4) :: yaxi               ! 96  Y axis
    !
    integer(kind=4) :: spec               ! 97  Spectroscopy section length
    integer(kind=4) :: ilin(3)            ! 98  Line name
    real(kind=8) :: fres                  !101  Frequency resolution
    real(kind=8) :: fima                  !103  Image frequency
    real(kind=8) :: freq                  !105  Rest Frequency
    real(kind=4) :: vres                  !107  Velocity resolution
    real(kind=4) :: voff                  !108  Velocity offset
    integer(kind=4) :: faxi               !109  Frequency axis
    !
    integer(kind=4) :: reso               !110  Resolution section length
    real(kind=4) :: majo                  !111  Major axis
    real(kind=4) :: mino                  !112  Minor axis
    real(kind=4) :: posa                  !113  Position angle
    !
    integer(kind=4) :: sigm               ! 114 Noise section length
    real(kind=4) :: noise                 ! 115 Theoretical noise
    real(kind=4) :: rms                   ! 116 Actual noise
    !
    integer(kind=4) :: prop               ! 117 Proper motion section length
    real(kind=4) :: mura                  ! 118 along RA, in mas/yr
    real(kind=4) :: mudec                 ! 119 along Dec, in mas/yr
    real(kind=4) :: parallax              ! 120 in mas
!!  real(kind=4) :: pepoch                ! 121 in yrs ?
  end type gildas_header
  !
  type :: sic_header
    sequence
    integer(kind=4) :: ityp(3)            !  1
    integer(kind=4) :: form               !  4
    integer(kind=4) :: nvb                !  5
    integer(kind=4) :: fill(5)            !  6
    integer(kind=4) :: gene               ! 11
    integer(kind=4) :: ndim               ! 12
    integer(kind=4) :: dim(4)             ! 13
    real(kind=8) :: convert(3,4)          ! 17-40
    !
    integer(kind=4) :: blan               ! 41
    real(kind=4) :: blank(2)              ! 42-43
    !
    integer(kind=4) :: extrema            ! 44
    real(kind=4) :: min                   ! 45
    real(kind=4) :: max                   ! 46
    integer(kind=4) :: where(2,4)         ! 47-54
    !
    integer(kind=4) :: desc               ! 55
    integer(kind=4) :: iuni(3)            ! 56 Unit
    integer(kind=4) :: icod(3,4)          ! 59 Unit1,2,3,4
    integer(kind=4) :: isys(3)            ! 71 System
    integer(kind=4) :: dum1               ! Void
    !
    integer(kind=4) :: posi               ! 74
    integer(kind=4) :: isou(3)            ! 75  Source
    real(kind=8) :: ra                    ! 78
    real(kind=8) :: dec                   ! 80
    real(kind=8) :: lii                   ! 82
    real(kind=8) :: bii                   ! 84
    real(kind=4) :: epoc                  ! 86
    integer(kind=4) :: dum2               ! Void
    !
    integer(kind=4) :: proj               ! 87
    integer(kind=4) :: ptyp               ! 88
    real(kind=8) :: a0                    ! 89
    real(kind=8) :: d0                    ! 91
    real(kind=8) :: angle                 ! 93
    integer(kind=4) :: x_axis             ! 95
    integer(kind=4) :: y_axis             ! 96
    !
    integer(kind=4) :: spec               ! 97
    integer(kind=4) :: ilin(3)            ! 98 Line
    real(kind=8) :: freqres               ! 101
    real(kind=8) :: freqoff               ! 103
    real(kind=8) :: restfre               ! 105
    real(kind=4) :: velres                ! 107
    real(kind=4) :: veloff                ! 108
    integer(kind=4) :: f_axis             ! 109
    !
    integer(kind=4) :: beam               ! 110
    real(kind=4) :: major                 ! 111
    real(kind=4) :: minor                 ! 112
    real(kind=4) :: pa                    ! 113
    !
    integer(kind=4) :: sigma              ! 114
    real(kind=4) :: noise                 ! 115
    real(kind=4) :: rms                   ! 116
    !
    integer(kind=4) :: proper             ! 117 Proper motion section length
    real(kind=4) :: mura                  ! 118 along RA, in mas/yr
    real(kind=4) :: mudec                 ! 119 along Dec, in mas/yr
    real(kind=4) :: parallax              ! 120 in mas
!!  real(kind=4) :: pepoch                ! 121 in yrs ?
  end type sic_header
  !
  ! Gildas X,Y,Z version
  type :: gildas
    sequence
    character(len=256) :: file            ! File name
    type (strings) :: char
    type (location) :: loca
    type (gildas_header) :: gil
    integer(kind=4) :: blc(4)             ! Bottom left corner
    integer(kind=4) :: trc(4)             ! Top right corner
    integer(kind=4) :: header             ! Defined / Undefined
    integer(kind=4) :: status             ! Last error code
    real,         pointer :: r1d(:)       ! Pointer to 1D data
    real(kind=8), pointer :: d1d(:)
    integer,      pointer :: i1d(:)
    real,         pointer :: r2d(:,:)     ! Pointer to 2D data
    real(kind=8), pointer :: d2d(:,:)
    integer,      pointer :: i2d(:,:)
    real,         pointer :: r3d(:,:,:)
    real(kind=8), pointer :: d3d(:,:,:)   ! to 3D data
    integer,      pointer :: i3d(:,:,:)
    real,         pointer :: r4d(:,:,:,:)
    real(kind=8), pointer :: d4d(:,:,:,:) ! to 4D data
    integer,      pointer :: i4d(:,:,:,:)
  end type gildas
  !
  ! SIC Variable version
  type :: sic
    sequence
    character(len=256) :: file            ! File name
    type (strings) :: char
    type (location) :: loca
    type (sic_header) :: sic
    integer(kind=4) :: blc(4)
    integer(kind=4) :: trc(4)
    integer(kind=4) :: header
    integer(kind=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')
    call sysexi(fatale)
  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')
    call sysexi(fatale)
  endif
  call gdf_read_data (input_image, dinput, error)     ! 8  
  if (error) then
    call gagout('E-IMAGE_EXAMPLE, error reading input file')
    call sysexi(fatale)
  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')
    call sysexi(fatale)
  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')
    call sysexi(fatale)
  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:


next up previous contents index
Next: Obsolescent Fortran-77 access routines Up: Task Programming Manual Previous: General Outline and Data   Contents   Index
Gildas manager 2011-09-07