subroutine uv_extract_comm(line, error)
  use gkernel_interfaces
  use imager_interfaces, except_this=>uv_extract_comm
  use gbl_message
  use clean_arrays
  !----------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Parsing for Command UV_EXTRACT  
  !   UV_EXTRACT /RANGE Min Max TYPE /FIELD Number
  !!
  !----------------------------------------------------------
  character(len=*), intent(inout) :: line  !! Command line
  logical, intent(out)            :: error !! Error flag
  !
  character(len=*), parameter  :: rname='UV_EXTRACT'
  integer, parameter           :: o_field=1   ! option /FIELDS
  integer, parameter           :: o_file=2    ! option for /FILE
  integer, parameter           :: o_range=3   ! option for /RANGE 
  real(8) :: drange(2)
  character(len=12) :: csort
  integer :: isort
  integer(kind=4), parameter :: msort=3
  character(len=12) :: types(msort),mysort
  data types /'CHANNEL','VELOCITY','FREQUENCY'/
  !
  character(len=filename_length) :: in_file, ou_file
  integer :: n
  type(gildas) :: hiuv, houv
  logical :: use_file
  real, pointer :: duv_previous(:,:), duv_next(:,:)
  !
  integer(kind=4)             :: nvisi             ! Number of Vibilities
  integer(kind=4)             :: ncols             ! Number of columns in output
  integer :: nblock
  integer :: nc(2)
  logical :: err
  !
  ! Initialization
  if (sic_present(o_field,0)) then
    ! /FIELDS option is special
    if (sic_present(o_range,0)) then
      call map_message(seve%e,rname,'Option /FIELDS and /RANGE are exclusive')
      error = .true.
    else
      call uv_extract_fields(line,error)
    endif
    return
  endif
  !
  if (sic_present(o_range,0)) then
    ! /RANGE (for flexibility)
    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,n,.true.,error)
    if (error) return
    error = .false.
    call sic_ambigs('READ',csort,mysort,isort,types,msort,error)
    if (error)  return
  else
    call map_message(seve%e,rname,'Missing /RANGE specification')
    error = .true.
    return
  endif
  !
  call gildas_null(hiuv,type='UVT')
  call gildas_null(houv,type='UVT')
  !
  if (sic_present(o_file,0)) then
    call sic_ch(line,o_file,1,in_file,n,.true.,error)
    if (error) return
    call sic_parse_file(in_file,' ','.uvt',hiuv%file)
    !
    ! Strip extension if present
    call sic_parsef(in_file,ou_file,' ','.uvt')
    ou_file = in_file
    !
    ! Line (continuum-Free) UV table
    if (sic_present(o_file,2)) then
      call sic_ch(line,o_file,2,ou_file,n,.true.,error)
    else
      ou_file = trim(in_file)//'-line'
    endif
    call sic_parse_file(ou_file,' ','.uvt',houv%file)
    !
    call gdf_read_header(hiuv,error)
    if (error) return
    !
    call gdf_copy_header(hiuv,houv,error)
    !
    ! Set the Blocking Factor
    nblock = space_nitems('SPACE_GILDAS',hiuv,1)
    use_file = .true.
  else
    ! Work with Buffers
    if (huv%loca%size.eq.0) then
       call map_message(seve%e,rname,'No UV data loaded')
       error = .true.
       return
    endif
    !
    use_file = .false.
    call gdf_copy_header(huv,houv,error)
    call gdf_copy_header(huv,hiuv,error)
    !
  endif
  !
  ! Define the input range
  call out_range(rname,mysort,drange,nc,hiuv,error)
  if (error) return
  !  
  ! Adapt the output Header
  call uv_extract_header(houv, nc)
  !
  if (use_file) then
    !
    ! Create the output file
    call sic_parse_file(ou_file,' ','.uvt',houv%file)
    call gdf_create_image(houv,error)
    if (error) return
    ! Perform the extraction
    call uv_extract_sub(hiuv,houv,use_file,nblock,nc,error)
  else
    ! Define previous and destination buffers
    !
    nullify (duv_previous, duv_next)
    ncols = houv%gil%dim(1)
    nvisi = houv%gil%nvisi
    call uv_find_buffers (rname,ncols,nvisi,duv_previous, duv_next,error)
    if (error) then
       call map_message(seve%e,rname,'Cannot set buffer pointers')
       return
    endif
    !
    call gdf_copy_header(huv,hiuv,error)
    hiuv%r2d => duv_previous
    houv%r2d => duv_next
    nblock = 0
    ! Perform the extraction
    call uv_extract_sub(hiuv,houv,use_file,nblock,nc,error)
    !
    ! In Memory: Copy header back to HUV,  and handle buffers
    err = error   ! Save the error Status
    call gdf_copy_header (houv, huv, error)
    ! Reset proper pointers
    call uv_clean_buffers (duv_previous, duv_next,error)
    if (error) return
    ! Redefine SIC variables 
    call map_uvgildas ('UV',huv,error,duv)
    call uv_new_data(weight=.true., resample=.true.)
    if (err) error = .true. 
  endif
  !
