subroutine comm_proper_motion(line,comm,error)
  use gkernel_interfaces
  use clean_arrays
  use clean_types
  use gbl_message
  use imager_interfaces, only : proper_motion, proper_motion_file, uv_new_data
  use imager_interfaces, only : map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command 
  !     PROPER_MOTION PmRa PmDec [Epoch] [/FILE In Out]
  !
  !   Apply specified proper motion to current or specified UV Table
  !
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: line    !! Command line
  character(len=*), intent(in) :: comm    !! Command name
  logical, intent(inout) :: error         !! Error flag
  !
  integer, parameter :: o_file=1
  !
  character(len=filename_length) :: input,output
  character(len=16) :: ch
  integer :: n,i
  integer :: jepoch,j2000
  real(8) :: yepoch
  logical :: keep(3)
  real(8) :: proper(3) ! In mas/yr and Year
  integer :: nvisi
  !
  ! Input parameters
  proper = 0
  do i=1,2
    call sic_ch(line,0,i,ch,n,.true.,error)
    if (error) return
    if (ch.eq.'*') then
      keep(i) = .true.
    else
      call sic_r8(line,0,i,proper(i),.true.,error)
      if (error) return
      keep(i) = .false.
    endif
  enddo
  if (sic_present(0,3)) then
    call sic_ke(line,0,3,ch,n,.true.,error)
    if (ch.eq.'*') then
      keep(3) = .true.
    else
      if (index(ch,'-').ne.0) then
        call gag_fromdate(ch,jepoch,error)
        if (error) return
        ch = '01-JAN-2000'
        call gag_fromdate(ch,j2000,error)
        yepoch = (jepoch-j2000)/365.25d0 + 2000.0d0 ! Corresponding Epoch in Years
      else
        call sic_r8(line,0,3,yepoch,.true.,error)
        if (error) return
      endif
      keep(3) = .false.
      proper(3) = yepoch
    endif
  else
    keep(3) = .true.
  endif
  !
  if (sic_present(o_file,0)) then
    ! Not yet prepared -- Need more work...
    call sic_ch(line,o_file,2,output,n,.true.,error)
    if (error) return
    call sic_ch(line,o_file,1,input,n,.true.,error)
    if (error) return
    call proper_motion_file (comm,input, output, proper, keep, error)
  else
    if (.not.associated(duv)) then
      call map_message(seve%e,comm,'No UV data loaded')
      error = .true.
      return
    endif
    nvisi = huv%gil%nvisi
    if (keep(3).and.huv%gil%astr_words.eq.0)  proper(3)=2000.d0 ! In case nothing
    call proper_motion (proper,keep,huv,nvisi,duv)
    !
    ! Define the Proper Motion section
    huv%gil%epoc = proper(3)
    huv%gil%astr_words = def_astr_words ! 3
    huv%gil%mura = proper(1)
    huv%gil%mudec = proper(2)
    huv%gil%parallax = 0.0 
    ! Force reading if needed (no Buffer used)
    optimize(code_save_uv)%change = 2
!    call sic_delvariable('UV',.false.,error)
!    call uv_new_data(weight=.false.)
  endif
end subroutine comm_proper_motion
!
subroutine proper_motion_file (rname, cuvin, cuvou, proper, keep, error)
  use gkernel_interfaces
  use image_def
  use gbl_message
  use imager_interfaces, only : proper_motion, map_message
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER -- Support for command PROPER_MOTION
  !
  !      Apply specified proper motion to an input UV Table
  !   and write it on an output UV table. Version working on files.
  !!
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: rname   !! Caller name
  character(len=*), intent(in) :: cuvin   !! Input file name
  character(len=*), intent(in) :: cuvou   !! Output fiel name
  real(8), intent(inout) :: proper(3)     !! muRA muDec Epoch
  logical, intent(in) :: keep(3)          !! Keep previous values
  logical, intent(out) :: error           !! Error flag
  !
  ! Local ---
  character(len=80)  :: mess
  type (gildas) :: uvin
  type (gildas) :: uvou
  integer :: ier, nblock, ib, nvisi
  !
  ! Code ----
  error = len_trim(cuvin).eq.0
  if (error) then
    call map_message(seve%e,rname,'No input UV table name')
    return
  endif
  !
  call gildas_null (uvin, type = 'UVT')     ! Define a UVTable gildas header
  call gdf_read_gildas (uvin, cuvin, '.uvt', error, data=.false.)
  if (error) then
    call map_message(seve%e,rname,'Cannot read input UV table')
    return
  endif
  if (keep(3).and.uvin%gil%astr_words.eq.0)  proper(3)=2000.d0 ! In case nothing
  !
  ! Modify the header of the output UV table according to the desired goal
  call gildas_null (uvou, type = 'UVT')     ! Define a UVTable gildas header
  call gdf_copy_header(uvin,uvou,error)
  call sic_parse_file(cuvou,' ','.uvt',uvou%file)
  !
  uvou%gil%astr_words = def_astr_words ! 3
  uvou%gil%mura = proper(1)
  uvou%gil%mudec = proper(2)
  uvou%gil%parallax = 0.0
  uvou%gil%epoc = proper(3)
  !
  ! create the image
  call gdf_create_image(uvou,error)
  !
  ! 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 (ier.ne.0) then
    write(mess,*) 'Memory allocation error ',uvin%gil%dim(1), nblock
    call map_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  ! Loop over line table - The example assumes the same
  ! number of visibilities in Input and Output, which may not
  ! be true...
  uvin%blc = 0
  uvin%trc = 0
  uvou%blc = 0
  uvou%trc = 0
  do ib = 1,uvin%gil%dim(2),nblock
    write(mess,*) ib,' / ',uvin%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)
    !
    ! Here do the job
    nvisi = uvou%trc(2)-uvou%blc(2)+1
    !
    ! Note that we use UVIN to have the old proper motion & Epoch...
    call proper_motion (proper,keep,uvin,nvisi,uvin%r2d)
    !
    call gdf_write_data (uvou,uvin%r2d,error)
    if (error) return
  enddo
  !
  ! Finalize the image
  call gdf_close_image(uvin,error)
  call gdf_close_image(uvou,error)
  !
