subroutine gdf_compare_shape(first,second,equal)
  use image_def
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API
  !       Compare shapes of two GILDAS images
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: first       ! First GILDAS data set
  type (gildas), intent(in) :: second      ! Second GILDAS data set
  logical, intent(out) :: equal         ! are they equal ?
  ! Local
  integer :: i
  !
  equal = .true.
  if (first%gil%ndim.eq.second%gil%ndim) then
    do i = 1,first%gil%ndim
      if (first%gil%dim(i).ne.second%gil%dim(i)) then
        equal = .false.
        return
      endif
    enddo
  else if (first%gil%ndim.gt.second%gil%ndim) then
    do i=second%gil%ndim+1, first%gil%ndim
      if (first%gil%dim(i).gt.1) then
        equal = .false.
        return
      endif
    enddo
  else
    do i=first%gil%ndim+1,second%gil%ndim
      if (second%gil%dim(i).gt.1) then
        equal = .false.
        return
      endif
    enddo
  endif
end subroutine gdf_compare_shape
!
subroutine gdf_read_gdforfits_header(name,isfits,hgdf,hfits,error)
  use gbl_message
  use image_def
  use gfits_types
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gdf_read_gdforfits_header
  !------------------------------------------------------------------
  ! @ public
  ! Read the named file and store its header under GDF format
  ! in 'hgdf' structure. The input file can be either a standard GDF
  ! or a supported FITS.
  ! In return, the internal buffers are set to be ready to read data.
  !------------------------------------------------------------------
  character(len=*),    intent(in)    :: name    ! File name
  logical,             intent(out)   :: isfits  ! Found a GDF or a FITS?
  type(gildas),        intent(inout) :: hgdf    ! GDF image structure
  type(gfits_hdesc_t), intent(inout) :: hfits   ! FITS internal description, if relevant
  logical,             intent(inout) :: error   ! Error flag
  ! Local
  character(len=*), parameter :: rname='GDF_READ_HEADER'
  integer(kind=4), parameter :: hdu=1  ! 1 is Primary
  integer(kind=4) :: filekind
  !
  ! Read header to get the file information
  call gag_file_guess(rname,name,filekind,error)
  if (error)  return
  select case (filekind)
  case (1)
    isfits = .false.
    hgdf%file = name
    hgdf%blc = 0
    hgdf%trc = 0
    call gdf_read_header(hgdf,error)
    if (error) return
  case (2)
    isfits = .true.
    call gfits_open(name,'IN',error)
    if (error)  return
    call gfits_goto_hdu(hfits,hdu,error)
    if (error)  return
    call fitscube2gdf_header(name,hdu,hfits,hgdf,gfits_getnosymbol,error)
    if (error)  return
    ! Make sure the FITS file is at the right position for later data accesses
    call gfits_flush_data(error)
    if (error)  return
  case default
    isfits = .false.
    call gio_message(seve%e,rname,'Unsupported file kind')
    error = .true.
    return
  end select
  !
end subroutine gdf_read_gdforfits_header
!
subroutine gdf_read_header(imag,error,rank)
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gdf_read_header
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API
  !       Read an image header from the requested file
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: imag   ! Image structure
  logical,      intent(out)   :: error  ! Error flag
  integer,      intent(in), optional :: rank  ! Desired rank
  ! Local
  character(len=filename_length) :: file
  integer :: islo
  !
  error = .false.
  imag%status = code_read_header
  file = imag%file
  call sic_parsef(file,imag%file,' ','.gdf')
  call gio_geis (islo,error)
  if (error) return
  if (imag%loca%read) then
    call gio_reis(islo,imag%char%type,imag%file,imag%gil%form,imag%loca%size,  &
    error)
  else
    call gio_wris(islo,imag%char%type,imag%file,imag%gil%form,imag%loca%size,  &
    error)
  endif
  if (error) then
    call gio_message(seve%e, 'GDF_READ_HEADER', 'Cannot read input file')
    call gio_fris(islo,error)
    return
  endif
  !
  call gio_read_header(imag,islo,error)
  !
  ! Optional RANK= argument
  if (present(rank)) then
    call sub_trim_header('GDF_READ_HEADER',imag,rank,error)
  endif
  !
  ! Check for errors
  if (error) then
    call gio_fris(islo,error)
    return
  endif
  !
  ! Set success indicators
  imag%loca%islo = islo
  imag%loca%mslo = 0
  imag%status = 0
  !
end subroutine gdf_read_header
!
subroutine gdf_trim_header(imag,rank,error)
  use gio_dependencies_interfaces
  use gio_interfaces, only : gio_message
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API
  !       Read an image header from the requested file
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: imag    ! Image structure
  integer(4),   intent(in)    :: rank    ! Requested Rank
  logical,      intent(out)   :: error   ! Error flag
  !
  call sub_trim_header('GDF_TRIM_HEADER',imag,rank,error)
