program uv_zero
  use gildas_def
  use gkernel_interfaces
  real :: weight, factor, flux
  character(len=filename_length) :: uv_table, greg_table
  logical :: error, do_spectrum
  !------------------------------------------------------------------------
  ! Code:
  call gildas_open
  call gildas_char( 'UV_TABLE$', uv_table)
  call gildas_real( 'FLUX$', flux, 1)
  call gildas_logi( 'DO_SPECTRUM$', do_spectrum, 1)
  call gildas_char( 'GREG_TABLE$', greg_table)
  call gildas_real( 'WEIGHT$', weight, 1)
  call gildas_real( 'FACTOR$', factor, 1)
  call gildas_close
  !
  call sub_uv_zero(uv_table,flux,do_spectrum,greg_table,weight,factor,error)
  if (error) call sysexi(fatale)
  !  
end program
!
subroutine sub_uv_zero(uv_table,flux,do_spectrum,greg_table,weight,factor,error)
  use gildas_def
  use gkernel_interfaces
  use image_def
  use gbl_format
  use gbl_message
  !---------------------------------------------------------------------
  ! UV_ZERO: Add zero spacing to a UV Table from a Single Dish Spectrum.
  ! Input :
  !	  a UV table
  !	  a GREG table built by the CLASS\GREG command
  ! Output :
  !	  the input UV table
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: uv_table
  character(len=*), intent(in) :: greg_table
  real, intent(in) :: weight
  real, intent(in) :: factor
  real, intent(in) :: flux
  logical, intent(in) :: do_spectrum
  logical, intent(out) :: error
  ! Local
  character(len=*), parameter :: rname='UV_ZERO'
  character(len=80) :: mess
  type(gildas) :: hin, htab
  integer :: n, ncol, nchan, nzero, nvisi, ier
  integer :: codes(2)
  integer(kind=index_length) :: mvis
  !
  error = .false.
  !
  ! Input GREG table (zero spacing spectrum)
  if (do_spectrum) then
    n = len_trim(greg_table)
    if (n.le.0) then
      call gag_message(seve%e,rname,'No input spectrum name')
      error = .true.
      return
    endif
    call gildas_null(htab)
    call gdf_read_gildas(htab,greg_table,'.tab',error)
    if (error) then
      call gag_message(seve%e,rname,'Cannot read input spectrum')
      return
    endif
    nchan = htab%gil%dim(1)
    ncol = htab%gil%dim(2)
  else
    nchan = 1
    ncol = 1
    allocate (htab%r2d(nchan,ncol), stat=ier)
  endif
  !
  ! Input file
  n = len_trim(uv_table)
  if (n.le.0) then
    call gag_message(seve%e,rname,'No input name')
    error = .true.
    return
  endif
  call gildas_null(hin, type = 'UVT')
  call gdf_read_gildas(hin, uv_table, '.uvt', error, data=.false.)
  if (error) then
    call gag_message(seve%e,rname,'Cannot read input UV Table')
    return
  endif
  allocate (hin%r2d(2,hin%gil%nvisi),stat=ier)
  codes(1:2) = [code_uvt_u,code_uvt_v] 
  call gdf_read_uvonly_codes(hin, hin%r2d, codes, 2, error)
  if (error) return
  !
  nvisi = hin%gil%dim(2)  ! Check up to available space
  call find_zero(hin%r2d,nvisi,nzero)
  if (nzero.ne.0) then
    write(mess,'(A,I0)') 'Zero visibility found at ',nzero
    call gag_message(seve%i,rname,mess)
  endif
  deallocate (hin%r2d)
  !
  ! Now only use the Zero spacing visibility, old or new
  allocate (hin%r2d(hin%gil%dim(1),1), stat=ier)
  !
  if (nzero.eq.0) then
    !
    call gdf_close_image(hin,error)
    mvis = hin%gil%dim(2)+1      ! Add one visibility
    call gdf_extend_image(hin,mvis,error)
    if (error) then
      call gag_message(seve%e,rname,'Table extension failed')
      return
    endif
    nzero = mvis
    hin%r2d = 0
    hin%blc(1) = 1
    hin%trc(1) = hin%gil%dim(1)
    hin%blc(2) = nzero 
    hin%trc(2) = nzero 
  else
    hin%blc(1) = 1
    hin%trc(1) = hin%gil%dim(1)
    hin%blc(2) = nzero 
    hin%trc(2) = nzero 
    call gdf_read_data(hin,hin%r2d,error)
  endif
  !
  call add_zero(hin,nchan,ncol,htab%r2d, hin%r2d,   &
     &    weight, factor, flux, do_spectrum, error)
  if (error) return
  call gdf_write_data (hin,hin%r2d,error)
  if (error) return
  call gdf_close_image(hin,error)
  call gag_message(seve%i,rname,'Successful completion')
  !
