!
subroutine newuvt_close (xima)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Closes the output table.
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima
  ! Local
  logical :: error
  !-----------------------------------------------------------------------
  if (xima%loca%islo.eq.0) return
  call gdf_close_image(xima,error)
end subroutine newuvt_close
!
subroutine newuvt_init (xima,name,nvis,scan,positions,error)
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! Creates the output table header in X (the significant header parameters
  ! have already been defned in clic_table)
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  ! UV data file
  character(len=*), intent(in) :: name  ! desired file name
  integer, intent(in) :: nvis           ! Number of visibilities
  logical, intent(in) :: scan           ! Use SCAN number
  logical, intent(in) :: positions      ! Add position information
  logical, intent(out) :: error         ! Error flag
  ! Local
  integer :: i, last
  ! for the Telescope section -- Assumes CLIC only handles NOEMA data here
  ! if not, the telescope name should be passed as an argument to newuvt_init
  character(len=8), parameter :: cteles='NOEMA   '
  real(8) :: value(3)
  ! Add section Telescope
  call gdf_addteles(xima,'TELE',cteles,value,error)
  !
  ! Do not nullify X header here: it has already been partly computed before.
  !
  error = .false.
  !
  xima%file = name
  xima%gil%blan_words = def_blan_words
  xima%gil%extr_words = 6
  xima%gil%desc_words = def_desc_words
  xima%gil%posi_words = def_posi_words
  xima%gil%proj_words = def_proj_words
  xima%gil%spec_words = def_spec_words
  xima%gil%reso_words = def_reso_words
  xima%gil%uvda_words = 2 ! Not Zero is enough
  !
  xima%gil%eval = 0.
  xima%gil%dim(2) = nvis              ! +1 ! = add the dummy uv = 7.5 m point
  xima%gil%ref(2) = 0.
  xima%gil%inc(2) = 1.                ! needed to avoid crash in GRAPHIC
  xima%gil%val(2) = 0.
  xima%gil%ndim = 2
  xima%char%unit = 'Jy'
  xima%char%syst = 'EQUATORIAL'
  xima%gil%ptyp = p_azimuthal
  xima%gil%pang = 0.0
  xima%gil%xaxi = 0
  xima%gil%yaxi = 0
  xima%gil%faxi = 1
  xima%gil%form = fmt_r4
  !
  ! Here define the order in which you want the extra "columns"
  xima%gil%column_pointer = 0
  xima%gil%column_size = 0
  xima%gil%column_pointer(code_uvt_u) = 1
  xima%gil%column_pointer(code_uvt_v) = 2
  xima%gil%column_pointer(code_uvt_w) = 3
  xima%gil%column_pointer(code_uvt_date) = 4
  xima%gil%column_pointer(code_uvt_time) = 5
  xima%gil%column_pointer(code_uvt_anti) = 6
  xima%gil%column_pointer(code_uvt_antj) = 7
  xima%gil%natom = 3
  xima%gil%nstokes = 1
  xima%gil%fcol = 8
  last = xima%gil%fcol + xima%gil%natom * xima%gil%nchan - 1
!
! For the time being (1-Feb-2012), force SCAN information in place of W column
  if (scan) then
    xima%gil%column_pointer(code_uvt_w) = 0
    xima%gil%column_pointer(code_uvt_scan) = 3
! Normal code should use an extra column as below
!    last = last+1
!    xima%gil%column_pointer(code_uvt_scan) = last
  endif
!
  if (positions) then
    last = last+1
    xima%gil%column_pointer(code_uvt_loff) = last
    last = last+1
    xima%gil%column_pointer(code_uvt_moff) = last
  endif
  do i=1,code_uvt_last
    if (xima%gil%column_pointer(i).ne.0) xima%gil%column_size(i) = 1
  enddo
  !
  xima%gil%nvisi = nvis
  xima%gil%type_gdf = code_gdf_uvt
  ! CLIC is working in this version of the header
  ! Header will be updated at newuvt_cut stage.
  xima%gil%version_uv = code_version_uvt_freq
  call gdf_setuv (xima,error)
  xima%loca%size = xima%gil%dim(1) * xima%gil%dim(2)
  !!print *, 'Into newuvt_init ',xima%gil%nvisi, xima%gil%nchan, xima%gil%dim(1:2)
  !!print *, 'Into newuvt_init UVDA_WORDS', xima%gil%uvda_words
  call gdf_create_image (xima,error)
  !!print *, 'Done newuvt_init '
