subroutine uv_extract_main(line, error)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>uv_extract_main
  use gbl_message
  use clean_arrays
  !----------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  ! Command line interaction for UV_EXTRACT command
  !----------------------------------------------------------
  character(len=*), intent(inout) :: line  ! Command line
  logical, intent(out)            :: error ! Error flag
  !
  character(len=*), parameter  :: rname='UV_EXTRACT'
  integer, parameter           :: opt_rang=1 ! option for range
  integer, parameter           :: opt_freq=2 ! option for frequency
  integer, parameter           :: opt_widt=3 ! option for width
  integer, parameter           :: nunits =3
  character(len=10)            :: units(3)
  data units/'CHANNEL','FREQUENCY','VELOCITY'/
  !
  real(kind=4)      :: range(2)         ! Range of channels, velocities or frequencies
  integer           :: chlength         ! Argument length
  integer           :: centralchannel   ! Central channel in case of /frequency usage
  real(kind=8)      :: frequency        ! Frequency around which to extract signal
  real(kind=4)      :: width            ! Width to extract around frequency in unit
  integer           :: channels(2)      ! Limits for the new UV table in channels
  character(len=10) :: unitin           ! Input unit
  character(len=10) :: unit             ! Treated unit
  integer           :: dummy            ! dummy integer for one off operations
  !
  ! Initialization
  !
  width = 1
  unitin = 'CHANNEL'
  !
  ! Interface
  !
  if (huv%loca%size.eq.0) then
     call map_message(seve%e,rname,'No UV data loaded')
     error = .true.
     return
  endif
  if (sic_present(opt_freq,0).and.sic_present(opt_rang,0)) then
     call map_message(seve%e,rname,"Options /FREQUENCY and /RANGE are mutually exclusive.")
     error = .true.
     return
  else if (sic_present(opt_freq,0)) then
     call sic_r8(line, opt_freq, 1, frequency, .true., error)
     if (sic_present(opt_widt,0)) then
        call sic_r4(line, opt_widt, 1, width, .true., error)
        call sic_ke(line, opt_widt, 2, unitin, chlength, .false., error)
     endif
     call sic_ambigs (rname,unitin,unit,chlength,units,nunits,error)
     if (error) return
     !
     ! Transform frequency + width to range
     !
     call uv_spectral_frequency_sel(frequency, width, unit, channels, error)
  else if (sic_present(opt_rang,0)) then
     call sic_r4(line, opt_rang, 1, range(1), .true., error)
     call sic_r4(line, opt_rang, 2, range(2), .true., error)
     call sic_ke(line, opt_rang, 3, unitin, chlength, .false., error)
     call sic_ambigs (rname,unitin,unit,chlength,units,nunits,error)
     if (error) return
     !
     ! Go from range to channels
     !
     call uv_spectral_range_sel(range, unit, channels, error)
  else
     call map_message(seve%e,rname,"Options /RANGE OR /FREQUENCY must be present.")
     error = .true.
     return
  endif
  !
  call uv_extract_sub(channels, error)