end subroutine sub_uv_zero
!
subroutine add_zero(hin,nchan,ncol,spec,vis, weight, factor,  &
  flux, do_spectrum, error)
  use gildas_def
  use image_def
  use gkernel_interfaces
  use gbl_message
  !---------------------------------------------------------------------
  ! Add on visibility for zero spacing.
  !---------------------------------------------------------------------
  type(gildas), intent(in) :: hin         ! UV table header
  integer,intent(in) :: nchan             ! Number of channels
  integer,intent(in) :: ncol              ! Number of values per channel
  real, intent(in) :: spec(nchan,ncol)    ! Spectrum
  real, intent(out) :: vis(*)             ! Visibility
  real, intent(in) :: weight              ! Weight value
  real, intent(in) :: factor              ! Scale factor
  real, intent(in) :: flux                ! Continuum flux
  logical, intent(in) :: do_spectrum      ! 
  logical, intent(out) :: error      ! Error flag
  !
  character(len=*), parameter :: rname='UV_ZERO'
  ! Local
  integer :: i, ifirst, ilast, ier, nc, gdate
  real(8) :: dchan, rchan
  real, allocatable :: rdata(:)
  !------------------------------------------------------------------------
  ! Code:
  nc = hin%gil%nchan 
  vis(1:3) = 0.0
  call sic_gagdate(gdate)
  vis(4) = gdate     ! Current date
  vis(5) = 0.0
  vis(6:7) = -1.0    ! Convention: Antenna # -1 for Short spacings
  !
  if (do_spectrum) then
    !
    allocate (rdata(nc), stat=ier)
    if (ier.ne.0) then
      call gag_message(seve%e,rname,'Memory allocation failure')
      error = .true.
      return
    endif
    rdata(:) = 0
    !
    ! Search for reference channel
    dchan = spec(2,5)-spec(1,5)
    rchan = (hin%gil%freq-spec(1,5)) / dchan + 1.
    !
    ! Check limits to be filled
    if (dchan*hin%gil%fres.gt.0) then
      ifirst = nint((1-rchan)*dchan/hin%gil%fres + hin%gil%ref(1))
      ilast  = nint((nchan-rchan)*dchan/hin%gil%fres + hin%gil%ref(1))
    else
      ifirst = nint((nchan-rchan)*dchan/hin%gil%fres + hin%gil%ref(1))
      ilast  = nint((1-rchan)*dchan/hin%gil%fres + hin%gil%ref(1))
    endif
    ifirst = max(ifirst,1)
    ilast = min(ilast,nc)
    if (ifirst.gt.nc .or. ilast.lt.1) then
      call gag_message(seve%e,rname,'Spectra do not intersect')
      error = .true.
      return
    endif
    !
    ! Resample new spectrum
    call interpolate(   &
     &      rdata(ifirst),ilast-ifirst+1,hin%gil%fres,   &
     &      hin%gil%ref(1)-ifirst+1,hin%gil%freq,   &
     &      spec,nc,dchan,rchan,hin%gil%freq)
    !
    do i=1, nc
      vis(5 + 3*i) = rdata(i) * factor + flux
      vis(6 + 3*i) = 0
      vis(7 + 3*i) = weight
    enddo
  else
    do i=1, nc
      vis(5 + 3*i) = flux
      vis(6 + 3*i) = 0
      vis(7 + 3*i) = weight
    enddo
  endif