end subroutine newuvt_init
!
subroutine newuvt_extend (xima,name,nvis,nn,ndobs,ndscan,error,lc)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Open a Table to extend it.
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  ! UV data file
  character(len=*), intent(in) :: name  ! desired file name
  integer, intent(in) :: nvis           ! Number of visibilities
  logical, intent(out) :: error         ! Error flag
  integer, intent(in) :: nn             !
  integer, intent(in) :: ndobs(nn)      !
  integer, intent(in) :: ndscan(nn)     !
  logical, intent(in) :: lc             ! Check table before
  ! Local
  integer(kind=size_length) :: mvis
  integer :: ier
  character(len=60) :: chain
  real, allocatable :: old(:,:)
  !-----------------------------------------------------------------------
  !
  if (name.ne.xima%file) then
    call message(6,2,'EXTEND_TABLE', 'Unexpected file change')
    error = .true.
    return
  endif
  error = .false.
  !
  ! Compute new size, and remember there may be more preallocated data
  ! than used in the table to be appended
  write(chain,1001) xima%gil%dim(2),nvis
1001 format('Old table size ',i8,' Adding ',i8)
  call message(6,1,'TABLE',chain)
  !
  mvis = xima%gil%dim(2)+nvis
  !
  !!print *,'Lead Trail ',xima%gil%nlead, xima%gil%ntrail
  call gdf_extend_image (xima,mvis,error)
  !!print *,'Lead Trail ',xima%gil%nlead, xima%gil%ntrail
  if (error) then
    call message(8,4,'EXTEND_TABLE','Table extension failed')
    return
  endif
  !
  ! Check old region
  xima%blc(1) = 1
  xima%blc(2) = 1
  xima%trc(1) = xima%gil%dim(1)
  xima%trc(2) = xima%gil%dim(2)-nvis
  !
  if (xima%gil%version_gdf.lt.code_version_gdf_v20) then
  xima%gil%column_pointer(code_uvt_w) = 0
  xima%gil%column_pointer(code_uvt_scan) = 3
  xima%gil%column_size(code_uvt_w) = 0
  xima%gil%column_size(code_uvt_scan) = 1
  endif
  !
  if (lc) then
    allocate (old(xima%gil%dim(1),xima%trc(2)), stat=ier)
    error = ier.ne.0
    if (error) return
    call gdf_read_data(xima,old,error)
    !!Print *,'Done GDF_READ_DATA ', error
    if (.not.error) then
      !!Print *,'Doing CHECK_TABLE ', error
      call check_table(xima%gil%dim(1),xima%trc(2), old, nn,ndobs,ndscan,error)
    endif
    deallocate (old)
    if (error) return
  endif
  !
  ! Map only new region
  xima%blc(1) = 1
  xima%blc(2) = xima%gil%dim(2)+1-nvis
  xima%trc(1) = xima%gil%dim(1)
  xima%trc(2) = xima%gil%dim(2)
  !!print *, 'Done newuvt_extend '
end subroutine newuvt_extend
!
subroutine newuvt_cut (xima,nvis,uv_version,error)
  use image_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Update the number of visibilities
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: xima !
  integer, intent(in) :: nvis         ! True number of visibilities
  integer, intent(in) :: uv_version   ! Target image version 
  logical :: error                    !
  !
  ! Local
  character(len=80) :: chain
  !----------------------------------------------------------------------
  !
  write(chain,1001) xima%gil%dim(2), nvis
  call message(6,1,'TABLE',chain)
  xima%gil%dim(2) = nvis
  xima%gil%nvisi = nvis
  !
  !! print *, 'Doing newuvt_cut ',xima%gil%nchan,xima%gil%nvisi , xima%gil%dim
  call gdf_uv_doppler(xima,uv_version)
  call gdf_update_header(xima,error)
  !! print *, 'Done newuvt_cut ',xima%gil%nchan
  !