end subroutine proper_motion_file
!
subroutine proper_motion (mu,keep,huv,nvisi,visi)
  use gkernel_interfaces
  use image_def
  !---------------------------------------------------------------------
  ! @ private
  !*
  ! IMAGER --  Support for command PROPER_MOTION
  !
  !   Apply specified proper motion to a GILDAS UV data set in Memory.
  !!
  !---------------------------------------------------------------------
  real(8), intent(inout) :: mu(3)       !! Proper motion mas/yr & Year
  logical, intent(in) :: keep(3)        !! Keep previous values
  type (gildas), intent(in) :: huv      !! UV Header
  integer, intent(in) :: nvisi          !! Number of visibilities
  real(4), intent(inout) :: visi(huv%gil%dim(1),nvisi)  !! Visibility array
  !
  ! Constants
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 2.d0*pi/299792458.d-6
  real, parameter :: rad_to_sec=180.0*3600.0/pi
  integer, parameter :: md=100 ! This is a dammn lot of observing time !
  !
  ! Local ---
  real(8) :: mudif(3),muold(3),pos(2),freq,dpos(2)
  character(len=11) :: cdate
  integer :: i, ix, iu, iv, id, zerold
  real(4) :: reel, imag
  real(8) :: uu, vv, phi, sphi, cphi, d, dyear
  real(4) :: dayold, dold
  logical :: error, uv8
  !
  integer :: jd,nd
  integer :: aday(md)
  real :: apos(2,md)
  logical :: missing
  !
  !   Old PM in mas/yr & Epoch in days
  muold = [huv%gil%mura,huv%gil%mudec,huv%gil%epoc]
  if (huv%gil%astr_words.eq.0) muold(3) = mu(3)     ! No epoch, use specified one
  if (keep(1)) mu(1) = muold(1)
  if (keep(2)) mu(2) = muold(2)
  if (keep(3)) mu(3) = muold(3)
  !
  zerold = int(muold(3))
  write(cdate,'(A,I4)') '01-JAN-',zerold
  call gag_fromdate(cdate,id,error)
  dayold = id + 365.25*(muold(3)-zerold)
  !
  mudif = mu-muold       ! Difference
  !
  ! Get proper motion in Rad/year
  mudif(1:2) = mudif(1:2)*1d-3*pi/180D0/3600d0 ! Radians / year
  muold(1:2) = muold(1:2)*1d-3*pi/180D0/3600d0 ! Radians / year
  !
  ! Global displacement between epochs
  if (keep(3)) then
    dpos = 0.d0
  else
    ! Simple linear offsets...
    dpos = muold(1:2)*mudif(3)
  endif
  !Print *,'DPOS ',dpos(1)*rad_to_sec,dpos(2)*rad_to_sec
  !
  ! Get observing frequency
  freq = gdf_uv_frequency(huv)
  !
  uv8 = huv%gil%column_size(code_uvt_u).ne.1
  !
  iu = huv%gil%column_pointer(code_uvt_u)
  iv = huv%gil%column_pointer(code_uvt_v)
  id = huv%gil%column_pointer(code_uvt_date)
  if (uv8) print *,'UV8 ',uv8,iu,iv,id
  !
  dold = 0
  nd = 0
  !Print *,' Visi       Date     Jzero      Dyear      Pos(1:2)'
  do i = 1,nvisi
    if (uv8) then
      call r4tor4 (visi(iu,i),uu,2)   ! Avoid r8tor8 for alignment problems
      call r4tor4 (visi(iv,i),vv,2)
    else
      uu = visi(iu,i)                 ! Implicit Real(4) -> Real(8) conversion
      vv = visi(iv,i)
    endif
    !
    ! Get date in CLASS Days
    d = visi(id,i)
    ! Get time increment in Days / Days per year
    dyear = (d-dayold)/365.25
    ! Get moving Position at this date
    pos = mudif(1:2)*dyear
    ! Shift the Phases to the new Epoch 
    pos = pos - dpos
    ! Collect per day position changes for printing
    if (d.ne.dold) then
      missing = .true.
      do jd=1,nd
        if (d.eq.aday(jd)) then
          missing = .false.
          exit
        endif
      enddo
      !
      if (missing) then
        nd = nd+1
        aday(nd) = d
        apos(:,nd) = pos*rad_to_sec
      endif
      dold = d
    endif
    !
    ! compute new phase center in wavelengths
    pos = - freq * f_to_k * pos
    phi = pos(1)*uu + pos(2)*vv
    cphi = cos(phi)
    sphi = sin(phi)
    do ix = huv%gil%fcol, huv%gil%lcol, huv%gil%natom
      reel = visi(ix,i) * cphi - visi(ix+1,i) * sphi
      imag = visi(ix,i) * sphi + visi(ix+1,i) * cphi
      visi(ix,i) = reel
      visi(ix+1,i) = imag
    enddo
  enddo
  !
  ! Print per day positoin changes
  write(*,'(A)') '   Date      d(alpha)   d(beta)'
  do jd=1,nd
    call gag_todate(aday(jd),cdate,error)
    write(*,'(A,F9.3,F9.3)') cdate,apos(1,jd),apos(2,jd)
  enddo
  !
end subroutine proper_motion