end subroutine gdf_trim_header
!
subroutine sub_trim_header(caller,imag,therank,error)
  use gio_dependencies_interfaces
  use gio_interfaces, only : gio_message
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API
  !       Read an image header from the requested file
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: caller  ! Name of caller
  type(gildas), intent(inout)  :: imag    ! Image structure
  integer(4),   intent(in)     :: therank ! Requested Rank
  logical,      intent(inout)  :: error   ! Error flag
  !
  integer :: i
  character(len=60) :: mess
  !
  if (therank.lt.0) then
    if (imag%gil%ndim.ne.-therank) then
      write(mess,'(A,I1,A,I1)') 'Rank mismatch: Image ',imag%gil%ndim, &
        &   ', Requested ',-therank
      call gio_message(seve%e,caller, mess)
      error = .true.
      return
    endif
  else if (therank.eq.0) then
    !
    ! Trim all degenerate trailing dimensions
    if (imag%gil%dim(imag%gil%ndim).gt.1) then
      call gio_message(seve%e,caller,'Image cannot be trimmed')
      error = .true.
      return
    else
      do while (imag%gil%dim(imag%gil%ndim).eq.1)
        imag%gil%ndim = imag%gil%ndim - 1
      enddo
    endif
  else if (therank.lt.imag%gil%ndim) then
    do i=therank+1,gdf_maxdims
      if (imag%gil%dim(i).gt.1) then
        write(mess,'(A,I1)') 'File has rank > ',therank
        call gio_message(seve%e,caller, mess)
        error = .true.
        return
      endif
      imag%gil%ndim = therank
    enddo
  else if (therank.gt.imag%gil%ndim) then
    do i=imag%gil%ndim+1,therank
      imag%gil%dim(i) = 1
    enddo
    imag%gil%ndim = therank    
  endif
  !
  ! This should not be done: gheads% is a pure copy of the image file 
  !   header, and thus must be left untouched.
  ! if (imag%loca%islo.ne.0) gheads%gil%ndim(islo) = imag%gil%ndim
  !
end subroutine sub_trim_header
!
subroutine gdf_update_header(imag,error)
  use gio_interfaces, except_this=>gdf_update_header
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API routine
  !     Update an image header
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: imag      ! Image structure
  logical, intent(out) :: error             ! Flag
  ! Local
  integer(kind=4) :: islo
  !
  error = .false.
  islo = imag%loca%islo
  imag%status = code_update_header
  if (gdf_stis(islo).eq.-1) then
    call gio_message(seve%e, 'GDF_UPDATE_HEADER', 'Slot is not mapped')
    error = .true.
    return
  endif
  !
  call gio_write_header(imag,islo,error)
  if (error) return
  !
  ! FLush the image header
  call gdf_flih (islo,.false.,error)   ! Force writing even if slot is READO
  imag%status = 0
  !
  ! The image is left open...
  !!write(99,*) 'Tested gdf_update_header'
end subroutine gdf_update_header
!
subroutine gdf_copy_header(input,output, error)
  use image_def
  use gbl_message
  use gio_interfaces, only : gio_init_gildas, gdf_copy_gil, gio_message
  !---------------------------------------------------------------------
  ! @ public
  ! Copy (a part of) the input header into the output header.
  ! Since the arguments are the full gildas type, 'output' must be
  ! inout to avoid resetting the data part of the type. This implies that
  ! the other header components must also have been set/initialized
  ! before.
  !---------------------------------------------------------------------
  type(gildas), intent(in)    :: input   ! Input header
  type(gildas), intent(inout) :: output  ! Output header
  logical,      intent(inout) :: error   !
  !
  character(len=12) :: otype
  !
  if (input%header.ne.1) then
    call gio_message(seve%e,'GDF_COPY_HEADER','Input Header not initialized by GILDAS_NULL')
    error = .true.
    return
  endif
  call gio_init_gildas(output, 'GDF_COPY_HEADER - Output')
  !
  ! This overrides the pointers ... A Fortran-90 feature !...
  !   output%gil = input%gil
  ! So we use a dedicated routine
  call gdf_copy_gil (input,output,error)
  !
  otype = output%char%type
  output%char = input%char
  output%char%type = otype
  !
  output%loca%size = input%loca%size
  !
  ! Undefine other LOCAtion variables
  output%loca%addr = 0
  output%loca%islo = 0
  output%loca%mslo = 0
  output%loca%read = .true.   ! .false. was inconsistent with the Default
  output%loca%getvm = .false.