1001 format('Old size ',i8,' New ',i8)
end subroutine newuvt_cut

subroutine newuvt_open (xima,name,uv_version,error)
  use image_def
  use gkernel_interfaces
  use gbl_format
  !---------------------------------------------------------------------
  ! Open an existing table, to get the header information
  !---------------------------------------------------------------------
  type(gildas), intent(inout) :: xima  ! Image header
  character(len=*), intent(in) :: name !
  integer,intent(out)          :: uv_version ! Image version 
  logical, intent(out) :: error        !
  ! Global
  !-----------------------------------------------------------------------
  !
  xima%file = name
  xima%loca%read = .false.
  !
  call gdf_read_gildas(xima,name,'.uvt',error, data=.false.)
  uv_version =  xima%gil%version_uv
  ! CLIC is working in this version of the header
  call gdf_uv_doppler(xima,code_version_uvt_freq)
  if (error) return
  !!print *, 'Done newuvt_open ',xima%gil%nchan
end subroutine newuvt_open
!
subroutine newuvt_addvisi (xima,visi,qsb,qband,qbas,qntch,qnchan,   &
    ibase,isb,inbc,frout,fres,datac,datal,passc,passl,   &
    ndrop, good, scan, width, shape, resample, fft, &
    positions, error)
  use image_def
  use phys_const
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  ! Called by CLIC_TABLE
  ! creates one visibility point (i.e. one baseline and one band for a
  ! given scan), but many channels if in line mode.
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  !
  real, intent(out) :: visi(*)      ! Current visibility
  integer :: qsb                    !
  integer :: qband                  !
  integer :: qbas                   !
  integer :: qntch                  !
  integer :: qnchan                 !
  integer :: ibase                  !
  integer :: isb                    !
  integer :: inbc                   !
  real*8 :: frout                   !
  real*4 :: fres
  complex :: datac(qband,qsb,qbas)  !
  complex :: datal(qntch,qsb,qbas)  !
  complex :: passc(qband,qsb,qbas)  !
  complex :: passl(qntch,qsb,qbas)  !
!  real*4 :: daps(7)                 !
!  real*4 :: visi(3, qnchan)         !
!  real*4 :: offsets(2)              !
  integer :: ndrop(2)               !
  logical :: good                   !
  logical :: scan                   !
  real*4 :: width                   !
  character(len=*) :: shape         !
  logical :: resample               !
  logical :: fft                    !
  logical :: positions              !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  ! Local
  complex :: z, zz, zin(mlch), zout(mlch), zscale
  real :: wout(mlch)
  real :: w, ww, tsys(2), ri, afac, factor, fr, save_res, rchan, fresf
  integer :: is, i, j, nw, k, ni, js, i1, i2, nd1, nd2, nch, iw
  integer :: ifirst, ilast, l, nchan, ipola, ia, ja
  integer :: first_polar(mrlband*mch),second_polar(mrlband*mch)
  integer :: first_tsys(mrlband*mch),second_tsys(mrlband*mch)
  integer :: nfirst(mrlband*mch),nsecond(mrlband*mch)
  integer :: ibdata
  logical :: down_channel, ok
  real(8) :: f1, fn, fo1, fon, ff
  character(len=128) :: chain
  !
  integer ki
  !------------------------------------------------------------------------
  ! Code:
  is = isubb_out(1)
  if (is.gt.mbands) is = is-mbands
  if (qsb.eq.1) then ! Check available sideband
    if (r_sband(1,is).ne.isb) then
      call message(6,3,'TABLE','Sideband unavailable')
      error = .true.
      return
    endif
    ibdata = 1
  else
    ibdata = isb
  endif
  !
  rchan = xima%gil%ref(1)
  nchan = xima%gil%nchan
  !
  ! NGRX: This needs more work, if we have here polarizations with different tsys
  ! as a quick workaround, I use only tsys of the first polar.
  !
  ia = r_iant(ibase)
  ja = r_jant(ibase)
  if (weight_tsys) then
    if (inbc.le.r_mapbb(r_nbb)) then
      if (r_sb(is).eq.1) then
        tsys(1) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja)   &
          /dh_integ
        tsys(2) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja)   &
          /dh_integ
      else
        tsys(2) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja)   &
          /dh_integ
        tsys(1) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja)   &
          /dh_integ
      endif
    else
      call message(2,3,'SUB_TABLE',   &
        'Unknown correlator entry')
      error = .true.
      return
    endif
  else
    tsys(1) = 0
    tsys(2) = 0
  endif
  !
  do i = 1, 2*mch
    first_polar(i) = 0
    second_polar(i) = 0
    nfirst(i) = 0
    nsecond(i) = 0
  enddo
  if (tsys(1).eq.0) then
    tsys(1) = 300.**2/dh_integ
  endif
  if (tsys(2).eq.0) then
    tsys(2) = 300.**2/dh_integ
  endif
  !
  if (dobs_0 .eq.0) then
    dobs_0 = mod(dh_obs+32768,65536)-32768
  endif
  ! In CONT mode, correct u and v in each sideband
  ! to the same frequency frout
  if (cont_select) then
    if (isb.eq.1) then
      factor = (r_flo1 + r_fif1)/frout
    elseif (isb.eq.2) then
      factor = (r_flo1 - r_fif1)/frout
    endif
  else
    factor = 1.0
  endif
  visi(xima%gil%column_pointer(code_uvt_u)) = dh_uvm(1,ibase)*factor
  visi(xima%gil%column_pointer(code_uvt_v)) = dh_uvm(2,ibase)*factor