end subroutine add_zero
!
subroutine find_zero(vis,nv,nzero)
  use gildas_def
  !---------------------------------------------------------------------
  ! Find zero spacing visibility
  !---------------------------------------------------------------------
  integer, intent(in) :: nv          !
  real, intent(in) :: vis(2,nv)      !
  integer, intent(out) :: nzero      !
  ! Local
  integer :: i
  !------------------------------------------------------------------------
  ! Code:
  nzero = 0
  do i=1, nv
    if (vis(1,i).eq.0 .and. vis(2,i).eq.0) then
      nzero = i
      exit
    endif
  enddo
end subroutine find_zero
!
subroutine interpolate (x,xdim,xinc,xref,xval, & !! w,   &
    y,ydim,yinc,yref,yval)
  !---------------------------------------------------------------------
  ! Cloned from CLIC interpolate_2 routine
  !	Performs the linear interpolation/integration
  !
  ! 1) if actual interpolation (XINC <= YINC)
  !     this is a 2-point linear interpolation formula.
  !     the data is untouched if the resolution is unchanged and the shift
  !     is an integer number of channels.
  !
  ! 2) if not (XINC > YINC)
  !     boxcar convolution (width xinc-yinc) followed by linear interpolation
  !
  !---------------------------------------------------------------------
  integer :: xdim                   !
  real :: x(xdim)                !
  real(8) :: xinc                    !
  real(8) :: xref                      !
  real(8) :: xval                    !
  !! real :: w(xdim)                   !
  integer :: ydim                   !
  real :: y(ydim)                !
  real(8) :: yinc                      !
  real(8) :: yref                      !
  real(8) :: yval                    !
  ! Local
  integer :: i,imax,imin, j
  real(8) :: pix, val, expand
  real :: scale, ww
  !-----------------------------------------------------------------------
  !
  expand = abs(xinc/yinc)
  do i = 1, xdim
    !
    ! Compute interval
    val = xval + (i-xref)*xinc
    pix = (val-yval)/yinc + yref
    if (expand.gt.1.) then
      imin = int(pix-expand/2d0+0.5d0)
      imax = int(pix+expand/2d0+0.5d0)
      ! This initial test was stupid.... It rejected ANY channel which did not match
      ! the exact final sampling...
      !      IF ((MIN(IMIN,IMAX).LT.1).OR.(MAX(IMIN,IMAX).GT.YDIM)) THEN
      !      Print *,'Rejecting ',imin,imax,ydim
      !         W(I) = 0
      !         X(I) = 0
      ! We are here ADDING channels together to produce wider ones.
      ! Edge channels must be accounted for with their weight corresponding to the
      ! fraction of the final channel width covered by the initial sampling.
      !
      ! The band stitching will then be done properly in FILL_VISI, since this
      ! contribution  is added to the final visibility
      if (imin.lt.1) then
        imin = 1
        ww = 1.0               ! The whole channel is in...
      else
        ww = imin-(pix-expand/2d0-0.5d0)
      endif
      x(i) = y(imin)*ww
      scale = ww
      !
      if (imax.gt.ydim) then
        imax = ydim
        ww = 1.0
      else
        ww = pix+expand/2d0+0.5d0-imax
      endif
      x(i) = x(i) + y(imax)*ww
      scale = scale + ww
      !
      do j=imin+1, imax-1
        x(i) = x(i) + y(j)
        scale = scale+1.
      enddo
      ! Normalize
      !! w(i) = scale/expand      ! This is the fraction of channel covered
      x(i) = x(i)/scale
    else
      imin = int(pix)
      imax = imin+1
      if ((imin.lt.1).or.(imax.gt.ydim)) then
        !! w(i) = 0
        x(i) = 0
      else
        !! w(i) = 1
        x(i) = y(imin)*(imin+1-pix) + y(imin+1)*(pix-imin)
      endif
    endif
  enddo
end subroutine interpolate
!
