subroutine view_load_comm(line,error)
  use gkernel_interfaces
  use imager_interfaces, only : sub_read_image, map_message
  use clean_default
  use clean_arrays
  use clean_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! VIEWER -- Support for command LOAD
  !
  !   Support routine for command  
  !   DISPLAY\LOAD File [Write] [[/RANGE Start End Type]
  !   [/FREQUENCY RestFreqMHz] and [/PLANE Start End]
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Constants
  integer, parameter :: o_freq=1
  integer, parameter :: o_plane=2
  integer, parameter :: o_range=3
  integer, parameter :: o_cache=5
  integer, parameter :: o_trail=6
  logical, parameter :: compact = .false.
  character(len=8), parameter :: cread ='READ    '
  character(len=8), parameter :: cwrite='WRITE   '
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort)
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  ! Local ---
  logical, save :: do_reload=.false.
  integer :: np,nn,isort,save_opt
  character(len=filename_length) :: name
  logical :: do_freq, do_write
  real(8) :: drange(2), freq
  character(len=8) :: ckey
  character(len=12) :: csort
  character(len=12) :: mysort
  !
  ! Code ----
  ckey = ' '
  call sic_ke (line,0,2,ckey,np,.false.,error)
  if (np.ne.0) then
    nn = min(np,8)
    if (ckey(1:nn).eq.cread(1:nn)) then
      do_write = .false.
    else if (ckey(1:nn).eq.cwrite(1:nn)) then
      do_write = .true.
    else
      call map_message(seve%e,'LOAD','Invalid 2nd argument '//ckey(1:np))
      error = .true.
      return
    endif
  else
    do_write = .false.
  endif
  !
  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,'LOAD','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('LOAD',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...
  save_opt = rw_optimize
  if (do_reload) rw_optimize = 0
  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
  rw_optimize = save_opt
  if (error) return
  !
  ! Make it write-able if needed
  !
  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
  !
  ! Set ReadOnly status
  if (do_write) then
    call sic_delvariable ('DATA',.false.,error)
    hview%loca%read = .false.
    call sic_mapgildas ('DATA',hview,error,dview)
    call map_message(seve%w,'LOAD','DATA array is writeable')
  endif
  do_reload = do_write    ! Force reloading if Writeable
end subroutine view_load_comm
!
subroutine read_comm (line,error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>read_comm
  use clean_def
  use clean_arrays
  use clean_types
  use gbl_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command  READ
  !
  !   READ Type File [/COMPACT] [/NOCACHE] [/NOTRAIL] [/RANGE Start End Type]
  !   [/FREQUENCY RestFreqMHz] and [/PLANE Start End]
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line  !! Command line
  logical, intent(inout) :: error       !! Logical error flag
  !
  ! Constants
  integer, parameter :: o_compact=1
  integer, parameter :: o_freq=2
  integer, parameter :: o_plane=3
  integer, parameter :: o_range=4
  integer, parameter :: o_cache=5
  integer, parameter :: o_trail=6
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort)
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  ! Local ---
  character(len=filename_length), save :: uv_data_name=' '
  character(len=12) :: mysort
  integer ntype,nn,isort, i, nline, iarg
  character(len=12) argu,atype,acomm
  character(len=filename_length) :: name, aline
  logical compact,lexist,do_freq
  character(len=filename_length) :: file
  real(8) :: drange(2), freq
  character(len=12) :: csort
  !
  integer, save :: old_trail=0
  integer :: cur_trail, save_opt
  integer :: do_reload
  !
  ! Code ----
  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_list('READ',seve%i,'Choices are:',vtype,vread)
    return
  endif
  !
  if (argu.eq.'UV') argu = 'UV_DATA'
  if (argu.eq.'SINGLE') argu = 'SINGLEDISH'
  !
  if (argu.ne.'*') then
    iarg = 0
    do i=1,mtype
      if (argu.eq.vtype(i)) then
        iarg = i
        exit
      endif
    enddo
    if (iarg.eq.0) then
      call map_message(seve%e,'READ','No such Buffer '//argu)
      call sic_ambigs_list('READ',seve%i,'Choices are:',vtype,vread)
      error = .true.
      return
    endif
  endif
  !
  save_opt = rw_optimize
  if (sic_present(o_cache,0)) then
    do_reload = -2
  else
    do_reload = rw_optimize
  endif
  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) then
        call map_message(seve%e,'READ','No UV data already read')
        return
      endif
    else
      call sic_ch (line,0,2,name,nn,.true.,error)
    endif
    !
    ! Test TRAIL handling status
    ! Deactivate RW_OPTIMIZE if status changed
    if (sic_present(o_trail,0).or.(.not.read_trail)) then
      cur_trail = 1     ! /NOTRAIL option or by SET TRAIL
    else
      cur_trail = 0
    endif
    if (cur_trail.ne.old_trail) then
      do_reload = -1
    endif
    ! if different from last one...
    !WWWW
  else
    cur_trail = 0
    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)
  !
  select case(argu)
  case ('*')
    !
    ! Find all files of relevant extension, and load them
    do ntype = 2, ptype
      !
      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
  case ('FLUX','SUPPORT','POLYGON')
    do i=1,5
      if (sic_present(i,0)) then
        call map_message(seve%e,'READ','Option(s) incompatible with '//trim(argu)//' argument')
        error = .true.
        return
      endif
    enddo
    select case (argu)
    case ('FLUX')
      call sub_read_flux(name,error)
    case ('SUPPORT')
      aline = 'SUPPORT '//trim(name)
      nline = len_trim(aline)
      call sic_analyse(acomm,aline,nline,error)
      call support_comm(aline,error)
    case ('POLYGON')
      call exec_program('GREG2\POLYGON '//trim(name))
    end select
  case default
    call sic_ambigs ('READ',argu,atype,ntype,vtype,mtype,error)
    if (error) return
    !
    rw_optimize = do_reload  ! Force reload if needed
    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
    if (.not.error) call check_view(1,atype)  ! Force VIEW re-computation for these
  end select
  rw_optimize = save_opt
  if (error) return
  !
  if (argu.eq.'UV_DATA') then
    uv_data_name = name
    call uv_check_mosaic    ! Convert to POINT Mosaic if needed
    old_trail = cur_trail   ! Always true ?
    ! Unset self-calibration status
    call sic_let_inte('SELF_APPLIED',0,error)
  endif
end subroutine read_comm
!
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 
  !
  !   READ Type File [/COMPACT] [/FREQUENCY RestFreqMHz] [/RANGE Start End Type]
  !   [/NOCACHE] [/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           !! Logical error flag
  real(8), intent(in), optional :: freq     !! Desired rest frequency
  !
  ! Constants
  character(len=*), parameter :: rname='READ'
  !
  ! Local ---
  character(len=filename_length), save :: filename
  character(len=12), save :: otype
  integer, save :: nf=0
  logical, save :: first=.true.
  !
  type (gildas) :: head
  character(len=filename_length) :: file
  character(len=12) :: cteles
  integer :: nc(2), n
  integer(8) :: attempt
  logical :: nochange, err, is_uvfits, fits_format
  integer :: fits_fmt   ! Is in FITS format -1 IMAGE, 0 1 2 or 4 UVFITS with no or 1,2,4 Stokes state
  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, x_window
  integer :: a_style
  integer :: pcount
  !
  ! Code ----
  error = .false.
  call gildas_null(head)
  call sic_parse_file(name,' ',etype(ntype),file)
  !
  ! If the name contains a "*", it is a filter. Open a File Widget
  ! to get the filename.
  if (index(file,'*').ne.0) then
    if (first) then
      call sic_def_char('FILENAME',filename,.false.,error)
      if (error) return
      first = .false.
      call sic_get_logi('SIC%WINDOW',x_window,error)
      if (.not.x_window) call map_message(seve%w,rname, &
      & 'File filter only usable with a Widget-supporting environment')
    endif
    if (etype(ntype).ne.otype) nf = 0
    !
    if (x_window) then
      call exec_program('GUI\PANEL FILE toto')
      if (nf.eq.0) then
        call exec_program('SIC\LET FILENAME /PROMPT "Select file" /FILE '//trim(file))
      else
        call exec_program('SIC\LET FILENAME "'//filename(1:nf)//'" /PROMPT "Select file" /FILE '//trim(file))
        otype = etype(ntype)
      endif
      call exec_program('GUI\GO')     ! Launch the widget
      call exec_program('GUI\WAIT')   ! Wait for answer
      call end_dialog                 ! Close the last widget
      if (error) return
    else
      call exec_program('SIC\LET FILENAME /PROMPT "Specify file" /FILE '//trim(file))
    endif
    file = filename
    nf = len_trim(file)
  endif
  head%file = file
  !
  is_uvfits = .false.
  fits_fmt = 0    ! Not a FITS file by default
  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_format,error)
    if (error) return
    if (fits_format) 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
      fits_fmt = -1 ! Image ...
    endif
  else
    fits_format = .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))
      fits_format = .true.
      fits_fmt = 1
    endif
  endif
  !
  if (fits_format) 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 (fits_fmt.ge.0) then
      question = .false.
      a_style =  4 ! code_fits_casa = 4 - Get all Stokes by default
      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
      fits_fmt = max(head%gil%nstokes,1)
      !
      ! If less than 2  Stokes, ignore Stokes states
      if ((.not.sic_present(0,3)).and.(head%gil%nstokes.eq.2)) then
        call map_message(seve%w,rname,'Only 2 Stokes states, selecting Unpolarized signal')
        a_style = 0 ! No change
        fits_fmt = 1
      else if (head%gil%nstokes.gt.1) then
        call map_message(seve%w,rname,'Keeping all Stokes states')
      endif
      !
      if (head%gil%nteles.gt.0) then
        cteles = head%gil%teles(1)%ctele
        if ((cteles.eq."ALMA").or.(cteles.eq."ACA")) then
          head%char%syst = "ICRS"
          call map_message(seve%w,rname,'Telescope '//trim(cteles)//': Assuming ICRS coordinate system')
        endif
      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
    !
    if (head%gil%nteles.gt.0) then
      cteles = head%gil%teles(1)%ctele
      if ((cteles.eq."ALMA").or.(cteles.eq."ACA")) then
        if (head%char%syst.eq.' ') then
          head%char%syst = "ICRS"
          call map_message(seve%i,rname,'Telescope '//trim(cteles)//': Assuming ICRS coordinate system',seve%w)
        else if (head%char%syst.ne.'ICRS') then
          call map_message(seve%w,rname,'Inconsistent coordinate system '// &
            & trim(head%char%syst)//' for telescope '//trim(cteles))
          if (head%char%syst.eq.'EQUATORIAL') then
            call map_message(seve%i,rname,'Telescope '//trim(cteles)//': Assuming ICRS coordinate system',seve%w)
            head%char%syst = "ICRS"
          endif
        endif
      endif
    endif
    !
    ! 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
  !
  ! Hum, this is valid only for IMAGES - Need
  ! special case for SINGLEDISH which can be Table or Image
  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 ('UV_DATA') 
      attempt = huv_init%loca%size
    case ('CCT')
      attempt = hcct%loca%size
      last_resid = 'CCT'
    case ('RESIDUAL')
      attempt = hresid%loca%size
    case ('CLEAN')
      attempt = hclean%loca%size
    case ('DATA')
      attempt = hview%loca%size
    case ('MASK') 
      attempt = hmask%loca%size
    case ('CONTINUUM') 
      attempt = huv_cont%loca%size
    case ('SKY') 
      attempt = hsky%loca%size
    case default
      attempt = -1   ! No optimization if unknown buffer
    end select
    if (attempt.ge.0) then
      call sub_modified(ntype,file,optimize(ntype),nc,nochange,attempt)
      if (nochange) then
        if (fits_format) then
          call gfits_close(err)
        else
          error = .false.
          call gdf_close_image(head,error)  ! Must free the open slot
        endif
        return
      endif
    endif
    !
    if (vtype(ntype).eq.'UV_DATA') then
      if (allocated(drobust)) then
        deallocate(drobust)
        call sic_delvariable('ROBUST_BEAMS',.false.,error)
      endif
    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_format) 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,osize)
  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 -- Support for command READ
  !
  !   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
  integer(8), intent(in) :: osize         !! Previous size of data - If Zero, force reading
  !
  ! Local ---
  logical :: error
  character(len=36) :: mess, trail
  integer :: msev
  !
  ! Code ----
  nochange = .false.           ! By default
  !
  opti%modif%modif = .true.    ! In case of error
  call gag_filmodif(file,opti%modif,error)
  if (osize.eq.0) opti%modif%modif = .true. ! If not loaded ...
  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          ! Remember channel range
    return
  endif
  error = .false.             ! For further use
  opti%lastnc = nc
  !
  ! The buffers may however have been manipulated in IMAGER
  if (.FALSE.) then
    ! Old code - Temporarily kept for the record
    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')
        duv => huv_init%r2d !SG
        call map_uvgildas('UV',huv_current,error,huv_init%r2d) 
      endif
      optimize(atype)%change = 0
      trail = ' Reset from Buffer'
    else if (nochange) then
      if (rw_optimize.lt.0) then
        trail = ' /NOTRAIL status changed, reloaded'
        nochange = .false.
      else
        trail = ' not reloaded '
      endif
    else
      trail = ' reloaded '
    endif
  ENDIF
  !
  if (optimize(atype)%change.gt.1) then
    nochange = .false.
    trail = ' Buffer changed -- Reloaded '
    msev = seve%i
  else if (nochange) then
    if (rw_optimize.lt.0) then ! Value can be tested to specify message
      if (rw_optimize.eq.-1) then
        trail = ' /NOTRAIL status changed, reloaded'
      else if (rw_optimize.eq.-2) then
        trail = ' /NOCACHE option, reloaded'
      else
        trail = ' Reload forced by user'
      endif
      nochange = .false.
    else if (optimize(atype)%change.eq.1) then
      !
      ! Is there a buffer to be Reset ? 
      if (atype.eq.code_save_uv) then
        call uv_reset_buffer('READ')
        duv => huv_init%r2d
        call map_uvgildas('UV',huv_current,error,huv_init%r2d) 
      endif
      optimize(atype)%change = 0
      trail = ' Reset from Buffer'
    else
      ! ! Print *,'Optimize value ',optimize(atype)%change
      ! On essaye cela, mais c est peut-être superflu
      if (atype.eq.code_save_uv) then
        call uv_reset_buffer('READ')
        call map_uvgildas('UV',huv_current,error,huv_init%r2d) 
      endif
      trail = ' not reloaded '
    endif
  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 by user
  if (rw_optimize.eq.0) then
    call map_message(seve%w,'READ','Reading enforced by user')
    nochange = .false.
  endif
  !
end subroutine sub_modified
!
subroutine map_read (head,fd,fits_fmt,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, UV or Image, even
  !   from FITS format if needed
  !!
  !------------------------------------------------------------------
  type (gildas), intent(inout) :: head      !! Header of input data
  type(gfits_hdesc_t), intent(in) :: fd     !! FITS descriptor 
  integer, intent(in) :: fits_fmt           !! 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             !! Logical error flag
  integer, intent(in), optional :: count    !! Group size indicator for FITS ?
  !
  ! Constants
  character(len=4) :: rname = 'READ'
  integer, parameter :: o_trail=6
  !
  ! Local ---
  type (gildas) :: htmp
  character(len=80) :: chain
  integer :: i, ier, nchan, local_nc(2), blc, pcount
  logical :: subset
  real, allocatable :: tmp_data(:,:)
  !
  ! Code ----
  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',trim(head%file)//' is not a UV data set')
        error = .true.
      endif
    case ('CCT')
      if ((head%char%code(2).ne.'COMPONENT') .and. &
        & (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 ('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',trim(head%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',trim(head%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,fits_fmt,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)
    case ('UV_DATA')
      ! Special case for UV data
      ! Do not discard the current UV Data.
      !   call map_message(seve%i,'READ','Discarding current UV Data')
      !   call discard_uvdata(error)
      ! It would suppress the READ UV optimization
      call getset_uvdata('READ',head,[0.,0.],fd,fits_fmt,nc,pcount,error)
    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)
        huv_model%loca%size = 0
      endif
      !
      call gildas_null (huv_model, 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_model, '21', error)
      else
        call gdf_copy_header(htmp, huv_model, error)
      endif
      if (error)  return
      htmp%loca = head%loca
      huv_model%loca = head%loca   ! Why ?  See above !
      !
      ! Extract desired channels
      nchan = huv_model%gil%nchan
      local_nc = nc
      ier = gdf_range (local_nc, nchan)
      call gdf_uv_size(huv_model,local_nc)
      allocate(duvm(huv_model%gil%dim(1),huv_model%gil%dim(2)),stat=ier)
      call gdf_read_uvdataset(htmp,huv_model,local_nc,duvm,error)
      if (error) return
      !
      huv_model%loca%size = huv_model%gil%dim(1)*huv_model%gil%dim(2)
      call sic_mapgildas('UV_MODEL',huv_model,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,fits_fmt,head,dview,error)
      if (error) return
      call get_more_header(fits_fmt,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,fits_fmt,head,ddirty,error)
      if (error) return
      !
      call get_more_header(fits_fmt,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,fits_fmt,head,dresid,error)
      if (error) return
      call get_more_header(fits_fmt,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,fits_fmt,head,dclean,error)
      if (error) return
      call get_more_header(fits_fmt,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,fits_fmt,head,dsky,error)
      if (error) return
      call get_more_header(fits_fmt,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,fits_fmt,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,fits_fmt,hprim,dprim,error)
      if (error) return
      call get_more_header(fits_fmt,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 cct_read(nc,head,error)
    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,dshort)) then
        nullify(hshort%r3d)
      else if (associated(hshort%r3d))  then
        deallocate(hshort%r3d,stat=ier)
      endif
      if (allocated(dshort)) deallocate(dshort,stat=ier)
      if (allocated(dsingle)) deallocate(dsingle,stat=ier)
      hsingle%loca%size = 0
      hshort%loca%size = 0
      !
      ! 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 if (product(head%gil%dim(4:head%gil%ndim)).gt.1) then
        call map_message(seve%e,rname,'SINGLEDISH data must have rank 2 or 3')
        error = .true.
        return
      else
        head%gil%ndim = 3
        error = map_range(nc,head,hsingle)
        if (error) 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,fits_fmt,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 map_read_data(fd,fits_fmt,head,dsingle,error)
      endif
      if (error) return
      !
      call get_more_header(fits_fmt,head%file,hsingle)
      call sic_mapgildas('SINGLE',hsingle,error,dsingle)
    case ('UV_FIT')
      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 subset 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,fits_fmt,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,fits_fmt,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,fits_fmt,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,fits_fmt,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,fits_fmt,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 -- Utility routine  
  !   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
  !
  ! Local ---
  integer :: local_nc(2), hdim, faxi, rank
  !
  ! Code ----
  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            !! Logical error flag
  !
  ! Constants
  integer(kind=4), parameter :: mtype=4
  character(len=12) :: types(mtype)
  data types /'CHANNEL','VELOCITY','FREQUENCY','NONE'/
  !
  ! Local ---
  character(len=12) :: mytype,ctype
  real(8) :: frange(2)
  integer :: itype, nn, ier, nchan
  character(len=80) :: chain
  !
  ! Code ----
  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))
    ! Oops, need to Handle the special Class Table case
    ! But what happens when loading a single-channel map ???
    if (head%gil%ndim.eq.2) then
      if (head%gil%faxi.ne.0) then
        nchan = max(1,head%gil%dim(head%gil%faxi))
      endif
    endif
  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
!
function tab_range (nc,hin,hou,subset)
  use image_def
  use gkernel_interfaces, only : gdf_range
  !---------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Internal routine. 
  !
  !   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        !! Is this a subset ?
  !
  ! Local ---
  integer local_nc(2), hdim, faxi
  integer(kind=index_length) :: fdim
  !
  ! Code ----
  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
  !*
  ! IMAGER -- VIEWER -- Support for VIEW command
  !
  ! Declare that all buffers specificied in argu(n) must be
  ! reloaded by VIEW.
  !!
  integer, intent(in) :: n                !! Number of buffers to be checked
  character(len=*), intent(in) :: argu(n) !! Buffer name
  !
  ! Local ---
  logical :: error
  character(len=12) :: previous
  integer :: i,nn
  !
  ! Code ----
  ! Do not use commands here, only direct SIC routines
  call sic_get_char('IVIEW%PREVIOUS',previous,nn,error)
  do i=1,n
    if (previous.eq.argu(i)) then    
      call sic_let_char('IVIEW%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
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Utility routine.  
  ! 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
  !
  ! Constants
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort)
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  ! Local ---
  real(8) :: drange(2)        ! Range to be read
  character(len=12) :: csort, mysort
  integer :: isort, nn
  !
  ! Code ----
  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 READ FLUX  
  !-------------------------------------------------------
  character(len=*), intent(in) :: name    !! Short file name
  logical, intent(inout) :: error         !! Error return flag
  !
  ! Local ---
  character(len=*), parameter :: rname='READ FLUX'
  type(gildas) :: htab
  integer :: ier
  logical :: err
  integer(kind=index_length) :: dim(2)
  !
  ! Code ----
  ! 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,fits_fmt,head,rdata,error)
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, only : map_message
  use gbl_message
  !-------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Utility routine  
  !   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
  integer, intent(in) :: fits_fmt           !! Is a FITS file ?
  type(gildas), intent(inout) :: head       !! GILDAS header
  real, intent(out) :: rdata(*)             !! Data array
  logical, intent(inout) :: error           !! Error flag
  !
  ! Local ---
  integer(kind=size_length) :: nfill,ndata,nblank
  logical :: err
  !
  ! Code ----
  if (fits_fmt.eq.0) then
    call gdf_read_data(head,rdata,error)
  else
    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')
    ! Close FITS file now for immediate re-use
    err = .false.
    call gfits_close(err)
    !
    ! Patch Blanks if any
    nblank = 0
    err = .false.
    call fitscube2gdf_patch_bval(fd,head,rdata,ndata,nblank,err)
    if (nblank.eq.0) head%gil%eval = -1.0
    !
  endif
  !
  ! Set size
  head%loca%size = product(head%gil%dim(1:head%gil%ndim))
end subroutine map_read_data
!
subroutine get_more_header(fits_fmt,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, get_beam_fits_value
  !-------------------------------------------------------
  ! @ private
  !*
  !   IMAGER -- Utility routine  
  !
  !     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
  integer, intent(in) :: fits_fmt         !! Is it FITS ?
  !
  ! Constants
  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
  integer, parameter :: lmax=54
  !
  ! Local ---
  real(8), pointer :: d1ptr(:)
  real(4), pointer :: r1ptr(:)
  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=24) :: c24
  character(len=80) :: c80
  integer :: nnn, n, n_if, i, nf, ier, next, nstok, ll
  real(4) :: diaml, diamu
  real(8) :: xx, fratio, obsfreq, restfre, redshift, dummy(3)
  real(8) :: ra,dec,dm,dp,ifzero
  real(8), allocatable :: raval(:),deval(:),raoff(:),deoff(:), offs(:,:), ifreq(:)
  real(8), allocatable :: pmra(:), pmdec(:)
  real(8) :: yy,scale
  type(projection_t) :: uv_proj
  !
  ! Code ---
  call map_message(seve%t,'READ','Entering get_more_header')
  !
  ! Always set size
  head%loca%size = product(head%gil%dim(1:head%gil%ndim))
  ll = len_trim(file)
  if (ll.gt.lmax) then
    head%file = '[ '//file(1:20)//'...'//file(ll+30-lmax:ll)//' ]'
  else
    head%file = '[ '//trim(file)//' ]' ! File name
  endif
  !
  ! Convert unusual Keywords
  if (head%char%unit.eq.'beam-1 Jy') head%char%unit ='Jy/beam'
  if (fits_fmt.eq.0) return
  !
  ! Now handle any other critical information from additional Tables
  if (file(1:1).eq.'/'.or.index(file(1:ll),' ').ne.0) 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) then
    call map_message(seve%w,rname,'Ignoring read error in Binary Tables, continuing as much as possible',seve%e)
    error = .false.
  endif
  !
  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",seve%e)
        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)
        if (ier.ne.0) then
          call map_message(seve%e,rname,'Array allocation error')
          err = .false.
          call sic_delvariable('ATMPF',.true.,err)
          error = .true.
          error = .true.
          return
        endif
        !
        call adtoad(desc%addr,cptr,1)
        call c_f_pointer(cptr,d1ptr,[nf])
        raval(:) = d1ptr * pi/180.d0
        do i=1,nf
          if (raval(i).lt.0) raval(i) = raval(i)+2*pi
        enddo
        dm = minval(raval)
        dp = maxval(raval)
        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(c24,'(A,F9.4,A,F9.4,A)') "(",offs(1,i)*rad_to_sec,',',offs(2,i)*rad_to_sec,')'
          c80(next:) = c24
          next = next+24
          if (next.ge.70) 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.',seve%w)
      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
    !
    ! Proper Motion information
    name = 'ATMPF%AIPS_SU%COL%PMRA'
    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
      nf = max(nf,1)
      allocate(pmra(nf),pmdec(nf),stat=ier)
      if (ier.ne.0) then
        call map_message(seve%e,rname,'Array allocation error')
        err = .false.
        call sic_delvariable('ATMPF',.true.,err)
        error = .true.
        return
      endif      
      if (nf.le.1) then
        ! Single field case, just set A0 D0
        call sic_get_dble('ATMPF%AIPS_SU%COL%PMRA',pmra(1),error)
        call sic_get_dble('ATMPF%AIPS_SU%COL%PMDEC',pmdec(1),error)
        !
      else
        ! Convert the Descriptors to Fortran arrays
        !
        call adtoad(desc%addr,cptr,1)
        call c_f_pointer(cptr,d1ptr,[nf])
        pmra(:) = d1ptr
        !
        name = 'ATMPF%AIPS_SU%COL%PMDEC'
        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])
        pmdec(:) = d1ptr
        !
      endif
      xx = maxval(abs(pmra))
      yy = maxval(abs(pmdec))
      xx = max(xx,yy)
      if (xx.gt.0.) then
        if (xx.gt.3E-11) then
          scale = 3600E3*365.25 
        else
          scale = 180/pi*3600E3*86400*365.25
        endif
        pmra = pmra*scale
        pmdec = pmdec*scale
        !
        ! List the Proper Motions 
        call map_message(seve%i,rname,'Proper Motions : ')
        next = 1
        do i=1,nf
          write(c24,'(A,F8.2,A,F8.2,A)') "(",pmra(i),',',pmdec(i),')'
          c80(next:) = c24
          next = next+24
          if (next.ge.70) then
            write(*,'(A)') c80
            next = 1
          endif
        enddo
        if (next.gt.1) write(*,'(A)') c80(1:next-1)
      endif
      !
    endif
    !
    ! ACA antenna size
    if (sic_varexist('ATMPF%AIPS_AN')) then
      ! In theory, one should loop over the various version of the AIPS_AN extensions.
      ! In practice, they are nearly identical for these informations.
      call sic_get_char('ATMPF%AIPS_AN%ARRNAM',name,nnn,error)
      if (name.eq."ALMA") then
        ! Get a pointer 
        name = 'ATMPF%AIPS_AN%COL%DIAMETER'
        nnn = len_trim(name)
        call sic_descriptor(name(1:nnn),desc,found)
        if (found) then
          nf = desc%size
          call adtoad(desc%addr,cptr,1)
          call c_f_pointer(cptr,r1ptr,[nf])
          !
          diaml = minval(r1ptr)
          diamu = maxval(r1ptr)
          if (diaml.ne.diamu) then
            head%gil%teles(1)%diam = diamu
            call map_message(seve%w,rname,"Mixed array telescope size in UVFITS, use at your own risk...",seve%e)
            call gdf_addteles(head,'NAME','ACA',dummy,error)
            head%gil%teles(2) = head%gil%teles(1)
            head%gil%teles(2)%ctele = 'ACA'
            head%gil%teles(2)%diam = diaml
          else
            head%gil%teles(1)%diam = diaml
            if (diaml.ne.0.and.diaml.lt.10) then
              head%gil%teles(1)%ctele = "ACA"
              call map_message(seve%w,rname,"Found ACA data, changed array name")
            endif
          endif
        endif
      endif
    endif
    !
    ! Verify Frequency axis
    if (sic_varexist('ATMPF%RESTFREQ')) then
      call sic_get_dble('ATMPF%RESTFREQ',restfre,error)
      !TEST!Print *,'RestFreq ',RestFre,' ObsFreq ',obsfreq,' reference ',head%gil%convert(2,1)
      !TEST!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
      head%gil%val(1) = head%gil%freq
    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 -- Utility routine 
  !
  !   Update a variable from a FITS  Beam%Col% column
  !   of specified name. Use SIC commands for this.
  !!
  !-------------------------------------------------------
  real, intent(inout) :: r              !! Variable
  character(len=*), intent(in) :: key   !! FITS Column name
  logical, intent(inout) :: error       !! Logical error flag
  !
  character(len=120) :: chain
  !
  !! This could be re-coded using a SIC Descriptor and C_PTR
  !! That would avoid Line command pointer issues
  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 -- Utility routine 
  !
  !   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         !! Logical 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,fits_fmt,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 -- Utility routine 
  !
  !   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
  integer, intent(in) :: fits_fmt         !! FITS format file
  integer, intent(in) :: pcount           !! Fits group size if any
  type(gildas), intent(inout) :: htmp     !! Temporary header, with complete channel range
  type(gildas), intent(inout) :: head     !! Header of actual data,
  !!  using the specified channel range
  integer, intent(in) :: local_nc(2)      !! Channel range
  real, intent(out) :: rdata(:,:)         !! Data array
  logical, intent(inout) :: error         !! Logical Error flag
  !
  ! Local ---
  integer :: astoke
  logical :: eot, err
  !
  ! Code ----
  if (fits_fmt.eq.0) then
    call gdf_read_uvdataset(htmp,head,local_nc,rdata,error)
  else
    ! Make sure the FITS file is at the right position
    call gfits_flush_data(error)
    if (error) return
    !
    if (fits_fmt.gt.1) then
      astoke = 0   ! Get all Stokes parameters, otherwise inconsistent data size
    else
      astoke = 1   ! Only 1 output Stokes
    endif
    call map_read_uvfits(head,astoke,error,eot,pcount,rdata)
    ! Close FITS file now for immediate re-use
    err = .false.
    call gfits_close(err)
    !
  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 imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  !  IMAGER -- Read a complete FITS UV table
  !!
  !---------------------------------------------------------------------
  type(gildas),    intent(inout) :: fits    !! Gildas header corresponding to FITS file
  integer(kind=4), intent(in)    :: astoke  !! Stokes parameter to be read
  logical,         intent(out)   :: error   !! Logical Error flag
  logical,         intent(out)   :: eot     !! End ot Tape flag
  integer(kind=4), intent(in)    :: pcount  !! Daps count
  real, intent(out) :: outarray(:,:)        !! Data array
  !
  ! Constants
  character(len=*), parameter :: rname='READ_UVFITS'
  real(kind=4), parameter :: ps=1.0e-6 ! Because GILDAS uses MHz
  ! Local ---
  character(len=message_length) :: mess
  character(len=1) :: cstoke
  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), parang, msou
  integer(kind=4) :: ier, i, lc
  ! 
  integer(kind=index_length) :: ngood, nflag, nempty, kv, iblc, idim, itrc
  logical :: good, needs_good
  integer :: lsour, lpara
  !
  ! Code ---
  !
  ! 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
  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))
  if (associated(fits%gil%stokes)) then
    in_stokes(:) = fits%gil%stokes(1:in_nstokes)
  else
    in_stokes(:) = code_stokes_none
  endif
  !
  ! 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
  !  
  ! Get useful trailer pointers (from the internals of the GIO library)
  ! WS is the Weight Scaling Factor, WPS in the GIO common !...
  call gio_internals(weight=ws,source=lsour,parang=lpara)
  ws = ws * ps                ! Final weight scaling factor
  !
  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
  msou = -1
  !
  ! 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,parang,good)
      if (error) then
        write(mess,'(A,I0,A)') 'Error occcured at visibility ',KV+IBLC,'  - Rest ignored'
        call gio_message(seve%w,rname,mess)
      endif
      !
      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 columns
        if (fits%gil%ntrail.ne.0) then
          if (lsour.ne.0) then
            outarray(fits%gil%column_pointer(code_uvt_id),kv) = trail
            msou = max(msou,trail)
          endif
          if (lpara.ne.0) then
            outarray(fits%gil%column_pointer(code_uvt_para),kv) = parang
          endif
        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
    if (error) exit
  enddo
  !
  error = .false.
  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 map_message(seve%w,rname, &
      &   'More than 1 Stokes parameter, use STOKES command after',seve%w)
  !
  if (msou.ne.-1) then
    !
    ! Msou contains the largest Source ID, i.e. the number of sources
    if (msou.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