!!  visi(xima%gil%column_pointer(code_uvt_w)) = 0
  if (xima%gil%column_pointer(code_uvt_scan).ne.0) visi(xima%gil%column_pointer(code_uvt_scan)) = r_scan
  visi(xima%gil%column_pointer(code_uvt_date)) = dh_obs
  visi(xima%gil%column_pointer(code_uvt_time)) = dh_utc
  if (phys_base) then
    visi(xima%gil%column_pointer(code_uvt_anti)) = r_kant(r_iant(ibase))
    visi(xima%gil%column_pointer(code_uvt_antj)) = r_kant(r_jant(ibase))
  else
    visi(xima%gil%column_pointer(code_uvt_anti)) = r_iant(ibase)
    visi(xima%gil%column_pointer(code_uvt_antj)) = r_jant(ibase)
  endif
  !
  if (positions) then
!
! There is an ambiguity in CLIC between Pointing and Phase center
! What happens in a MODIFY POSITION ?...
!
! But here, GILDAS assumes this is both the Pointing AND the Phase center
! Further uv_shift will modify the phase center to a common value.
!
! The following code handles both the OTF and the mosaic case.
! In case of pointed observations, dh_offlam is equal to r_lamof.
! For pointed positions NOEMA always uses the pointing center 
! as tracking center.
    if (xima%gil%column_pointer(code_uvt_loff).ne.0) visi(xima%gil%column_pointer(code_uvt_loff)) = dh_offlam(1)*rad_per_sec
    if (xima%gil%column_pointer(code_uvt_moff).ne.0) visi(xima%gil%column_pointer(code_uvt_moff)) = dh_offbet(1)*rad_per_sec
    if (xima%gil%column_pointer(code_uvt_xoff).ne.0) visi(xima%gil%column_pointer(code_uvt_xoff)) = dh_offlam(1)*rad_per_sec
    if (xima%gil%column_pointer(code_uvt_yoff).ne.0) visi(xima%gil%column_pointer(code_uvt_yoff)) = dh_offbet(1)*rad_per_sec
  endif
  !
  ! Other extra columns could be added here...
  !
  visi(xima%gil%fcol:xima%gil%lcol) = 0.0
  good = .false.
  !
  ! Continuum out
  if (cont_select) then
    zz = 0
    ww = 0
    !
    do js = 1, lsubb_out
      is = isubb_out(js)
      if (.not.down_channel(ibase,is)) then
        !
        ! Spectrum from continuum backend:
        if (is.le.r_nband) then
          afac = 1.
          zscale = 1.
          call scaling (is,isb,ibase,zscale,afac,   &
            error)
          z = datac(is,ibdata,ibase)
          w = 2./tsys(isb)*abs(r_cfwid(is))
          if (do_pass) then
            z = z*passc(is,isb,ibase)
          endif
          z = z * zscale
          if (weight_cal) then
            w = w/afac**2
          endif
          !
          zz = zz + z*w
          ww = ww + w
        !
        ! Continuum  from line  backend:
        elseif (is.gt.mbands .and. is.le.r_lband+mbands) then
          is = is - mbands
          afac = 1.
          zscale = 1.
          call scaling (is,isb,ibase,zscale,afac,   &
            error)
          nch = r_lnch(is)
          nd1 = max(ndrop(1),nint(fdrop(1)*nch))+1
          nd2 = nch-max(ndrop(2),nint(fdrop(2)*nch))
          !
          ! Avoid Gibbs-affected channels:
          if (ngibbs.gt.0 .and. abs(r_lfres(is)).gt.0.1) then
            i1 = nch/2-ngibbs
            i2 = nch/2+ngibbs+1
          else
            i1 = nch/2
            i2 = i1+1
          endif
          do i = nd1, nd2
            fr = r_lrfoff(isb,is)   &
              +(i-r_lrch(isb,is))*r_lrfres(isb,is)
            if (nwin_out.gt.0) then
              ok = .false.
              do iw = 1, nwin_out
                ok = ok .or. (fr.gt.window_out(1,iw).and.   &
                  fr.le.window_out(2,iw))
              enddo
            else
              ok = .true.
            endif
            ok = ok .and. (i.le.i1 .or. i.ge.i2)
            if (ok) then
              j = i+r_lich(is)
              z = datal(j,ibdata,ibase)  * zscale
              if (do_pass)then
                if (passl(j,isb,ibase).ne.blankc) then
                  z = z*passl(j,isb,ibase)
                else
                  z =0
                endif
              endif
              w = 2./tsys(isb)*abs(r_lfres(is))
              if (weight_cal) then
                w = w/afac**2
              endif
              zz = zz + z*w
              ww = ww + w
            endif
          enddo
        endif
      endif
    enddo
    ! Put the correct weights now
    if (new_receivers) then
      if (weight_cal) then
        w = 2./tsys(isb)/abs(zscale)**2 * abs(fres)
      else
        w = 2./tsys(isb) * abs(fres)
      endif
    else
       w = ww
    endif
    !
    if (ww.gt.0) then
      zz = zz / ww
      visi(xima%gil%fcol) = real(zz)
      visi(xima%gil%fcol+1) = aimag(zz)
      visi(xima%gil%fcol+2) = w
      good = .true.
    endif
  !
  ! Spectrum out
  else
    nw = 0
    !
    ! Spectrum from Continuum backend
    if (isubb_out(1).le.mbands) then
      !
      k = xima%gil%fcol
      do j = 1, lsubb_out
        i = isubb_out(j)
        afac = 1.
        zscale = 1.
        call scaling (i,isb,ibase,zscale,afac,   &
          error)
        if (.not.down_channel(ibase,i) .and.   &
          i.le.r_nband) then
          z = datac(i,ibdata,ibase) * zscale
          if (do_pass) then
            z = z * passc(i,isb,ibase)
          endif
          visi(k) = real(z)
          visi(k+1) = aimag(z)
          visi(k+2) = w
          good = .true.
        endif
        k = k + 3
      enddo
    !
    ! Spectrum from Line backend
    else
      save_res = xima%gil%fres
      do js = 1, lsubb_out
        is = isubb_out(js)-mbands
        afac = 1.
        zscale = 1.
        call scaling (is,isb,ibase,zscale,afac,   &
          error)
        ipola = r_lpolentry(1,is)
        inbc = r_bb(is)
        if (is.le.r_lband .and.   &
          .not.down_channel(ibase,is+mbands)) then
          fresf = r_lrfres(isb,is)/(1+r_doppl)
          nch = r_lnch(is)
          ! Drop edge channels and unnecessary channels.
          nd1 = max(ndrop(1),nint(fdrop(1)*nch))
          nd2 = max(ndrop(2),nint(fdrop(2)*nch))
          ff = r_lrfoff(isb,is)-xima%gil%freq   &
            -(r_lvoff(isb,is)-xima%gil%voff)/299792.d0*xima%gil%freq
          f1 = ff+(nd1+0.5-r_lrch(isb,is))*fresf
          fn = ff+(nch-nd2+0.5-r_lrch(isb,is))*fresf
          if (fft) then
            if (fresf*xima%gil%fres.gt.0) then
              ifirst = nint(f1/xima%gil%fres+rchan+1)
              ilast  = nint(fn/xima%gil%fres+rchan-1)
            else
              ilast = nint(f1/xima%gil%fres+rchan-1)
              ifirst  = nint(fn/xima%gil%fres+rchan+1)
            endif
            if ((ilast.lt.1) .or. (ifirst.gt.nchan)) then
              write(chain,2000) csub(is+mbands), ifirst, ilast
              l = lenc(chain)
              call message(6,3,'FILL_VISI',chain(1:l))
              goto 98
            endif
            ifirst = max(ifirst,1)
            ilast = min(ilast,nchan)
            fo1 = 1d-3*nint(1d3*   &
              (ifirst-0.5-rchan)*xima%gil%fres)
            fon = 1d-3*nint(1d3*   &
              (ilast+0.5-rchan)*xima%gil%fres)
            do while ((f1-fo1)*(f1-fon).gt.0 .and. nd1.lt.nch)
              f1 = f1+fresf
              nd1 = nd1 +1
            enddo
            ni = nint((ilast-ifirst+1)   &
              *abs(xima%gil%fres/fresf))
          else
            if (fresf*xima%gil%fres.gt.0) then
              ifirst = nint(f1/xima%gil%fres+rchan)
              ilast  = nint(fn/xima%gil%fres+rchan)
            else
              ilast = nint(f1/xima%gil%fres+rchan)
              ifirst  = nint(fn/xima%gil%fres+rchan)
            endif
            if ((ilast.lt.1) .or. (ifirst.gt.nchan)) then
              write(chain,2000) csub(is+mbands), ifirst, ilast
              l = lenc(chain)
              call message(6,3,'FILL_VISI',chain(1:l))
              goto 98
            endif
            ni = nch-nd1-nd2
            ifirst = max(ifirst,1)
            ilast = min(ilast,nchan)
            ilast = min(ilast,ifirst+ni-1)
          endif
          ri = r_lrch(isb,is)-nd1
          do i=1, ni
            j = i+r_lich(is)+nd1
            zin(i) = datal(j,ibdata,ibase)  * zscale
            if (do_pass) then
              if (passl(j,isb,ibase).eq.blankc) then
                zin(i) = 0
              else
                zin(i) = zin(i)*passl(j,isb,ibase)
              endif
            endif
          enddo
          !
          ! Interpolate Gibbs-affected channels:
          if (ngibbs.gt.0 .and. abs(r_lfres(is)).gt.0.1) then
            i1 = nch/2-ngibbs -nd1
            i2 = nch/2+ngibbs+1 -nd1
            do i=i1+1,i2-1
              zin(i) = (zin(i1)*(i2-i)+zin(i2)*(i-i1))/(i2-i1)
            enddo
          endif
          !
          if (resample) then
            ff = (r_lvoff(isb,is)-xima%gil%voff)/299792.d0*xima%gil%freq
            if (ifirst.le.ilast-4 .and. fft) then
              call fft_interpolate (zout(ifirst),   &
                ilast-ifirst+1, xima%gil%fres,   &
                rchan-ifirst+1, xima%gil%freq+ff,   &
                width, shape,   &
                wout(ifirst), zin, ni, fresf,   &
                ri, r_lrfoff(isb,is),   &
                1., 'TPAR', error)
              if (error) goto 98
            else
              call interpolate_2 (zout(ifirst),   &
                ilast-ifirst+1, xima%gil%fres,   &
                rchan-ifirst+1, xima%gil%freq+ff,   &
                wout(ifirst), zin, ni, fresf,   &
                ri, r_lrfoff(isb,is))
            endif
          endif
          xima%gil%vres = -xima%gil%fres*299792.458/xima%gil%freq
          !
          if (resample) then
            do i=ifirst, ilast
              ki = xima%gil%fcol + xima%gil%natom*(i-1)
              visi(ki) =  visi(ki)+real(zout(i))*wout(i)
              visi(ki+1) = visi(ki+1)+aimag(zout(i))*wout(i)
              visi(ki+2) = visi(ki+2)+wout(i)
              if (first_polar(i).eq.0) then
                 first_polar(i) = ipola
                 if (isb.eq.(3-r_sb(is))/2) then
                    first_tsys(i) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja) &
     &                   /dh_integ
                 else
                    first_tsys(i) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja) &
     &                   /dh_integ
                 endif
                 nfirst(i) = 1
              elseif(ipola.eq.first_polar(i)) then
                 if (isb.eq.(3-r_sb(is))/2) then
                    first_tsys(i) = first_tsys(i)                     &
     &                      +r_tsyss(inbc,ia)*r_tsyss(inbc,ja)/dh_integ
                 else
                    first_tsys(i) = first_tsys(i)                     &
     &                      +r_tsysi(inbc,ia)*r_tsysi(inbc,ja)/dh_integ
                 endif
                 nfirst(i) = nfirst(i)+1
              elseif(second_polar(i).eq.0) then
                 second_polar(i) = ipola
                 if (isb.eq.(3-r_sb(is))/2) then
                    second_tsys(i) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja) &
     &                   /dh_integ
                 else
                    second_tsys(i) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja) &
     &                   /dh_integ
                 endif
                 nsecond(i) = 1
              elseif(ipola.eq.second_polar(i)) then
                 if (isb.eq.(3-r_sb(is))/2) then
                    second_tsys(i) =second_tsys(i)                     &
     &                   +r_tsyss(inbc,ia)*r_tsyss(inbc,ja)/dh_integ
                 else
                    second_tsys(i) =second_tsys(i)                     &
     &                   +r_tsysi(inbc,ia)*r_tsysi(inbc,ja)/dh_integ
                 endif
                 nsecond(i) = nsecond(i)+1
              endif
            enddo
          else
            k = 1
            w = 1.0            ! /(ILAST-IFIRST+1) removed 27.07.06 FG
            if (fresf*xima%gil%fres.gt.0) then
              do i=ifirst, ilast
                ki = xima%gil%fcol + xima%gil%natom*(i-1)
                visi(ki) =  visi(ki)+real(zin(k))*w
                visi(ki+1) = visi(ki+1)+aimag(zin(k))*w
                visi(ki+2) = visi(ki+2)+w
                if (first_polar(i).eq.0) then
                   first_polar(i) = ipola
                   if (isb.eq.(3-r_sb(is))/2) then
                      first_tsys(i) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja) &
     &                   /dh_integ
                   else
                      first_tsys(i) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja) &
     &                   /dh_integ
                   endif
                   nfirst(i) = 1
                elseif(ipola.eq.first_polar(i)) then
                   if (isb.eq.(3-r_sb(is))/2) then
                      first_tsys(i) = first_tsys(i)                     &
     &                      +r_tsyss(inbc,ia)*r_tsyss(inbc,ja)/dh_integ
                   else
                      first_tsys(i) = first_tsys(i)                     &
     &                      +r_tsysi(inbc,ia)*r_tsysi(inbc,ja)/dh_integ
                   endif
                   nfirst(i) = nfirst(i)+1
                elseif(second_polar(i).eq.0) then
                   second_polar(i) = ipola
                   if (isb.eq.(3-r_sb(is))/2) then
                      second_tsys(i) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja) &
     &                   /dh_integ
                   else
                      second_tsys(i) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja) &
     &                   /dh_integ
                   endif
                   nsecond(i) = 1
                elseif(ipola.eq.second_polar(i)) then
                   if (isb.eq.(3-r_sb(is))/2) then
                      second_tsys(i) =second_tsys(i)                     &
     &                   +r_tsyss(inbc,ia)*r_tsyss(inbc,ja)/dh_integ
                   else
                      second_tsys(i) =second_tsys(i)                     &
     &                   +r_tsysi(inbc,ia)*r_tsysi(inbc,ja)/dh_integ
                   endif
                   nsecond(i) = nsecond(i)+1
                endif
                k = k+1
              enddo
            else
              do i= ilast, ifirst, -1
                ki = xima%gil%fcol + xima%gil%natom*(i-1)
                visi(ki) =  visi(ki)+real(zin(k))*w
                visi(ki+1) = visi(ki+1)+aimag(zin(k))*w
                visi(ki+2) = visi(ki+2)+w
                k = k+1
                if (first_polar(i).eq.0) then
                   first_polar(i) = ipola
                   if (isb.eq.(3-r_sb(is))/2) then
                      first_tsys(i) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja) &
     &                   /dh_integ
                   else
                      first_tsys(i) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja) &
     &                   /dh_integ
                   endif
                   nfirst(i) = 1
                elseif(ipola.eq.first_polar(i)) then
                   if (isb.eq.(3-r_sb(is))/2) then
                      first_tsys(i) = first_tsys(i)                     &
     &                      +r_tsyss(inbc,ia)*r_tsyss(inbc,ja)/dh_integ
                   else
                      first_tsys(i) = first_tsys(i)                     &
     &                      +r_tsysi(inbc,ia)*r_tsysi(inbc,ja)/dh_integ
                   endif
                   nfirst(i) = nfirst(i)+1
                elseif(second_polar(i).eq.0) then
                   second_polar(i) = ipola
                   if (isb.eq.(3-r_sb(is))/2) then
                      second_tsys(i) = r_tsyss(inbc,ia)*r_tsyss(inbc,ja) &
     &                   /dh_integ
                   else
                      second_tsys(i) = r_tsysi(inbc,ia)*r_tsysi(inbc,ja) &
     &                   /dh_integ
                   endif
                   nsecond(i) = 1
                elseif(ipola.eq.second_polar(i)) then
                   if (isb.eq.(3-r_sb(is))/2) then
                      second_tsys(i) =second_tsys(i)                     &
     &                   +r_tsyss(inbc,ia)*r_tsyss(inbc,ja)/dh_integ
                   else
                      second_tsys(i) =second_tsys(i)                     &
     &                   +r_tsysi(inbc,ia)*r_tsysi(inbc,ja)/dh_integ
                   endif
                   nsecond(i) = nsecond(i)+1
                endif
              enddo
            endif
          endif
