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
The subroutines using GILDAS headers are: