subroutine view_load_comm(line,error)
  use gkernel_interfaces
  use imager_interfaces, only : sub_read_image
  use clean_default
  use clean_arrays
  use clean_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! VIEWER
  !
  !   Support routine for command
  !   DISPLAY\LOAD File [[/RANGE Start End Type]
  !   [/FREQUENCY RestFreqMHz] and [/PLANE Start End]
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  !
  ! Local
  integer, parameter :: o_freq=1
  integer, parameter :: o_plane=2
  integer, parameter :: o_range=3
  logical, parameter :: compact = .false.
  !
  integer nn,isort
  character(len=filename_length) :: name
  logical do_freq
  real(8) :: drange(2), freq
  character(len=12) :: csort
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort),mysort
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  call sic_ch (line,0,1,name,nn,.true.,error)
  if (error) return
  !
  ! Default settings
  drange = 0
  mysort = 'NONE'
  !
  ! /PLANE (for compatibility or different application)
  if (sic_present(o_plane,0)) then
    if (sic_present(o_range,0)) then
      call map_message(seve%e,'READ','Options /RANGE and /PLANES are incompatible')
      error =.true.
      return
    endif
    call sic_r8 (line,o_plane,1,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,o_plane,2,drange(2),.true.,error)
    if (error) return
  endif
  !
  ! /RANGE (for flexibility)
  if (sic_present(o_range,0)) then
    call sic_r8 (line,o_range,1,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,o_range,2,drange(2),.true.,error)
    if (error) return
    call sic_ke (line,o_range,3,csort,nn,.true.,error)
    if (error) return
    error = .false.
    call sic_ambigs('READ',csort,mysort,isort,types,msort,error)
    if (error)  return
  endif
  !
  ! /FREQUENCY Option
  do_freq = sic_present(o_freq,0)
  if (do_freq) then
    call sic_r8(line,o_freq,1,freq,.true.,error)
    if (error) return
  endif
  !
  ! 'DATA'  is the last item of the list...
  if (do_freq) then
    call sub_read_image (name,mtype,drange,mysort,compact,o_range,error,freq)
  else
    call sub_read_image (name,mtype,drange,mysort,compact,o_range,error)
  endif
  call check_view(1,'DATA')  ! Force VIEW re-computation for these
  last_shown = 'DATA' ! Could be an issue since it has not been SHOWn or VIEWed yet
end subroutine view_load_comm
!
subroutine read_image (line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>read_image
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Support routine for command
  !   READ Type File [/COMPACT] [/NOTRAIL] [/RANGE Start End Type]
  !   [/FREQUENCY RestFreqMHz] and [/PLANE Start End]
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line
  logical, intent(inout) :: error
  ! Local
  integer, parameter :: o_compact=1
  integer, parameter :: o_freq=2
  integer, parameter :: o_plane=3
  integer, parameter :: o_range=4
  integer, parameter :: o_trail=5
  !
  integer ntype,nn,isort, i
  character(len=12) argu,atype
  character(len=filename_length) :: name
  logical compact,lexist,do_freq
  character(len=filename_length) :: file
  real(8) :: drange(2), freq
  character(len=12) :: csort
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort),mysort
  character(len=filename_length), save :: uv_data_name=' '
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  call sic_ke (line,0,1,argu,nn,.true.,error)
  if (error) return
  !
  if ((argu.eq.'?').and.(sic_narg(0).eq.1)) then
    call sic_ambigs ('READ',argu,atype,ntype,vtype,mtype,error)
    error = .false.
    return
  endif
  !
  if (argu.eq.'UV') argu = 'UV_DATA'
  if (argu.eq.'UV_DATA') then
    if (sic_narg(0).eq.1) then
      name = uv_data_name
      nn = len_trim(name)
      error = nn.eq.0
      if (error) call map_message(seve%e,'READ','No UV data already read')
    else
      call sic_ch (line,0,2,name,nn,.true.,error)
    endif
  else
    call sic_ch (line,0,2,name,nn,.true.,error)
  endif
  if (error) return
  !
  ! Default settings
  drange = 0
  mysort = 'NONE'
  !
  ! /PLANE (for compatibility or different application)
  if (sic_present(o_plane,0)) then
    if (sic_present(o_range,0)) then
      call map_message(seve%e,'READ','Options /RANGE and /PLANES are incompatible')
      error =.true.
      return
    endif
    call sic_r8 (line,o_plane,1,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,o_plane,2,drange(2),.true.,error)
    if (error) return
  endif
  !
  ! /RANGE (for flexibility)
  if (sic_present(o_range,0)) then
    call sic_r8 (line,o_range,1,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,o_range,2,drange(2),.true.,error)
    if (error) return
    call sic_ke (line,o_range,3,csort,nn,.true.,error)
    if (error) return
    error = .false.
    call sic_ambigs('READ',csort,mysort,isort,types,msort,error)
    if (error)  return
  endif
  !
  ! /FREQUENCY Option
  do_freq = sic_present(o_freq,0)
  if (do_freq) then
    call sic_r8(line,o_freq,1,freq,.true.,error)
    if (error) return
  endif
  !
  ! /COMPACT
  compact = sic_present(o_compact,0)
  !
  if (argu.eq.'*') then
    !
    ! Find all files of relevant extension, and load them
    do ntype = 2, ptype