end subroutine uv_extract_comm
!
subroutine uv_extract_fields(line,error)
  use gkernel_interfaces
  use gkernel_types
  use imager_interfaces, except_this=>uv_extract_fields
  use gbl_message
  use clean_arrays
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support for Command  
  !   UV_EXTRACT /FIELDS NumberList
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(inout) :: line  !! Command line
  logical, intent(out)            :: error !! Error flag
  !
  ! Constants
  character(len=*), parameter  :: rname='UV_EXTRACT'
  integer, parameter           :: o_field=1   ! option /FIELDS
  integer, parameter           :: o_file=2    ! option for /FILE
  integer, parameter           :: o_range=3   ! option for /RANGE 
  real(8), parameter :: rad_to_sec=3600.d0*180d0/acos(-1.d0)
  !
  ! Local ---
  real, pointer :: duv_previous(:,:), duv_next(:,:)
  !
  ! For /FIELD option
  character(len=120) :: chain
  integer :: nu, nv, mp, np
  integer :: ixoff, iyoff, idoff, ier
  real, pointer :: duv_in(:,:), duv_out(:,:)
  integer :: ifield, jfield, nfields! Field number & Number of fields
  real, allocatable :: doff(:,:)    ! Field offsets
  integer, allocatable :: ivoff(:)  ! Input Visibility pointers
  integer, allocatable :: jvoff(:)  ! Output Visibility pointers
  integer :: ivstart, ivend, kvstart, kvend
  logical :: sorted, shift
  real(8) :: new(3)
  real(4) :: uvmin, uvmax
  !
  logical :: err, found
  type(sic_descriptor_t) :: desc
  integer, allocatable :: fields(:)
  ! 
  ! Code ---
  !
  ! Special /FIELD case: extract the selected fields
  shift = .false.  ! Must be initialized
  !
  mp = abs(themap%nfields)
  if (mp.eq.0) then
    call map_message(seve%e,rname,'UV data is not a Mosaic')
    error = .true.
    return
  endif
  ! Select Fields first
  call sic_delvariable('FIELDS%N_SELECT',.false.,error)
  call sic_delvariable('FIELDS%SELECTED',.false.,error)
  error = .false.
  !
  call select_fields(rname,line,o_field,mp,np,fields,error)
  if (error) return
  !
  allocate(doff(2,mp),ivoff(mp+1),jvoff(mp+1),stat=ier)
  if (ier.ne.0) then
    call map_message(seve%e,rname,'Memory allocation failure')
    error = .true.
    return
  endif
  !
  nu = huv%gil%dim(1)
  nv = huv%gil%nvisi
  if (themap%nfields.gt.0) then
    ixoff = huv%gil%column_pointer(code_uvt_xoff)
    iyoff = huv%gil%column_pointer(code_uvt_yoff)
  else
    ixoff = huv%gil%column_pointer(code_uvt_loff)
    iyoff = huv%gil%column_pointer(code_uvt_moff)
  endif
  idoff = huv%gil%column_pointer(code_uvt_id)
  !
  ! This one would work only for Sorted Mosaics.
  !! call mosaic_loadfield (duv,nu,nv,ixoff,iyoff,mp,doff,ivoff,uvmax,uvmin)
  new = 0.d0
  call mosaic_sort (error,sorted,shift,new,uvmax,uvmin, &
    & ixoff, iyoff, idoff, mp, doff,ivoff)
  !
  nv = 1
  do jfield=1,np 
    ifield = fields(jfield)
    jvoff(jfield) = nv
    nv = nv + ivoff(ifield+1)-ivoff(ifield)
    jvoff(jfield+1) = nv
  enddo
  nv = nv-1
  nfields = np  
  !
  ! Prepare appropriate array...
  nullify (duv_previous, duv_next)
  call uv_find_buffers (rname,nu,nv,duv_previous, duv_next,error)
  if (error) then
    call map_message(seve%e,rname,'Cannot set buffer pointers')
    return
  endif
  !
  do jfield=1,nfields
    ifield = fields(jfield)
    ! This looks tricky, but is working.
    ! It is used to extract an arbitrary subset of all fields
    ! In input Ifield
    ivstart = ivoff(ifield)      ! Starting Visibility of field
    ivend   = ivoff(ifield+1)-1  ! Ending Visibility of field
    ! In output Jfield
    kvstart = jvoff(jfield)      ! Starting Visibility of field
    kvend   = jvoff(jfield+1)-1  ! Ending Visibility of field
    write(chain,'(A,I0,4(1X,I0),2F10.2)') 'Processing field # ',ifield, &
      & ivstart,ivend, kvstart, kvend, doff(1,ifield)*rad_to_sec, doff(2,ifield)*rad_to_sec
    call map_message(seve%i,rname,chain)
    !
    ! Set the range
    duv_in => duv(:,ivstart:ivend)
    duv_out => duv_next(:,kvstart:kvend)
    !
    ! Copy...
    duv_out = duv_in
  enddo  
  ! Reset proper pointers
  call uv_clean_buffers (duv_previous, duv_next,error)
  if (error) return
  ! Redefine SIC variables 
  huv%gil%nvisi = nv
  huv%gil%dim(2) = nv
  !
  ! Delete variables that may have been affected
  err = .false.
  call sic_descriptor('UVS',desc,found)  
  if (found) call sic_delvariable('UVS',.false.,err)
  !
  call check_uvdata_type(rname,huv,duv,themap,error)
  call uv_new_data(weight=.true.)
  !
  deallocate(fields)
