subroutine gdf_allocate (hx,error)
  use gio_interfaces, only : gio_message, gdf_range
  use image_def
  use gbl_message
  !-----------------------------------------------------------------
  ! @ public
  !   Allocate the appropriate work space
  !   for a Gildas data type.
  ! CAUTION
  !   blc, trc not yet tested ...
  !
  !-----------------------------------------------------------------
  type (gildas), intent(inout) :: hx    ! Gildas data type
  logical, intent(out) :: error         ! Error flag
  !
  character(len=*), parameter :: rname = 'GDF_ALLOCATE'
  character(len=80) :: mess
  integer :: is, rank, type, form, ier, i
  integer(kind=size_length) :: asize
  integer(kind=index_length) :: my_dims(gdf_maxdims), nc(2)
  !
  ier = 0
  if (any(hx%blc.ne.0) .or. any(hx%trc.ne.0)) then
    call gio_message(seve%w,rname,'Subset mode not tested yet')
    my_dims = 1
    do i=1,hx%gil%ndim
      nc(1) = hx%blc(i)
      nc(2) = hx%trc(i)
      ier = gdf_range(nc,hx%gil%dim(i))
      my_dims(i) = nc(2)-nc(1)+1
    enddo
  else
    my_dims = hx%gil%dim
  endif
  !
  if (hx%gil%form.eq.0) then
    form = fmt_r4
  else
    form = hx%gil%form
  endif
  !
  rank = hx%gil%ndim
  type = hx%gil%type_gdf
  !
  ! UVT Table case needs special treatment
  if (type.eq.abs(code_gdf_uvt)) then
    if (type.ne.hx%gil%type_gdf) then
      if (hx%gil%type_gdf .eq. code_gdf_uvt) then
        mess = "UV data set is in UVT order, not TUV"
      else if (hx%gil%type_gdf .eq. code_gdf_tuv) then
        mess = "UV data set is in TUV order, not UVT"
      else
        mess = "File is not a UVT or TUV data set"
      endif
      goto 200
    endif
    if (rank.ne.0 .and. rank.ne.2) then
      write(mess,'(A,I1,A)') "UV data sets must have 2 dimensions, found ", rank
      goto 200
    endif
    if (form.ne.fmt_r4) then
      mess = "UV data sets are only Real*4"
      goto 200
    endif
    !
    allocate (hx%r2d(my_dims(1), my_dims(2)), stat=ier)
    !
    ! Currently, all other types are treated as Images...
  else
    select case (rank)
    !
    case(0)
      ! Return a "flat" array, whatever the image rank
      asize = 1
      do is=1,hx%gil%ndim
        asize = asize*my_dims(is)
      enddo
      if (form.eq.fmt_r4) then
        allocate (hx%r1d(asize), stat=ier)
      else if (form.eq.fmt_r8) then
        allocate (hx%d1d(asize), stat=ier)
      else if (form.eq.fmt_i4) then
        allocate (hx%i1d(asize), stat=ier)
      endif
    case(1)
      ! Return a true 1-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r1d(my_dims(1)), stat=ier)
      else if (form.eq.fmt_r8) then
        allocate (hx%d1d(my_dims(1)), stat=ier)
      else if (form.eq.fmt_i4) then
        allocate (hx%i1d(my_dims(1)), stat=ier)
      endif
      !
    case(2)
      ! Return a true 2-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r2d(my_dims(1), my_dims(2)), stat=ier)
      else if (form.eq.fmt_r8) then
        allocate (hx%d2d(my_dims(1), my_dims(2)), stat=ier)
      else if (form.eq.fmt_i4) then
        allocate (hx%i2d(my_dims(1), my_dims(2)), stat=ier)
      endif
      !
     case(3)
      ! Return a true 3-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r3d(my_dims(1), my_dims(2), my_dims(3)), stat=ier)
      else if (form.eq.fmt_r8) then
        allocate (hx%d3d(my_dims(1), my_dims(2), my_dims(3)), stat=ier)
      else if (form.eq.fmt_i4) then
        allocate (hx%i3d(my_dims(1), my_dims(2), my_dims(3)), stat=ier)
      endif
      !
    case(4)
      ! Return a true 4-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r4d(my_dims(1), my_dims(2), my_dims(3), my_dims(4)), stat=ier)
      else if (form.eq.fmt_r8) then
        allocate (hx%d4d(my_dims(1), my_dims(2), my_dims(3), my_dims(4)), stat=ier)
      else if (form.eq.fmt_i4) then
        allocate (hx%i4d(my_dims(1), my_dims(2),  my_dims(3), hx%gil%dim(4)), stat=ier)
      endif
    case default
      write(mess,'(A,I1,A)') "Rank ",rank," no yet supported"
      goto 200
    end select
  endif
  error = ier.ne.0
  if (.not.error) return
  !
  mess = "Memory allocation failure"
  !