end subroutine gdf_copy_header
!
subroutine gdf_transpose_header(input,output,order,error,drop)
  use image_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, except_this=>gdf_transpose_header
  !---------------------------------------------------------------------
  ! @ public
  !       Transpose a header information
  !---------------------------------------------------------------------
  type (gildas),     intent(in)    :: input   ! Initial Header
  type (gildas),     intent(inout) :: output  ! Transposed Header
  character(len=*),  intent(in)    :: order   ! Transposition code
  logical,           intent(inout) :: error   ! Flag
  logical, optional, intent(in)    :: drop    ! Drop trailing dimensions?
  ! Local
  character(len=*), parameter :: rname='TRANSPOSE'
  integer(kind=4) :: itr(gdf_maxdims), mtr, i
  character(len=message_length) :: mess
  logical :: drop_trailing_dims
  !
  ! Interpret the transposition code
  call transpose_getorder(order,itr,gdf_maxdims,error)
  if (error) return
  mtr = maxval (itr)
  !
  ! Copy header:
  ! output = input ! No, this re-affects improperly the pointers...
  call gildas_null (output)
  ! To get started with because the copy depends on Header types.
  output%gil%type_gdf = input%gil%type_gdf
  output%char%type = input%char%type
  call gdf_copy_header(input,output,error)
  !
  ! Make sure all axes mentioned in the transposition code do exist
  !
  if (mtr.gt.input%gil%ndim) then
    if (input%gil%type_gdf.eq.code_gdf_image) then
      ! Implicitely extend missing dimensions by degenerate ones (only for
      ! images/cubes).
      write(mess,201)  &
        'Forcing image dimension from ',input%gil%ndim,' to ',mtr,' for code ',order
      call gio_message(seve%w, rname, mess)
      output%gil%ndim = mtr
      do i=1,gdf_maxdims
        output%gil%dim(i) = max (1,output%gil%dim(i))
      enddo
    else
      ! Enlarging the number of dimensions is forbidden (non-sense for
      ! tables)
      write(mess,'(A,A,A,I0,A)')  &
        'Invalid code ',trim(order),' (data has only ',input%gil%ndim,' dimensions)'
      call gio_message(seve%e,rname,mess)
      error = .true.
      return
    endif
  endif
  !
  ! Allow trailing dimensions to remain unspecified and untouched if present
  do i=1,input%gil%ndim
    if (itr(i).eq.0) itr(i) = i
  enddo
  !
  ! General
  do i=1,output%gil%ndim
    output%gil%dim(i) = max(input%gil%dim(itr(i)),1)
    output%gil%convert(:,i) = input%gil%convert(:,itr(i))
  enddo
  !
  ! Extrema
  if (input%gil%extr_words.ne.0) then
    do i=1,gdf_maxdims
      output%gil%minloc(i) = input%gil%minloc(itr(i))
    enddo
    do i=1,gdf_maxdims
      output%gil%maxloc(i) = input%gil%maxloc(itr(i))
    enddo
  else
    output%gil%extr_words = 0
  endif
  ! Units
  do i=1,output%gil%ndim
    output%char%code(i) = input%char%code(itr(i))
  enddo
  !
  ! Define the projection axes
  if (output%gil%proj_words.ne.0) then
    do i=1,output%gil%ndim
      if (itr(i).eq.input%gil%xaxi) then
        output%gil%xaxi = i
      elseif (itr(i).eq.input%gil%yaxi) then
        output%gil%yaxi = i
      endif
    enddo
  endif
  ! Define the Spectral axis
  if (output%gil%spec_words.ne.0) then
    do i=1,output%gil%ndim
      if (itr(i).eq.input%gil%faxi) output%gil%faxi = i
    enddo
  endif
  !
  ! In case of 21 transposition and Only TWO dimensions:
  ! indicate the transposition status in the type_gdf item.
  ! This can apply to UV Tables, Table (GILDAS and VO),
  ! Class Tables (a subset of UV Tables actually),
  ! SpreadSheets (if ever implemented)
  if (order.eq.'21'.and.output%gil%ndim.eq.2) then
    output%gil%type_gdf = -output%gil%type_gdf
  endif
  !!Print *,output%gil%type_gdf,'CODE ',code,' Dim ',output%gil%ndim,output%gil%dim
  !
  ! Reshape if needed (re-compute number of effective dimensions)
  if (present(drop)) then
    drop_trailing_dims = drop
  else
    drop_trailing_dims = .true.
  endif
  if (drop_trailing_dims) then
    do i=1,gdf_maxdims
      if (output%gil%dim(i).gt.1) output%gil%ndim = i
    enddo
  endif
  !
201 format(a,i1,a,i1,a,a)
end subroutine gdf_transpose_header
!
function gildas_error(header,name,error)
  use gio_interfaces, only : gio_message
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API routine
  !     Translate any possible error code, and return an error if needed
  !---------------------------------------------------------------------
  logical gildas_error                  ! intent(out)
  type (gildas), intent(in) :: header   ! Image header
  character(len=*), intent(in) :: name  ! Calling facility name
  logical, intent(out) :: error         ! Error flag
  ! Local
  integer :: icode, myseve
  character(len=32) :: codename(8)
  character(len=message_length) :: chain
  !
  data codename /  &
    'GDF_READ_DATA',   'GDF_READ_HEADER','GDF_UPDATE_HEADER',  &
    'GDF_WRITE_HEADER','GDF_WRITE_DATA', 'GDF_READ_VMIMAGE',   &
    'GDF_FREE_IMAGE',  'GDF_CREATE_IMAGE'/
  !
  if (header%header.ne.1) then
    chain = 'Header not initialized by GILDAS_NULL'
    call gio_message(seve%e,name,chain)
    error = .true.
  else if (header%status.eq.0) then
    error = .false.
  elseif (header%status.gt.0) then
    chain = 'Allocate error'
    call gio_message(seve%e, name, chain)
    error = .true.
  else
    icode = abs(header%status)
    if (header%status.eq.code_gio_extcol) then
      myseve = seve%w
      chain = 'Extra column in table'
    elseif (header%status.lt.code_gio_miscol) then
      myseve = seve%e
      chain = 'Missing column in table'
      error = .true.
    else
      myseve = seve%e
      chain = 'Error in '//codename(icode)
      call gio_message(seve%e,name,chain)
      error = .true.
    endif
    call gio_message(myseve,name,chain)
    if (myseve.eq.seve%e) then
      write(chain,'(A)') 'File: '//header%file
      call gio_message(myseve,name,chain)
    endif
  endif
  gildas_error = error