end subroutine uv_extract_main
!
subroutine uv_extract_sub(channels, error)
  use gkernel_interfaces
  use mapping_interfaces, except_this=>uv_extract_sub
  use clean_def
  use clean_types
  use clean_arrays
  use gbl_message
  !----------------------------------------------------------
  ! @ private
  !
  ! MAPPING
  !    Support routine for command UV_extract
  !    Extract a range of channels from a UV table
  !----------------------------------------------------------
  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'
  !
  integer                     :: nchan             ! Number of channels of new UV table  
  type(gildas)                :: tempuv            ! Temporary UV buffer to store cropped UV table
  real, pointer               :: duv_previous(:,:) ! original UV buffer pointer
  real, pointer               :: duv_next(:,:)     ! Destiny UV buffer pointer
  integer                     :: ier               ! Integer error flag
  ! the following two variable have to be Kind 4 for compatibility with buffer initiliazation
  integer(kind=4)             :: nvisi             ! Number of Vibilities
  integer(kind=4)             :: ncols             ! Number of columns in output
  integer(kind=index_length)  :: lastc             ! Last channel to be copied
  integer(kind=index_length)  :: ivisi             ! Index for loop over visibilities
  integer(kind=index_length)  :: firstcolin        ! First column of extractable data in UV buffer
  integer(kind=index_length)  :: lastcolin         ! Last column of extractable data in UV buffer
  integer(kind=index_length)  :: firstcolout       ! First column of data in temporary UV buffer
  integer(kind=index_length)  :: lastcolout        ! Last column of data in temporary UV buffer
  integer(kind=4)             :: icol              ! Index to loop through columns
  !
  nchan = channels(2)-channels(1)+1  
  !
  ! Create, fill header and allocate internal UV buffer for data manipulation
  !
  call gildas_null(tempuv, type= 'UVT')
  call gdf_copy_header(huv, tempuv, error)
  if (error) then
     call map_message(seve%e,rname,"Failed to copy header from buffer UV table into temporary buffer")
     return
  endif
  !
  ! Fixing header
  !
  tempuv%gil%nchan = nchan
  tempuv%gil%ref(1) = huv%gil%ref(1)-channels(1)+1
  tempuv%gil%fcol = tempuv%gil%nlead+1
  tempuv%gil%lcol = tempuv%gil%nlead + tempuv%gil%natom*tempuv%gil%nchan
  tempuv%gil%dim(1) = tempuv%gil%lcol + tempuv%gil%ntrail
  ncols = tempuv%gil%dim(1)
  nvisi = tempuv%gil%dim(2)
  !
  ! Shift the trailing columns of the output table by the right amount
  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
      tempuv%gil%column_pointer(icol) = &
        huv%gil%column_pointer(icol) - (huv%gil%lcol-tempuv%gil%lcol)
    endif
  enddo
  !
  ! Define initial points for copy
  !
  if (channels(1).ge.1.and.channels(1).le.huv%gil%nchan) then
     firstcolin = huv%gil%nlead+(channels(1)-1)*huv%gil%natom+1
     firstcolout = tempuv%gil%nlead+1
  else if (channels(1).lt.1) then
     firstcolin = huv%gil%nlead+1
     firstcolout = tempuv%gil%nlead+(abs(channels(1))+1)*huv%gil%natom+1
     if (firstcolout.gt.(tempuv%gil%dim(1)-tempuv%gil%ntrail)) then
        firstcolin = -1 ! this means nothing to copy
     endif
  else if (channels(1).gt.huv%gil%nchan) then
     firstcolin = -1 ! this means nothing to copy
  endif
  !
  ! Define final points for copy
  !
  if (channels(2).ge.1.and.channels(2).le.huv%gil%nchan) then
     lastcolin = huv%gil%nlead+channels(2)*huv%gil%natom
     lastcolout = tempuv%gil%nlead+tempuv%gil%nchan*tempuv%gil%natom
  else if (channels(2).lt.0) then
     firstcolin = -1 ! this means nothing to copy
  else if (channels(2).gt.huv%gil%nchan) then
     lastcolin = huv%gil%dim(1)-tempuv%gil%ntrail
     lastc = nchan-huv%gil%nchan ! last copy channel
     lastcolout = tempuv%gil%nlead+(lastc+huv%gil%nchan)*tempuv%gil%natom
  endif
  !
  ! Define previous and destiny buffers
  !
  nullify (duv_previous, duv_next)
  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
  ! Zero out output UV table to simplify copy operations
  duv_next(:,:) = 0.0
  !
  ! Now copy only the wanted channels to the temporary buffer, parallelizable on the visibilities
  !   
  !$OMP PARALLEL &
  !$OMP DEFAULT(none) &
  !$OMP SHARED(huv, duv_previous, duv_next, tempuv, firstcolin, lastcolin, firstcolout, lastcolout, nvisi) &
  !$OMP PRIVATE(ivisi)
  !$OMP DO
  do ivisi=1, nvisi
     ! Copy first columns
     duv_next(1:huv%gil%nlead,ivisi) = duv_previous(1:huv%gil%nlead,ivisi)
     ! Copy data, if there is any data to copy
     if (firstcolin.ne.-1) duv_next(firstcolout:lastcolout,ivisi) = duv_previous(firstcolin:lastcolin,ivisi)
     ! Copy trailing columns if any
     if (tempuv%gil%ntrail.gt.0) then
        duv_next(tempuv%gil%dim(1)-tempuv%gil%ntrail+1:tempuv%gil%dim(1),ivisi) =   &
             &     duv_previous(huv%gil%dim(1)-huv%gil%ntrail+1:huv%gil%dim(1),ivisi)  
     endif
  end do
  !$OMP END DO
  !$OMP END PARALLEL  
  !
  ! Now Copy header from tempuv to huv, and handle buffers
  !
  call gdf_copy_header(tempuv, huv, error)
  ! Reset proper pointers
  call uv_clean_buffers (duv_previous, duv_next,error)
  if (error) return
  ! Redefine SIC variables 
  call sic_delvariable ('UV',.false.,error)
  call sic_mapgildas ('UV',huv,error,duv) 
end subroutine uv_extract_sub
