# Fortran-90 access to images

Section basically up to date

Fortran-90 allows definition of data structures (derived types) which are convenient to handle data structures. Data access to GILDAS files is done by reading all or part of the data into memory, using standard FORTRAN direct I/O. The header is read into a specific Fortran derived type, the gildas derived part, which has a sub-type mimicking the file header plus ancillary information re-organized for convenience. The data can be read into standard Fortran arrays. Fortran pointers are provided as placeholders for this purpose in the gildas data type for rank 1 to 4 real arrays.

The portable version of the GILDAS software makes the distinction between an image and the "incarnation" of an image subset in memory. Each image has an associated "Image Slot" (IS), while each memory part has an associated "Memory Slot" (MS). Several memory slots may corresponds to several "windows" into a single image slot.

The Fortran-90 module image_def defines the gildas derived type.

    !
    module image_def
      use gildas_def
      use gbl_format
      use gio_headers
      !
      !
      type :: gildas
        sequence
        character(len=256)   :: file = ' '  ! File name
        type (strings)       :: char        !
        type (location)      :: loca        !
        type (gildas_header_v2) :: gil      !
        integer(kind=index_length) :: blc(gdf_maxdims) = 0       ! Bottom left corner
        integer(kind=index_length) :: trc(gdf_maxdims) = 0       ! Top right corner
        integer(kind=4) :: header = 0       ! Defined / Undefined
        integer(kind=4) :: status = 0       ! Last error code
        real,         pointer :: r1d(:)       => null()  ! Pointer to 1D data
        real(kind=8), pointer :: d1d(:)       => null()
        integer,      pointer :: i1d(:)       => null()
        real,         pointer :: r2d(:,:)     => null()  ! Pointer to 2D data
        real(kind=8), pointer :: d2d(:,:)     => null()
        integer,      pointer :: i2d(:,:)     => null()
        real,         pointer :: r3d(:,:,:)   => null()  ! Pointer to 3D data
        real(kind=8), pointer :: d3d(:,:,:)   => null()
        integer,      pointer :: i3d(:,:,:)   => null()
        real,         pointer :: r4d(:,:,:,:) => null()  ! Pointer to 4D data
        real(kind=8), pointer :: d4d(:,:,:,:) => null()
        integer,      pointer :: i4d(:,:,:,:) => null()
      end type gildas
      !
    end module image_def
    !
    !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