end subroutine uv_extract_fields
!
subroutine uv_extract_header(huv, nc)
  use image_def
  use gkernel_interfaces, only : gdf_range
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --
  !   Support for Command    UV_EXTRACT /RANGE     
  !
  !   Setup output header consistently
  !!
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: huv    !! Header to be modified
  integer, intent(in) :: nc(2)          !! Desired channel range
  !
  ! Local ---
  integer :: local_nc(2), ier, nchan, icol, lshift
  integer :: nf, ns, istart, iend
  real(8), allocatable :: freqs(:)
  integer, allocatable :: stokes(:)
  !
  ! Code ----
  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
  !
  ! Shift trailing columns if needed
  if (huv%gil%ntrail.gt.0) then
    huv%gil%dim(1) = huv%gil%dim(1)+huv%gil%ntrail
    lshift = (huv%gil%nchan-nchan)*huv%gil%nstokes*huv%gil%natom
    do icol=1,code_uvt_last
      if (huv%gil%column_pointer(icol).gt.huv%gil%lcol) then
        !Print *,'Shifting ',l,' by ',-huvin%gil%lcol+huvou%gil%lcol
        huv%gil%column_pointer(icol) = huv%gil%column_pointer(icol) - lshift
      endif
    enddo
  endif 
  !
  huv%gil%nchan = nchan
  !
  ! Shift random frequency information if any
  if (huv%gil%nfreq.ne.0) then
    nf = huv%gil%nfreq
    ns = max(1,huv%gil%nstokes)
    allocate(freqs(nf),stokes(nf))
    freqs(:) =  huv%gil%freqs(:)
    stokes(:) = huv%gil%stokes(:)
    deallocate(huv%gil%freqs,huv%gil%stokes)
    !
    ! Each channel counts for NS Stokes 
    huv%gil%nfreq = nchan*ns
    allocate(huv%gil%freqs(huv%gil%nfreq),huv%gil%stokes(huv%gil%nfreq),stat=ier)
    istart = (local_nc(1)-1)*ns + 1
    iend   = local_nc(2)*ns
    huv%gil%freqs(:) = freqs(istart:iend)
    huv%gil%stokes(:) = stokes(istart:iend)
  endif
  !  