98        error = .false.
          continue
        endif
      enddo
      !
      ! Set the proper channel width now
      if (weight_cal) then
        w = 2./abs(zscale)**2 * abs(xima%gil%fres)
      else
        w = 2. * abs(xima%gil%fres)
      endif
      do i=1, nchan
        ki = xima%gil%fcol + xima%gil%natom*(i-1)
        if (visi(ki+2).ne.0) then
          visi(ki) = visi(ki)/visi(ki+2)
          visi(ki+1) = visi(ki+1)/visi(ki+2)
          if (nfirst(i).ne.0) then
             first_tsys(i) = first_tsys(i)/nfirst(i)
             ww = w / first_tsys(i)
          endif
          if (nsecond(i).ne.0) then
             second_tsys(i) = second_tsys(i)/nsecond(i)
             ww = ww+ w / second_tsys(i)
          endif
          if (ww.ne.0) then
             visi(ki+2) = ww
          endif
          good = .true.
        endif
      enddo
      if (abs((save_res-xima%gil%fres)/xima%gil%fres).gt.1e-4) then
        write(chain,'(a,1pg13.6)')   &
          'Channel separation rounded to ',xima%gil%fres
        call message(4,1,'FILL_VISI',chain(1:lenc(chain)))
      endif
    endif
  endif
  return
2000 format('Subband ',a,' maps to output channels ',i9,' to ',i9)
end subroutine newuvt_addvisi
