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 (obsolete) /PLANE
  !---------------------------------------------------------------------
  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
  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
  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
  !
  call sic_ch (line,0,2,name,nn,.true.,error)
  if (error) return
  !
  if (argu.eq.'UV') argu = 'UV_DATA'
  !
  ! Default settings
  drange = 0
  mysort = 'NONE'
  !
  ! /PLANE (for compatibility)
  if (sic_present(o_plane,0)) then
    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
    mysort = 'CHANNEL'
  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 = 1, mtype
      lexist = sic_findfile(name,file,' ',etype(ntype))
      if (lexist) then
        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,error,freq)
        else
          call sub_read_image (name,ntype,drange,csort,compact,error)
        endif
        call check_view(1,atype)  ! Force VIEW re-computation for these
      endif
    enddo
  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,error,freq)
    else
      call sub_read_image (name,ntype,drange,mysort,compact,error)
    endif
    call check_view(1,atype)  ! Force VIEW re-computation for these
  endif
  !
end subroutine read_image
!
subroutine sub_read_image (name,ntype,drange,crange,compact,error, freq)
  use gkernel_interfaces
  use imager_interfaces, only : map_read
  use clean_def
  use clean_arrays
  use clean_types
  !---------------------------------------------------------------------
  ! @ private-mandatory
  !
  ! IMAGER
  !   Support routine for command
  !   READ Type File [/COMPACT] [/FREQUENCY RestFreqMHz] [/RANGE Start End Type]
  !   [/NOTRAIL] and obsolescent [/PLANE]
  !---------------------------------------------------------------------
  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
  logical, intent(inout) :: error
  real(8), intent(in), optional :: freq   ! Desired rest frequency
  !
  type (gildas) :: head
  integer :: nc(2)
  logical :: nochange, attempt, err
  real(4) :: velo
  !
  !!Print *,'Planes read ',nc
  !
  call gildas_null(head)
  call sic_parse_file(name,' ',etype(ntype),head%file)
  !
  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
  !
  call out_range('READ',crange,drange,nc,head,error)
  if (error) return
  !
  ! 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
    case ('RESIDUAL')
      attempt = hresid%loca%size.ne.0
    case ('CLEAN')
      attempt = hclean%loca%size.ne.0
    case default
      attempt = .true.
    end select
    if (attempt) then
      call sub_modified(ntype,head%file,optimize(ntype),nc,nochange)
      if (nochange) return
    endif
  endif
  !
  ! Read Data as required
  call map_read(head,vtype(ntype),nc,compact,error)
  !
  ! Indicate Buffer has been read
  optimize(ntype)%change = 0
  !
  ! Free image slot 
  err = .false.
  call gdf_close_image (head,err)
  if (err) error = .true.
  !
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
  !---------------------------------------------------------------------
  ! @ 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 Mapping
  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)
  ! No Read / Write optimization
  ! RW_Optimize is an integer, so that we may distinguish
  ! optimization based on "atype"
  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,out,nc,compact,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>map_read
  use clean_def
  use clean_arrays
  use clean_types
  use clean_default
  use uvfit_data
  use gbl_message
  !----------------------------------------------------------------------
  ! @ private
  !
  ! IMAGER
  !  Read some type of input data.
  !------------------------------------------------------------------
  type (gildas), intent(inout) :: head ! Header of data
  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
  !
  type (gildas) :: htmp
  character(len=80) chain
  integer i, ier, nchan, local_nc(2), blc
  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.
  !
  if (.not.compact) then
    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 gdf_read_data(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.
      !
      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)
      !
      ! 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
      !
      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)
        error = .true.
        return
      else if (ram_need.gt.sys_ramsize/2) then
        write(mess,'(A,F8.1,A,F8.1,A)') 'Data size (',1d-3*ram_need, &
          & 'GB) exceeds half of available RAM (',1d-3*sys_ramsize,' GB)'
        call map_message(seve%w,rname,mess)
      endif
      !
      allocate(duvi(huv%gil%dim(1),huv%gil%dim(2)),stat=ier)
      call gdf_read_uvdataset(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
      !
      duv => duvi              ! Point on original data
      duvr => duvi             ! Point on original data
      !
      ! Check the type and number of fields
      call check_uvdata_type(huv,duv,themap,error)
      if (error) return
      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
      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
    case ('MODEL')
      !
      ! Free the previous zone
      call sic_delvariable ('UVM',.false.,error)
      if (allocated(duvm)) then
        deallocate(duvm,stat=ier)
      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_def_real ('UVM',duvm,huvm%gil%ndim,   &
       &        huvm%gil%dim,.true.,error)
      !
    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 ('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 gdf_read_data(head,ddirty,error)
      if (error) return
      !
      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 gdf_read_data(head,dresid,error)
      if (error) return
      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 gdf_read_data(head,dclean,error)
      if (error) return
      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 gdf_read_data(head,dsky,error)
      if (error) return
      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 gdf_read_data(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 gdf_read_data(hprim,dprim,error)
      if (error) return
      call sic_mapgildas('PRIMARY',hprim,error,dprim)
      !
      ! Old GILDAS primary beams had only one Frequency channel
      !
      ! Switch to mosaic mode
      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
        ! 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
      endif
      ! Hereafter ndim=2 will say it is a Table
      !  
      ! Specify the subset if possible
      if (head%gil%ndim.eq.2) then        
        call map_message(seve%w,rname,'SINGLEDISH table -- range under test')
        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 gdf_read_data(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)
      endif
      if (error) return
      !
      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 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 gdf_read_data(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 gdf_read_data(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 gdf_read_data(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 gdf_read_data(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 gkernel_interfaces, only : gdf_range
  !---------------------------------------------------
  ! @ 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
    map_range = any(nc.ne.1) 
  else
    !
    ! Frequency axis: Find out the actual range
    local_nc = nc
    map_range = gdf_range(local_nc,hin%gil%dim(faxi)).ne.0
    if (map_range) return
    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)
  endif
end function map_range
!
subroutine out_range(rname,atype,drange,nc,head,error)
  use image_def
  use gbl_message
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! @ 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 (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.'NONE') call map_message(seve%w,rname, &
      & 'No Frequency axis, /RANGE option ignored.')
    nc = 1
    return
  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,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.'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 = [1,nchan]
  else
    call map_message(seve%f,rname,"Type of value '"//trim(mytype)//"' not supported")
    error = .true.
    return
  endif
  !
  ier = gdf_range (nc, nchan)
  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
  !-------------------------------------------------------
  ! @ 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 task UV_UPDATE_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
  ! 
  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
  !
  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 = nc
  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
!