The type gildas_v2 closely mimicks the actual layout of the data file, but is ** not ** identical. Some of its content are provided as convenience to handle the quantities, but are ** not ** intended to be used directly in the application programs. The ijxyz((3) (where xyz can be typ, lin, sou, sys, uni, cod) pseudo-integer arrays in particular should never be used and may disappear in future releases (or become private). They correspond to the character strings held in the derived type strings.

      type :: gildas_header_v2
         !
         ! Spread on two blocks
         !
         ! Block 1: Basic Header and Dimension information
         sequence
         !
         ! Trailer:
         integer(kind=4) :: ijtyp(3) = 0       !  1  Image Type
         integer(kind=4) :: form    = fmt_r4   !  4  Data format (FMT_xx)
         integer(kind=8) :: ndb     = 0        !  5  Number of blocks
         integer(kind=4) :: nhb     = 2        !  7  Number of header blocks
         integer(kind=4) :: ntb     = 0        !  8  Number of trailing blocks
         integer(kind=4) :: version_gdf = code_version_gdf_current !  9  Data format Version number
         integer(kind=4) :: type_gdf =  code_gdf_image  !  10 code_gdf_image or code_null
         integer(kind=4) :: dim_start = gdf_startdim    !  11  Start offset for DIMENSION, should be odd, >12
         integer(kind=4) :: pad_trail
         ! The maximum value would be 17 to hold up to 8 dimensions.
         !
         ! DIMENSION Section. Caution about alignment...
         integer(kind=4) :: dim_words   = 2*gdf_maxdims+2  ! at s_dim=17  Dimension section length
         integer(kind=4) :: blan_start !! = dim_start + dim_lenth + 2   ! 18  Pointer to next section
         integer(kind=4) :: mdim    = 4        !or > ! 19  Maximum number of dimensions in this data format
         integer(kind=4) :: ndim    = 0        ! 20  Number of dimensions
         integer(kind=index_length) :: dim(gdf_maxdims) = 0     ! 21  Dimensions
         !
         ! BLANKING
         integer(kind=4) :: blan_words = 2     ! Blanking section length
         integer(kind=4) :: extr_start         ! Pointer to next section
         real(kind=4) :: bval = +1.23456e+38   ! Blanking value
         real(kind=4) :: eval = -1.0           ! Tolerance
         !
         ! EXTREMA
         integer(kind=4) :: extr_words = 6    ! Extrema section length
         integer(kind=4) :: coor_start !! = extr_start + extr_words +2     !
         real(kind=4) :: rmin    = 0.0         ! Minimum
         real(kind=4) :: rmax    = 0.0         ! Maximum
         integer(kind=index_length) :: minloc(gdf_maxdims) = 0 ! Pixel of minimum
         integer(kind=index_length) :: maxloc(gdf_maxdims) = 0 ! Pixel of maximum
    ! in file:     integer(kind=8) :: mini = 0           ! Rank 1 pixel of minimum
    ! in file:     integer(kind=8) :: maxi = 0           ! Rank 1 pixel of maximum
         !
         ! COORDINATE Section
         integer(kind=4) :: coor_words  = 6*gdf_maxdims   ! at s_coor  Section length
         integer(kind=4) :: desc_start  !! = coord_start + coord_words +2     !
         real(kind=8)    :: convert(3,gdf_maxdims)   !  Ref, Val, Inc for each dimension
         !
         ! DESCRIPTION Section
         integer(kind=4) :: desc_words  = 3*(gdf_maxdims+1) ! at s_desc, Description section length
         integer(kind=4) :: null_start  !! = desc_start + desc_words +2     !
         integer(kind=4) :: ijuni(3)   = 0        ! Data Unit
         integer(kind=4) :: ijcod(3,gdf_maxdims) = 0    ! Axis names
         integer(kind=4) :: pad_desc              ! For Odd gdf_maxdims only
         !
         !
         ! The first block length is thus
         !	s_dim-1 + (2*mdim+4) + (4) + (8) +  (6*mdim+2) + (3*mdim+5)
         ! = s_dim-1 + mdim*(2+6+3) + (4+4+2+5+8)
         ! = s_dim-1 + 11*mdim + 23
         ! With mdim = 7, s_dim=11, this is 110 spaces
         ! With mdim = 8, s_dim=11, this is 121 spaces
         ! MDIM > 8 would NOT fit in one block...
         !
         ! Block 2: Ancillary information
         !
         ! The same logic of Length + Pointer is used there too, although the
         ! length are fixed. Note rounding to even number for the pointer offsets
         ! in order to preserve alignement...
         !
         integer(kind=4) :: posi_start  = 1
         !
         ! POSITION
         integer(kind=4) :: posi_words = 15    ! Position section length: 15 used + 1 padding
         integer(kind=4) :: proj_start         !! = s_posi + 16     ! Pointer to next section
         integer(kind=4) :: ijsou(3) = 0       ! 75  Source name
         integer(kind=4) :: ijsys(3) = 0       ! 71  Coordinate System (moved from Description section)
         real(kind=8) :: ra         = 0.d0     ! 78  Right Ascension
         real(kind=8) :: dec        = 0.d0     ! 80  Declination
         real(kind=8) :: lii        = 0.d0     ! 82  Galactic longitude
         real(kind=8) :: bii        = 0.d0     ! 84           latitude
         real(kind=4) :: epoc       = 0.0      ! 86  Epoch of coordinates
         real(kind=4) :: pad_posi
         !
         ! PROJECTION
         integer(kind=4) :: proj_words = 9     ! Projection length: 9 used + 1 padding
         integer(kind=4) :: spec_start !! = proj_start + 12
         real(kind=8) :: a0      = 0.d0        ! 89  X of projection center
         real(kind=8) :: d0      = 0.d0        ! 91  Y of projection center
         real(kind=8) :: pang    = 0.d0        ! 93  Projection angle
         integer(kind=4) :: ptyp = p_none      ! 88  Projection type (see p_... codes)
         integer(kind=4) :: xaxi = 0           ! 95  X axis
         integer(kind=4) :: yaxi = 0           ! 96  Y axis
         integer(kind=4) :: pad_proj
         !
         ! SPECTROSCOPY
         integer(kind=4) :: spec_words  = 14   ! Spectroscopy length: 14 used
         integer(kind=4) :: reso_start  !! = spec_words + 16
         real(kind=8) :: fres       = 0.d0     !101  Frequency resolution
         real(kind=8) :: fima       = 0.d0     !103  Image frequency
         real(kind=8) :: freq       = 0.d0     !105  Rest Frequency
         real(kind=4) :: vres       = 0.0      !107  Velocity resolution
         real(kind=4) :: voff       = 0.0      !108  Velocity offset
         real(kind=4) :: dopp       = 0.0      !     Doppler factor
         integer(kind=4) :: faxi    = 0        !109  Frequency axis
         integer(kind=4) :: ijlin(3) = 0       ! 98  Line name
         integer(kind=4) :: vtyp    = vel_unk  ! Velocity type (see vel_... codes)
         !
         ! RESOLUTION
         integer(kind=4) :: reso_words = 3     ! Resolution length: 3 used + 1 padding
         integer(kind=4) :: nois_start !! = reso_words + 6
         real(kind=4) :: majo    = 0.0         !111  Major axis
         real(kind=4) :: mino    = 0.0         !112  Minor axis
         real(kind=4) :: posa    = 0.0         !113  Position angle
         real(kind=4) :: pad_reso
         !
         ! NOISE
         integer(kind=4) :: nois_words = 2     ! Noise section length: 2 used
         integer(kind=4) :: astr_start !! = s_nois + 4
         real(kind=4) :: noise   = 0.0         ! 115 Theoretical noise
         real(kind=4) :: rms     = 0.0         ! 116 Actual noise
         !
         ! ASTROMETRY
         integer(kind=4) :: astr_words = 3    ! Proper motion section length: 3 used + 1 padding
         integer(kind=4) :: uvda_start !! = s_astr + 4
         real(kind=4) :: mura     = 0.0        ! 118 along RA, in mas/yr
         real(kind=4) :: mudec    = 0.0        ! 119 along Dec, in mas/yr
         real(kind=4) :: parallax = 0.0        ! 120 in mas
         real(kind=4) :: pad_astr
         ! real(kind=4) :: pepoch   = 2000.0     ! 121 in yrs ?
         !
         ! UV_DATA information
         integer(kind=4) :: uvda_words  = 18+2*code_uvt_last ! Length of section: 14 used
         integer(kind=4) :: void_start  !! = s_uvda + l_uvda + 2
         integer(kind=4) :: version_uv = code_version_uvt_current  ! 1 version number. Will allow us to change the data format
         integer(kind=4) :: nchan = 0         ! 2 Number of channels
         integer(kind=8) :: nvisi = 0         ! 3-4 Independent of the transposition status
         integer(kind=4) :: nstokes = 0       ! 5 Number of polarizations
         integer(kind=4) :: natom = 0         ! 6. 3 for real, imaginary, weight. 1 for real.
         real(kind=4)    :: basemin = 0.      ! 7 Minimum Baseline
         real(kind=4)    :: basemax = 0.      ! 8 Maximum Baseline
         integer(kind=4) :: fcol              ! 9 Column of first channel
         integer(kind=4) :: lcol              ! 10 Column of last  channel
         ! The number of information per channel can be obtained by
         !       (lcol-fcol+1)/(nchan*natom)
         ! so this could allow to derive the number of Stokes parameters
         ! Leading data at start of each visibility contains specific information
         integer(kind=4) :: nlead = 7           ! 11 Number of leading informations (at lest 7)
         ! Trailing data at end of each visibility may hold additional information
         integer(kind=4) :: ntrail = 0          ! 12 Number of trailing informations
         !
         ! Leading / Trailing information codes have been specified before
         integer(kind=4) :: column_pointer(code_uvt_last) = code_null ! Back pointer to the columns...
         integer(kind=4) :: column_size(code_uvt_last) = 0  ! Number of columns for each
         ! In the data, we instead have the codes for each column
         ! integer(kind=4) :: column_codes(nlead+ntrail)         ! Start column for each ...
         ! integer(kind=4) :: column_types(nlead+ntrail) /0,1,2/ ! Number of columns for each: 1 real*4, 2 real*8
         ! Leading / Trailing information codes
         !
         integer(kind=4) :: order = 0          ! 13  Stoke/Channel ordering
         integer(kind=4) :: nfreq = 0          ! 14  ! 0 or = nchan*nstokes
         integer(kind=4) :: atoms(4)           ! 15-18 Atom description
         !
         real(kind=8), pointer :: freqs(:) => null()     ! (nchan*nstokes) = 0d0
         integer(kind=4), pointer :: stokes(:) => null() ! (nchan*nstokes) or (nstokes) = code_stoke
         !
         ! back pointers to the ref,val,inc naming convention
         real(kind=8), pointer :: ref(:) => null()
         real(kind=8), pointer :: val(:) => null()
         real(kind=8), pointer :: inc(:) => null()
      end type gildas_header_v2

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
      use gkernel_interfaces
      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, type='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. Initialize the input image header. Argument type is optional, and default to “IMAGE”
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)
  Initialize a header. No access to header components should be done before this, as some variables are dangling pointers before initialization.
- 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)
  Transpose a header according to given transposition code. This routine transposes the axes information, but not the data.