end function gildas_error
!
integer function gio_word_length(header)
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  ! GDF / GIO Internal routine
  !       Return the word length (in Bytes) of a GILDAS image
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: header           !
  !
  if (header%gil%form.eq.fmt_r8 .or. header%gil%form.eq.fmt_c4 &
    .or. header%gil%form.eq.fmt_i8) then
    gio_word_length = 8
  else if (header%gil%form.eq.fmt_c8) then
    gio_word_length = 16
  else
    gio_word_length = 4
  endif
end function gio_word_length
!
subroutine gio_read_header(imag,islo,error)
  use gio_interfaces, only : gio_init_gildas, gdf_copy_gil
  use image_def
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF / GIO Internal routine
  !       Read an image header on a specified image slot
  !           The slot must have been opened before
  !---------------------------------------------------------------------
  type(gildas),    intent(inout) :: imag   !
  logical,         intent(inout) :: error  !
  integer(kind=4), intent(in)    :: islo   !
  !
  character(len=*), parameter :: rname='GIO_READ_HEADER'
  !
  call gio_message(seve%t,rname,'Entering...')
  !
  call gio_init_gildas(imag,rname)
  imag%gil%type_gdf = gheads(islo)%gil%type_gdf ! Can be done ?
  call gdf_copy_gil (gheads(islo), imag, error)
  imag%char = gheads(islo)%char
  !
  call gio_message(seve%t,rname,'Leaving !..')
end subroutine gio_read_header
!
subroutine gio_write_header(imag,islo,error)
  use image_def
  use gio_image
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  ! GDF / GIO Internal routine
  !       Update an image header on a specified image slot
  !           The slot must have been opened before
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: imag  !
  logical, intent(out) :: error      !
  integer(kind=4), intent(in) :: islo
  !
  character(len=*), parameter :: rname='GIO_WRITE_HEADER'
  !
  call gio_message(seve%t,rname,'Entering...')
  gheads(islo) = imag  ! What about the pointers ?
  !
  !!gheads(islo)%gil%type_gdf =  imag%gil%type_gdf  ! Can be done for sure
  !!call gdf_copy_gil (imag, gheads(islo), error)
  !!gheads(islo)%char = imag%char 
  !
  ! Set the number of starting blocks consistently
  istbl(islo) = max(istbl(islo),imag%gil%nhb)
  error = .false.
  call gio_message(seve%t,rname,'Leaving !..')
end subroutine gio_write_header
!
subroutine gdf_get_extrema (mine,error)
  use gbl_format
  use image_def
  use gbl_message
  use gio_dependencies_interfaces, no_interface1=>gr4_extrema,  &
                                   no_interface2=>gr8_extrema
  use gio_interfaces, only : gio_message, gdf_index_to_where
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API
  !   Compute the extrema from a Virtual Memory image (one with the
  !   appropriate address field). Note that the address field
  !   can have been set independently of the %getvm status
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: mine   !
  logical,       intent(out)   :: error  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  character(len=*), parameter :: rname='EXTREMA'
  integer(kind=address_length) :: ip
  integer(kind=size_length) :: imin,imax
  integer(kind=8) :: ilong
  !
  ! Map the image Readonly if needed
  if (mine%loca%addr.eq.0) then
    call gio_message(seve%e,rname,'Image data is not defined')
    error = .true.
    return
  endif
  if (mine%gil%form.ne.fmt_r4 .and. mine%gil%form.ne.fmt_r8) then
    call gio_message(seve%e,rname,'Invalid format')
    error = .true.
    return
  endif
  !
  ! Set the blanking
  error = .false.
  if (mine%gil%blan_words.eq.0) then
    mine%gil%bval = 0.0
    mine%gil%eval = -1.0
  endif
  !
  ! Compute the Extrema
  ip = gag_pointer(mine%loca%addr,memory)
  if (mine%gil%form.eq.fmt_r4) then
    call gr4_extrema (mine%loca%size,memory(ip),     &
                      mine%gil%bval, mine%gil%eval,  &
                      mine%gil%rmin, mine%gil%rmax,imin,imax)
  elseif (mine%gil%form.eq.fmt_r8) then
    call gr8_extrema (mine%loca%size,memory(ip),     &
                      mine%gil%bval, mine%gil%eval,  &
                      mine%gil%rmin, mine%gil%rmax,imin,imax)
  endif
  !
  if (imin.eq.0 .or. imax.eq.0)  &
    call gio_message(seve%w,rname,'No valid value, extrema not updated')
  !
  ilong = imin
  call gdf_index_to_where(ilong,mine%gil%ndim,mine%gil%dim,mine%gil%minloc)
  ilong = imax
  call gdf_index_to_where(ilong,mine%gil%ndim,mine%gil%dim,mine%gil%maxloc)
  mine%gil%extr_words = def_extr_words
