program uv_subtract
  use image_def
  use gbl_format
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! TASK  UV_SUBTRACT
  !       Subtract a continuum from a line table
  !
  ! Input :
  !	TABLE$	The line UV table
  !	SELF$	The continuum UV table to remove
  !	DTIME$	The smoothing time constant
  !       WCOL$   The column(s) to be subtracted
  !	SUBT$	Subtract point source model from data
  ! S.Guilloteau 19-Jun-1991
  !---------------------------------------------------------------------
  character(len=*), parameter :: rname='UV_SUBTRACT'
  ! Local
  character(len=filename_length) :: uv_table,self_name
  real(8) :: dtime
  integer :: wcol(2)
  real :: factor
  logical :: error
  !
  call gildas_open
  call gildas_char('UV_TABLE$',uv_table)
  call gildas_char('SELF$',self_name)
  call gildas_dble('DTIME$',dtime,1)
  call gildas_inte('WCOL$',wcol,2)
  call gildas_real('SUB$',factor,1)
  call gildas_close
  dtime = 0.5d0*dtime
  !
  call sub_uv_subtract(uv_table,self_name,dtime,wcol,factor,error)
  if (error) call sysexi(fatale)
end program
!
subroutine sub_uv_subtract(uv_table,self_name,dtime,wicol,factor,error)
  use image_def
  use gbl_format
  use gkernel_interfaces
  use mapping_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! TASK  UV_SUBTRACT
  !       Subtract a continuum from a line table
  !
  ! Input :
  !	TABLE$	The line UV table
  !	SELF$	The continuum UV table to remove
  !	DTIME$	The smoothing time constant
  !       WCOL$   The column(s) to be subtracted
  !	SUBT$	Subtract point source model from data
  ! S.Guilloteau 19-Jun-1991
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: uv_table
  character(len=*), intent(in) :: self_name
  real(8), intent(in)  :: dtime
  integer, intent(in)  :: wicol(2)
  real, intent(in)  :: factor
  logical, intent(out) :: error
  !
  character(len=*), parameter :: rname='UV_SUBTRACT'
  ! Local
  type(gildas) :: x,y
  character(len=filename_length) :: name
  character(len=80) :: mess
  real(8) :: time,stime
  integer :: wcol(2)
  !
  complex(4) :: resul, self
  integer :: i,nvs,nvi,nsc,nc,n,j, k, nblock, ier
  real :: rbase(2),reel,imgi,uv(2)
  real :: kilow,weight
  real(8), allocatable :: ipw(:)
  integer, allocatable :: ipi(:)
  real(8) :: freq
  real(8), parameter :: pi=3.14159265358979323846d0
  real(8), parameter :: f_to_k = 1.d0/299792458.d-6
  !
  self = cmplx(1.0,0.0)
  weight = 1.0
  wcol = wicol
  !
  ! Open continuum table
  n = len_trim(self_name)
  if (n.le.0) goto 999
  call gildas_null (y, type = 'UVT')
  name = self_name(1:n)
  call gdf_read_gildas (y, name, '.uvt', error)
  if (error) then
    call map_message(seve%e,rname,'Cannot read input UV table')
    goto 999
  endif
  !
  freq = y%gil%val(1)+y%gil%fres*(y%gil%val(1)/y%gil%freq)*((y%gil%nchan+1)*0.5-y%gil%ref(1))
  kilow = freq*f_to_k
  nsc = min(max(1,wcol(1)),y%gil%nchan)
  wcol(1) = nsc 
  if (wcol(2).eq.0) then
    wcol(2) = nsc
  else
    wcol(2) = max(1,min(wcol(2),nsc))
  endif
  !
  ! Load time variable and sort by time order
  !
  ! Sort self-cal table
  nvs = y%gil%dim(1)
  nvi = y%gil%nvisi
  allocate (ipw(nvi), ipi(nvi), stat=ier)
  call dotime (nvs, nvi, y%r2d, ipw, ipi, stime)
  !
  ! Open line table
  n = len_trim(uv_table)
  if (n.le.0) goto 999
  call gildas_null (x, type = 'UVT')
  name = uv_table
  call gdf_read_gildas (x, name, '.uvt', error, data=.false.)
  if (error) then
    call map_message(seve%e,rname,'Cannot read input/output UV table')
    goto 999
  endif
  !
  call gdf_nitems('SPACE_GILDAS',nblock,x%gil%dim(1))
  nblock = min(nblock,x%gil%dim(2))  ! A decent number of visibilities...
  !
  allocate (x%r2d(x%gil%dim(1),nblock), stat=ier)
  nc = x%gil%nchan
  !
  ! Loop over line table
  x%blc = 0
  x%trc = 0
  do i=1,x%gil%dim(2),nblock
    write(mess,*) i,' / ',x%gil%nvisi,nblock
    call map_message(seve%d,rname,mess)
    x%blc(2) = i
    x%trc(2) = min(x%gil%dim(2),i-1+nblock) 
    call gdf_read_data(x,x%r2d,error)
    k = 1
    do j=x%blc(2),x%trc(2)
      !
      ! Get time and baseline
      call getiba (x%r2d(:,k),stime,time,rbase,uv)
      !
      ! Compute the observed reference visibility for that baseline
      call geself (nvs, nvi, wcol,y%r2d,    &
     &        time,dtime,ipw,ipi,   &
     &        rbase,resul,uv)
      !
      ! No data: flag
      if (resul.eq.cmplx(0.,0.)) then
        call doflag (nc,x%r2d(:,k))
      else
        ! Compute fraction of source to remove
        reel = factor*real(resul)
        imgi = factor*imag(resul)
        ! Remove source
        call dosubt (nc,x%r2d(:,k),reel,imgi)
      endif
      k = k+1
    enddo
    call gdf_write_data (x,x%r2d,error)
  enddo
  ! end loop
  call gdf_close_image(x,error)
  call gdf_close_image(y,error)
  call map_message(seve%i,rname,'Successful completion')
  return
999   error = .true.
end subroutine sub_uv_subtract