end subroutine uv_extract_header
!
subroutine uv_extract_sub(hiuv,houv,use_file,nblock,channels,error)
  use image_def
  use gkernel_interfaces
  use imager_interfaces, except_this=>uv_extract_sub
  use gbl_message
  !----------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support routine for command UV_EXTRACT /RANGE 
  !
  !    Extract a range of channels from a UV table
  !!
  !----------------------------------------------------------
  type(gildas), intent(inout) :: hiuv     !! Input UV header
  type(gildas), intent(inout) :: houv     !! Extracted UV header
  logical, intent(in)         :: use_file !! File indicator
  integer, intent(in)         :: nblock   !! Blocking factor
  integer, intent(in) :: channels(2)      !! Limits for the new UV table in channels
  logical, intent(inout) :: error         !! Error flag
  !
  character(len=*), parameter :: rname='UV_EXTRACT'
  !
  ! Local ---
  character(len=80) :: mess
  integer(kind=index_length)  :: ib           ! Blocked visibility counter
  integer(kind=index_length)  :: mvisi        ! Number of blocked visibilities
  integer(kind=index_length)  :: nvisi        ! Number of visibilities
  integer(kind=index_length)  :: ivisi        ! Index for loop over visibilities
  integer(kind=index_length)  :: fcoli        ! First column of extractable data in UV buffer
  integer(kind=index_length)  :: lcoli        ! Last column of extractable data in UV buffer
  integer(kind=index_length)  :: fcolo        ! First column of data in temporary UV buffer
  integer(kind=index_length)  :: lcolo        ! Last column of data in temporary UV buffer
  integer :: ier
  !
  fcoli = hiuv%gil%nlead+1+(channels(1)-1)*hiuv%gil%nstokes*hiuv%gil%natom
  lcoli = hiuv%gil%nlead+channels(2)*hiuv%gil%nstokes*hiuv%gil%natom
  fcolo = houv%gil%nlead+1
  lcolo = houv%gil%dim(1)-houv%gil%ntrail
  !
  if (use_file) then
    !
    ! Data file case - Use blocking
    mvisi = nblock
    hiuv%blc = 0
    houv%blc = 0
    !
    allocate(hiuv%r2d(hiuv%gil%dim(1),mvisi),houv%r2d(houv%gil%dim(1),mvisi),stat=ier)
    if (ier.ne.0) then
      call map_message(seve%e,rname,'Memory allocation error')
      error = .true.
      return
    endif
    !
    do ib=1,hiuv%gil%dim(2),mvisi
      !
      ! Read the data
      write(mess,*) ib,' / ',hiuv%gil%dim(2),mvisi
      call map_message(seve%i,rname,mess)
      hiuv%blc(2) = ib
      hiuv%trc(2) = min(hiuv%gil%dim(2),ib-1+mvisi)
      nvisi = hiuv%trc(2)-hiuv%blc(2)+1
      call gdf_read_data(hiuv,hiuv%r2d,error)
      if (error) return
      !
      do ivisi=1, nvisi
        ! Copy first columns
        houv%r2d(1:houv%gil%nlead,ivisi) = hiuv%r2d(1:hiuv%gil%nlead,ivisi)
        ! Copy data
        houv%r2d(fcolo:lcolo,ivisi) = hiuv%r2d(fcoli:lcoli,ivisi)
        ! Copy trailing columns if any
        if (houv%gil%ntrail.gt.0) then
          houv%r2d(houv%gil%dim(1)-houv%gil%ntrail+1:houv%gil%dim(1),ivisi) = & 
            hiuv%r2d(hiuv%gil%dim(1)-hiuv%gil%ntrail+1:hiuv%gil%dim(1),ivisi)  
        endif
      enddo
      !
      houv%blc = hiuv%blc
      houv%trc = hiuv%trc
      call gdf_write_data (houv,houv%r2d,error)
      if (error) return
    enddo
    !
    deallocate(hiuv%r2d,houv%r2d)  
    call gdf_close_image(hiuv,error)
    call gdf_close_image(houv,error)
    if (error) return
    !
    call map_message(seve%i,rname,'Created '//trim(houv%file))
    !
  else
    ! Memory version
    do ivisi=1, hiuv%gil%nvisi
      ! Copy first columns
      houv%r2d(1:houv%gil%nlead,ivisi) = hiuv%r2d(1:hiuv%gil%nlead,ivisi)
      ! Copy data
      houv%r2d(fcolo:lcolo,ivisi) = hiuv%r2d(fcoli:lcoli,ivisi)
      ! Copy trailing columns if any
      if (houv%gil%ntrail.gt.0) then
        houv%r2d(houv%gil%dim(1)-houv%gil%ntrail+1:houv%gil%dim(1),ivisi) = & 
          hiuv%r2d(hiuv%gil%dim(1)-hiuv%gil%ntrail+1:hiuv%gil%dim(1),ivisi)  
      endif
    enddo
  endif
  !
end subroutine uv_extract_sub