end subroutine gdf_get_extrema
!
subroutine gdf_get_baselines (mine,error)
  use gio_dependencies_interfaces
  use gio_interfaces, only : gio_message
  use image_def
  use gbl_message
  use gbl_format
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API
  !   Compute the baseline range from a Virtual Memory UV data (one with the
  !   appropriate address field). Note that the address field
  !   can have been set independently of the %getvm status
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: mine   !
  logical,       intent(out)   :: error  !
  ! Global
  include 'gbl_memory.inc'
  ! Local
  integer :: iu,iv
  integer(kind=address_length) :: ip
  real(4) :: base,baseuv(2)
  integer(kind=index_length) :: i
  !
  ! Check consistency
  if (mine%loca%addr.eq.0) then
    call gio_message(seve%e,'GET_BASELINES','UV data is not defined')
    error = .true.
    return
  endif
  if (abs(mine%gil%type_gdf).ne.code_gdf_uvt) then
    call gio_message(seve%e,'GET_BASELINES','This is not a UV data')
    error = .true.
    return
  endif
  if (mine%gil%form.ne.fmt_r4 .and. mine%gil%form.ne.fmt_r8) then
    call gio_message(seve%e,'GET_BASELINES','Invalid format')
    error = .true.
    return
  endif
  !
  mine%gil%basemin = 1.E12
  mine%gil%basemax = 0.0
  ip = gag_pointer(mine%loca%addr,memory)
  !
  iu = mine%gil%column_pointer(code_uvt_u)
  iv = mine%gil%column_pointer(code_uvt_v)
  !
  if (mine%gil%type_gdf.eq.code_gdf_uvt) then
    if (mine%gil%column_size(code_uvt_u).eq.2) then
      do i=1,mine%gil%nvisi !! not %dim(2)
        call r8tor4(memory(ip+2*(iu-1)),baseuv(1),1)
        call r8tor4(memory(ip+2*(iv-1)),baseuv(2),1)
        base = baseuv(1)**2+baseuv(2)**2
        mine%gil%basemin = min(base,mine%gil%basemin)
        mine%gil%basemax = max(base,mine%gil%basemax)
        ip = ip+2*mine%gil%dim(1)
      enddo
    else
      do i=1,mine%gil%nvisi !! not %dim(2)
        call r4tor4(memory(ip+iu-1),baseuv(1),1)
        call r4tor4(memory(ip+iv-1),baseuv(2),1)
        base = baseuv(1)**2+baseuv(2)**2
        mine%gil%basemin = min(base,mine%gil%basemin)
        mine%gil%basemax = max(base,mine%gil%basemax)
        ip = ip+mine%gil%dim(1)
      enddo
    endif
  else
    if (mine%gil%column_size(code_uvt_u).eq.2) then
      do i=1,mine%gil%nvisi !! not %dim(1)
        call r8tor4(memory(ip+2*mine%gil%dim(1)*(iu-1)),baseuv(1),1)
        call r8tor4(memory(ip+2*mine%gil%dim(1)*(iv-1)),baseuv(2),1)
        base = baseuv(1)**2+baseuv(2)**2
        mine%gil%basemin = min(base,mine%gil%basemin)
        mine%gil%basemax = max(base,mine%gil%basemax)
        ip = ip+2
      enddo
    else
      do i=1,mine%gil%nvisi !! not %dim(1)
        call r4tor4(memory(ip+mine%gil%dim(1)*(iu-1)),baseuv(1),1)
        call r4tor4(memory(ip+mine%gil%dim(1)*(iv-1)),baseuv(2),1)
        base = baseuv(1)**2+baseuv(2)**2
        mine%gil%basemin = min(base,mine%gil%basemin)
        mine%gil%basemax = max(base,mine%gil%basemax)
        ip = ip+1
      enddo
    endif
  endif
  mine%gil%basemin = sqrt(mine%gil%basemin)
  mine%gil%basemax = sqrt(mine%gil%basemax)
  !! Print *,'Base ',mine%gil%basemin,mine%gil%basemax
  !
