subroutine uv_add_comm(line,error)
  !$ use omp_lib
  use image_def
  use clean_arrays
  use gkernel_interfaces
  use gbl_format
  use gbl_message
  use imager_interfaces, only : map_message 
  !-----------------------------------------------------------------------
  ! @ private
  !*
  !  IMAGER -- Support for command UV_ADD
  !
  !   UV_ADD ITEM [Mode] [/FILE FileIn FileOut]
  !
  ! Task to compute and add some missing information in a UV
  ! Table, such as the Doppler correction and the Parallactic Angle 
  !
  ! Gets the Observatory from the Telescope name in the input UV table,
  ! suggests to use SPECIFY command if not available.
  !!
  !-----------------------------------------------------------------------
  character(len=*), intent(in)    :: line   !! Command line
  logical,          intent(inout) :: error  !! Logical error flag
  ! 
  ! Constants
  character(len=*), parameter :: rname='UV_ADD'
  real(kind=8), parameter :: clight_kms=299792.458d0
  real(kind=8),  parameter :: pi=3.141592653589793d0
  integer, parameter :: o_file=1
  integer, parameter :: mvoc=2
  character(len=16) :: vocab(mvoc)
  data vocab/'DOPPLER','PARALLACTIC'/
  !
  ! Local ---
  character(len=16) :: argum,key
  integer :: ikey
  integer :: mthread
  character(len=filename_length) :: file
  character(len=12) :: telescope
  type (gildas) :: uvin, uvou
  integer(kind=4) :: nf, ier, ib, n
  integer(kind=index_length) :: i,j
  real(kind=4) :: rdate, rtime, doppler, parang
  character(len=2) :: coord
  character(len=80) :: mess
  real(kind=4) :: equinox
  real(kind=8) :: lambda, beta
  integer(kind=4) :: nblock, nvisi, idate, itime
  logical :: dofile
  integer(kind=4) :: mode
  integer(kind=4) :: idopp
  integer(kind=4) :: ipara
  integer :: count
  real(8), allocatable :: when(:)
  integer(kind=4), allocatable :: iorder(:)
  !
  ! Code ----
  ! Make sure the Ephemeris are available
  call astro_init
  !
  ! Get the Key for adding some stuff.
  argum = '*'
  call sic_ke(line,0,1,argum,n,.false.,error)
  if (argum.ne.'*') then
    call sic_ambigs (rname,argum,key,ikey,vocab,mvoc,error)
    if (error) return
  else
    key = '*'
  endif
  !
  ! /FILE option
  dofile = sic_present(o_file,0)
  !
  ! Argument MODE is a test control only
  mode = 0
  if (dofile) mode = -1
  call sic_i4(line,0,2,mode,.false.,error)
  if (error)  return
  if (mode.lt.0) then
    if (.not.dofile) then
      call map_message(seve%e,rname,'Negative MODE not allowed without /FILE')
      error = .true.
      return
    endif
  else if (mode.gt.0 .and. mode.ne.3) then
    if (mode.gt.uvin%gil%dim(1)) then
      call map_message(seve%e,rname,'Error: MODE larger than number of columns')
      error = .true.
      return
    else
      call map_message(seve%w,rname,'Warning: MODE is neither 0 nor 3')
    endif
  endif  
  !
  ! Open the input file and read Header
  call gildas_null (uvin, type = 'UVT')     ! Define a UVTable gildas header
  if (dofile) then
    call sic_ch(line,o_file,1,file,nf,.true.,error)
    if (error)  return
    call gdf_read_gildas (uvin, file, '.uvt', error, data=.false.)
    if (error) then
      call map_message(seve%e,rname,'Cannot read input UV table')
      return
    endif
  else
    if (huv_current%loca%size.eq.0) then
      call map_message(seve%e,rname,'No UV table loaded')
      error = .true.
    else
      call gdf_copy_header(huv_current,uvin,error)
    endif
    if (error) return
  endif
  !
  ! Define the telescope name
  if (uvin%gil%nteles.ne.0) then
    telescope = uvin%gil%teles(1)%ctele   
  else
    call map_message(seve%e,rname,'No telescope in UV table, use SPECIFY command')
    error = .true.
    return
  endif
  call astro_observatory_byname(telescope,error)
  if (error) return
  !
  call gildas_null (uvou, type = 'UVT')     ! Define a UVTable gildas header
  if (dofile) then
    call sic_ch(line,o_file,2,file,nf,.true.,error)
    if (error) return
    ! Define blocking factor, on largest data file, usually the input one
    ! but not always...
    call gdf_nitems('SPACE_GILDAS',nblock,uvin%gil%dim(1)) ! Visibilities at once
    nblock = min(nblock,uvin%gil%dim(2))
    ! Allocate respective space for each file
    allocate (uvin%r2d(uvin%gil%dim(1),nblock),stat=ier)
    if (failed_allocate(rname,'UV input data',ier,error))  return
    !
  else
    ! Work in place
    uvin%r2d => duv 
  endif
  !
  ! Here modify the header of the output UV table according
  ! to the desired goal
  call gdf_copy_header(uvin,uvou,error)
  !
  idopp = 0
  ipara = 0
  if (key.eq.'*' .or. key.eq.'DOPPLER') then
    !
    ! Inherit the Pointer for Doppler effect
    idopp = uvou%gil%column_pointer(code_uvt_topo) 
    call find_dummy_column (uvou,idopp,mode)
    if (key.eq.'DOPPLER' .and. idopp.eq.0) then
      call map_message(seve%e,rname,'No Doppler column available')
      error = .true.
    else
      uvou%gil%column_pointer(code_uvt_topo) = idopp
      uvou%gil%column_size(code_uvt_topo) = 1
    endif
  endif
  !
  if (key.eq.'*' .or. key.eq.'PARALLACTIC') then
    !
    ! Inherit the Pointer for Doppler effect
    ipara = uvou%gil%column_pointer(code_uvt_para) 
    call find_dummy_column (uvou,ipara,mode)
    if (key.eq.'PARALLACTIC' .and. ipara.eq.0) then
      call map_message(seve%e,rname,'No Parallactic Angle column available')
      error = .true.
    else
      uvou%gil%column_pointer(code_uvt_para) = ipara
      uvou%gil%column_size(code_uvt_para) = 1
    endif
  endif
  !
  if (ipara.eq.idopp) then
    call map_message(seve%e,rname,'Cannot place Doppler and Parallactic angle in same column')
    error = .true.
  else if (.not.error) then
    if (idopp.ne.0) then
      write(mess,'(A,I0)') 'Placing Doppler factor in column ',idopp
      call map_message(seve%i,rname,mess)
    endif
    if (ipara.ne.0) then
      write(mess,'(A,I0)') 'Placing Parallactic Angle in column ',ipara
      call map_message(seve%i,rname,mess)
    endif
  endif
  if (error) then
    call gdf_close_image(uvin,error)
    deallocate(uvin%r2d,stat=ier)
    error = .true.
    return
  endif
  !
  !
  uvou%gil%vtyp = vel_lsr
  coord = uvin%char%syst
  if (coord.eq.'EQ') then
    equinox = uvin%gil%epoc
    lambda = uvin%gil%ra
    beta   = uvin%gil%dec
  else if (coord.eq.'GA') then
    equinox = uvin%gil%epoc
    lambda = uvin%gil%lii
    beta   = uvin%gil%bii
  else
    call map_message(seve%w,rname,'Unsupported system '//coord)
    call map_message(seve%w,rname,'Assuming EQUATORIAL 2000.0')
    coord = 'EQ'
    equinox = 2000.0
    lambda = uvin%gil%ra
    beta   = uvin%gil%dec
  endif
  !
  rdate = -1e38
  rtime = -1e38
  idate = uvin%gil%column_pointer(code_uvt_date)
  itime = uvin%gil%column_pointer(code_uvt_time)
  !
  if (dofile) then
    call sic_parse_file(file,' ','.uvt',uvou%file)
    !
    ! create the image
    uvou%gil%dopp = 0.d0
    uvou%gil%version_uv = code_version_uvt_syst
    call gdf_create_image(uvou,error)
    if (error) then
      call gdf_close_image(uvin,error)
      deallocate(uvin%r2d,stat=ier)
      error = .true.
      return
    endif
    !
    ! Check if additional columns are needed
    if (uvin%gil%dim(1).ne.uvou%gil%dim(2)) then
      allocate(uvou%r2d(uvou%gil%dim(1),uvou%gil%dim(2)),stat=ier)
      if (ier.ne.0) then
        call gdf_close_image(uvin,error)
        call gdf_close_image(uvou,error)
        deallocate(uvin%r2d,stat=ier)
        error = .true.
        return
      endif
    else
      uvou%r2d => uvin%r2d
    endif
    !
    ! Loop over line table
    allocate (when(nblock),iorder(nblock))
    !
    uvou%blc = 0
    uvou%trc = 0
    uvin%blc = 0
    uvin%trc = 0
    !
    mthread = 1
    !$ mthread = omp_get_max_threads()
    count = 0
    do ib = 1,uvou%gil%dim(2),nblock
      write(mess,*) ib,' / ',uvou%gil%dim(2),nblock
      call map_message(seve%i,rname,mess)
      uvin%blc(2) = ib
      uvin%trc(2) = min(uvin%gil%dim(2),ib-1+nblock)
      uvou%blc(2) = ib
      uvou%trc(2) = uvin%trc(2)
      !
      call gdf_read_data(uvin,uvin%r2d,error)
      nvisi = uvin%trc(2)-uvin%blc(2)+1
      if (uvin%gil%dim(1).ne.uvou%gil%dim(2)) then
        uvou%r2d(1:uvin%gil%dim(1),:) = uvin%r2d(:,:)
      endif
      !
      ! Do the job - This is be much faster if the file is Time sorted
      when(1:nvisi) = uvou%r2d(idate,1:nvisi)*86400d0 + uvou%r2d(itime,1:nvisi)
      do i=1,nvisi
        iorder(i) = i
      enddo
      call gr8_trie(when,iorder,nvisi,error)
      !
      ! Parallelism is possible if RDATE and RTIME are PRIVATE and 
      ! re-initialized at each block, but this proved inefficient.
      !
      ! svisi = (nvisi+mthread-1)/mthread
      ! !$OMP PARALLEL DEFAULT(none) NUM_THREADS(mthread) &
      ! !$OMP & SHARED (nvisi,uvou, idate, itime, ipara, idopp) &
      ! !$OMP & PRIVATE (i,j,rdate,rtime,doppler,parang,error,rw) &
      ! !$OMP & SHARED (coord,equinox,lambda,beta, svisi, count, iorder, when)
      ! !$ rdate = -1e38
      ! !$ rtime = -1e38
      ! !$OMP DO SCHEDULE(STATIC,svisi) REDUCTION(+:count)
      do j=1,nvisi
        i  = iorder(j)
        !
        ! 2 seconds is more than enough a tolerance for our case.
        ! In practice, we recompute at each scan, in fact.
        if (uvou%r2d(idate,i).ne.rdate .or. (abs(uvou%r2d(itime,i)-rtime).gt.2.0) ) then
          rdate = uvou%r2d(idate,i)
          rtime = uvou%r2d(itime,i)
          call sub_uv_doppler_para(uvou%gil%vtyp,rdate,rtime,doppler,parang,&
            coord,equinox,lambda,beta,error)
          count = count+1
        endif
        if (idopp.ne.0) uvou%r2d(idopp,i) = doppler
        if (ipara.ne.0) uvou%r2d(ipara,i) = parang
      enddo
      ! !$OMP ENDDO
      ! !$OMP END PARALLEL
      if (sic_ctrlc()) then
        error = .true.
        call map_message(seve%e,rname,'Aborted by ^C')
      else
        call gdf_write_data (uvou,uvou%r2d,error)
      endif
      if (error) then
        call gdf_close_image(uvou,error)
        call gdf_close_image(uvin,error)
        if (uvin%gil%dim(1).ne.uvou%gil%dim(2)) then
          deallocate(uvou%r2d,stat=ier)
        else
          nullify(uvou%r2d)
        endif
        deallocate(uvin%r2d,stat=ier)
        error = .true.
        return
      endif
    enddo
    write(mess,'(A,I0,A)') 'Called ',count,' times ephemerides'
    call map_message(seve%i,rname,mess)
    !
    call gdf_close_image(uvin,error)
    call gdf_close_image(uvou,error)
    if (uvin%gil%dim(1).ne.uvou%gil%dim(2)) then
      deallocate(uvou%r2d,stat=ier)
    else
      nullify(uvou%r2d)
    endif
    deallocate(uvin%r2d,stat=ier)
  else
    call map_message(seve%i,rname,'Working on current UV table')
    do i=1,uvin%gil%nvisi
      !
      if (uvin%r2d(idate,i).ne.rdate .or. uvin%r2d(itime,i).ne.rtime) then
        rdate = uvin%r2d(idate,i)
        rtime = uvin%r2d(itime,i)
        call sub_uv_doppler_para(uvou%gil%vtyp,rdate,rtime,doppler,parang,&
          coord,equinox,lambda,beta,error)
        ! factor = (1.d0 + doppler)
      endif
      if (idopp.ne.0) uvin%r2d(idopp,i) = doppler
      if (ipara.ne.0) uvin%r2d(ipara,i) = parang
    enddo
    if (sic_ctrlc()) then
      error = .true.
      call map_message(seve%e,rname,'Aborted by ^C')
      return
    endif
    !
    call gdf_copy_header(uvou,huv_current,error)
  endif
end subroutine uv_add_comm
!
subroutine sub_uv_doppler_para(vtype,rdate,rtime,doppler,parang, &
        & coord,equinox,lambda,beta,error)
  use gbl_constant
  use phys_const
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for UV_ADD command
  !
  ! Compute the Doppler correction, calling ASTRO routine, according to:
  ! * observatory location, 
  ! * reference frame (LSR, Helio...)
  ! Radio convention is used
  !
  ! Also get the Parallactic Angle 
  !!
  !---------------------------------------------------------------------
  integer(kind=4),  intent(in)  :: vtype    !! Type of referential
  real(kind=4),     intent(in)  :: rdate    !! GAG Date
  real(kind=4),     intent(in)  :: rtime    !! UT Time
  real(kind=4),     intent(out) :: doppler  !! Doppler factor
  real(kind=4),     intent(out) :: parang   !! Parallactic Angle
  character(len=2), intent(in)  :: coord    !!
  real(kind=4),     intent(in)  :: equinox  !!
  real(kind=8),     intent(in)  :: lambda   !!
  real(kind=8),     intent(in)  :: beta     !!
  logical,          intent(out) :: error    !! flag
  !
  ! Local ---
  real(kind=8) :: vshift
  real(kind=8) :: s_2(2), s_3(3), dop, lsr, svec(3), x_0(3), dparang
  real(kind=8) :: jtdt, jut1, jutc
  !
  ! Code ---
  doppler = -1d0
  !
  ! Reset the time
  jutc = rdate + rtime/86400.d0 +  2460549.5d0
  !
  ! For what we want to do, these are negligible
  jut1 = 0.d0
  Jtdt = 0.
  call do_astro_time(jutc,jut1,jtdt,error)
  if (error) return
  !
  ! Call ASTRO
  call do_object(coord,equinox,lambda,beta,s_2,s_3,dop,lsr,svec, &
      &   x_0,dparang,error)
  if (error) return
  !
  ! Now retrieve the Doppler value
  !
  select case (vtype)
  case (vel_lsr)
     vshift = dop+lsr
  case (vel_hel)
     vshift = dop
  case (vel_ear)
     vshift = 0.0d0
  case default
     vshift = 0.0d0
  end select
  !
  ! This follows the CLASS convention, but it seems that the
  ! CLIC convention is WRONG ...
  doppler = - vshift / clight * 1d3
  !
  parang = dparang
end subroutine sub_uv_doppler_para
!
subroutine find_dummy_column(uvou,icode,mode)
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  ! GILDAS --  Locate a re-usable dummy or empty column in UV header
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: uvou !! UV Header
  integer, intent(inout) :: icode     !! Column code -- must be zero
  integer, intent(in)    :: mode      !! Preferred column - if zero, an empty one
  !
  ! Local ---
  integer :: i
  !
  ! Code ----
  if (icode.ne.0) return
  !
  if (uvou%gil%column_pointer(code_uvt_moff).ne.0 .and. &
    & uvou%gil%column_pointer(code_uvt_loff).eq.0) then
    ! Use the (often) Dummy MOFF column
    icode = uvou%gil%column_pointer(code_uvt_moff)
    uvou%gil%column_size(code_uvt_moff) = 0
    uvou%gil%column_pointer(code_uvt_moff) = 0
  else if (uvou%gil%column_pointer(code_uvt_id).ne.0) then
    ! or the Source ID column
    icode = uvou%gil%column_pointer(code_uvt_id)
    uvou%gil%column_size(code_uvt_id) = 0
    uvou%gil%column_pointer(code_uvt_id) = 0 
  else if (mode.gt.0) then
    ! or as a fall back, column indicated by MODE
    icode = mode 
    do i = 1,code_uvt_last
      if (uvou%gil%column_pointer(i).eq.icode)  then
        uvou%gil%column_size(i) = 0
        uvou%gil%column_pointer(i) = 0
      endif
    enddo
  else if (mode.lt.0) then
    !
    ! Add an Empty column
    uvou%gil%ntrail = uvou%gil%ntrail+1
    uvou%gil%dim(1) = uvou%gil%dim(1)+1
    icode = uvou%gil%dim(1)
  else
    ! or find an empty column (not coded yet)
  endif
end subroutine find_dummy_column