200  call gio_message(seve%e,rname,mess)
  error = .true.
end subroutine gdf_allocate
!
subroutine gdf_read_gildas(hx,name,ext,error, rank, data)
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gdf_read_gildas
  use image_def
  use gbl_message
  !-----------------------------------------------------------------
  ! @ public
  ! Read a Gildas Data File of name "name" and extention "ext"
  ! and return it into the "hx" Gildas data type.
  !
  ! Desired Form & Rank can be specified: an error will happen
  ! in case of mismatch.
  !-----------------------------------------------------------------
  type(gildas),     intent(inout)        :: hx      ! Gildas data type
  character(len=*), intent(in)           :: name    ! Filename
  character(len=*), intent(in)           :: ext     ! Extension
  logical,          intent(inout)        :: error   ! Error flag
  integer,          intent(in), optional :: rank    !
  logical,          intent(in), optional :: data    !
  ! Local
  character(len=*), parameter :: rname='GDF_READ_GILDAS'
  integer :: form, type, ier, therank
  character(len=80) :: mess
  logical :: addrank, aheader
  !
  call sic_parse_file(name,' ',ext,hx%file)
  !
  ! Default form, rank & type
  form = hx%gil%form
  type = hx%gil%type_gdf
  !
  addrank = present(rank)
  if (present(data)) then
    aheader = .not.data
  else
    aheader = .false.
  endif
  !
  call gdf_read_header(hx,error)
  if (error) then
    mess = "Cannot read input file "//trim(hx%file)
    goto 200
  endif
  if (form.ne.0) then
    if (hx%gil%form.ne.form) then
      if (form.eq.fmt_r4) then
        mess = "Only real images supported"
      else if (form.eq.fmt_r8) then
        mess = "Only double images supported"
      else if (form.eq.fmt_i4) then
        mess = "Only integer images supported"
      endif
      goto 200
    endif
  else
    form = hx%gil%form
  endif
  !
  ! Addrank indicates some Rank checking, trimming or extension
  if (addrank) then
    therank = rank
    if (therank.lt.0) then
      ! Matching
      if (hx%gil%ndim.ne.-therank) then
        write(mess,'(A,I0,A,I0)')  &
          'Rank mismatch: Image ',hx%gil%ndim,', Requested ',-therank
        goto 200
      endif
      therank = -rank  ! >0
    else if (therank.gt.0) then
      ! Trimming or extension
      call sub_trim_header(rname,hx,therank,error)
      if (error) return
    else
      ! Rank 0 means flat memory model
    endif
  else
    ! Use image rank from file
    therank = hx%gil%ndim
  endif
  !
  ! Return if header only
  if (aheader) return
  !
  ! UVT Table case needs special treatment
  if (type.eq.abs(code_gdf_uvt)) then
    if (type.ne.hx%gil%type_gdf) then
      if (hx%gil%type_gdf .eq. code_gdf_uvt) then
        write(mess,'(A,I1,A)') "UV data set is in UVT order, not TUV"
      else if (hx%gil%type_gdf .eq. code_gdf_tuv) then
        write(mess,'(A,I1,A)') "UV data set is in TUV order, not UVT"
      else
        write(mess,'(A,I1,A)') "File is not a UVT or TUV data set"
      endif
      goto 200
    endif
    if (therank.ne.0 .and. therank.ne.2) then
      write(mess,'(A,I1,A,I2)') "UV data sets must have 2 dimensions, found ",rank
      goto 200
    endif
    if (form.ne.fmt_r4) then
      write(mess,'(A,I1,A)') "UV data sets are only Real*4"
      goto 200
    endif
    !
    allocate (hx%r2d(hx%gil%dim(1), hx%gil%dim(2)), stat=ier)
    if (ier.ne.0) goto 100
    !
    ! This will read properly the extra columns even if
    ! Real*8 and data conversions are implied...
    call gdf_read_uvall (hx,hx%r2d,error)
    !
    ! Currently, all other types are treated as Images...
  else
    select case (therank)
    !
    case(0)
      ! Return a "flat" array, whatever the image rank
      if (form.eq.fmt_r4) then
        allocate (hx%r1d(hx%loca%size), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%r1d,error)
        hx%loca%addr = locwrd(hx%r1d)
      else if (form.eq.fmt_r8) then
        allocate (hx%d1d(hx%loca%size), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%d1d,error)
        hx%loca%addr = locwrd(hx%d1d)
      else if (form.eq.fmt_i4) then
        allocate (hx%i1d(hx%loca%size), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%i1d,error)
        hx%loca%addr = locwrd(hx%i1d)
      endif
    case(1)
      ! Return a true 1-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r1d(hx%gil%dim(1)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%r1d,error)
      else if (form.eq.fmt_r8) then
        allocate (hx%d1d(hx%gil%dim(1)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%d1d,error)
      else if (form.eq.fmt_i4) then
        allocate (hx%i1d(hx%gil%dim(1)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%i1d,error)
      endif
      !
    case(2)
      ! Return a true 2-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r2d(hx%gil%dim(1), hx%gil%dim(2)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%r2d,error)
      else if (form.eq.fmt_r8) then
        allocate (hx%d2d(hx%gil%dim(1), hx%gil%dim(2)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%d2d,error)
      else if (form.eq.fmt_i4) then
        allocate (hx%i2d(hx%gil%dim(1), hx%gil%dim(2)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%i2d,error)
      endif
      !
     case(3)
      ! Return a true 3-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r3d(hx%gil%dim(1), hx%gil%dim(2), hx%gil%dim(3)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%r3d,error)
      else if (form.eq.fmt_r8) then
        allocate (hx%d3d(hx%gil%dim(1), hx%gil%dim(2), hx%gil%dim(3)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%d3d,error)
      else if (form.eq.fmt_i4) then
        allocate (hx%i3d(hx%gil%dim(1), hx%gil%dim(2), hx%gil%dim(3)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%i3d,error)
      endif
      !
    case(4)
      ! Return a true 4-D only array
      if (form.eq.fmt_r4) then
        allocate (hx%r4d(hx%gil%dim(1), hx%gil%dim(2), hx%gil%dim(3), hx%gil%dim(4)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%r4d,error)
      else if (form.eq.fmt_r8) then
        allocate (hx%d4d(hx%gil%dim(1), hx%gil%dim(2), hx%gil%dim(3), hx%gil%dim(4)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%d4d,error)
      else if (form.eq.fmt_i4) then
        allocate (hx%i4d(hx%gil%dim(1), hx%gil%dim(2),  hx%gil%dim(3), hx%gil%dim(4)), stat=ier)
        if (ier.ne.0) goto 100
        call gdf_read_data(hx,hx%i4d,error)
      endif
    case default
      write(mess,'(A,I0,A)') "Rank ",rank," not yet supported"
      goto 200
    end select
  endif
  error = .false.
  return

100  mess = "Memory allocation failure"
200  call gio_message(seve%e,rname,mess)
  error = .true.
end subroutine gdf_read_gildas
!
subroutine gdf_read_data(imag,array,error)
  use gio_interfaces
  use image_def
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type & rank mismatch)
  !       Read data from an image structure and
  !       place it in the specified array
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: imag       ! Image descriptor
  real(kind=4), intent(inout) :: array(*)   ! Data
  logical,      intent(out)   :: error      ! Flag
  ! Local
  integer(kind=4) :: is,ms,form
  integer(kind=size_length) :: mydims(gdf_maxdims)
  character(len=message_length) :: chain
  character(len=*), parameter :: rname='GDF_READ_DATA'
  !
  imag%status = code_read_data
  is = imag%loca%islo
  if (gdf_stis(is).eq.-1) then
    call gio_message(seve%e,rname,'No such image')
    error = .true.
    return
  endif
  !
  ! Reshape slot to current image shape
  mydims = imag%gil%dim
  call gio_cdim(is,imag%gil%ndim,mydims)
  if (imag%gil%form.eq.0) then
    form = fmt_r4
    write(chain,'(A,I6)') 'Using default file format ',form
    call gio_message(seve%w,rname,chain)
  else
    form = imag%gil%form
  endif
  !!Print *,'DAMS ', imag%blc,imag%trc
  call gio_dams(ms,is,imag%blc,imag%trc,array,form,error)
  !!Print *,'DAMS ', imag%gil%ndim,imag%gil%dim
  if (error) return
  !
  ! Free it
  call gio_frms(ms,error)
  imag%loca%mslo = ms
  imag%status = 0
end subroutine gdf_read_data
!
subroutine gdf_write_data(imag,array,error)
  use gildas_def
  use image_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces
  !---------------------------------------------------------------------
  ! @ no-interface (because of argument type & rank mismatch)
  !       Write data to an image file specified
  !       by its image structure. The image must have been
  !       opened for write before
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: imag       ! Image descriptor
  real, intent(in) :: array(*)              ! Data
  logical, intent(out) :: error             ! Flag
  ! Local
  integer :: ms, is
  integer(kind=size_length) :: mydims(gdf_maxdims)
  character(len=*), parameter :: rname='GDF_WRITE_DATA'
  !
  imag%status = code_write_data
  is = imag%loca%islo
  if (gdf_stis(is).eq.-1) then
    call gio_message(seve%e,rname,'No such image')
    error = .true.
    return
  endif
  ! Reshape slot to current image shape
  mydims = imag%gil%dim
  call gio_cdim(is,imag%gil%ndim,mydims)
  !
  ! Associate pre-defined memory area to image
  imag%loca%addr = locwrd(array)
  call gio_pums (ms,is,imag%blc,imag%trc,imag%loca%addr,imag%gil%form,error)
  if (error) return
  !
  ! Dump to disk
  call gio_frms(ms,error)
  imag%loca%mslo = ms
  imag%status = 0
end subroutine gdf_write_data
!
function gdf_range_48(nc,nchan)
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public-generic   gdf_range
  ! GDF API
  !       Return a range of (pixel / channel / items)
  !---------------------------------------------------------------------
  integer(4) :: gdf_range_48  ! Intent(out)  0 if no error
  integer(8), intent(in) :: nchan     ! The actual number of channels
  integer(4), intent(inout) :: nc(2)  ! The interpreted range of selected channels
  !
  integer(4) :: res
  integer(8) :: mc(2)     ! The actual number of channels
  integer mchan
  !
  ! Use the <0 convention to start from the end
  !
  mc = nc
  mchan = nchan
  if (mc(1).lt.0) then
    mc(1) = mchan+mc(1)
  else if (mc(1).eq.0) then
    mc(1) = 1
  else if (mc(1).gt.mchan) then
    mc(1) = mchan
  endif
  if (mc(2).le.0) then
    mc(2) = mchan+mc(2)
  elseif (mc(2).gt.mchan) then
    mc(2) = mchan
  endif
  !
  if (mc(2).gt.2147483647) then
    call gio_message(seve%e,'GDF_RANGE','Range too large for an Integer(4)')
    res = -1
  else if (mc(2).lt.mc(1)) then
    call gio_message(seve%e,'GDF_RANGE','Invalid range: Last smaller than First')
    print *,'MC ',mc
    res = -2
  else
    res = 0
    nc = mc
  endif
  gdf_range_48 = res
end function gdf_range_48
!
function gdf_range_88(nc,nchan)
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public-generic  gdf_range
  ! GDF API
  !       Return a range of (pixel / channel / items)
  !---------------------------------------------------------------------
  integer(4) :: gdf_range_88          ! Intent(out)
  integer(8), intent(in) :: nchan     ! The actual number of channels
  integer(8), intent(inout) :: nc(2)  ! The interpreted range of selected channels
  !
  integer :: res
  integer(8) :: mc(2)     ! The actual number of channels
  !
  ! Use the <0 convention to start from the end
  !
  mc = nc
  if (mc(1).lt.0) then
    mc(1) = nchan+mc(1)
  else if (mc(1).eq.0) then
    mc(1) = 1
  else if (mc(1).gt.nchan) then
    mc(1) = nchan
  endif
  if (mc(2).le.0) then
    mc(2) = nchan+mc(2)
  elseif (mc(2).gt.nchan) then
    mc(2) = nchan
  endif
  !
  if (mc(2).lt.mc(1)) then
    call gio_message(seve%e,'GDF_RANGE','Invalid range: Last smaller than First')
    print *,'MC ',mc
    res = -2
  else
    res = 0
    nc = mc
  endif
  gdf_range_88 = res
end function gdf_range_88
!
function gdf_range_44(nc,nchan) ! result (res)
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public-generic  gdf_range
  ! GDF API
  !       Return a range of (pixel / channel / items)
  !---------------------------------------------------------------------
  integer(4) :: gdf_range_44          ! Intent(out)  0 if no error
  integer(4), intent(in) :: nchan     ! The actual number of channels
  integer(4), intent(inout) :: nc(2)  ! The interpreted range of selected channels
  !
  integer(4) :: mc(2)     ! The actual number of channels
  integer(4) :: res
  !
  ! Use the <0 convention to start from the end
  !
  mc = nc 
  if (mc(1).lt.0) then
    mc(1) = nchan+mc(1)
  else if (mc(1).eq.0) then
    mc(1) = 1
  else if (mc(1).gt.nchan) then
    mc(1) = nchan
  endif
  if (mc(2).le.0) then
    mc(2) = nchan+mc(2)
  else if (mc(2).gt.nchan) then
    mc(2) = nchan
  endif
  !
  if (mc(2).lt.mc(1)) then
    call gio_message(seve%e,'GDF_RANGE','Invalid range: Last smaller than First')
    print *,'MC ',mc
    res = -2
  else
    res = 0
    nc = mc
  endif
  gdf_range_44 = res
end function gdf_range_44
!
function gdf_range_84(nc,nchan)
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public-generic  gdf_range
  ! GDF API
  !       Return a range of (pixel / channel / items)
  !---------------------------------------------------------------------
  integer(4) :: gdf_range_84          ! Intent(out)  0 if no error
  integer(4), intent(in) :: nchan     ! The actual number of channels
  integer(8), intent(inout) :: nc(2)  ! The interpreted range of selected channels
  !
  integer(8) :: mc(2)     ! The actual number of channels
  integer(4) :: res
  integer(8) :: mchan
  !
  ! Use the <0 convention to start from the end
  !
  if (any(nc.gt.2147483647_8) .or. any(nc.lt.-2147483648_8)) then
    call gio_message(seve%e,'GDF_RANGE','Range too large for an Integer(4)')
    gdf_range_84 = -1
    res = -1
    return
  endif
  mc = nc
  mchan = nchan
  if (mc(1).lt.0) then
    mc(1) = mchan+mc(1)
  else if (mc(1).eq.0) then
    mc(1) = 1
  else if (mc(1).gt.mchan) then
    mc(1) = mchan
  endif
  if (mc(2).le.0) then
    mc(2) = mchan+mc(2)
  elseif (mc(2).gt.mchan) then
    mc(2) = mchan
  endif
  !
  if (mc(2).lt.mc(1)) then
    call gio_message(seve%e,'GDF_RANGE','Invalid range: Last smaller than First')
    print *,'MC ',mc
    res = -2
  else
    res = 0
    nc = mc
  endif
  gdf_range_84 = res
end function gdf_range_84