!!      if (vtype(ntype).eq.'CGAINS') cycle
!!      if (vtype(ntype).eq.'SELFCAL') cycle
      !
      lexist = sic_findfile(name,file,' ',etype(ntype))
      !!Print *,vtype(ntype),trim(file), lexist
      if (lexist) then
        !!Read(5,*) nn
        call map_message(seve%i,'READ','Loading '//vtype(ntype)//trim(file))
        if (ntype.eq.1 .or. ntype.eq.mtype) then
          csort = 'NONE'
        else
          csort = mysort
        endif
        if (do_freq) then
          call sub_read_image (name,ntype,drange,csort,compact,o_range,error,freq)
        else
          call sub_read_image (name,ntype,drange,csort,compact,o_range,error)
        endif
        call check_view(1,atype)  ! Force VIEW re-computation for these
      endif
    enddo
  else if (argu.eq.'FLUX') then
    do i=1,5
      if (sic_present(i,0)) then
        call map_message(seve%e,'READ','Option(s) incompatible with FLUX argument')
        error = .true.
        return
      endif
    enddo
    call sub_read_flux(name,error)
  else
    call sic_ambigs ('READ',argu,atype,ntype,vtype,mtype,error)
    if (error) return
    !
    if (do_freq) then
      call sub_read_image (name,ntype,drange,mysort,compact,o_range,error,freq)
    else
      call sub_read_image (name,ntype,drange,mysort,compact,o_range,error)
    endif
    call check_view(1,atype)  ! Force VIEW re-computation for these
  endif
  !
  if (argu.eq.'UV_DATA') uv_data_name = name
end subroutine read_image
!
subroutine sub_read_image (name,ntype,drange,crange,compact,o_range,error, freq)
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, only : map_read, map_message
  use clean_def
  use clean_arrays
  use clean_default
  use clean_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER
  !   Support routine for command
  !   READ Type File [/COMPACT] [/FREQUENCY RestFreqMHz] [/RANGE Start End Type]
  !   [/NOTRAIL] and, for transposed data,  [/PLANE Start End]
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: name    ! Name of file
  integer, intent(in) :: ntype            ! Type of data
  real(8), intent(in) :: drange(2)        ! Range to be read
  character(len=*), intent(in) :: crange  ! Type of range
  logical, intent(in) :: compact          ! ACA buffer flag
  integer, intent(in) :: o_range          ! Number of Option /RANGE
  logical, intent(inout) :: error
  real(8), intent(in), optional :: freq   ! Desired rest frequency
  !
  character(len=*), parameter :: rname='READ'
  !
  type (gildas) :: head
  character(len=filename_length) :: file
  integer :: nc(2), n
  logical :: nochange, attempt, err, fits_fmt, is_uvfits
  real(4) :: velo
  !
  integer(kind=4), parameter :: khdu=1  ! Desired HDU. 1 is Primary HDU.
  type(gfits_hdesc_t) :: fd             ! I hope this is available here
  logical :: question, check
  integer :: a_style
  integer :: pcount
  !
  ! Code
  call gildas_null(head)
  call sic_parse_file(name,' ',etype(ntype),file)
  head%file = file
  !
  is_uvfits = .false.
  if (ftype(ntype).eq.1) then
    ! Allow direct reading of FITS file in this case
    ! Test if FITS file, by .fits extension
    call is_fitsfile(file,fits_fmt,error)
    if (error) return
    if (fits_fmt) then
      call map_message(seve%w,rname,trim(file)//' is a FITS image')
      if (sic_present(o_range,0)) then
        call map_message(seve%e,rname,'Option /RANGE not (yet) valid for FITS image')
        error = .true.
        return
      endif
    endif
  else
    fits_fmt = .false.
    n = len_trim(file)
    if ((file(n-4:n).eq.'.fits').or.(file(n-6:n).eq.'.uvfits'))  then
      call map_message(seve%w,rname,'Reading FITS format not yet thoroughly tested for '//vtype(ntype),3)
      fits_fmt = .true.
      is_uvfits = .true.
    endif
  endif
  !
  if (fits_fmt) then  
    ! Open FITS file, including basic sanity checks
    call gfits_open(file,'IN',error)
    if (error)  return
    call gfits_goto_hdu(fd,khdu,error)
    if (error)  return
    !
    ! --- Read the header (always) ---
    call gildas_null(head)
    head%blc = 0
    head%trc = 0
    !
    if (is_uvfits) then
      question = .false.
      a_style = 0 
      check = .false.
      call touvt(head,a_style,question,check,error,pcount,sic_getsymbol)
      if (error) then
        call gio_message(seve%e,rname,'Error reading UVFITS header')
        call gfits_close(err)
        return
      endif
      !
      head%file = file
    else
      ! Convert the HDU to a GILDAS Header
      call fitscube2gdf_header(file,khdu,fd,head,sic_getsymbol,error)
      if (error) return
      head%loca%size = product(head%gil%dim(1:head%gil%ndim))
      head%file = file
    endif
    !
  else
    head%blc = 0
    head%trc = 0
    !
    !
    ! Read Header
    call gdf_read_header (head,error)
    if (error) return
    !
    ! Shift it to the requested Rest Frequency if needed
    if (present(freq)) then
      velo = head%gil%voff
      call gdf_modify(head,velo,freq,error=error)
      if (error) return
    endif
    !
  endif
  call out_range('READ',crange,drange,nc,head,error)
  if (error) return
  head%loca%size = product(head%gil%dim(1:head%gil%ndim))
  !
  ! Check if anything changed
  if (.not.compact) then
    ! We must check if the corresponding buffer is still allocated !...
    select case(vtype(ntype))
    case ('CCT')
      attempt = hcct%loca%size.ne.0
      last_resid = 'CCT'
    case ('RESIDUAL')
      attempt = hresid%loca%size.ne.0
    case ('CLEAN')
      attempt = hclean%loca%size.ne.0
    case ('DATA')
      attempt = hview%loca%size.ne.0
    case ('MASK') 
      attempt = hmask%loca%size.ne.0
    case ('CONTINUUM') 
      attempt = hcont%loca%size.ne.0
    case ('SKY') 
      attempt = hsky%loca%size.ne.0
    case default
      attempt = .false.  ! No optimization if unknown buffer
    end select
    if (attempt) then
      call sub_modified(ntype,file,optimize(ntype),nc,nochange)
      if (nochange) return
    endif
  endif
  !
  ! Read Data as required
  call map_read(head,fd,fits_fmt,vtype(ntype),nc,compact,error,pcount)
  !
  ! Indicate Buffer has been read
  optimize(ntype)%change = 0
  !
  ! Free image slot 
  if (.not.fits_fmt) then
    err = .false.
    call gdf_close_image (head,err)
    if (err) error = .true.
  endif
  !
  ! First loaded will be shown, not the last one...
  if (last_shown.eq.' ') then
    select case(vtype(ntype))
    case('CLEAN')
      last_shown = 'CLEAN'
    case ('SKY') 
      last_shown = 'SKY'
    end select
  endif  
  !
end subroutine sub_read_image
!
subroutine sub_modified(atype,file,opti,nc,nochange)
  use gkernel_interfaces
  use gkernel_types
  use clean_types
  use clean_arrays
  use gbl_message
  use imager_interfaces, only : map_uvgildas, map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Check if the file of type "atype" needs to be read again.
  !---------------------------------------------------------------------
  integer, intent(in) :: atype          ! Code of type of file
  character(len=*), intent(in) :: file  ! Filename
  type(readop_t), intent(inout) :: opti ! Status of corresponding buffer
  integer, intent(in) :: nc(2)          ! Range to be read
  logical, intent(out) :: nochange      ! Change status
  !
  logical :: error
  character(len=36) :: mess, trail
  integer :: msev
  !
  nochange = .false.           ! By default
  !
  opti%modif%modif = .true.    ! In case of error
  call gag_filmodif(file,opti%modif,error)
  if (.not.opti%modif%modif) then
    if (nc(1).eq.opti%lastnc(1) .and. nc(2).eq.opti%lastnc(2)) then
      mess = 'File not modified and same range  -- '
      msev = seve%w
      nochange = .true.
    else
      mess = 'File not modified, different range - '
      msev = seve%i
    endif
  else
    opti%lastnc = nc
    return
  endif
  opti%lastnc = nc
  !
  ! The buffers may however have been manipulated in IMAGER
  if (optimize(atype)%change.gt.1) then
    nochange = .false.
    trail = ' Buffer changed -- Reloaded '
    msev = seve%i
  else if (optimize(atype)%change.eq.1 .and. nochange) then
    !
    ! Is there a buffer to be Reset
    if (atype.eq.code_save_uv) then
      call uv_reset_buffer('READ')
      call map_uvgildas('UV',huv,error,duvi) 
    endif
    optimize(atype)%change = 0
    trail = ' Reset from Buffer'
  else if (nochange) then
    trail = ' not reloaded '
  else
    trail = ' reloaded '
  endif
  !
  call map_message(msev,'READ',mess//trail)
  ! RW_Optimize is an integer, so that we may distinguish
  !    optimization based on "atype"
  ! 0 means No Read / Write optimization
  if (rw_optimize.eq.0 .and. nochange) then
    call map_message(seve%w,'READ','Reading enforced by user')
    nochange = .false.
  endif
  !
end subroutine sub_modified
!
subroutine map_read (head,fd,is_fits,out,nc,compact,error,count)
  use gkernel_interfaces
  use imager_interfaces, except_this=>map_read
  use clean_def
  use clean_arrays
  use clean_types
  use clean_beams
  use clean_default
  use uvfit_data
  use gbl_message
  !------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !  Read some type of input data.
  !------------------------------------------------------------------
  type (gildas), intent(inout) :: head    ! Header of input data
  type(gfits_hdesc_t), intent(in) :: fd   ! FITS descriptor 
  logical, intent(in) :: is_fits          ! Input FITS file
  character(len=*), intent(in) :: out     ! Desired data
  integer, intent(in) :: nc(2)            ! Channel range
  logical, intent(in) :: compact          ! Put in ACA space ?
  logical, intent(out) :: error
  integer, intent(in), optional :: count
  !
  type (gildas) :: htmp
  character(len=80) chain
  integer i, ier, nchan, local_nc(2), blc, pcount
  character(len=4) :: rname = 'READ'
  integer, parameter :: o_trail=5
  logical :: subset
  !
  real, allocatable :: tmp_data(:,:)
  integer :: ram_need
  character(len=132) :: mess
  !
  error = .false.
  pcount = 0
  if (present(count)) pcount = count
  !
  if (.not.compact) then
    !
    ! First, verify that the data set matches the required format
    select case(out)
    case ('UV_DATA','MODEL','CGAINS') 
      !
      if (head%char%type(1:9).ne.'GILDAS_UV') then
        call map_message(seve%e,'READ','Input file is not a UV data set')
        error = .true.
      endif
    case ('CCT')
      if (head%char%code(3).ne.'COMPONENT') then
        call map_message(seve%e,rname,trim(head%file)//' is not a CCT Table')
        error = .true.
      endif      
!    case ('CGAINS','AGAINS')
    
    case ('SINGLEDISH')
      if (abs(head%gil%type_gdf).eq.code_gdf_uvt) then
        call map_message(seve%e,rname,trim(head%file)//' is not a SINGLE DISH data set')
        error = .true.
      endif     
    case ('DATA')
      if (head%gil%type_gdf.ne.code_gdf_image) then
        call map_message(seve%e,'READ','Input file is not an hypercube')
        error = .true.
      endif  
      if (head%char%code(3).eq.'COMPONENT') then
        call map_message(seve%e,rname,trim(head%file)//' is not a hypercube, but a CCT Table')
        error = .true.
      endif      
    case default
      if (head%gil%type_gdf.ne.code_gdf_image) then
        call map_message(seve%e,'READ','Input file is not an hypercube')
        error = .true.
      endif          
    end select
    if (error) return
    !
    select case (out)
    case ('BEAM')
      ! Beam is a 4-D array of dimension Nx Ny Np Nb
      ! where Nb is the number of "beam frequencies"
      ! and Np the number of pointing centers
      call gdf_copy_header(head, hbeam, error)
      hbeam%loca = head%loca
      save_data(code_save_beam) = .false.
      call sic_delvariable ('BEAM',.false.,error)
      if (allocated(dbeam)) deallocate(dbeam,stat=ier)
      hbeam%gil%dim(3) = max(1,hbeam%gil%dim(3))
      hbeam%gil%dim(4) = max(1,hbeam%gil%dim(4))
      allocate(dbeam(hbeam%gil%dim(1),hbeam%gil%dim(2),   &
       &        hbeam%gil%dim(3),hbeam%gil%dim(4)),stat=ier)
      call map_read_data(fd,is_fits,hbeam,dbeam,error)
      if (error) return
      !
      ! One should check here the beam order:
      ! input beams can also be
      !   Nx Ny Nb
      ! or
      !   NX Ny Np
      ! depending on GILDAS  version used for creation
      call sic_mapgildas('BEAM',hbeam,error,dbeam)
      ! Special case for UV data
    case ('UV_DATA')
      !
      if (head%char%type(1:9).ne.'GILDAS_UV') then
        call map_message(seve%e,'READ','Input file is not a UV data set')
        error = .true.
        return
      endif
      !
      ! Free the previous zone
      call uv_free_buffers
      save_data(code_save_uv) = .false.
      ! No UV_PREVIEW done, then...
      call sic_delvariable('PREVIEW',.false.,error)
      error = .false.
      !
      call gildas_null (huv, type= 'UVT')
      call gildas_null (htmp, type= 'UVT')
      call gdf_copy_header(head, htmp, error)
      ! Check appropriate order
      if (htmp%char%code(1).eq."RANDOM") then
        call map_message(seve%w,rname,'UV data is transposed')
        call gdf_transpose_header (htmp, huv, '21', error)
        subset = .true.
      else
        call gdf_copy_header(htmp, huv, error)
        subset = .false.
      endif
      if (error)  return
      htmp%loca = head%loca
      huv%loca = head%loca   ! Why : to get the image slot !...
      !
      call sic_delvariable ('UV',.false.,error)
      call sic_delvariable ('UVS',.false.,error)
      call sic_delvariable ('DCHANFLAG',.false.,error)
      !
      ! Extract desired channels
      nchan = huv%gil%nchan
      local_nc = nc
      ier = gdf_range (local_nc, nchan)
      nchan = local_nc(2)-local_nc(1)+1
      huv%gil%ref(1) = huv%gil%ref(1)-local_nc(1)+1
      huv%gil%dim(1) = huv%gil%nlead+huv%gil%natom*huv%gil%nstokes*nchan
      if (huv%gil%ntrail.gt.0) then
        if (sic_present(o_trail,0)) then    ! /NOTRAIL option
          do i=1,code_uvt_last
            if (huv%gil%column_pointer(i).gt.huv%gil%dim(1)) then
              call map_message(seve%w,rname,'Found column '//uv_column_name(i))
              huv%gil%column_size(i) = 0
              huv%gil%column_pointer(i) = 0
            endif
          enddo
          huv%gil%ntrail = 0
        endif
        ! use them according to user selection
        huv%gil%dim(1) = huv%gil%dim(1) + huv%gil%ntrail
      endif
      huv%gil%nchan = nchan
      !
      ! Set the Channel Flags to 1 (good)
      allocate(dchanflag(nchan),stat=ier)
      dchanflag = 1
      call sic_def_inte('DCHANFLAG',dchanflag,1,nchan,.false.,error)
      !
      call sic_get_inte('SIC%RAMSIZE',sys_ramsize,error)
      ram_need = (huv%gil%dim(1)*huv%gil%dim(2))/(512*512)   ! Size of RAM requested
      if (ram_need.gt.sys_ramsize) then
        write(mess,'(A,F8.1,A,F8.1,A)') 'Data size (',1d-3*ram_need, &
          & 'GB) exceeds available RAM (',1d-3*sys_ramsize,' GB)'
        call map_message(seve%e,rname,mess,1)
        error = .true.
        return
      else if (ram_need.gt.sys_ramsize/3) then
        write(mess,'(A,F8.1,A,F8.1,A)') 'Data size (',1d-3*ram_need, &
          & 'GB) exceeds 1/3rd  of available RAM (',1d-3*sys_ramsize,' GB)'
        call map_message(seve%w,rname,mess,3)
      endif
      !
      allocate(duvi(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
      call map_read_uvdataset(fd,is_fits,pcount,htmp,huv,local_nc,duvi,error)
      if (error) then
        deallocate(duvi,stat=ier)
        return
      endif
      ! Erase undefined part of visibility data
      if (huv%gil%nvisi.lt.huv%gil%dim(2)) then
        duvi(:,huv%gil%nvisi+1:huv%gil%dim(2)) = 0.
      endif
      !
      huv%r2d => duvi
      call get_more_header(is_fits,head%file,huv)
      !
      ! Check the type and number of fields
      call check_uvdata_type(huv,duvi,themap,error)
      if (error) return
      !
      ! Finalize
      duv => duvi              ! Point on original data
      duvr => duvi             ! Point on original data
      !
      call map_uvgildas('UV',huv,error,duvi) 
      call gildas_null (huvi, type = 'UVT')
      call gdf_copy_header(huv,huvi, error)
      !
      do_weig = .true.
      !
      ! Unload the PRIMARY array if defined
      call sic_delvariable ('PRIMARY',.false.,error)
      if (allocated(dprim)) deallocate(dprim,stat=ier)
      hprim%loca%size = 0
      !
      ! Delete the BEAM_RANGES array if any
      nbeam_ranges = -1    ! Beam ranges unchecked
      call sic_delvariable ('BEAM_RANGES',.false.,error)
      !
      ! Delete the SELF array if defined
      call sic_delvariable ('UVSELF',.false.,error)
      if (allocated(duvself)) deallocate(duvself,stat=ier)
      hself%loca%size = 0
      ! Delete the CONTINUUM array if defined
      call sic_delvariable ('UVCONT',.false.,error)
      if (allocated(duvc)) deallocate(duvc,stat=ier)
      huvc%loca%size = 0
      ! Delete the CONTINUUM image if defined
      call sic_delvariable ('CONTINUUM',.false.,error)
      if (allocated(dcont)) deallocate(dcont,stat=ier)
      hcont%loca%size = 0
      !
      ! Final warning for POLARIZATION
      if (huv%gil%nstokes.gt.1) then
        write(mess,'(A,I0,A)') 'UV data has ',huv%gil%nstokes,' polarization states, use STOKES command'
        call map_message(seve%w,rname,mess,3)
      endif
    case ('MODEL')
      !
      if (head%char%type(1:9).ne.'GILDAS_UV') then
        call map_message(seve%e,'READ','Input file is not a UV data set')
        error = .true.
        return
      endif
      !
      uv_model_updated = .true.
      !
      ! Free the previous zone
      call sic_delvariable ('UV_MODEL',.false.,error)
      if (allocated(duvm)) then
        deallocate(duvm,stat=ier)
        huvm%loca%size = 0
      endif
      !
      call gildas_null (huvm, type= 'UVT')
      call gildas_null (htmp, type= 'UVT')
      call gdf_copy_header(head, htmp, error)
      ! Check appropriate order
      if (htmp%char%code(1).eq."RANDOM") then
        call map_message(seve%w,rname,'UV data is transposed')
        call gdf_transpose_header (htmp, huvm, '21', error)
      else
        call gdf_copy_header(htmp, huvm, error)
      endif
      if (error)  return
      htmp%loca = head%loca
      huvm%loca = head%loca   ! Why ?  See above !
      !
      ! Extract desired channels
      nchan = huvm%gil%nchan
      local_nc = nc
      ier = gdf_range (local_nc, nchan)
      nchan = local_nc(2)-local_nc(1)+1
      huvm%gil%ref(1) = huvm%gil%ref(1)-local_nc(1)+1
      huvm%gil%dim(1) = huvm%gil%nlead+huvm%gil%natom*nchan
      allocate(duvm(huvm%gil%dim(1),huvm%gil%dim(2)),stat=ier)
      call gdf_read_uvdataset(htmp,huvm,local_nc,duvm,error)
      if (error) return
      !
      huvm%loca%size = huvm%gil%dim(1)*huvm%gil%dim(2)
      call sic_mapgildas('UV_MODEL',huvm,error,duvm)
      !
    case ('CGAINS')
      !
      ! Free the previous zone
      call sic_delvariable ('CGAINS',.false.,error)
      if (allocated(duvbg)) then
        deallocate(duvbg,stat=ier)
      endif
      !
      call gildas_null (hbgain, type= 'UVT')
      call gildas_null (htmp, type= 'UVT')
      call gdf_copy_header(head, htmp, error)
      ! Check appropriate order
      if (htmp%char%code(1).eq."RANDOM") then
        call map_message(seve%w,rname,'Gain data is transposed')
        call gdf_transpose_header (htmp, hbgain, '21', error)
      else
        call gdf_copy_header(htmp, hbgain, error)
      endif
      if (error)  return
      htmp%loca = head%loca
      hbgain%loca = head%loca   ! Why ? See above !
      !
      ! Extract 1 channel
      local_nc = 1
      nchan = 1
      hbgain%gil%ref(1) = hbgain%gil%ref(1)-local_nc(1)+1
      hbgain%gil%dim(1) = hbgain%gil%nlead+hbgain%gil%natom*nchan
      hbgain%gil%nchan = 1
      ! Trim trailing column
      if (hbgain%gil%ntrail.gt.0) then
        do i=1,code_uvt_last
          if (hbgain%gil%column_pointer(i).gt.hbgain%gil%dim(1)) then
            call map_message(seve%w,rname,'Found column '//uv_column_name(i))
            hbgain%gil%column_size(i) = 0
            hbgain%gil%column_pointer(i) = 0
          endif
        enddo
        hbgain%gil%ntrail = 0
      endif
      !
      allocate(duvbg(hbgain%gil%dim(1),hbgain%gil%dim(2)),stat=ier)
      call gdf_read_uvdataset(htmp,hbgain,local_nc,duvbg,error)
      if (error) return
      !
      hbgain%loca%size = hbgain%gil%dim(1)*hbgain%gil%dim(2)
      call sic_mapgildas ('CGAINS',hbgain,error,duvbg)
      !
    case ('DATA')
      !
      call sic_delvariable ('DATA',.false.,error)
      if (allocated(dview)) deallocate(dview,stat=ier)
      !
      ! Specify the subset
      error = map_range(nc,head,hview)
      if (error) return
      allocate(dview(hview%gil%dim(1),hview%gil%dim(2),   &
       &        hview%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,head,dview,error)
      if (error) return
      call get_more_header(is_fits,head%file,hview)
      call sic_mapgildas ('DATA',hview,error,dview)
      !
    case ('DIRTY')
      save_data(code_save_dirty) = .false.
      call sic_delvariable ('DIRTY',.false.,error)
      if (allocated(ddirty)) deallocate(ddirty,stat=ier)
      !
      ! Specify the subset
      error = map_range(nc,head,hdirty)
      if (error) return
      !
      allocate(ddirty(hdirty%gil%dim(1),hdirty%gil%dim(2),   &
       &        hdirty%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,head,ddirty,error)
      if (error) return
      !
      call get_more_header(is_fits,head%file,hdirty)
      call sic_mapgildas('DIRTY',hdirty,error,ddirty)
      user_method%do_mask = .true.
      !
      ! Define Min Max
      d_max = hdirty%gil%rmax
      if (hdirty%gil%rmin.eq.0) then
        d_min = -0.03*hdirty%gil%rmax
      else
        d_min = hdirty%gil%rmin
      endif
      !
    case ('RESIDUAL')
      save_data(code_save_resid) = .false.
      call sic_delvariable ('RESIDUAL',.false.,error)
      if (allocated(dresid)) deallocate(dresid,stat=ier)
      ! Specify the subset
      error = map_range(nc,head,hresid)
      if (error) return
      allocate(dresid(hresid%gil%dim(1),hresid%gil%dim(2),   &
       &        hresid%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,head,dresid,error)
      if (error) return
      call get_more_header(is_fits,head%file,hdirty)
      call sic_mapgildas('RESIDUAL',hresid,error,dresid)
      user_method%do_mask = .true.
      !
    case ('CLEAN')
      save_data(code_save_clean) = .false.
      call sic_delvariable ('CLEAN',.false.,error)
      if (allocated(dclean)) deallocate(dclean,stat=ier)
      !
      ! Specify the subset
      error = map_range(nc,head,hclean)
      if (error) return
      allocate(dclean(hclean%gil%dim(1),hclean%gil%dim(2),   &
       &        hclean%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,head,dclean,error)
      if (error) return
      call get_more_header(is_fits,head%file,hclean)
      call sic_mapgildas ('CLEAN',hclean,error,dclean)
      !
    case ('SKY')
      save_data(code_save_sky) = .false.
      call sic_delvariable ('SKY',.false.,error)
      if (allocated(dsky)) deallocate(dsky,stat=ier)
      ! Specify the subset
      error = map_range(nc,head,hsky)
      if (error) return
      allocate(dsky(hsky%gil%dim(1),hsky%gil%dim(2),   &
       &        hsky%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,head,dsky,error)
      if (error) return
      call get_more_header(is_fits,head%file,hsky)
      call sic_mapgildas ('SKY',hsky,error,dsky)
      !
    case ('MASK')
      save_data(code_save_mask) = .false.
      call sic_delvariable ('MASK',.false.,error)
      if (allocated(dmask)) deallocate(dmask,stat=ier)
      ! Specify the subset
      error = map_range(nc,head,hmask)
      if (error) return
      allocate(dmask(hmask%gil%dim(1),hmask%gil%dim(2),hmask%gil%dim(3)),   &
       &        stat=ier)
      call map_read_data(fd,is_fits,head,dmask,error) 
      if (error) return
      call sic_mapgildas ('MASK',hmask,error,dmask)
      user_method%do_mask = .true.
      !
    case ('PRIMARY')
      !
      ! Primary is a 4-D array of dimension Np Nx Ny Nb
      ! where Nb is the number of "beam frequencies"
      ! and Np the number of pointing centers
      !
      ! /RANGE option not effective here
      !
      call gdf_copy_header(head, hprim, error)
      hprim%loca = head%loca
      save_data(code_save_primary) = .false.
      call sic_delvariable ('PRIMARY',.false.,error)
      if (allocated(dprim)) deallocate(dprim,stat=ier)
      hprim%gil%dim(4) = max(1,hprim%gil%dim(4))
      allocate(dprim(hprim%gil%dim(1),hprim%gil%dim(2),   &
       &        hprim%gil%dim(3),hprim%gil%dim(4)),stat=ier)
      call map_read_data(fd,is_fits,hprim,dprim,error)
      if (error) return
      call get_more_header(is_fits,head%file,hprim)
      call sic_mapgildas('PRIMARY',hprim,error,dprim)
      !
      ! Old GILDAS primary beams had only one Frequency channel
      !
      ! Switch to mosaic mode only if more than 1 field
      if (hprim%gil%dim(1).le.1) return
      !
      user_method%trunca = hprim%gil%inc(1)  ! Truncation of beam
      user_method%search = user_method%trunca
      user_method%restor = user_method%trunca
      call map_message(seve%i,rname,'Primary Beam read, setting MOSAIC')
      call sub_mosaic('ON',error)
      if (error) return
    case ('CCT')
      call gdf_copy_header(head, hcct, error)
      hcct%loca = head%loca
      save_data(code_save_cct) = .false.
      call sic_delvariable ('CCT',.false.,error)
      if (allocated(dcct)) deallocate(dcct,stat=ier)
      ! Specify the subset
      error = map_range(nc,head,hcct)
      if (error) return
      allocate(dcct(hcct%gil%dim(1),hcct%gil%dim(2),   &
       &        hcct%gil%dim(3)),stat=ier)
      call gdf_read_data(head,dcct,error)
      if (error) return
      call sic_mapgildas ('CCT',hcct,error,dcct)
      !
    case ('SINGLEDISH')
      save_data(code_save_single) = .false.
      call sic_delvariable ('SINGLE',.false.,error)
      call sic_delvariable ('SHORT',.false.,error)
      if (associated(hshort%r3d,dsingle)) then
        nullify(hshort%r3d)
      else if (associated(hshort%r3d)) then
        deallocate(hshort%r3d,stat=ier)
      endif
      if (allocated(dsingle)) deallocate(dsingle,stat=ier)
      !
      ! Find out what type of data it is
      if (head%gil%xaxi*head%gil%yaxi.eq.2) then
        call map_message(seve%i,rname,'Reading a 3-D data cube')
        ! This is an image
        if (head%gil%ndim.eq.2) then
          ! Extend 2-D images as a data cube
          head%gil%ndim = 3
          head%gil%dim(3) = 1
        endif
      else
        ! This must be a Class Table
        if (head%gil%ndim.ne.2) then
          call map_message(seve%e,rname,'Unrecognized SINGLEDISH data')
          error = .true.
          return
        endif
        call map_message(seve%i,rname,'Reading a CLASS table')
      endif
      ! Hereafter ndim=2 will say it is a Table
      !  
      ! Specify the subset if possible
      if (head%gil%ndim.eq.2) then        
        error = tab_range(nc,head,hsingle,subset)
        if (error) return
        hsingle%gil%dim(3) = 1
      else if (head%gil%ndim.eq.3) then        
        error = map_range(nc,head,hsingle)
        if (error) return
      else
        call map_message(seve%e,rname,'SINGLEDISH data must have rank 2 or 3')
        error = .true.
        return
      endif
      !
      allocate(dsingle(hsingle%gil%dim(1),hsingle%gil%dim(2),   &
       &        hsingle%gil%dim(3)),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'SINGLEDISH data allocation error')
        error = .true.
        return
      endif
      !      
      if (hsingle%gil%ndim.eq.2) then     
        ! The section to be read is not-contiguous...
        ! Read the smallest contiguous section for simplicity,
        ! i.e. up to the last selected channel
        allocate(tmp_data(head%trc(1),head%gil%dim(2)),stat=ier)
        if (ier.ne.0) then
          call map_message(seve%e,rname,'SINGLEDISH temporary data allocation error')
          error = .true.
          return
        endif
        blc = head%blc(1)
        head%blc(1) = 1
        call map_read_data(fd,is_fits,head,tmp_data,error)
        !
        ! Put in place
        dsingle(1:3,:,1) = tmp_data(1:3,:)  ! Extra columns
        dsingle(4:,:,1) = tmp_data(blc:,:)  ! Real data
        deallocate(tmp_data)
      else
!!        call gdf_read_data(head,dsingle,error)
        call map_read_data(fd,is_fits,head,dsingle,error)
      endif
      if (error) return
      !
      call get_more_header(is_fits,head%file,hsingle)
      call sic_mapgildas('SINGLE',hsingle,error,dsingle)
!!      if (hsingle%gil%ndim.eq.3) then     
!!        call gildas_null(hshort)
!!        call gdf_copy_header(hsingle,hshort,error)
!!        call sic_mapgildas('SHORT',hshort,error,dsingle)
!!        hshort%r3d => dsingle
!!      endif
    case ('UV_FIT')
!      save_data(code_save_mask) = .false.
      call sic_delvariable ('UV_FIT',.false.,error)
      if (allocated(duvfit)) deallocate(duvfit,stat=ier)
      ! Specify the subset
      error = map_range(nc,head,huvfit)
      if (error) return
      allocate(duvfit(huvfit%gil%dim(1),huvfit%gil%dim(2)), & 
       &        stat=ier)
      call gdf_read_data(head,duvfit,error) 
      if (error) return
      call sic_mapgildas ('UV_FIT',huvfit,error,duvfit)
      !
    case ('CONTINUUM')
      call gdf_trim_header(head,2,error)
      if (error) return
      !
      save_data(code_save_cont) = .false.
      call sic_delvariable ('CONTINUUM',.false.,error)
      if (allocated(dcont)) deallocate(dcont,stat=ier)
      ! No subsect allowed
      call gdf_copy_header(head, hcont, error)
      allocate(dcont(hcont%gil%dim(1),hcont%gil%dim(2)),   &
       &        stat=ier)
      call map_read_data(fd,is_fits,head,dcont,error)
      if (error) return
      call sic_mapgildas ('CONTINUUM',hcont,error,dcont)
      !
    case default
      chain = 'Unsupported operation '//out
      call map_message(seve%e,rname,chain)
      error = .true.
    end select
    !
    ! Compact Array data
  else
    ! 4-D not yet done...
    !
    select case (out)
    case ('BEAM')
      call gdf_copy_header(head, c_hbeam, error)
      c_hbeam%loca = head%loca
      save_data(code_save_beam) = .false.
      call sic_delvariable ('C_BEAM',.false.,error)
      if (allocated(c_dbeam)) deallocate(c_dbeam,stat=ier)
      allocate(c_dbeam(c_hbeam%gil%dim(1),c_hbeam%gil%dim(2),   &
           &        c_hbeam%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,c_hbeam,c_dbeam,error)
      if (error) return
      c_hbeam%gil%dim(3) = max(1,c_hbeam%gil%dim(3))
      call sic_def_real ('C_BEAM',c_dbeam,c_hbeam%gil%ndim,   &
           &        c_hbeam%gil%dim,.true.,error)
    case ('DIRTY')
      call gdf_copy_header(head, c_hdirty, error)
      c_hdirty%loca = head%loca
      save_data(code_save_dirty) = .false.
      call sic_delvariable ('C_DIRTY',.false.,error)
      if (allocated(c_ddirty)) deallocate(c_ddirty,stat=ier)
      allocate(c_ddirty(c_hdirty%gil%dim(1),c_hdirty%gil%dim(2),   &
           &        c_hdirty%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,c_hdirty,c_ddirty,error)
      if (error) return
      call sic_def_real ('C_DIRTY',c_ddirty,c_hdirty%gil%ndim,   &
           &        c_hdirty%gil%dim,.true.,error)
      cuse_method%do_mask = .true.
      !
    case ('RESIDUAL')
      call gdf_copy_header(head, c_hresid, error)
      c_hresid%loca = head%loca
      save_data(code_save_resid) = .false.
      call sic_delvariable ('C_RESIDUAL',.false.,error)
      if (allocated(c_dresid)) deallocate(c_dresid,stat=ier)
      allocate(c_dresid(c_hresid%gil%dim(1),c_hresid%gil%dim(2),   &
           &        c_hresid%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,c_hresid,c_dresid,error)
      if (error) return
      call sic_def_real ('C_RESIDUAL',c_dresid,c_hresid%gil%ndim,   &
           &        c_hresid%gil%dim,.true.,error)
      cuse_method%do_mask = .true.
      !
    case ('PRIMARY')
      call gdf_copy_header(head, c_hprim, error)
      c_hprim%loca = head%loca
      call sic_delvariable ('C_PRIMARY',.false.,error)
      if (allocated(c_dprim)) deallocate(c_dprim,stat=ier)
      allocate(c_dprim(c_hprim%gil%dim(1),c_hprim%gil%dim(2),   &
           &        c_hprim%gil%dim(3)),stat=ier)
      call map_read_data(fd,is_fits,c_hprim,c_dprim,error)
      if (error) return
      call sic_def_real ('C_PRIMARY',c_dprim,c_hprim%gil%ndim,   &
           &        c_hprim%gil%dim,.true.,error)
      !
      ! Switch to mosaic mode
      cuse_method%trunca = c_hprim%gil%inc(1)  ! Truncation of beam
      cuse_method%search = cuse_method%trunca
      cuse_method%mosaic = .true.
    case default
      chain = 'Unsupported operation '//out
      call map_message(seve%e,rname,chain)
      error = .true.
    end select
  endif
end subroutine map_read
!
function map_range (nc,hin,hou)
  use image_def
  use imager_interfaces, only : map_message
  use gkernel_interfaces, only : gdf_range
  use gbl_message
  !---------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Define channel range and set output Map header
  ! accordingly.
  !---------------------------------------------------
  logical :: map_range ! intent(out)
  integer, intent(in) :: nc(2)         ! Input channel range
  type (gildas), intent(inout) :: hin     ! Input header
  type (gildas), intent(inout) :: hou     ! Output header
  !
  integer :: local_nc(2), hdim, faxi, rank
  !
  map_range = .false.
  !
  ! Trim header to 3
  rank = 3
  call gdf_trim_header(hin,rank,map_range)
  if (map_range) return
  !
  ! Copy header
  call gdf_copy_header(hin, hou, map_range)
  if (map_range) return
  hou%loca = hin%loca
  !
  ! Verif Frequency axsi
  faxi = hin%gil%faxi
  !
  if (faxi.eq.0) then
    ! NO Frequency axis -- map_range must called with default value
    local_nc = abs(nc)
    map_range = (local_nc(1).lt.1).or.(local_nc(2).gt.hin%gil%dim(3))
    if (map_range) then
      call map_message(seve%e,'READ','invalid /RANGE option arguments')
      return
    endif
    faxi = 3
  else
    !
    ! Frequency axis: Find out the actual range
    if (nc(2).lt.0) then
      faxi = 3
      local_nc = -nc
    else
      local_nc = nc
    endif
    map_range = gdf_range(local_nc,hin%gil%dim(faxi)).ne.0
    if (map_range) return
  endif
  !
  hdim = local_nc(2) - local_nc(1) + 1
  !
  ! Set the input header subset range
  hin%blc(faxi) = local_nc(1)
  hin%trc(faxi) = local_nc(2)
  !
  ! Set the output header reference channel and number of channels
  hou%gil%ref(faxi) = hou%gil%ref(faxi)+1-max(hin%blc(faxi),1)
  hou%gil%dim(faxi) = hdim
  !
  ! Correct the data size
  hou%loca%size = hin%loca%size*hou%gil%dim(faxi)/hin%gil%dim(faxi)
end function map_range
!
subroutine out_range(rname,atype,drange,nc,head,error)
  use image_def
  use gbl_message
  use gkernel_interfaces
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Utility routine to define a channel range from a
  !   Velocity, Frequency or Channel range
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname  ! Caller name
  character(len=*), intent(in) :: atype  ! Type of range
  real(8), intent(in) :: drange(2)     ! Input range
  integer, intent(out) :: nc(2)          ! Ouput channel number
  type(gildas), intent(in) :: head       ! Reference GILDAS data frame
  logical, intent(out) :: error          ! Error flag
  !
  real(8) :: frange(2)
  integer :: itype, nn, ier, nchan
  character(len=80) :: chain
  integer(kind=4), parameter :: mtype=4
  character(len=12) :: types(mtype),mytype,ctype
  data types /'CHANNEL','VELOCITY','FREQUENCY','NONE'/
  !
  ctype = atype
  call sic_upper(ctype)
  error = .false.
  call sic_ambigs(rname,ctype,mytype,itype,types,mtype,error)
  if (error)  return
  !
  if (abs(head%gil%type_gdf).eq.code_gdf_uvt) then
    nchan = head%gil%nchan
  else if (mytype.ne.'NONE') then
    if (head%gil%faxi.ne.0) then
      nchan = head%gil%dim(head%gil%faxi)
    else if (head%gil%ndim.eq.2) then
      call map_message(seve%w,rname,'Dataset is 2-D only') 
      nchan = 1
    else if (mytype.ne.'CHANNEL') then
      call map_message(seve%e,rname, &
        & 'No Frequency axis, /RANGE option ignored.')
      error = .true.
      return
    else
      nchan = head%gil%dim(3)
    endif
  else 
    nchan = max(1,head%gil%dim(3))
  endif
  !
  if (mytype.eq.'CHANNEL') then
    nc = nint(drange)
  else if (mytype.eq.'VELOCITY') then
    if ( abs(head%gil%type_gdf).eq.abs(code_gdf_uvt) ) then
      ! UV data case
      frange = (drange - head%gil%voff) / head%gil%vres + head%gil%ref(head%gil%faxi)
    else if  (head%gil%faxi.eq.0) then  !
      call map_message(seve%e,rname,'No Velocity/Frequency Axis')
      error = .true.
      return
    else if (head%char%code(head%gil%faxi).eq.'FREQUENCY') then
      frange = -(drange-head%gil%voff)*head%gil%freq/299792.458d0+head%gil%freq
      frange = (frange - head%gil%val(head%gil%faxi)) / head%gil%fres + head%gil%ref(head%gil%faxi)
    else if (head%char%code(head%gil%faxi).eq.'VELOCITY') then
      frange = (drange - head%gil%voff) / head%gil%vres + head%gil%ref(head%gil%faxi)
    else
      call map_message(seve%e,rname,'Axis type '//head%char%code(head%gil%faxi)//' not supported')
      error = .true.
      return
    endif
    !
    nc = nint(frange)
    if (nc(1).gt.nc(2)) then
      nn = nc(2)
      nc(2) = nc(1)
      nc(1) = nn
    endif
    if (nc(1).gt.nchan .or. nc(2).lt.1) then
      write(chain,'(A,I0,A,I0,A,I0,A)') 'Channel Range [',nc(1),',',nc(2),'] out of bounds [1,',nchan,']'
      call map_message(seve%e,rname,chain)
      error = .true.
      return
    else
      write(chain,'(A,I0,A,I0,A)') 'Selecting Channel Range [',nc(1),',',nc(2),']'
      call map_message(seve%i,rname,chain)
    endif
    nc = max(1,min(nc,nchan))
  else if (mytype.eq.'FREQUENCY') then
    ! The current code is only valid for UV Tables.
    ! See as above for the VELOCITY case
    ! drange = nc - head%gil%ref(head%gil%faxi) ) * head%gil%vres + head%gil%voff
    if ( abs(head%gil%type_gdf).eq.abs(code_gdf_uvt) ) then
      ! UV data case is always the same...
      frange = (drange - head%gil%freq) / head%gil%fres + head%gil%ref(head%gil%faxi)
    else if (head%gil%faxi.eq.0) then  !
      call map_message(seve%e,rname,'No Velocity/Frequency Axis')
      error = .true.
      return
    else if (head%char%code(head%gil%faxi).eq.'FREQUENCY') then
      frange = (drange - head%gil%val(head%gil%faxi)) / head%gil%fres + head%gil%ref(head%gil%faxi)
    else if (head%char%code(head%gil%faxi).eq.'VELOCITY') then
      frange = -(drange-head%gil%freq)/head%gil%freq*299792.458d0 + head%gil%voff
      frange = (frange - head%gil%val(head%gil%faxi)) / head%gil%vres + head%gil%ref(head%gil%faxi)
    else
      call map_message(seve%e,rname,'Axis type '//head%char%code(head%gil%faxi)//' not supported')
      error = .true.
      return
    endif
    !
    nc = nint(frange)
    if (nc(1).gt.nc(2)) then
      nn = nc(2)
      nc(2) = nc(1)
      nc(1) = nn
    endif
    if (nc(1).gt.nchan .or. nc(2).lt.1) then
      write(chain,'(A,I8,A,I8,A,I8,A)') 'Range [',nc(1),',',nc(2),'] out of bounds [1,',nchan,']'
      call map_message(seve%e,rname,chain)
      error = .true.
      return
    endif
    nc = max(1,min(nc,nchan))
  else if (mytype.eq.'NONE') then
    nc = nint(drange)
  else
    call map_message(seve%f,rname,"Type of value '"//trim(mytype)//"' not supported")
    error = .true.
    return
  endif
  !
  ier = gdf_range (nc, nchan)
  if (abs(head%gil%type_gdf).eq.code_gdf_uvt) then
    continue
  else
    if (mytype.eq.'NONE') nc = -nc  ! Negative value special code
  endif
  if (ier.ne.0) error = .true.
  !
end subroutine out_range
!
subroutine check_uvdata_type(huv,duv,map,error)
  use image_def
  use clean_def
  use gbl_message
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, only : mosaic_getfields, map_message,  &
    & get_bsize, define_fields
  !-------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !     Internal routine
  ! Check number and types of fields
  !-------------------------------------------------------
  type(gildas), intent(inout) :: huv
  real, intent(inout) :: duv(:,:)
  type(uvmap_par), intent(inout) :: map
  logical, intent(inout) :: error
  !
  type(projection_t) :: uv_proj
  integer :: np, nv
  integer :: loff, moff, xoff, yoff, lid, nf, i, ier
  character(len=12) :: chain
  real :: value
  !
  map%nfields = 0
  call sic_delvariable('FIELDS',.false.,error)
  error = .false.
  huv%loca%size = huv%gil%dim(1)*huv%gil%dim(2)
  if (huv%gil%ntrail.eq.0) return
  !
  np = huv%gil%dim(1)
  nv = huv%gil%nvisi
  !
  loff = huv%gil%column_pointer(code_uvt_loff)
  moff = huv%gil%column_pointer(code_uvt_moff)
  !
  xoff = huv%gil%column_pointer(code_uvt_xoff)
  yoff = huv%gil%column_pointer(code_uvt_yoff)
  !
  lid  = huv%gil%column_pointer(code_uvt_id)
  !
  if (lid.ne.0 .and. (loff.eq.0.or.moff.eq.0)) then
    value = duv(lid,1)
    if (any(duv(lid,:).ne.value)) then 
      nf = maxval(duv(lid,:))
      write(chain,'(I12)') nf
      call map_message(seve%e,'READ','Mosaic of '//adjustl(trim(chain))//' fields with only Source ID column')
      call map_message(seve%i,'READ','Use command UV_FIELDS to specify field coordinates')
      huv%loca%size = 0 ! Set UV as undefined
      error = .true.
      return
    else
      map%nfields = 0
      call map_message(seve%w,'READ','Degenerate mosaic of 1 field with Source ID column')
    endif    
  else if (loff.ne.0 .or. moff.ne.0) then
    call mosaic_getfields (duv,np,nv,loff,moff,nf,map%offxy)
    if (nf.gt.1) then
      map%nfields = -nf
      write(chain,'(I12)') nf
      call map_message(seve%i,'READ','Raw mosaic of '//adjustl(trim(chain))//' fields')
    else
      map%nfields = 0
      call map_message(seve%w,'READ','Degenerate raw mosaic of 1 field')
    endif
  else if (xoff.ne.0 .or. yoff.ne.0) then
    call mosaic_getfields (duv,np,nv,xoff,yoff,nf,map%offxy)
    if (nf.gt.1) then
      map%nfields = nf
      write(chain,'(I12)') nf
      call map_message(seve%i,'READ','Phase shifted mosaic of '//adjustl(trim(chain))//' fields')
    else
      map%nfields = 0
      call map_message(seve%w,'READ','Degenerate phase shifted mosaic of 1 field')
    endif
  endif
  !
  if (map%nfields.eq.0) return
  !
  ! Convention for Rotated UV data is still pending for Mosaics
  if (huv%gil%pang.ne.0.) then
    call map_message(seve%e,'READ','Rotated UV data not yet supported for Mosaics (no convention defined by IRAM)')
    huv%loca%size = 0 ! Set UV as undefined
    error = .true.
    return
  endif
  !
  if (huv%gil%nteles.le.0) then
    call map_message(seve%w,'READ','No Telescope section in data') 
    call map_message(seve%r,'READ', &
      &   '         Use command "SPECIFY TELESCOPE Name" to add one') 
  endif
  ! 
  map%bsize = 0     ! Must be initialized
  call get_bsize(huv,'READ',' ',map%bsize,error)  ! Compute the primary beams
  !
  ! Compute the Pointing Centers
  call gwcs_projec(huv%gil%a0, huv%gil%d0, huv%gil%pang, huv%gil%ptyp, uv_proj, error)
  allocate(map%centers(2,abs(map%nfields)),stat=ier)
  !
  do i=1,abs(map%nfields)
    call rel_to_abs(uv_proj, dble(map%offxy(1,i)), dble(map%offxy(2,i)), &
      & map%centers(1,i), map%centers(2,i), 1)
  enddo
  !
  call define_fields(map,error)
end subroutine check_uvdata_type
!
subroutine define_fields(map,error)  
  use image_def
  use clean_def
  use gkernel_interfaces
  !---------------------------------------------------
  ! @ private
  !   IMAGER
  ! Define the FIELDS% structure for Mosaics
  !---------------------------------------------------
  type(uvmap_par), intent(in) :: map
  logical, intent(inout) :: error
  !
  integer(kind=index_length) :: dim(2)
  !
  call sic_defstructure('FIELDS',.true.,error)
  call sic_def_inte('FIELDS%N',map%nfields,0,dim,.false.,error)
  dim(1:2) = [2,abs(map%nfields)]
  call sic_def_real('FIELDS%OFFSETS',map%offxy,2,dim,.false.,error) 
  call sic_def_real('FIELDS%PRIMARY',map%bsize,0,dim,.false.,error)
  call sic_def_dble('FIELDS%CENTERS',map%centers,2,dim,.false.,error) 
end subroutine define_fields
!
function tab_range (nc,hin,hou,subset)
  use image_def
  use gkernel_interfaces, only : gdf_range
  !---------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !   Define channel range and set output Table header
  ! accordingly. Valid for a CLASS Table of Spectra
  !---------------------------------------------------
  logical :: tab_range ! intent(out)
  integer, intent(in) :: nc(2)         ! Input channel range
  type (gildas), intent(inout) :: hin     ! Input header
  type (gildas), intent(inout) :: hou     ! Output header
  logical, intent(out) :: subset
  !
  integer local_nc(2), hdim, faxi
  integer(kind=index_length) :: fdim
  !
  subset = .false.
  ! Copy header
  call gdf_copy_header(hin, hou, tab_range)
  if (tab_range) return
  hou%loca = hin%loca
  !
  ! Find out the actual range
  faxi = hin%gil%faxi
  local_nc = abs(nc)    ! Out_Range may return negative value as code
  fdim = hin%gil%dim(faxi)-3
  tab_range = gdf_range(local_nc,fdim).ne.0
  if (tab_range) return
  hdim = local_nc(2) - local_nc(1) + 1 + 3 ! Allow 3 additional columns
  !
  ! Set the input header subset range
  local_nc = local_nc+3                    ! Shift by the 3 columns
  hin%blc(faxi) = local_nc(1)
  hin%trc(faxi) = local_nc(2)
  !
  ! Set the output header reference channel and number of channels
  hou%gil%ref(faxi) = hou%gil%ref(faxi)+1-max(hin%blc(faxi)-3,1)
  hou%gil%dim(faxi) = hdim
  !
  ! Correct the data size
  hou%loca%size = hin%loca%size*hou%gil%dim(faxi)/hin%gil%dim(faxi)
end function tab_range
!
subroutine check_view(n,argu)
  ! @ public-mandatory
  integer, intent(in) :: n
  character(len=*), intent(in) :: argu(n)
  !
  logical :: error
  character(len=12) :: previous
  integer :: i,nn
  !
  ! Do not use commands here, only direct SIC routines
  call sic_get_char('VIEW%PREVIOUS',previous,nn,error)
  do i=1,n
    if (previous.eq.argu(i)) then    
      call sic_let_char('VIEW%PREVIOUS','outdated',error)
    endif
  enddo
end subroutine check_view
!
subroutine parse_range_opt(line,o_range,head,nc,error)
  use image_def
  use gkernel_interfaces
  use imager_interfaces, only : out_range
  !---------------------------------------------------------------------
  ! IMAGER
  !    @ private
  ! Parse the /RANGE option in a general way, once the data Header is
  ! defined.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line    ! Command line
  integer, intent(in) :: o_range          ! /RANGE option number
  type(gildas), intent(in) :: head        ! Data header
  integer, intent(inout) :: nc(2)         ! Channel range
  logical, intent(out) :: error           ! Error flag
  !
  real(8) :: drange(2)        ! Range to be read
  character(len=12) :: csort
  integer(kind=4), parameter :: msort=3
  integer :: isort, nn
  character(len=12) :: types(msort),mysort
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  error = .false.
  ! /RANGE (for flexibility)
  if (sic_present(o_range,0)) then
    call sic_r8 (line,o_range,1,drange(1),.true.,error)
    if (error) return
    call sic_r8 (line,o_range,2,drange(2),.true.,error)
    if (error) return
    call sic_ke (line,o_range,3,csort,nn,.true.,error)
    if (error) return
    error = .false.
    call sic_ambigs('READ',csort,mysort,isort,types,msort,error)
    if (error)  return
  else
    return
  endif
  !
  call out_range('READ',csort,drange,nc,head,error)
end subroutine parse_range_opt
!
!
subroutine sub_read_flux(name,error)
  use gkernel_interfaces
  use moment_arrays
  use gbl_message
  use imager_interfaces, only : map_message
  !-------------------------------------------------------
  ! @ private
  !   IMAGER
  !   Support routine for WRITE FLUX  
  !-------------------------------------------------------
  character(len=*), intent(in) :: name  ! Short file name
  logical, intent(inout) :: error       ! Error return flag
  !
  character(len=*), parameter :: rname='READ FLUX'
  type(gildas) :: htab
  integer :: ier
  logical :: err
  integer(kind=index_length) :: dim(2)
  !
  ! Delete any existing structure
  err = .false.
  call sic_delvariable('FLUX',.false.,err)
  if (allocated(flux_velo)) then
    deallocate(flux_velo,flux_freq,flux_values,stat=ier)
  endif
  flux_nc = 0
  flux_nf = 0
  !
  call gildas_null(htab)
  call sic_parse_file (name,' ','.tab',htab%file)
  call gdf_read_header(htab,error)
  if (error) return
  if (htab%gil%ndim.ne.2 .or. htab%gil%dim(2).lt.3) then
    call map_message(seve%e,rname,trim(htab%file)//' is not a Flux Table')
    err = .true.
    goto 98
  endif
  !
  flux_nc = htab%gil%dim(1) 
  flux_nf = htab%gil%dim(2) - 2 
  allocate (flux_velo(flux_nc),flux_freq(flux_nc),flux_values(flux_nc,flux_nf), &
    & htab%r2d(htab%gil%dim(1),htab%gil%dim(2)),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation error')
    err = .true.
    goto 98
  endif  
  !
  call gdf_read_data(htab,htab%r2d,err)
  if (err) goto 98
  !
  flux_velo(:) =   htab%r2d(:,1) 
  flux_freq(:) =   htab%r2d(:,2) ! Loss of precision, but tolerable in most cases.
  flux_values(:,:) =  htab%r2d(:,3:)
  !
  ! Redefine the FLUX structure
  !
  call sic_defstructure('FLUX',.true.,error)
  dim(1:2) = [flux_nc,flux_nf]
  call sic_def_real('FLUX%VALUES',flux_values,2,dim,.false.,error) 
  dim(1:2) = [flux_nc,1]
  call sic_def_real('FLUX%VELOCITIES',flux_velo,1,dim,.false.,error) 
  call sic_def_dble('FLUX%FREQUENCIES',flux_freq,1,dim,.false.,error) 
  call sic_def_inte('FLUX%NF',flux_nf,0,dim,.false.,error) 
  call sic_def_inte('FLUX%NC',flux_nc,0,dim,.false.,error) 
  !  
98  continue
  call gdf_close_image(htab,error)
  if (associated(htab%r2d)) deallocate(htab%r2d)
  error = err
end subroutine sub_read_flux
!
subroutine map_read_data(fd,isfits,head,rdata,error)
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, only : map_message
  use gbl_message
  !-------------------------------------------------------
  ! @ private
  !   IMAGER
  !   Read data in an internal buffer, from a GDF file
  !   or a FITS file, as indicated by "is_fits"
  !-------------------------------------------------------
  type(gfits_hdesc_t), intent(in) :: fd   ! FITS descriptor
  logical, intent(in) :: isfits           ! Is a FITS file ?
  type(gildas), intent(inout) :: head     ! GILDAS header
  real, intent(out) :: rdata(*)           ! Data array
  logical, intent(inout) :: error         ! Error flag
  !
  integer(kind=size_length) :: nfill,ndata,nblank
  !
  if (isfits) then
    ndata = product(head%gil%dim(1:head%gil%ndim))
    ! Make sure the FITS file is at the right position
    nfill = 0
    call gfits_flush_data(error)
    if (error) return
    !
    ! Read data - Subset will come later
    call read_allmap(fd,rdata,ndata,nfill,head%gil%bval,error)
    if (nfill.lt.ndata) call map_message(seve%w,'READ','FITS data file is incomplete')
    if (error) return
    !
    ! Patch Blanks if any
    nblank = 0
    call fitscube2gdf_patch_bval(fd,head,rdata,ndata,nblank,error)
    if (nblank.eq.0) head%gil%eval = -1.0
    ! Close FITS file now for immediate re-use
    call gfits_close(error)
    !
  else
    call gdf_read_data(head,rdata,error)
  endif
  !
  ! Set size
  head%loca%size = product(head%gil%dim(1:head%gil%ndim))
end subroutine map_read_data
!
subroutine get_more_header(isfits,file,head)
  use image_def
  use iso_c_binding
  use gkernel_interfaces
  use gbl_message
  use gkernel_types
  use imager_interfaces, only : map_message, sub_memory_fields
  !-------------------------------------------------------
  ! @ private
  !   IMAGER
  !     Update an internal Gildas Header by converting
  ! some possibly non-standard units. If the origin is
  ! a FITS file, update missing information from that found
  ! in specific FITS Table extensions.  The SIC command 
  ! DEFINE FITS is used for this purpose.
  !-------------------------------------------------------
  type(gildas), intent(inout) :: head   ! Header to be updated
  character(len=*), intent(in) :: file  ! Input file name
  logical, intent(in) :: isfits         ! Is it FITS ?
  !
  real, parameter :: pi=acos(-1.0)
  character(len=*), parameter :: rname='READ'
  real(8), parameter :: clight=299792458d0
  real(4), parameter :: rad_to_sec=180.*3600./pi
  !
  real(8), pointer :: d1ptr(:)
  type(c_ptr) :: cptr
  character(len=filename_length) :: chain
  logical :: error, err, found
  type(sic_descriptor_t) :: desc
  character(len=512) :: mess
  character(len=64) :: name, string
  character(len=20) :: c20
  character(len=80) :: c80
  integer :: nnn, n, n_if, i, nf, ier, next, nstok
  real(8) :: xx, fratio, obsfreq, restfre, redshift
  real(8) :: ra,dec,dm,dp,ifzero
  real(8), allocatable :: raval(:),deval(:),raoff(:),deoff(:), offs(:,:), ifreq(:)
  type(projection_t) :: uv_proj
  !
  ! Always set size
  head%loca%size = product(head%gil%dim(1:head%gil%ndim))
  !
  ! Convert unusual Keywords
  if (head%char%unit.eq.'beam-1 Jy') head%char%unit ='Jy/beam'
  if (.not.isfits) return
  !
  ! Now handle any other critical information from additional Tables
  if (file(1:1).eq.'/') then
    chain = 'define fits atmpf "'//trim(file)//'" header /global'
  else
    chain = 'define fits atmpf '//trim(file)//' header /global'
  endif
  !
  error = .false.
  call exec_command(chain,error)
  if (error) return
  !
  if (head%gil%type_gdf.eq.code_gdf_image) then
    if (sic_varexist('ATMPF%BEAMS')) then
      head%gil%reso_words = 3
      call get_beam_fits_value(head%gil%majo,'BMAJ',error)
      head%gil%majo = pi*head%gil%majo/180./3600.
      call get_beam_fits_value(head%gil%mino,'BMIN',error)
      head%gil%mino = pi*head%gil%mino/180./3600.
      call get_beam_fits_value(head%gil%posa,'BPA',error)
      head%gil%posa = pi*head%gil%posa/180.
    endif
  else if (head%gil%type_gdf.eq.code_gdf_uvt) then
    !
    ! Frequency axis must be defined, otherwise this is NOT a UVFITS file
    obsfreq = 0
    do i=3,6
      call sic_get_char('ATMPF%CTYPE'//char(i+ichar('0')),string,n,error)
      if (string.eq."FREQ") then
        call sic_get_dble('ATMPF%CRVAL'//char(i+ichar('0')),obsfreq,error)
      else if (string.eq."IF") then
        call sic_get_inte('ATMPF%NAXIS['//char(i+ichar('0'))//']',n_if,error)
        if (n_if.gt.1) then
          call map_message(seve%w,rname,"More than 1 IF in UVFITS file, proceed with caution",3)
        endif
      endif
    enddo
    if (obsfreq.eq.0) then
      call map_message(seve%e,rname,"Input file is not a UVFITS")
      ! 
      err = .false.
      call sic_delvariable('ATMPF',.true.,err)
      error = .true.
      return 
    endif
    ! This has already been handled by the basic Header
    !   head%gil%val(1) = obsfreq*1D-6
    !
    ! Unit
    if (head%char%unit.eq."UNCALIB") head%char%unit = 'Jy'
    !
    ! Pointing and Phase centers
    name = 'ATMPF%AIPS_SU%COL%RAEPO'
    nnn = len_trim(name)
    if (sic_varexist(name)) then
      ! Mosaic (possibly degenerate)
      call sic_descriptor(name(1:nnn),desc,found)
      nf = desc%size/2  ! It is a Double Precision variable
      if (nf.le.1) then
        ! Single field case, just set A0 D0
        call sic_get_dble('ATMPF%AIPS_SU%COL%RAEPO',xx,error)
        xx = xx*pi/180
        if (xx.lt.0) xx = xx+2*pi
        head%gil%a0 = xx
        head%gil%ra = xx
        !
        call sic_get_dble('ATMPF%AIPS_SU%COL%DECEPO',xx,error)
        xx = xx*pi/180
        if (xx.lt.0) xx = xx+2*pi
        head%gil%d0 = xx
        head%gil%dec = xx
        !
        call sic_get_char('ATMPF%AIPS_SU%COL%SOURCE',head%char%name,nnn,error)
      else
        ! Convert the Descriptors to Fortran arrays
        allocate(raval(nf),deval(nf),raoff(nf),deoff(nf),offs(2,nf),stat=ier)
        !
        call adtoad(desc%addr,cptr,1)
        call c_f_pointer(cptr,d1ptr,[nf])
        raval(:) = d1ptr * pi/180.d0
        dm = minval(raval)
        dp = maxval(raval)
        if (dm.lt.0) then
          dm = dm+2*pi
          dp = dp+2*pi
        endif
        ra = (dm+dp)/2
        !
        name = 'ATMPF%AIPS_SU%COL%DECEPO'
        nnn = len_trim(name)
        call sic_descriptor(name(1:nnn),desc,found)
        call adtoad(desc%addr,cptr,1)
        call c_f_pointer(cptr,d1ptr,[nf])
        deval(:) = d1ptr * pi/180d0
        dm = minval(deval)
        dp = maxval(deval)
        dec = (dm+dp)/2
        !
        head%gil%a0 = ra
        head%gil%d0 = dec
        !
        ! Set the Projection
        call gwcs_projec(head%gil%a0,head%gil%d0,head%gil%pang,head%gil%ptyp,uv_proj,error)
        !
        ! Convert to Offsets
        call abs_to_rel(uv_proj,raval,deval,raoff,deoff,nf)
        offs(1,:) = raoff
        offs(2,:) = deoff
        ! List the Offsets
        call map_message(seve%i,rname,'Offsets : ')
        next = 1
        do i=1,nf
          write(c20,'(A,F8.2,A,F8.2,A)') "(",offs(1,i)*rad_to_sec,',',offs(2,i)*rad_to_sec,')'
          c80(next:) = c20
          next = next+20
          if (next.ge.80) then
            write(*,'(A)') c80
            next = 1
          endif
        enddo
        if (next.gt.1) write(*,'(A)') c80(1:next-1)
        !
        call sic_get_char('ATMPF%AIPS_SU%COL%SOURCE[1]',head%char%name,nnn,error)
        error = .false.
        call sub_memory_fields(head,head%r2d,nf,offs,error)
        !
      endif
    else
      ! Single fields: Assume RA & Dec from phase center
      if (head%gil%a0.eq.0 .and. head%gil%d0.eq.0) then
        call map_message(seve%w,rname,'Phase center is 0,0 => please check source coordinates afterwards.',3)
      else
        head%gil%ra = head%gil%a0
        head%gil%dec = head%gil%d0
      endif
      call sic_get_char('ATMPF%AIPS_SU%COL%SOURCE',head%char%name,nnn,error) ! Does not harm...
    endif
    !
    ! Verify Frequency axis
    if (sic_varexist('ATMPF%RESTFREQ')) then
      call sic_get_dble('ATMPF%RESTFREQ',restfre,error)
      !!Print *,'RestFreq ',RestFre,' ObsFreq ',obsfreq,' reference ',head%gil%convert(2,1)
      !!Print *,'Velocity ',head%gil%voff, ' Header ',head%gil%freq
      fratio = restfre/obsfreq
      if (fratio.gt.1.004) then
        redshift = fratio-1d0
        write(mess,'(A,F9.5,A,F12.3,A)') "Estimated redshift ",redshift," for Rest Frequency ",restfre*1D-6," MHz"
        call map_message(seve%i,rname,mess)
        call map_message(seve%w,rname,'Velocity reset to Zero and Rest Frequency adjusted accordingly')
        head%gil%voff = 0d0
        restfre = obsfreq
        !
        if (sic_varexist('REDSHIFT')) then
          call sic_let_dble('REDSHIFT',redshift,error)
        endif
      endif
      head%gil%freq = restfre*1D-6
    endif
    !
    ! Velocities in excess of 2000 km/s are also presumably Extragalactic 
    if (head%gil%voff.gt.2000) then
      write(mess,'(A,1PG10.3,A)') 'Excessive Velocity ',head%gil%voff, &
        & 'reset to Zero and Rest Frequency adjusted accordingly'
      head%gil%val(1) = head%gil%freq*(1.d0-head%gil%voff/clight)
      head%gil%voff = 0
      head%gil%vres = head%gil%fres/head%gil%val(1)*clight
      head%gil%freq = head%gil%val(1)
      call map_message(seve%w,rname,mess)
    endif  
    !
    ! IFs are a special VLA - ALMA - CASA convention to specify the
    ! frequencies if n_IF is non zero
    name = 'ATMPF%AIPS_FQ%COL%IF_FREQ'
    nnn = len_trim(name)
    if (sic_varexist(name)) then
      call sic_descriptor(name(1:nnn),desc,found)
      nf = desc%size/2  ! It is a Double Precision variable
      if (n_if.ne.1) then
        if (nf.ne.head%gil%nchan) then
          call map_message(seve%w,rname,'Mismatch IF and Number of channels')
        else
          ! Convert the Descriptors to Fortran arrays
          allocate(ifreq(nf),stat=ier)
          !
          call adtoad(desc%addr,cptr,1)
          call c_f_pointer(cptr,d1ptr,[nf])
          ifreq(:) = d1ptr(:)
          !
          ! Get the Zero frequency
          call sic_get_dble('ATMPF%CRVAL4',ifzero,error)
          ifreq = ifreq+ifzero
          ! 
          ! Set the Random Frequency axis and Stokes values
          nstok = max(1,head%gil%nstokes)
          do i=1,nf !! head%gil%nchan
            head%gil%freqs((i-1)*nstok+1:i*nstok) = ifreq(i)*1d-6
          enddo
        endif
      endif
    endif
  endif
  ! 
  err = .false.
  call sic_delvariable('ATMPF',.true.,err)
  !
end subroutine get_more_header
!
subroutine get_beam_fits_value(r,key,error)
  use gkernel_interfaces
  !-------------------------------------------------------
  ! @ private
  !   IMAGER
  !   Update a variable from a FITS  Beam%Col% column
  !   of specified name. Use SIC commands for this.
  !-------------------------------------------------------
  real, intent(inout) :: r            ! Variable
  logical, intent(inout) :: error   
  character(len=*), intent(in) :: key ! FITS Column name
  !
  character(len=120) :: chain
  !
  call sic_def_real('A_TMP_VAR',r,0,0,.false.,error)
  chain = 'COMPUTE A_TMP_VAR MEDIAN ATMPF%BEAMS%COL%'//key
  call exec_command(chain,error)
  call sic_delvariable('A_TMP_VAR',.false.,error)
  error = .false.
end subroutine get_beam_fits_value
!
subroutine is_fitsfile(file,isfits,error)
  use gbl_message
  use imager_interfaces, only : map_message, map_iostat
  !-------------------------------------------------------
  ! @ private
  !   IMAGER
  !   Test if a File is a valid FITS (image) file.
  !   No assumption is made about the file extension.
  !-------------------------------------------------------
  character(len=*), intent(in) :: file  ! File name
  logical, intent(out) :: isfits        ! Return value
  logical, intent(inout) :: error       ! Error flag
  ! Local
  integer :: ier
  character(len=10) :: chead
  !
  isfits = .false.
  error = .true.
  open(unit=1,file=file,status='OLD',action='READ',iostat=ier)
  if (ier.ne.0) then
    call map_iostat(seve%e,'READ',ier)
    return
  endif
  read(unit=1,fmt='(A)',iostat=ier) chead
  close(unit=1)
  if (ier.ne.0) then
    call map_iostat(seve%e,'READ',ier)
    return
  endif
  !
  if (chead.eq.'SIMPLE  = ') then
    isfits = .true.
    error = .false.
  else if (chead(1:6).eq.'GILDAS') then
    error = .false.
  else
    call map_message(seve%e,'READ',trim(file)// &
      & ' is neither a GILDAS nor a FITS format file')
    error = .true.
  endif
end subroutine is_fitsfile
!
subroutine map_read_uvdataset(fd,isfits,pcount,htmp,head,local_nc,rdata,error)
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, only : map_message, map_read_uvfits
  use gbl_message
  !-------------------------------------------------------
  ! @ private
  !   IMAGER
  !   Read data in an internal buffer, from a GDF file
  !   or a FITS file, as indicated by "is_fits"
  !-------------------------------------------------------
  type(gfits_hdesc_t), intent(in) :: fd   ! FITS descriptor
  logical, intent(in) :: isfits           ! Is a FITS file ?
  integer, intent(in) :: pcount
  type(gildas), intent(inout) :: htmp
  type(gildas), intent(inout) :: head     ! GILDAS header
  integer, intent(in) :: local_nc(2)      ! Channel range
  real, intent(out) :: rdata(:,:)         ! Data array
  logical, intent(inout) :: error         ! Error flag
  !
  integer :: astoke
  logical :: eot
  !
  if (isfits) then
    ! Make sure the FITS file is at the right position
    call gfits_flush_data(error)
    if (error) return
    !
    astoke = 0   ! Get all Stokes parameters, otherwise inconsistent data size
    call map_read_uvfits(head,astoke,error,eot,pcount,rdata)
    ! Close FITS file now for immediate re-use
    call gfits_close(error)
    !
  else
    call gdf_read_uvdataset(htmp,head,local_nc,rdata,error)
  endif
  !
end subroutine map_read_uvdataset

subroutine map_read_uvfits(fits,astoke,error,eot,pcount,outarray)
  use image_def
  use gbl_format
  use gbl_message
  use image_def
  use gkernel_interfaces
!!  use gio_dependencies_interfaces
!!  use gio_interfaces, except_this=>read_uvfits
!!  use gio_fitsdef
  !---------------------------------------------------------------------
  ! @ private
  !   Read all the input FITS UV table
  !---------------------------------------------------------------------
  type(gildas),    intent(inout) :: fits    !
  integer(kind=4), intent(in)    :: astoke  ! Stokes parameter
  logical,         intent(out)   :: error   ! Error flag
  logical,         intent(out)   :: eot     ! End ot Tape flag
  integer(kind=4), intent(in)    :: pcount  ! Daps count
  real, intent(out) :: outarray(:,:)
  ! Local
  character(len=*), parameter :: rname='READ_UVFITS'
  character(len=message_length) :: mess
  character(len=1) :: cstoke
  real(kind=4), parameter :: ps=1.0e-6 ! Because GILDAS uses MHz
  logical :: err, do_stokes
  integer(kind=4) :: jv,ib,inchan,onchan,nblock
  real(kind=4) :: ws
  real(kind=4), allocatable :: inarray(:)
  integer(kind=4), allocatable :: in_stokes(:)
  integer(kind=4) :: in_nstokes, insize, stokes_order
  real(kind=4) :: trail, mtrail, rinte, indaps(7)
  integer(kind=4) :: ier, nt, i, lc
  ! 
  integer(kind=index_length) :: ngood, nflag, nempty, kv, iblc, idim, itrc
  logical :: good, needs_good
  !
  ! Prepare reading of the visibilities
  rinte = 0       ! Integration time
  eot = .false.   ! Otherwise, error on Ifort
  err = .false.   ! Make sure it is initialized
  error = .false.
  call gfits_flush_data(error)
  if (error) return
  !! fd%nb = 2881 ! WHAT ?
  !
  !! call gdf_print_header(fits)
  mtrail = 0
  !
  call gdf_nitems('SPACE_GILDAS',nblock,fits%gil%dim(1)) ! Visibilities at once
  nblock = min(nblock,fits%gil%dim(2))
  !
  ! Optionally change the Stokes parameters
  in_nstokes = fits%gil%nstokes
  allocate(in_stokes(in_nstokes))
  in_stokes(:) = fits%gil%stokes(1:in_nstokes)
  !
  ! Keep all Stokes only if Astoke is 0 or all 4 Stokes present
  if (in_nstokes.eq.4) then
    if (astoke.ne.0) then
      call gio_message(seve%w,rname,'Keeping all 4 stokes parameters')
    endif
  else if (astoke.ne.0) then
    if (in_nstokes.gt.1) then
      call gio_message(seve%i,rname,'Treating signal as unpolarized')
    endif
    fits%gil%nstokes = 1
    fits%gil%stokes(1) =  code_stokes_none
    stokes_order = fits%gil%order
    fits%gil%order = 0                        ! No order if only 1 Stokes
  else
    if (in_nstokes.gt.1) then
      cstoke = char(in_nstokes+ichar('0'))
      call gio_message(seve%w,rname,'Keeping all '//cstoke//' stokes parameters')
    endif
  endif
  !
  if (in_nstokes.eq.fits%gil%nstokes) then
    allocate(inarray(fits%gil%dim(1)),stat=ier)
    inchan = fits%gil%nchan*fits%gil%nstokes
    onchan = inchan
  else
    ! Change a number of sizes and properly shift the Column Pointers
    ! before creating the data file
    onchan = fits%gil%nchan*fits%gil%nstokes
    inchan = fits%gil%nchan*in_nstokes
    insize = fits%gil%nlead + inchan*3 + fits%gil%ntrail
    fits%gil%dim(1) = (fits%gil%nlead + onchan*3 + fits%gil%ntrail)
    allocate(inarray(insize),stat=ier)
    !
    ! Shift trailing columns
    if (fits%gil%ntrail.ne.0) then
      ! This is a generic code 
      do i=1,code_uvt_last
       if (fits%gil%column_pointer(i).gt.fits%gil%nlead) then
          fits%gil%column_pointer(i) = fits%gil%column_pointer(i) + 3*(onchan-inchan)
        endif
      enddo
    endif
  endif
  if (ier.ne.0) then
    call gio_message(seve%e,rname,'Memory allocation error')
    error = .true.
    return
  endif
  !
  lc = fits%gil%dim(1)-fits%gil%ntrail
  !  
  ! WS is the Weight Scaling Factor, WPS in the GIO common !...
  call gio_uvwps(ws)
  ws = ws * ps                ! Final weight scaling factor
  !
  ! This code is NOT generic. It assumes the code_uvt_id (or equivalent)
  ! just follows the last channel, and is the only copied trailing column...
  if (fits%gil%ntrail.eq.0) then
    nt = 0
  else
    nt = 7+3*onchan+1
  endif
  fits%blc(1) = 1
  fits%trc(1) = fits%gil%dim(1)
  fits%blc(2) = 0
  fits%trc(2) = 0
  error = .false.
  !
  if (in_nstokes.eq.fits%gil%nstokes) then
    if (in_nstokes.gt.1) call gio_message(seve%w,rname,'Keeping all Stokes parameters')
    do_stokes = .false.
    needs_good = .true.   ! Test ...
  else
    call gio_message(seve%w,rname,'Extracting unpolarized signal')
    do_stokes = .true.
    needs_good = .false.  ! Test itou...
  endif
  !
  ngood = 0
  nflag = 0
  nempty = 0
  !
  ! Input sizes
  idim = fits%gil%dim(2)
  itrc = 0
  kv = 0  ! Output counter
  !
  do ib = 1, idim, nblock
    iblc = itrc+1
    itrc = min(idim,itrc+nblock)
    !
    write(mess,'(A,I9,A,I9,A,I9,A,I0,A)') &
         & 'Reading ',iblc,' to ', itrc, &
         & ' / ',idim,' (',nint((100.*itrc)/idim),'%)'
    call gio_message(seve%i,rname,mess)
    do jv = 1,itrc-iblc+1 
      good = needs_good
      call read_visi (indaps,inarray,inchan,ws,error,pcount,trail,rinte,good)
      if (error) goto 100
      !
      if (good) then
        kv = kv+1
        ! Daps
        outarray(1:7,kv) = indaps 
        ! Visibilities
        if (do_stokes) then
          call uvfits_stokes_select(inarray,inchan,outarray(8:lc,kv),onchan, &
            & in_nstokes,in_stokes,fits%gil%stokes(1),stokes_order)
        else
          outarray(8:lc,kv) = inarray
        endif
        !
        ! Trailing column (only 1 so far, assumed to be Source ID...)
        if (nt.ne.0) then
          outarray(nt:nt,kv) = trail
          mtrail = max(mtrail,trail)
        endif
        ngood = ngood+1
      else
        nflag = nflag+1
      endif
    enddo
    !
    if (kv.ne.0) then
      fits%blc(2) = fits%trc(2)+1
      fits%trc(2) = fits%trc(2)+kv
    else
      nempty = nempty+1
    endif
  enddo
  write(mess,'(A,I9,A)') 'Read   ',ngood,' visibilities'
  call gio_message(seve%i,rname,mess)
  !
  ! If some data has been ignored, say it and update visibility number
  if (nempty.gt.0) then
    write(mess,'(I0,A)') nempty ,' input blocks were empty'
    call gio_message(seve%w,rname,mess)
  endif
  if (nflag.gt.0) then
    write(mess,'(A,I9,A)') 'Ignored ',nflag,' flagged visibilities'
    call gio_message(seve%w,rname,mess)
    fits%gil%nvisi = ngood  ! This is needed but not sufficient...
    fits%gil%dim(2) = ngood ! so it is better to also change the array size 
    !! call gdf_update_header(fits,error)
  endif
  if (fits%gil%nstokes.gt.1)  call gio_message(seve%w,rname, &
      &   'More than 1 Stokes parameter, use STOKES command after')
!
100 continue
  !
  if (nt.ne.0) then
    !
    ! Mtrail contains the largest Source ID, i.e. the number of sources
    if (mtrail.le.1) then
      call gio_message(seve%w,rname,'Only one source found in MultiSource UVFITS file')
      ! We could (and perhaps should) set these to 0,
      ! since the information is to be ignored. But that would mean
      ! undefined trailing columns in the UV data.
      !! fits%gil%column_pointer(code_uvt_id) = fits%gil%dim(1)-1
      !! fits%gil%column_size(code_uvt_id) = 1
    endif
    !! Needed only in case we update the Pointers.
    !! call gdf_update_header(fits,error)
  endif
  !
end subroutine map_read_uvfits
!