end subroutine gdf_get_baselines
!
subroutine gildas_null(hx, type)
  use gio_dependencies_interfaces
  use image_def
  use gio_interfaces, only : gio_init_gildas, gio_zero_gildas
  use gio_uv
  !---------------------------------------------------------------------
  ! @ public
  ! GDF API
  !   Initialize a Gildas structure and reset its content
  !---------------------------------------------------------------------
  type(gildas), intent(out), target :: hx ! Gildas structure
  character(len=*), intent(in), optional :: type
  !
  call gio_init_gildas(hx, 'GILDAS_NULL')
  call gio_zero_gildas(hx)
  !
  hx%gil%uvda_words = 0 ! Set section to be absent by default
  if (.not.present(type)) return
  !
  if (type.eq.'UVT' .or. type.eq.'TUV') then
    hx%gil%ndim = 2
    hx%gil%form = fmt_r4
    hx%gil%uvda_words = 1  ! Set section to be present
    !
    ! V 2.0 version: fixed layout of the 7 mandatory daps...
    ! V 2.1 version: with Doppler information
    hx%gil%version_uv = code_version_uvt_current
    hx%gil%column_pointer = 0
    hx%gil%column_pointer(code_uvt_u) = 1
    hx%gil%column_pointer(code_uvt_v) = 2
    hx%gil%column_pointer(code_uvt_w) = 3
    hx%gil%column_pointer(code_uvt_date) = 4
    hx%gil%column_pointer(code_uvt_time) = 5
    hx%gil%column_pointer(code_uvt_anti) = 6
    hx%gil%column_pointer(code_uvt_antj) = 7
    !
    hx%gil%column_size = 0
    where (hx%gil%column_pointer.ne.0) hx%gil%column_size = 1
    !
    hx%gil%fcol = 8
    hx%gil%lcol = 0 ! Not yet defined
    hx%gil%nlead = 7
    hx%gil%ntrail = 0
    hx%gil%nstokes = 1
    hx%gil%natom = 3
    hx%gil%order = 0
    !
    if (type.eq.'UVT') then
      hx%gil%type_gdf = code_gdf_uvt
      hx%char%code(1) = 'UV-DATA'
      hx%char%code(2) = 'RANDOM'
    elseif (type.eq.'TUV') then
      hx%gil%type_gdf = code_gdf_tuv
      hx%char%code(1) = 'RANDOM'
      hx%char%code(2) = 'UV-DATA'
    endif
    hx%char%code(3:gdf_maxdims) = ' '
    hx%char%type = 'GILDAS_UVFIL'
    ! No blanking in UV Tables
    hx%gil%blan_words = 0
    !
    hx%mos%nfields = 0
    !
  else if (type.eq.'TABLE') then
    hx%gil%type_gdf = code_gdf_table
    hx%gil%ndim = 2
    hx%gil%dim(3:gdf_maxdims) = 1
    hx%gil%blan_words = 0
    hx%gil%extr_words = 0
    hx%gil%desc_words = 0
    hx%gil%posi_words = 0
    hx%gil%proj_words = 0
    hx%gil%spec_words = 0
    hx%gil%reso_words = 0
    hx%gil%coor_words = 0
    hx%gil%uvda_words = 0
  else if (type.eq.'IMAGE') then
    hx%gil%extr_words = 0
    continue
  else if (type.eq.'VOTABLE') then
    hx%gil%type_gdf = code_gdf_vo
    hx%gil%ndim = 2
    hx%gil%dim(3:gdf_maxdims) = 1
    hx%gil%blan_words = 0
    hx%gil%extr_words = 0
    hx%gil%desc_words = 0
    hx%gil%posi_words = 0
    hx%gil%proj_words = 0
    hx%gil%spec_words = 0
    hx%gil%reso_words = 0
    hx%gil%coor_words = 0
    hx%gil%uvda_words = 0
    !
  else
    PRINT *,"Programming error, unsupported type ",type," in call to GILDAS_NULL"
    call sysexi(fatale)
  endif
  !
end subroutine gildas_null
!
subroutine gio_init_gildas(hx, caller)
  use gio_interfaces, only : gio_message
  use image_def
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  ! GDF API
  !   Initialize a Gildas structure: set the required pointers
  !---------------------------------------------------------------------
  type(gildas), intent(inout), target :: hx ! Gildas structure
  character(len=*), intent(in) :: caller    ! Caller's name
  !
  if (.not.associated(hx%gil%ref,hx%gil%convert(1,:))) then
    ! Do not bother anymore: this may happen in parallel programming
    ! just reset the pointer as needed
    !
    !if (associated(hx%gil%ref)) then
    !  call gio_message(seve%e,caller,'Ref pointer badly associated')
    !endif
    !
    ! Use elaborate pointers with stride...
    hx%gil%ref => hx%gil%convert(1,:)
    hx%gil%val => hx%gil%convert(2,:)
    hx%gil%inc => hx%gil%convert(3,:)
  endif
  ! Unclear whether this must be here or in GILDAS_NULL actually...
  hx%header = 1 ! Header is initialized
  !
  ! We should clear any possible trailing pointer array
  if (associated(hx%gil%freqs)) deallocate(hx%gil%freqs)
  if (associated(hx%gil%stokes)) deallocate(hx%gil%stokes)
  if (allocated(hx%gil%teles)) deallocate(hx%gil%teles)
  !
  ! and reset to zero their associated sizes
  hx%gil%nfreq = 0
  hx%gil%nstokes = 0
  hx%gil%nteles = 0
  !
  if (allocated(hx%mos%fields)) deallocate(hx%mos%fields)
  hx%mos%nfields = 0
end subroutine gio_init_gildas
!
subroutine gio_zero_gildas(header)
  use image_def
  use gbl_format
  !---------------------------------------------------------------------
  ! @ private
  ! GDF API routine
  !    Initialize a Gildas header content to default values
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: header           !
  ! Local
  integer :: i
  !
  !     Location
  header%loca%al64 = 0
  header%loca%size = 0
  header%loca%addr = 0
  header%loca%islo = 0
  header%loca%mslo = 0
  header%loca%read = .true.
  header%loca%getvm = .false.
  !     Strings
  header%char%type = 'GILDAS_IMAGE'
  header%char%unit = ' '       ! 56
  do i=1,gdf_maxdims
    header%char%code(i) = ' '  ! 59
  enddo
  header%char%syst = ' '       ! 71
  header%char%name = ' '       ! 75,76,77
  header%char%line = ' '
  !! header%char%tele = ' '
  header%file = ' '            ! File name
  ! Header
  header%gil%type_gdf = code_null ! or code_gdf_image
  !!header%gil%ijtyp = 0          !  1
  header%gil%form = fmt_r4     !  4
  header%gil%ndb  = 0          !  5
  !! header%gil%fill = 0          !  6 (unused)
  !
  header%gil%ndim = 0          ! 12
  header%gil%dim  = 0          ! 13
  header%gil%dim_words = 2+2*gdf_maxdims    ! Max Dim, N Dim, + All Dimensions
  header%gil%coor_words = 6*gdf_maxdims     ! Conversion coordinates
  header%gil%convert = 1.0
  !
  header%gil%blan_words = 2          ! 41
  header%gil%bval = +1.23456e+38   ! 42
  header%gil%eval = -1.0       ! 43
  !
  header%gil%extr_words = 0
  header%gil%rmin = 0.0
  header%gil%rmax = 0.0
  header%gil%minloc = 0
  header%gil%maxloc = 0
  !
  header%gil%desc_words  = def_desc_words        ! 55
  !!header%gil%ijuni = 0          ! 56
  !!header%gil%ijcod = 0          ! 59
  !!header%gil%ijsys = 0          ! 71
  !
  header%gil%posi_words = def_posi_words         ! 74
  !!header%gil%ijsou = 0          ! 75
  header%gil%ra  = 0.0         ! 78
  header%gil%dec = 0.0         ! 80
  header%gil%lii = 0.0         ! 82
  header%gil%bii = 0.0         ! 84
  header%gil%epoc = equinox_null        ! 86
  !
  header%gil%proj_words = def_proj_words          ! 87
  header%gil%ptyp = p_none     ! 88
  header%gil%a0 = 0.0d0        ! 89
  header%gil%d0 = 0.0d0        ! 91
  header%gil%pang = 0.0d0      ! 93
  header%gil%xaxi = 0          ! 95
  header%gil%yaxi = 0          ! 96
  !
  header%gil%spec_words = def_spec_words   !
  !!header%gil%ijlin = 0       ! 98
  header%gil%fres = 0.0        ! 101
  header%gil%fima = 0.0        ! 103
  header%gil%freq = 0.0        ! 105
  header%gil%vres = 0.0        ! 107
  header%gil%voff = 0.0        ! 108
  header%gil%faxi = 0          ! 109
  header%gil%dopp = 0.0
  header%gil%vtyp = vel_lsr    ! LSR by default
