subroutine clic_table(line,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use clic_xypar
  use clic_index
  use clic_rdata
  !---------------------------------------------------------------------
  ! CLIC  Internal routine.
  ! Prepare a UV Table (GILDAS Format)
  ! Command :
  !   TABLE file_name OLD|NEW
  ! 1   /RESAMPLE nchan rchan res VELOCITY|FREQUENCY
  ! 2   /DROP n1 n2
  ! 3   /COMPRESS tmax uvmax
  ! 4   /FREQUENCY name frest
  ! 5   /NOCHECK [SOURCE|POINTING|EPOCH|PHASE|SCAN]
  ! 6   /SCAN Replace w coordinate by scan number.  (set by default  !...)
  ! 7   /FFT  Fourier Transform resampling algorithm
  ! 8   /MOSAIC   Add Phase offsets, without checking POINTING & PHASE
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'gbl_memory.inc'
  ! Local
  integer :: mfvoc, mfilvoc, nkey, mshavoc, mchavoc, nk
  parameter (mfvoc=2, mfilvoc=2, mshavoc=4, mchavoc=5)
  logical :: lcheck(mchavoc)
  integer :: tnchan, ndrop(2), nvis, nvisi, nfl, new_scans(m_cx),  nchan
  integer :: new_dates(m_cx), n_new
  integer(kind=address_length) :: ipk, ipkc, ipkl
  integer(kind=address_length) :: ipkt, addr,  data_in, ip_data, kin
  integer(kind=data_length)    :: ldata_in, h_offset, c_offset, l_offset
  integer :: ir, ib, kr
  integer :: n_vis, nout, isb, isb1, isb2, narg, is, nch, nd1, nd2, ni
  integer :: ifirst, ilast, i, j, k, i1, i2, iw, nchannels, nbc
  integer :: isub, inbc, inbc1, inbc2, ninput, savenbc(mnbb)
  integer :: lsub_nbc(mnbb), isub_nbc(mnbb,mrlband),n_visi(mnbb)
  integer :: lsubb_out_saved, isubb_out_saved(mrlband), isid_auto(mnbb)
  integer :: iwin(mrlband), iov(mrlband), jov(mrlband), kov, nov, iwi, jwi
  integer :: imin(mnbb,2*(mwin_out+mrlband)), ismin
  integer :: imax(mnbb,2*(mwin_out+mrlband)), ismax
  logical :: myend, ok, down_baseline, good, flagged, positions
  logical :: append, compr, frequency, warning, warned
  logical :: check, scan, noloop, resample, fft, skip, initialized
  logical :: do_select, first, overlap, counting, newinput
  integer :: found_unit, sbout
  real :: trchan, tfres, tvres, tvoff
  real :: uv_max, time_max, width, bandwidth(mnbb), gain(mnbb)
  real :: fmin(mnbb,2*(mwin_out+mrlband)), fmini
  real :: fmax(mnbb,2*(mwin_out+mrlband)), fmaxi
  real(8) :: newfreq, tfoff, clight, ff, f1, fn, fr, fs
  character(len=256) :: chain
  character(len=12) :: key, fvoc(mfvoc), filvoc(mfilvoc)
  character(len=12) :: shavoc(mshavoc), chavoc(mchavoc)
  character(len=12) :: newname, shape
  character(len=13) :: xch, ych
  parameter (clight=299792.458d0)
  !
  ! test coordinates to specific precision ..
  real(8), parameter :: sec=pi/180D0/3600.D0
  real(8) :: coo_test=0.01d0*sec
  real(8) :: fre_test=1d-7
  real(8) :: point_check=0.05d0*sec
  real(8) :: phase_check=0.005d0*sec
  logical :: setup=.true.
  character(len=10) :: strnam
  !
  integer :: o_vis
  integer :: ier
  real, allocatable :: dima(:,:)
  !
  data shavoc/'TBOX','TPARABOLA','FBOX','FTRIANGLE'/
  data fvoc/'FREQUENCY','VELOCITY'/
  data filvoc/'NEW','OLD'/
  data chavoc/'SOURCE','POINTING','PHASE','EPOCH','SCAN'/
  !
  ! Only FILE should be saved ?
  character(len=256), save :: file=' '
  integer, save :: file_uv_version
  !------------------------------------------------------------------------
  ! Code:
  error = .false.
  if (setup) then
     strnam = 'TOLERANCE%'
     call sic_defstructure(strnam,.true.,error)
     call sic_def_dble(strnam//'POINT',point_check,0,0,.false.,error)
     call sic_def_dble(strnam//'PHASE',phase_check,0,0,.false.,error)
     call sic_def_dble(strnam//'COORDINATES',coo_test,0,0,.false.,error)
     call sic_def_dble(strnam//'FREQUENCY',fre_test,0,0,.false.,error)
     setup = .false.
  endif
  !
!  if (.not.new_receivers) then
!     call message(6,3, 'TABLE',   &
!          'This version does not process old data')
!     error = .true.
!     return
!  endif
  !
  ! Verify if any input file
  call check_input_file(error)
  if (error) return
  call check_index(error)
  if (error) return
  do i=1,mchavoc
     lcheck(i) = .true.
  enddo
  check = .not.sic_present(5,0)
  if (.not.check) then
     do i=1,sic_narg(5)
        call clic_kw (line,5,i,key,nkey,chavoc,mchavoc,   &
             .false.,error,.true.)
        lcheck(nkey) = .false.
        check = .true.
     enddo
  endif
  !      scan = sic_present(6,0)
  scan = .true.
  resample = .false.
  fft = sic_present(7,0)
  !
  positions = sic_present(8,0)
  !
  ! Decode Command Line ----------------------------------------------------
  ! Get file name
  if (sic_present(0,1)) then
     file = ' '  ! Reset file name to protect against errors
     ! New name
     call sic_ch (line,0,1,chain,narg,.true.,error)
     if (error) return
     call sic_parsef(chain,file,' ','.uvt')
     key = 'OLD'
     call clic_kw (line,0,2,key,nkey,filvoc,mfilvoc,.false.,error,.true.)
     if (error) return
     if (key.eq.'NEW') then
        append = .false.
        initialized = .false.
       ! A new table will be created in X image: initialize
       call gildas_null(xima, type = 'UVT')
     elseif (key.eq.'OLD') then
        append = .true.
        call gildas_null(xima, type = 'UVT')
        ! this puts the table header in X and Y buffers.
          !!Print *,'Calling NEWUVT_OPEN '
        call newuvt_open(xima,file,file_uv_version,error)
        if (error) return
        ! Copy to Y buffer (Y buffer is used when reading scan headers and comparing to X)
        call gdf_copy_header(xima,yima,error)
        call newuvt_close (xima) ! Free the image slot, as newuvt_extend will be called
     endif
  elseif (len_trim(file).ne.0) then
     ! No name, use current table
     append = .true.
     ! No "call gildas_null(xima)" here, since its header has to be
     ! remembered from one call to another.
     ! But one need to convert the header in the correct version
     ! CLIC is working in this version of the header
     call gdf_uv_doppler(xima,code_version_uvt_freq)
  else
     ! No name, no current image
     call message(6,3, 'TABLE','No table to append to ...')
     error = .true.
     return
  endif
  n_vis = 0
  warned = .false.
  !
  ! Target sampling : /RESAMPLE
  tnchan = 0
  trchan = 0
  tfres = 0.
  tvres = 0.
  tfoff = 0.
  tvoff = 0.
  shape = 'TPAR'
  width = 1
  if (sic_present(1,0)) then
     if (append) then
        call message(8,2,'TABLE','OLD Table: /RESAMPLE ignored')
     else
        call sic_i4(line,1,1,tnchan,.true.,error)
        if (error) return
        call sic_r4(line,1,2,trchan,.false.,error)
        if (error) return
        key = 'FREQUENCY'
        call clic_kw(line,1,5,key,nkey,fvoc,mfvoc,.false.,error,.true.)
        if (error) return
        if (key.eq.'FREQUENCY') then
           call sic_r8(line,1,3,tfoff,.false.,error)
           call sic_r4(line,1,4,tfres,.false.,error)
        elseif (key.eq.'VELOCITY') then
           call sic_r4(line,1,3,tvoff,.false.,error)
           call sic_r4(line,1,4,tvres,.false.,error)
        endif
        if (error) return
        call clic_kw(line,1,6,shape,nk,shavoc,mshavoc,.false.,error,.true.)
        if (error) return
        call sic_r4(line,1,7,width,.false.,error)
        if (error) return
        resample = .true.
     endif
  endif
  ndrop(1) = 0
  ndrop(2) = 0
  !
  ! Drop end channels (2)
  if (sic_present(2,0)) then
     call sic_i4(line,2,1,ndrop(1),.true.,error)
     call sic_i4(line,2,2,ndrop(2),.false.,error)
     if (error) return
  endif
  !
  ! Compress option (3)
  compr = sic_present(3,0)
  if (compr) then
     time_max = 60.
     uv_max = 7.5
     call sic_r4(line,3,1,time_max,.false.,error)
     call sic_r4(line,3,2,uv_max,.false.,error)
     if (error) return
  endif
  !
  ! Frequency option (4)
  frequency = sic_present(4,0)
  if (frequency) then
     if (append) then
        call message(8,2,'TABLE','OLD Table: /FREQUENCY ignored')
        newfreq = 0
     else
        call sic_ch(line,4,1,newname,narg,.true.,error)
        call sic_r8(line,4,2,newfreq,.true.,error)
        if (error) return
     endif
  else
     newfreq = 0
  endif
  ! -------------------------------------------------------------------------
  ! First loop on current index to check consistency
  n_new = 0
  myend = .false.
  call get_first(.false.,error)
  if (error) return
  !
  ! Check if data can be gotten
  call get_data (ldata_in,data_in,error)
  if (error) return
  !
  ! Select ALL - default are spectral bands
  if (all_select) then
     if (.not.widex_select) then
       if (r_nband_widex.ne.0) then
          call message(6,4,'CLIC_TABLE', &
                'Selecting ALL is not allowed with WIDEX units')
          error = .true.
          return
       endif
       lsubb_out = max(1,r_lband)
       do is=1, lsubb_out
          isubb_out(is) = is+mbands
       enddo
     else
       lsubb_out = 0
       do is = 1, r_lband
         if (r_iunit(is).ge.9) then
           lsubb_out =  lsubb_out + 1
           isubb_out(lsubb_out) = is+mbands
           found_unit = r_iunit(is)-8
           write (chain,'(a,i1,a)') 'Selecting widex unit ',found_unit, &
               ': it is logical unit '//csub(isubb_out(lsubb_out))
           call message(6,1,'CLIC_TABLE',chain(1:lenc(chain)))
         endif
       enddo
     endif
     do_select = .true.
  else
     do_select = .false.
  endif
  !
  ! No loop on records if spectral bands are to be written OR if scan average
  noloop = (isubb_out(1).gt.mbands) .or. (i_average.eq.1)
  !
  ! cut_header updates the Y image in the loop hereafter: initialize it
  ! (only once, out of the loop for efficiency reasons)
  call gildas_null(yima, type = 'UVT')
  !
  first = .true.
  do while (.not.myend)
     !
     ! Check spectral setup
     call check_units(first,error)
     if (error) return
     if (frequency) then
        call vel_scale_2 (newname,newfreq)
     endif
     ! Cut_header update the Y buffer according to scan header,
     ! in order to compare it with the Y buffer corresponding to the current Table.
     call cut_header (ndrop,newfreq,positions,error)
     if (error) return
     !
     ! We use the first scan header to initialise the table header,
     ! if not in append mode.
     if (.not.append .and. .not.initialized) then
        call gdf_copy_header(yima,xima,error)
        ! We use the line command optional parameters, if any.
        ! 7 daps + (real, imag, weight)*nchannels
        if (tnchan .ne. 0) then
            !!Print *,'Setting number of channels ',tnchan
           xima%gil%nchan = tnchan
           xima%gil%dim(1) = 3*tnchan+7
           xima%gil%fcol = 8
           xima%gil%lcol = xima%gil%dim(1)
           if (positions) then
             ! Add offset positions at the end of each visibility
             xima%gil%dim(1) = xima%gil%dim(1)+2
           endif
           if (trchan .ne. 0) then
              xima%gil%ref(1) = trchan
           else
              xima%gil%ref(1) = xima%gil%ref(1) + nint(0.5*(tnchan+1)-xima%gil%ref(1))
           endif
           !           
           ! fres,vres in the source frame, inc(1) in the topocentric frame
           if (tfres .ne. 0) then
              xima%gil%inc(1) = tfres*xima%gil%val(1)/xima%gil%freq
              xima%gil%vres = -tfres*clight/xima%gil%freq
              xima%gil%fres = tfres
           elseif (tvres .ne. 0) then
              xima%gil%vres = tvres
              xima%gil%inc(1) = -tvres*xima%gil%val(1)/clight
              xima%gil%fres = - tvres*xima%gil%freq/clight
           endif
           ! Make velocity or frequency  change possible :
           if (tvoff.ne.0) then
              xima%gil%voff = tvoff
           elseif (tfoff.ne.0) then
              tvoff = xima%gil%voff-tfoff/xima%gil%freq*clight
              xima%gil%voff = tvoff
           endif
           ! or even frequency offset ...
        else
          Print *,'TNCHAN is 0'
        endif
        xima%gil%vtyp = r_typev ! Velocity referential
        !
        ! Define the primary beam size
        xima%gil%majo = 56.0*(90.0e3/xima%gil%freq)
        print *,'I-CLIC,  Primary beam size ',xima%gil%majo,'"'
        xima%gil%majo = xima%gil%majo*pi/180.0/3600.0
        !
        ok = .true.
        warning = .false.
        warned = .false.
        initialized = .true.
     else
        ! Append to an existing table (X) - check consistency
        warning = .false.
        ok =   &
             yima%gil%epoc .eq. xima%gil%epoc   &
             .and. (abs(yima%gil%ra-xima%gil%ra).lt.coo_test)   &
             .and. (abs(yima%gil%dec-xima%gil%dec).lt.coo_test)   &
             .and. (abs(yima%gil%a0-xima%gil%a0).lt.coo_test)   &
             .and. (abs(yima%gil%d0-xima%gil%d0).lt.coo_test)   &
             .and. (yima%gil%version_uv.eq.xima%gil%version_uv)
        nchan = max(xima%gil%nchan,int(abs(xima%gil%ref(1))))
        warning = warning   &
             .or. abs(yima%gil%freq-xima%gil%freq).gt.fre_test*xima%gil%freq   &
             .or. abs(yima%gil%fres-xima%gil%fres)*nchan.gt.0.1   &
             .or. yima%gil%dim(1) .ne. xima%gil%dim(1)   &
             .or. abs(yima%gil%ref(1)-xima%gil%ref(1)).gt.fre_test*xima%gil%freq/yima%gil%fres
        ! force resampling for multiple line subbands.
        warning = warning .or.   &
             (lsubb_out.gt.1) .and. (isubb_out(1).gt.mbands)
     endif
     !
     ! First check for inconsistent headers : This is an error.
     !
     if (check .and. .not. ok) then
        if (lcheck(1) .and. yima%char%name .ne. xima%char%name) then
           write(6,*) 'Source :',yima%char%name, xima%char%name
           error = .true.
        endif
        if (lcheck(4) .and. yima%gil%epoc .ne. xima%gil%epoc) then
           write(6,*) 'Epoch :',yima%gil%epoc, xima%gil%epoc
           error = .true.
        endif
        if (lcheck(2) .and. abs(yima%gil%ra-xima%gil%ra).gt.point_check) then
           call sexag(xch,xima%gil%ra,24)
           call sexag(ych,yima%gil%ra,24)
           write(6,*) 'Pointing RA :',ych,xch
           error = .true.
        endif
        if (lcheck(2) .and. abs(yima%gil%dec-xima%gil%dec).gt.point_check) then
           call sexag(xch,xima%gil%dec,360)
           call sexag(ych,yima%gil%dec,360)
           write(6,*) 'Pointing DEC :',ych,xch
           error = .true.
        endif
        if (lcheck(3) .and. abs(yima%gil%a0-xima%gil%a0).gt.phase_check) then
           call sexag(xch,xima%gil%a0,24)
           call sexag(ych,yima%gil%a0,24)
           write(6,*) 'Phase A0 :',ych,xch,abs(xima%gil%a0-yima%gil%a0)/sec
           error = .true.
        endif
        if (lcheck(3) .and. abs(yima%gil%d0-xima%gil%d0).gt.phase_check) then
           call sexag(xch,xima%gil%d0,360)
           call sexag(ych,yima%gil%d0,360)
           write(6,*) 'Phase D0 :',ych,xch,abs(xima%gil%d0-yima%gil%d0)/sec
           error = .true.
        endif
        if (yima%gil%version_uv.ne.xima%gil%version_uv) then
           write(6,*) 'Version UVT :',xima%gil%version_uv/10.0,  &
                       yima%gil%version_uv/10.0
           error = .true.
        endif
        if (error) then
           write (chain,'(A,I5,A,I5)')   &
                'Inconsistent observation set, obs. # ',r_num,   &
                ' Scan ',r_scan
           call message(6,3,'TABLE',chain(1:lenc(chain)))
           return
        endif
     endif
     !
     ! Warning if different frequency parameters, which must force resampling.
     !
     if (warning .and. .not.warned) then
        resample = .true.
        write (chain,'(A,I5,A,I5)')   &
             'Spectrum resampling is needed, obs. # ',r_num,   &
             ' Scan ',r_scan
        call message(6,2,'TABLE',chain(1:lenc(chain)))
        if (yima%gil%freq.ne. xima%gil%freq) then
           write(chain,*) 'Rest frequencies :',yima%gil%freq,   &
                xima%gil%freq
           call message(6,2,'TABLE',chain(1:lenc(chain)))
        endif
        if (yima%gil%voff.ne. xima%gil%voff) then
           write(chain,*) 'Velocities :',yima%gil%voff,   &
                xima%gil%voff
           call message(6,2,'TABLE',chain(1:lenc(chain)))
        endif
        if (yima%gil%fres .ne. xima%gil%fres) then
           write(chain,*) 'Frequency resolutions :',yima%gil%fres,   &
                xima%gil%fres
           call message(6,2,'TABLE',chain(1:lenc(chain)))
        endif
        if (yima%gil%ref(1) .ne. xima%gil%ref(1)) then
           write(chain,*) 'Reference channels :',yima%gil%ref(1),   &
                xima%gil%ref(1)
           call message(6,2,'TABLE',chain(1:lenc(chain)))
        endif
        warned = .true.
        if (yima%gil%dim(1) .ne. xima%gil%dim(1)) then
           ! yima%gil%dim = current data
           ! xima%gil%dim = existing table
           if ((positions).and.(yima%gil%dim(1).eq.(xima%gil%dim(1)+2))) then
              write(chain,*) 'Option /POSITIONS cannot be used to write in this table'
              call message(6,2,'TABLE',chain(1:lenc(chain)))
              error = .true.
              return
           endif
           if ((.not.positions).and.(xima%gil%dim(1).eq.(yima%gil%dim(1)+2))) then
              write(chain,*) 'Option /POSITIONS must be used to write in this table'
              call message(6,2,'TABLE',chain(1:lenc(chain)))
              error = .true.
              return
           endif
           write(chain,*) 'Number of channels :',(yima%gil%dim(1)-7)/3,   &
                (xima%gil%dim(1)-7)/3
           call message(6,2,'TABLE',chain(1:lenc(chain)))
           warned = .true.
        endif
     endif
     if (noloop) then
        n_vis = n_vis + r_nbas
     else
        n_vis = n_vis + r_ndump*r_nbas
     endif
     if (sic_ctrlc()) then
        error = .true.
        goto 200
     endif
     n_new = n_new+1
     new_scans(n_new) = r_scan
     new_dates(n_new) = r_dobs
     call get_next(myend,error)
     if (error) return
     first = .false.
  enddo
  !
  ! Determines receiver tuning for each narrow input
  do j = 1, mnbb
     gain(j) = 0.
     do i = 1, r_nant
        gain(j) = max(gain(j),r_gim(j,i))
     enddo
  enddo
  !
  ! Automatic receiver tuning determination per narrow.
  if (isideb_out.eq.4 .and. cont_select) then
     do j = 1, mnbb
        isid_auto(j) = 1 ! Default is USB
        if (gain(j).lt.0.1) then
           isid_auto(j) = (3-r_isb)/2
           n_visi(j) = 1
        else
           isid_auto(j) = 3
           n_visi(j) = 2
        endif
     enddo
  elseif (isideb_out.eq.3.and.cont_select) then
     do i = 1, mnbb
        n_visi(i) = 2
     enddo
  else
     do i = 1, mnbb
        n_visi(i) = 1
     enddo
  endif
  !
  ! Automatic sideband determination
  if (isideb_out.ge.3.and..not.cont_select) then
     do j = 1, mnbb
        isid_auto(j) = 3
     enddo
  endif
  !
  ! Select all: refne the choice of subbands, depending on the
  ! table spectral parameters.
  if (all_select .and. .not.cont_select) then
     lsubb_out=0
     do is = 1, r_lband
        nch = r_lnch(is)
        nd1 = max(ndrop(1),nint(fdrop(1)*nch))
        nd2 = max(ndrop(2),nint(fdrop(2)*nch))
        ok = .false.
        if (abs(xima%gil%fres).ge.abs(r_lrfres(1,is))) then
           do isb=1,2
              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))*r_lrfres(isb,is)
              fn = ff+(nch-nd2+0.5-r_lrch(isb,is))*r_lrfres(isb,is)
              if (r_lrfres(isb,is)*xima%gil%fres.gt.0) then
                 ifirst = nint(f1/xima%gil%fres+xima%gil%ref(1))
                 ilast  = nint(fn/xima%gil%fres+xima%gil%ref(1))
              else
                 ilast = nint(f1/xima%gil%fres+xima%gil%ref(1))
                 ifirst  = nint(fn/xima%gil%fres+xima%gil%ref(1))
              endif
              ok = ok .or.   &
                   ((ilast.ge.1) .and. (ifirst.le.(xima%gil%dim(1)-7)/3))
           enddo
        endif
        if (widex_select) ok = r_iunit(is).ge.9
        if (ok) then
           lsubb_out = lsubb_out + 1
           isubb_out(lsubb_out) = is+mbands
        endif
     enddo
     if (lsubb_out.gt.0) then
        write(chain,*) (csub(isubb_out(is))//' ',is=1,lsubb_out)
        call message(6,1,'TABLE','Using '//chain(1:lenc(chain)))
     else
        call message(8,3,'TABLE','No matching subband')
        error = .true.
        return
     endif
  endif
  !
  ! How many quarters in observations
  ! ... and continuum effective bandwith
  !
  if (cont_select) then
     first = .true.
     ninput = 0
     do inbc = 1,mnbb
        iwin(inbc) = 0
     enddo
     fmini = 1e6
     fmaxi = 0.
     if(isideb_out.eq.3) then
        isb = 1
     else
        isb = isideb_out
     endif
     do isub = 1,lsubb_out
        i = isubb_out(isub)
        if (i.gt.mbands) then
           is = i-mbands
        else
           is = i
        endif
        if (r_lpolmode(is).ne.1) then
           return
        endif
        nbc = r_bb(is)
        if (isideb_out.gt.3) then
           if (isid_auto(nbc).eq.3) then
              isb = 1
           else
              isb = isid_auto(nbc)
           endif
        endif
        if (cont_select) then
           if (i.gt.mbands) then
              nch = r_lnch(is)
              nd1 = max(ndrop(1),nint(fdrop(1)*nch))+1
              nd2 = nch-max(ndrop(2),nint(fdrop(2)*nch))
              ni = nch-nd1-nd2
              f1 = r_lfcen(is)+r_lfres(is)*(1+nd1-r_lcench(is))
              counting = .false.
              !
              ! Avoid Gibbs-affected channels:
              if (ngibbs.gt.0.and.abs(r_lfres(is)).gt.0.1 &
     &              .and.r_lnch(is).le.1000) then
                 i1 = nch/2-ngibbs
                 i2 = nch/2+ngibbs+1
              else
                 i1 = nch/2
                 i2 = i1+1
              endif
              do j = nd1, nd2
                 fr = r_lfcen(is)+r_lfres(is)*(j-r_lcench(is))
                 fs = r_lrfoff(isb,is)   &
                      +(j-r_lrch(isb,is))*r_lrfres(isb,is)
                 if (nwin_out.gt.0) then
                    ok = .false.
                    do iw = 1, nwin_out
                       ok = ok .or. (fs.gt.window_out(1,iw).and.   &
                            fs.le.window_out(2,iw))
                    enddo
                 else
                    ok = .true.
                 endif
                 ok = ok .and. (j.le.i1 .or. j.ge.i2)
                 !
                 ! Split corr. unit if continuum windows
                 if (.not.ok) then
                    if (counting) then
                       fn = fr
                       iwin(nbc) = iwin(nbc)+1
                       if (f1.lt.fn) then
                          fmin(nbc,iwin(nbc)) = f1
                          fmax(nbc,iwin(nbc)) = fn
                       else
                          fmin(nbc,iwin(nbc)) = fn
                          fmax(nbc,iwin(nbc)) = f1
                       endif
                       imin(nbc,iwin(nbc)) = is
                       imax(nbc,iwin(nbc)) = is
                       counting = .false.
                       call check_window(fmin,fmax,imin,imax,nbc,iwin(nbc))
                    endif
                 else
                    if (.not.counting) then
                       f1 = fr
                       counting = .true.
                    endif
                 endif
              enddo
              if (counting) then
                 fn = r_lfcen(is)+r_lfres(is)*(nch-nd2-r_lcench(is))
                 fn = fr
                 iwin(nbc) = iwin(nbc)+1
                 if (f1.lt.fn) then
                    fmin(nbc,iwin(nbc)) = f1
                    fmax(nbc,iwin(nbc)) = fn
                 else
                    fmin(nbc,iwin(nbc)) = fn
                    fmax(nbc,iwin(nbc)) = f1
                 endif
                 imin(nbc,iwin(nbc)) = is
                 imax(nbc,iwin(nbc)) = is
                 call check_window(fmin,fmax,imin,imax,nbc,iwin(nbc))
              endif
           else
              iwin(nbc) = iwin(nbc)+1
              f1 = r_cfcen(is)-r_cfwid(is)/2.
              fn = r_cfcen(is)+r_cfwid(is)/2.
              if (f1.lt.fn) then
                 fmin(nbc,iwin(nbc)) = f1
                 fmax(nbc,iwin(nbc)) = fn
              else
                 fmin(nbc,iwin(nbc)) = fn
                 fmax(nbc,iwin(nbc)) = f1
              endif
              imin(nbc,iwin(nbc)) = is
              imax(nbc,iwin(nbc)) = is
              call check_window(fmin,fmax,imin,imax,nbc,iwin(nbc))
           endif
        endif
        if (first) then
           if (nbc.ne.0) then
              ninput = 1
              savenbc(ninput) = nbc
              first = .false.
           endif
        endif
        newinput = .true.
        do inbc =1, ninput
           if (nbc.eq.savenbc(inbc).and.nbc.ne.0) newinput = .false.
        enddo
        if (newinput) then
           ninput = ninput+1
           savenbc(ninput) = nbc
        endif
     enddo
     if (cont_select) then
        do inbc = 1, mnbb
           bandwidth(inbc) = 0
        enddo
        do inbc = 1, ninput
           print *,"----------"
           if (ninput.eq.1) then
              i = isubb_out(1)
              if (i.gt.mbands) i = i-mbands
              if (r_lpolmode(i).ne.1) then
                 return
              endif
              nbc = r_bb(i)
           else
              nbc = inbc
           endif
           nbc = savenbc(inbc)
           print *,"Spectral windows for input ",nbc
           do iwi = 1, iwin(nbc)
              print *,"Window # ",iwi,": fmin ",fmin(nbc,iwi),", fmax ",fmax(nbc,iwi)
              bandwidth(nbc) = bandwidth(nbc)+(fmax(nbc,iwi)-fmin(nbc,iwi))
              ismin = imin(nbc,iwi)
              ismax = imax(nbc,iwi)
              if (isideb_out.lt.3) then
                 fmini = min(fmini, &
                      r_flo1 + (3-2*isideb_out)* (r_flo2(ismin)   &
                      + r_band2(ismin)  * (r_flo2bis(ismin)   &
                      + r_band2bis(ismin)* fmin(nbc,iwi))), &
                      r_flo1 + (3-2*isideb_out)* (r_flo2(ismax)   &
                      + r_band2(ismax) * (r_flo2bis(ismax)   &
                      + r_band2bis(ismax)* fmax(nbc,iwi))))
                 fmaxi = max(fmaxi, &
                      r_flo1 + (3-2*isideb_out)* (r_flo2(ismin)   &
                      + r_band2(ismin) * (r_flo2bis(ismin)   &
                      + r_band2bis(ismin)* fmin(nbc,iwi))), &
                      r_flo1 + (3-2*isideb_out)* (r_flo2(ismax)   &
                      + r_band2(ismax) * (r_flo2bis(ismax)   &
                      + r_band2bis(ismax)* fmax(nbc,iwi))))
              elseif (isideb_out.gt.3) then
                 if (isid_auto(inbc).lt.3) then
                    fmini = min(fmini, &
                         r_flo1 + (3-2*isid_auto(inbc))* (r_flo2(ismin)   &
                         + r_band2(ismin) * (r_flo2bis(ismin)   &
                         + r_band2bis(ismin)* fmin(nbc,iwi))), &
                         r_flo1 + (3-2*isid_auto(inbc))* (r_flo2(ismax)   &
                         + r_band2(ismax) * (r_flo2bis(ismax)   &
                         + r_band2bis(ismax)* fmax(nbc,iwi))))
                    fmaxi = max(fmaxi, &
                         r_flo1 + (3-2*isid_auto(inbc))* (r_flo2(ismin)   &
                         + r_band2(ismin) * (r_flo2bis(ismin)   &
                         + r_band2bis(ismin)* fmin(nbc,iwi))), &
                         r_flo1 + (3-2*isid_auto(inbc))* (r_flo2(ismax)   &
                         + r_band2(ismax) * (r_flo2bis(ismax)   &
                         + r_band2bis(ismax)* fmax(nbc,iwi))))
                 endif
              else
                 fmini = 0
                 fmaxi = 1e6
              endif
           enddo
           if (freq_out.eq.0.and..not.append) then
              if (isideb_out.lt.3) then
                 xima%gil%val(1) = (fmaxi+fmini)/2
              elseif (isideb_out.gt.3.and.(fmaxi-fmini).lt.9e5) then
                 xima%gil%val(1) = (fmaxi+fmini)/2
              else
                 xima%gil%val(1) = r_flo1
              endif
           endif
           print *,"Effective bandwith :",bandwidth(nbc)
           if (isideb_out.eq.3.and.gain(inbc).lt.0.1) then
              call message (6,2,'TABLE','DSB selected but SSB receiver tuning')
              write (chain,'(A,I1,A,F5.3)')   &
                 'Narrow input ',nbc,' has a maximum rejection of ',gain(nbc)
              call message (6,2,'TABLE',chain(1:lenc(chain)))
           endif
        enddo
        print *,"----------"
     endif
     !
     nvisi = 0
     if (cont_select.and..not.append) xima%gil%fres = 0
     do inbc = 1, ninput
        nvisi = nvisi+ n_visi(savenbc(inbc))
        if (cont_select.and..not.append) then
           xima%gil%fres = xima%gil%fres + bandwidth(savenbc(inbc))
        endif
     enddo
     n_vis = n_vis * nvisi
     if (cont_select.and..not.append) then
        xima%gil%fres = xima%gil%fres/ninput
        xima%gil%vres = xima%gil%fres/xima%gil%val(1)*299792.458d0
        xima%gil%freq = xima%gil%val(1)/(1.d0+r_doppl)
     endif
  else
    ninput = 1
  endif
  if (.not.cont_select) n_vis = n_vis * n_visi(1)
  call message(6,1,'TABLE',   &
       'Table parameters for '//trim(file)//':')
  write(chain,'(A,A12,2(A,F12.3))')   &
       'X_LINE = ',xima%char%line ,' X_FREQ = ',xima%gil%freq,' X_VAL1 = ',xima%gil%val(1)
  call message(6,1,'TABLE',chain(1:lenc(chain)))
  write(chain,'(3(A,F12.3))')  'X_FRES = ',xima%gil%fres,   &
       ' X_VRES = ',xima%gil%vres,' X_VOFF = ',xima%gil%voff
  call message(6,1,'TABLE',chain(1:lenc(chain)))
  write(chain,'(A,I12,A,F12.4,A)')   &
       ' NCHAN = ',xima%gil%nchan ,' X_REF1 = ',xima%gil%ref(1)
  call message(6,1,'TABLE',chain(1:lenc(chain)))
  !
  ! Create new file or append to existing one
  if (append) then
    !!Print *,'Calling newuvt_extend'
    call newuvt_extend(xima,file,n_vis,n_new,new_dates,new_scans,   &
          error,lcheck(5))
    if (error) return
    o_vis = xima%gil%nvisi
    !!Print *,'FCOL ', xima%gil%fcol , xima%gil%lcol
  else
    !!Print *,'Calling NEWUVT_INIT '
    call newuvt_init(xima,file,n_vis,scan, positions, error)
    o_vis = 0
    call gdf_copy_header(xima,yima,error)
  endif
  !
  ! Here, allocate the data space, only new region
  allocate (dima(xima%gil%dim(1),n_vis), stat=ier)
  dima = 0.0
  !
  ! Loop on current index to write the visibilities
  myend = .false.
  nfl = 0
  call get_first(.false.,error)
  if (error) goto 98
  nvis = 0
  skip = .false.
  do while (.not.myend)
     if (frequency) then
        call vel_scale_2 (newname,newfreq)
     endif
     call get_data (ldata_in,data_in,error)
     if (error) goto 98
     call check_cal(skip)
     if (skip) then
        skip = .false.
        goto 180
     endif
     if (do_pass) then
        call set_pass (r_nsb,r_nband,r_nbas+r_ntri,   &
             r_lntch, passc, passl, error)
        if (error) goto 98
     endif
     call set_corr(error)
     ! Optionnally compress the data
     if (compr) then
        ip_data = gag_pointer(data_in,memory)
        call compress(time_max, uv_max, memory(ip_data),nout,error)
        if (error) goto 98
        r_ndump = nout
        call loose_data
     endif
     !
     noloop = .false.
     kin = gag_pointer(data_in, memory)
     do ir = 1, r_ndump
        ! Read only the average record if needed
        if (noloop) goto 180
        noloop = (isubb_out(1).gt.mbands) .or. (i_average.eq.1)
        ! Note: take the data header from uncorrected data.
        if (noloop) then
           call spectral_dump(kr,0,0)
        else
           kr = ir
        endif
        ipk = kin+ h_offset(kr)
        call decode_header (memory(ipk))
        call set_scaling(error)
        if (error) return
        flagged = .false.
        if (isideb_out.le.2) then
           isb1 = isideb_out
           isb2 = isideb_out
        elseif (isideb_out.ge.3) then
           if (cont_select) then
              isb1 = 1
              isb2 = 2
              ! fnd the good sideband if declared LINE DSB
           else
              sbout = 0
              do is = 1, lsubb_out
                if (isubb_out(is).gt.mbands) i = isubb_out(is) - mbands
                if (sbout.eq.0) then
                  sbout = r_sb(i)
                elseif (r_sb(i).ne.sbout) then
                  call message(6,3,'CLIC_TABLE', &
                            'Cannot mix sidebands in LINE mode')
                  error= .true.
                  return
                endif
              enddo
              isb1 = (3-sbout)/2
              isb2 = isb1
           endif
        endif
        !
        ! Writes a visibility for each different "input" for continuum
        if (cont_select) then
           do inbc = 1, mnbb
              lsub_nbc(inbc) = 0
           enddo
           do is = 1, lsubb_out
              isub = isubb_out(is)
              i = isub
              if (isub.gt.mbands) i = isub - mbands
              if (r_lpolmode(i).eq.1) then
                 inbc = r_bb(i)
                 lsub_nbc(inbc) = lsub_nbc(inbc) + 1
                 isub_nbc(inbc,lsub_nbc(inbc)) = isub
              endif
           enddo
        else
           inbc1 = 1
           inbc2 = inbc1
        endif
        !
        do ib = 1, r_nbas
           if (.not.down_baseline(ib)) then
              ! Take corrected or uncorrected
              if (noloop) then
                 call spectral_dump(kr,0,ib)
                 ipkl = kin + l_offset(kr)
              else
                 kr = ir
                 ipkl = kin + l_offset(r_ndump+1)   ! dummy
              endif
              ipkc = kin + c_offset(kr)
              do isb = isb1, isb2
                 if (ninput.gt.1) then
                    lsubb_out_saved = lsubb_out
                    do is = 1, lsubb_out
                       isubb_out_saved(is) = isubb_out(is)
                    enddo
                 endif
                 do inbc = 1, ninput
                    if (cont_select) then
                       nbc = savenbc(inbc)
                    else
                       nbc = 1
                    endif
                    if (isideb_out.le.3.or.isid_auto(inbc).eq.3.or.isid_auto(inbc).eq.isb) then
                       if (ninput.gt.1) then
                          lsubb_out = lsub_nbc(nbc)
                          do is = 1, lsubb_out
                             isubb_out(is) = isub_nbc(nbc,is)
                          enddo
                       endif
                       nchannels = xima%gil%nchan
                       ! NVIS is used to increment
           !!Print *,'Calling newuvt_addvisi ',nvis, nchannels
                       call newuvt_addvisi (xima,dima(1,nvis+1), r_nsb, r_nband, r_nbas, r_lntch,   &
                          nchannels, ib, isb, nbc, xima%gil%val(1), bandwidth(nbc),  &
                          memory(ipkc), memory(ipkl), passc, passl, ndrop, good, &
                          scan, width, shape, resample, fft, positions, error)
                       if (error) goto 98
                       if (good) then
                          nvis = nvis + 1
                       else
                          flagged = .true.
                       endif
                    endif
                    if (ninput.gt.1) then
                       lsubb_out = lsubb_out_saved
                       do is = 1, lsubb_out
                          isubb_out(is) = isubb_out_saved(is)
                       enddo
                    endif
                 enddo
              enddo
           else
              flagged = .true.
           endif
        enddo
        if (flagged) nfl = nfl + 1
     enddo
     ! End of scan
180  if (sic_ctrlc()) goto 98
     if (nfl.ne.0) then
        write(chain,'(I6,A)') nfl,' records flagged or unused'
        call message(4,2,'TABLE',chain(1:lenc(chain)))
        nfl = 0
     endif
     call get_next(myend,error)
     if (error) goto 98
  enddo
  !
  ! The table is now fnished
  write(chain,'(I6,A,I6,A)') nvis,   &
       ' visibilities written (out of ',n_vis,' possible)'
  call message(6,1,'TABLE', chain(1:lenc(chain)))
  call gdf_write_data (xima, dima, error)
  !!Print *,'Calling newuvt_cut ',nvis
  if (.not.append) then
    ! Write a new file with current header version
    call gdf_get_uvt_version(file_uv_version)  ! Get code_version_uvt_current
  endif
  call newuvt_cut(xima,nvis+o_vis,file_uv_version,error)
!
200 continue
  deallocate (dima, stat=ier)
  !!Print *,'Done deallocation '
  call newuvt_close(xima)
  return
  ! Error return
98 continue
  deallocate (dima, stat=ier)
  if (.not.append) then
    ! Write a new file with current header version
    call gdf_get_uvt_version(file_uv_version)  ! Get code_version_uvt_current
  endif
  call newuvt_cut(xima,nvis+o_vis,file_uv_version,error)
  call newuvt_close(xima)
  error = .true.
  return
end subroutine clic_table
!
subroutine check_table(nc, nv, vis, nn, ndobs, ndscan, error)
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! CLIC TABLE command :
  ! Check that new data is really new
  !---------------------------------------------------------------------
  integer :: nc                     !
  integer :: nv                     !
  real :: vis(nc,nv)                !
  integer :: nn                     !
  integer :: ndobs(nn)              !
  integer :: ndscan(nn)             !
  logical :: error                  !
  ! Local
  integer :: i, j, iscan, idobs, lch
  character(len=11) :: cdobs
  character(len=80) :: ch
  !-----------------------------------------------------------------------
  !
  do i=1, nv
    iscan = vis(3,i)
    idobs = vis(4,i)
    do j=1, nn
      if ((ndobs(nn).eq.idobs).and.(ndscan(nn).eq.iscan)) then
        error = .true.
        call datec(idobs,cdobs,error)
        ch = 'Scan '
        write(ch(6:10),'(i5)') iscan
        ch (11:) = ' Date '//cdobs//' already in output table'
        lch = lenc(ch)
        call message(8,4,'CHECK_TABLE',ch(1:lch))
        return
      endif
    enddo
  enddo
end subroutine check_table
!
subroutine dummy_visi(visi,n)
  !---------------------------------------------------------------------
  ! Add a dummy (zero weight) visibility in the table to defne the
  ! field of view for automatic imaging
  !---------------------------------------------------------------------
  integer :: n                      !
  real :: visi(n)                   !
  ! Local
  integer :: i
  !
  visi(1) = 7.5                ! meter
  do i = 2, n
    visi(i) = 0.0
  enddo
end subroutine dummy_visi
!
subroutine check_window(fmin,fmax,imin,imax,inbc,nwin)
  !
  ! Checks windows overlap, optionally, reduce window number
  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  !
  integer :: inbc, nwin, imin(mnbb,2*(mwin_out+mrlband))
  integer :: imax(mnbb,2*(mwin_out+mrlband))
  real :: fmin(mnbb,2*(mwin_out+mrlband))
  real :: fmax(mnbb,2*(mwin_out+mrlband))
  ! Local
  integer :: iwi, kov, nov, iov(mrlband)
  logical :: overlap
  real :: f1, fn
  !
  overlap = .false.
  nov = 0
  !
  f1 = fmin(inbc,nwin)
  fn = fmax(inbc,nwin)
  do iwi=1, nwin - 1
     if (((f1.ge.fmin(inbc,iwi)).and.(f1.le.fmax(inbc,iwi))).or.((fn.ge.fmin(inbc,iwi)).and.(fn.le.fmax(inbc,iwi)))) then
        overlap = .true.
        nov = nov+1
        iov(nov) = iwi
     endif
  enddo
  if (overlap) then
     ! Checks and extends existing windows if applicable
     do kov = nov, 1, -1
        fmin(inbc,iov(kov)) = min(fmin(inbc,iov(kov)), &
             fmin(inbc,nwin))
        if (fmin(inbc,iov(kov)).gt.fmin(inbc,nwin)) then
           imin(inbc,iov(kov)) = imin(inbc,nwin)
        endif
        fmax(inbc,iov(kov)) = max(fmax(inbc,iov(kov)), &
             fmax(inbc,nwin))
        if (fmax(inbc,iov(kov)).lt.fmax(inbc,nwin)) then
           imax(inbc,iov(kov)) = imax(inbc,nwin)
        endif
        nwin = nwin-1
     enddo
  endif
end subroutine check_window

subroutine print_window(fmin,fmax,nbc,nwin)
  !
  ! Print windows
  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  !
  integer :: nwin, nbc
  real :: fmin(mnbb,2*(mwin_out+mrlband))
  real :: fmax(mnbb,2*(mwin_out+mrlband))
  !
  integer :: iwin
  !
  print *,"I-PRINT_WINDOW",nwin,"windows"
  do iwin=1,nwin
     print *,"Window #",iwin,"fmin",fmin(nbc,iwin),"fmax",fmax(nbc,iwin)
  enddo
end subroutine print_window

subroutine check_units(first,error)
  use gildas_def
  use classic_api
  logical :: first
  logical :: error
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  ! Local
  integer :: i, iunit, save_unit(mrlband)
  real*8  :: save_cen(mrlband)
  real*4  :: save_res(mrlband)
  character(len=80) :: ch
  save save_unit, save_cen, save_res
  !-----------------------------------------------------------------------------
  if (first) then
    if (lsubb_out.lt.1.or.lsubb_out.gt.r_lband) then
       call message(6,3,'CHECK_UNITS','Invalid selection')
       error = .true.
       return
    endif
    do iunit =1, lsubb_out
       if (isubb_out(iunit).gt.mbands) then
         i = isubb_out(iunit)-mbands
       else
         i = isubb_out(iunit)
       endif
       save_unit(iunit) = r_iunit(i)
       save_cen(iunit) = r_lfcen(i)
       save_res(iunit) = r_lfres(i)
    enddo
  else
    do iunit =1, lsubb_out
       if (isubb_out(iunit).gt.mbands) then
         i = isubb_out(iunit)-mbands
       else
         i = isubb_out(iunit)
       endif
       if (i.gt.r_lband) then
         call message(6,3,'CHECK_UNITS','Unit '//csub(isubb_out(iunit))// &
            ' absent from dataset')
         error = .true.
         return
       endif
       if (r_iunit(i).ne.save_unit(iunit)) then
         write (ch,'(a,a,a,i2,a,i2)') 'Logical unit ', &
           csub(isubb_out(iunit)), ' modified from physical unit ', &
            save_unit(iunit),' to physical unit ',r_iunit(i)
         call message(6,3,'CHECK_UNITS',trim(ch))
         error = .true.
         return
       endif
       if ((r_lfcen(i).ne.save_cen(iunit)).or.  &
           (r_lfres(i).ne.save_res(iunit))) then
         write (ch,'(a,a,a)') 'Setup of subband ', &
           csub(isubb_out(iunit)), ' modified in data set'
         call message(6,3,'CHECK_UNITS',trim(ch))
         error = .true.
         return
       endif
    enddo
  endif
  return
end subroutine check_units