!
  header%gil%reso_words = 0
  header%gil%majo = 0.0        ! 111
  header%gil%mino = 0.0        ! 112
  header%gil%posa = 0.0        ! 113
  !
  header%gil%nois_words = 0
  header%gil%noise = 0.0       ! 115
  header%gil%rms = 0.0         ! 116
  !
  header%gil%astr_words = 0
  header%gil%mura = 0.0        ! 118
  header%gil%mudec = 0.0       ! 119
  header%gil%parallax = 0.0    ! 120
  !!      HEADER%GIL%PEPOCH = 2000.0         ! 121
  !
  header%gil%uvda_words = 0
  !
  header%gil%tele_words = 0
  header%gil%nteles = 0
  header%gil%magic  = 1000
  !
  header%blc = 0
  header%trc = 0
  header%status = 0
  !
  header%mos%nfields = 0
end subroutine gio_zero_gildas
!
subroutine gdf_copy_gil(input,output,error)
  use image_def
  use gbl_message
  use gio_dependencies_interfaces
  use gio_interfaces, only : gio_message
  !---------------------------------------------------------------------
  ! @ public
  ! Copy the %gil%  part of the input header into the output header.
  !   Only used by SIC outside of GIO...
  !---------------------------------------------------------------------
  type (gildas), intent(in) :: input   ! Input header
  type (gildas), intent(inout) :: output  ! Output header
  logical, intent(out) :: error
  !
  integer(kind=address_length) :: inlen, outlen, uvtlen, curlen
  integer :: ier, ifi
  integer :: save_type, save_chain(3)
  character(len=64) :: chain
  !
  error = .false.
  ier = 0
  !
  ! Maximum length
  uvtlen = (locwrd(input%gil%nfreq) - locwrd(input%gil%ijtyp)) / 4 + 1
  if (abs(input%gil%type_gdf).ne.abs(code_gdf_uvt)) then
    inlen = (locwrd(input%gil%uvda_words) - locwrd(input%gil%ijtyp)) / 4
  else
    inlen = (locwrd(input%gil%nfreq) - locwrd(input%gil%ijtyp)) / 4 + 1
  endif
  !
  if (abs(output%gil%type_gdf).ne.abs(code_gdf_uvt)) then
    outlen = (locwrd(output%gil%uvda_words) - locwrd(output%gil%ijtyp)) / 4
  else
    outlen = (locwrd(output%gil%nfreq) - locwrd(output%gil%ijtyp)) / 4 + 1
  endif
  !
  curlen = min(inlen, outlen)
  !!Print *,'curlen ',curlen,' uvtlen ',uvtlen,' inlen ',inlen,' outlen ',outlen
  !!Print *,'Input ',input%gil%type_gdf, ' output ',output%gil%type_gdf
  !
  ! If both are UV data sets,
  ! need to copy %freq & %stokes items if they are defined...
  if (curlen.eq.uvtlen) then
    if (input%gil%nfreq.ne.0) then
      write(chain,*) input%gil%nfreq
      call gio_message(seve%d,'GDF_COPY_HEADER','Copying '//trim(chain)//' Frequency & Stokes')
    endif
    !DEBUG! Print *,'FREQ Input ',input%gil%nfreq, ' output ',output%gil%nfreq
    ! Would also need to copy %freq & %stokes
    if (output%gil%nfreq.ne.input%gil%nfreq) then
      if (associated(output%gil%freqs)) then
        !DEBUG! Print *,'Deallocating FREQS'    !Under TEST
        deallocate(output%gil%freqs, output%gil%stokes, stat=ier)
        if (ier.ne.0) then
          call gio_message(seve%w,'GDF_COPY_HEADER','Frequency & Stokes array deallocation error')
        endif
      endif
      if (input%gil%nfreq.ne.0) then
        !DEBUG! Print *,'Allocating FREQS',input%gil%nfreq !Under TEST
        allocate(output%gil%freqs(input%gil%nfreq), output%gil%stokes(input%gil%nfreq), stat=ier)
        if (ier.ne.0) then
          call gio_message(seve%e,'GDF_COPY_HEADER','Frequency & Stokes array allocation error')
          error = .true.
        else
          !DEBUG! Print *,'Input ',ubound(input%gil%freqs), ubound(input%gil%stokes)    !Under TEST
          !DEBUG! Print *,'Output ',ubound(output%gil%freqs), ubound(output%gil%stokes) !Under TEST
          !DEBUG! Print *,'Input Stokes ',input%gil%stokes(:)
          output%gil%freqs(:) = input%gil%freqs(:)
          output%gil%stokes(:) = input%gil%stokes(:)
        endif
        output%gil%nfreq = input%gil%nfreq 
      endif
    else if (input%gil%nfreq.gt.0) then
      ! Size matches and are non-zero...
      output%gil%freqs(:) = input%gil%freqs(:)
      output%gil%stokes(:) = input%gil%stokes(:)
    endif
    !
    if ((input%gil%nfreq.eq.0).and.(abs(input%gil%order).eq.abs(code_stok_chan))) then
      !DEBUG! Print *,' Stokes order ',input%gil%order, code_stok_chan
      !
      write(chain,'(A,I0,A)') 'Copying ',input%gil%nstokes,' pure Stokes'
      call gio_message(seve%d,'GDF_COPY_HEADER',chain)
      !DEBUG! Print *,'Stokes sizes ',input%gil%nstokes, output%gil%nstokes
      !
      if (output%gil%nstokes.ne.input%gil%nstokes) then
        if (associated(output%gil%stokes)) then
          deallocate(output%gil%stokes, stat=ier)
          if (ier.ne.0) then
            call gio_message(seve%w,'GDF_COPY_HEADER','Stokes array deallocation error')
          endif
        endif
        if (input%gil%nstokes.gt.1) then
          allocate(output%gil%stokes(input%gil%nstokes), stat=ier)
          if (ier.ne.0) then
            call gio_message(seve%e,'GDF_COPY_HEADER','Stokes array allocation error')
            error = .true.
          else
            output%gil%stokes(:) = input%gil%stokes(:)
          endif
        endif
      else if (input%gil%nstokes.gt.1) then
        ! Size matches and are non-zero...
        !DEBUG! Print *,'Copying Stokes ',ubound(output%gil%stokes)
        output%gil%stokes(:) = input%gil%stokes(:)
      endif
    endif
    !
  endif
  !
  ! Telescope information
!  if (input%gil%nteles.ne.0) then
!    write(chain,*) input%gil%nteles
!    call gio_message(seve%w,'GDF_COPY_HEADER','Copying '//trim(chain)//' telescope information')
!  endif
  !! Print *,'NTELES ',input%gil%nteles, ' output ',output%gil%nteles
  ! Would also need to copy the Telescope data
  if (output%gil%nteles.ne.input%gil%nteles) then
    if (allocated(output%gil%teles)) then
      deallocate(output%gil%teles, stat=ier)
      if (ier.ne.0) then
        call gio_message(seve%w,'GDF_COPY_HEADER','Telescope deallocation error')
      endif
    endif
    if (input%gil%nteles.ne.0) then
      allocate(output%gil%teles(input%gil%nteles), stat=ier)
      if (ier.ne.0) then
        call gio_message(seve%e,'GDF_COPY_HEADER','Telescope allocation error')
        error = .true.
      else
        output%gil%teles(:) = input%gil%teles(:)
      endif
    endif
  else if (input%gil%nteles.gt.0) then
    output%gil%teles(:) = input%gil%teles(:)
  endif
  !
  ! Only copy what is defined otherwise
  save_type = output%gil%type_gdf  ! Save the requested type
  save_chain = output%gil%ijtyp
  call r4tor4(input%gil, output%gil, curlen)
  ! Restore it, but preserve the Transposition status...
  if (abs(save_type).ne.abs(output%gil%type_gdf)) then
    output%gil%type_gdf = save_type
    !!Print *,'Restoring desired destination type ',save_type, input%gil%type_gdf, output%gil%type_gdf
  else
    !!Print *,'Restoring initial transposition state ',save_type, input%gil%type_gdf, output%gil%type_gdf
  endif
  output%gil%ijtyp = save_chain
  if (abs(output%gil%type_gdf).eq.abs(code_gdf_uvt)) then
    call gdf_setuv(output,error)
  endif
  !
  if (input%mos%nfields.ne.0) then
    !
    write(chain,'(A,I0,A)') 'Copying ',input%mos%nfields,' Fields mosaic information'
    call gio_message(seve%d,'GDF_COPY_HEADER',chain)
    if (output%mos%nfields.ne.input%mos%nfields) then
      if (allocated(output%mos%fields)) deallocate(output%mos%fields)      
      allocate(output%mos%fields(input%mos%nfields))
      output%mos%nfields = input%mos%nfields
    endif
    do ifi = 1,input%mos%nfields
      output%mos%fields(ifi) = input%mos%fields(ifi)
    enddo
  endif
end subroutine gdf_copy_gil
