!
! Simplified TABLE in LINE mode only, but with elaborate
! polarization capabilities.
!
subroutine sg_table(line,error)
  use image_def
  use gio_params
  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   /ADD Item
  ! 2   /DROP n1 n2
  ! 3   /FFT  Fourier Transform resampling algorithm
  ! 4   /FREQUENCY name frest
  ! 5   /NOCHECK [SOURCE|POINTING|EPOCH|PHASE|SCAN]
  ! 6   /RESAMPLE nchan rchan res VELOCITY|FREQUENCY
  ! 7   /POLARIZATION SPLIT|AVERAGE|JOINT
  !
  ! Code currently handles dual-polarization in 3 different ways
  !   SPLIT:   A different visibility for each polarization
  !     AVERAGE: averaged polarizations before writing
  !     JOINT:   All channels Polar 1, then All channels polar 2 in visibility
  !---------------------------------------------------------------------
  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, 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,ia,ja
  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, 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, flagged, positions
  logical :: append, compr, frequency, warning, warned
  logical :: check, scan, noloop, resample, fft, skip, initialized
  logical :: do_select, first, overlap, counting, newinput
  real :: trchan, tfres, tvres, tvoff
  real :: width
  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,file
  character(len=12) :: key, fvoc(mfvoc), filvoc(mfilvoc)
  character(len=12) :: shavoc(mshavoc), chavoc(mchavoc)
  character(len=12) :: newname, shape, cpolar(3), ctele
  parameter (clight=299792.458d0)
  !
  ! test coordinates to specific precision ..
  real(8), parameter :: sec=pi/180D0/3600.D0
  ! Source, Pointing, Phase_Center, Epoch, Scan, Frequency
  real(8) :: tolerance(6) = (/0.d0 ,0.05d0*sec,0.005d0*sec,1d-5, 0.d0, 1.d-7/)
  logical :: setup=.true.
  character(len=*), parameter :: strnam = 'TOLE_SG%'
  !
  ! It is saved, but not the same as in command TABLE
  !
  integer, save :: file_uv_version
  !
  logical newuvt_format, treat_polar, add_scan, new_pola
  integer :: o_vis, ki
  integer :: ier, js, dvis, stokes, n_pol_scan, current_entry, iseq, pol_scan
  logical :: pol_flagged(mnbas)
  real, allocatable :: dima(:,:), temp(:,:)
  integer, allocatable :: pol_scan_list(:), pol_num_num(:),pol_num_list(:,:)
  integer :: lpol, hpol, lpola, hpola, npola, pola(4) ! Polarisation states counter
  integer :: extra(code_uvt_last)
  integer :: nextra, pcode(3), polcode
  real(8) :: xang(5)  ! Descriptive angles
  real(8) :: value(3) ! Dummy XYZ for telescope coordinates
  integer :: ipol, ibb
  complex :: est_i, prod
  !
  data shavoc/'TBOX','TPARABOLA','FBOX','FTRIANGLE'/
  data fvoc/'FREQUENCY','VELOCITY'/
  data filvoc/'NEW','OLD'/
  data chavoc/'SOURCE','POINTING','PHASE','EPOCH','SCAN'/
  data cpolar/'SPLIT','AVERAGE','JOINT'/
  data pcode /-1,0,1/
  !
  ! Only FILE should be saved ?
  save file
  !------------------------------------------------------------------------
  ! Code:
  error = .false.
  if (setup) then
    call sic_defstructure(strnam,.true.,error)
    call sic_def_dble(strnam//'POINT',tolerance(2),0,0,.false.,error)
    call sic_def_dble(strnam//'PHASE',tolerance(3),0,0,.false.,error)
    call sic_def_dble(strnam//'EPOCH',tolerance(4),0,0,.false.,error)
    call sic_def_dble(strnam//'FREQUENCY',tolerance(6),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
  !
  if (cont_select) then
    call message(6,3, 'TABLE', 'This version does not produce Continuum tables')
    error = .true.
    return
  endif
  !
  ! Verify if any input file
  call check_input_file(error)
  if (error) return
  call check_index(error)
  if (error) return
  !
  ! /NOCHECK  (Option 5)
  lcheck(1:mchavoc) = .true.
  if (sic_present(5,0)) then
    do i=1,sic_narg(5)
      call clic_kw (line,5,i,key,nkey,chavoc,mchavoc,.false.,error,.true.)
      lcheck(nkey) = .false.
    enddo
    check = any(lcheck)
  else
    check = .true.
  endif
  !
  scan = .true.
  resample = .false.
  !
  ! FFT Option (3)
  fft = sic_present(3,0)
  !
  ! /ADD Columns: Scan, Position, etc...
  if (sic_present(1,0)) then
    nextra = code_uvt_last
    call uvt_extra_cols(line,nextra, extra, error)
    if (error) return
    Print *,'extra ',extra(1:nextra)
  else
    nextra = 0
  endif
  !
  ! /POLARIZATION Key
  polcode = 0
  if (sic_present(7,0)) then
    call clic_kw (line,7,1,key,nkey,cpolar,4,.false.,error,.true.)
    if (error) return
    polcode = pcode(nkey)
    Print *,'Handling polarization ',polcode,key
    npola = 0
    pola = 0
  endif
  !
  ! /STOKES Key
  stokes =  code_stokes_none
  if (sic_present(8,0)) then
    call clic_kw (line,8,1,key,nkey,gio_stokes_names,21,.false.,error,.true.)
    if (error) return
    stokes = nkey-17
    Print *,'Handling stokes number',stokes,gio_stokes_names(stokes)
    if (stokes.gt.0) then
      allocate (pol_scan_list(nindex), stat=ier)
      allocate (pol_num_num(nindex), stat=ier)
      allocate (pol_num_list(nindex,16), stat=ier)
      n_pol_scan = 0
      pol_num_num = 0
      pol_num_list = 0
    endif
  endif
  !
  ! 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')
      xima%gil%column_pointer = 0
      xima%gil%column_size = 0
      !
    elseif (key.eq.'OLD') then
      append = .true.
      call gildas_null(xima, type= 'UVT')
      ! this puts the table header in X and Y buffers.
      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.
    !! call gdf_copy_header(xima,yima, error) ! Just in case ?
    ! No "call gildas_null(xima)" here, since its header has to be
    ! remembered from one call to another.
  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.0
  !
  ! /RESAMPLE
  if (sic_present(6,0)) then
    if (append) then
      call message(8,2,'TABLE','OLD Table: /RESAMPLE ignored')
    else
      call sic_i4(line,6,1,tnchan,.true.,error)
      if (error) return
      call sic_r4(line,6,2,trchan,.false.,error)
      if (error) return
      key = 'FREQUENCY'
      call clic_kw(line,6,5,key,nkey,fvoc,mfvoc,.false.,error,.true.)
      if (error) return
      if (key.eq.'FREQUENCY') then
        call sic_r8(line,6,3,tfoff,.false.,error)
        call sic_r4(line,6,4,tfres,.false.,error)
      elseif (key.eq.'VELOCITY') then
        call sic_r4(line,6,3,tvoff,.false.,error)
        call sic_r4(line,6,4,tvres,.false.,error)
      endif
      if (error) return
      call clic_kw(line,6,6,shape,nk,shavoc,mshavoc,.false.,error,.true.)
      if (error) return
      call sic_r4(line,6,7,width,.false.,error)
      if (error) return
      resample = .true.
    endif
  endif
  !
  ! Drop end channels (2)
  ndrop(1) = 0
  ndrop(2) = 0
  if (sic_present(2,0)) then
    call sic_i4(line,2,2,ndrop(2),.true.,error)
    call sic_i4(line,2,1,ndrop(1),.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(.true.,error)
  if (error) return
  !
  ! Select ALL - default are spectral bands
  if (all_select) then
    lsubb_out = max(1,r_lband)
    do is=1, lsubb_out
      isubb_out(is) = is+mbands
    enddo
    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)
  if (.not.noloop) then
    ! No loop on records anymore
    call message(6,3, 'TABLE','Only SCAN average allowed')
    error = .true.
    return
  endif
  !
  ! 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')
  !
  do while (.not.myend)
    ! Reset the Frequency
    if (frequency) call vel_scale_3 (newname,newfreq)
    ! Cut_header update the YIMA buffer according to scan header,
    ! in order to compare it with the XIMA 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
      ! Use the truncate scan header to initialize the Table header
      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
        !
        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
        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
        continue
        !! Print *,'TNCHAN is 0 ', xima%gil%nchan
      endif
      xima%gil%vtyp = r_typev ! Velocity type
      !
      ! Extra columns
      xima%gil%fcol = 8
      if (polcode.gt.0) then  ! JOINT mode
! Do not need column_pointer(code_uvt_stok) here. This is defined
! in the %gil%stokes array
        if (stokes.ne.code_stokes_none) then
          Print *,'JOINT: Handling 4 Polarization per visibility'
          xima%gil%nstokes = 4
          xima%gil%dim(1) = 3*xima%gil%nchan*4+7
          xima%gil%lcol = xima%gil%dim(1)
        else
          Print *,'JOINT: Handling 2 Polarization per visibility'
          xima%gil%nstokes = 2
          xima%gil%dim(1) = 3*xima%gil%nchan*2+7
          xima%gil%lcol = xima%gil%dim(1)
        endif
      else if (polcode.eq.0) then ! AVERAGE mode
        xima%gil%dim(1) = 3*xima%gil%nchan+7
        xima%gil%lcol = xima%gil%dim(1)
      else if (polcode.lt.0) then ! SPLIT mode
        Print *,'SPLIT: Handling changing Polarization state'
! Need column_pointer(code_uvt_stok) here to store the information.
        xima%gil%dim(1) = 3*xima%gil%nchan+7
        xima%gil%lcol = xima%gil%dim(1)
        xima%gil%dim(1) =  xima%gil%dim(1)+1
        xima%gil%column_pointer(code_uvt_stok) = xima%gil%dim(1)
      endif
      !
      ! Add the other extra columns, avoiding duplication
      do i=1,nextra
        if (xima%gil%column_pointer(extra(i)).eq.0) then
          xima%gil%dim(1) = xima%gil%dim(1)+1
          xima%gil%column_pointer(extra(i)) = xima%gil%dim(1)
          if (extra(i).eq.code_uvt_ra .or. extra(i).eq.code_uvt_dec) then
            xima%gil%dim(1) = xima%gil%dim(1)+1
            xima%gil%column_size(extra(i)) = 2
          endif
        endif
      enddo
      !
      ! 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
      !
      if (r_teles(1:4).ne.'ALMA' .and. r_teles(1:3).ne.'SMA') then
        ctele = 'NOEMA'
      else
        ctele = r_teles
      endif
      call gdf_addteles(xima,'TELE',ctele,value,error)
      ! We could finalize the UV header here...
      ! call gdf_setuv(xima,error)
      !
      ok = .true.
      warning = .false.
      warned = .false.
      initialized = .true.
    else
      ! Append to an existing table (X) - check consistency
      warning = .false.
      call check_consistency (lcheck,xima,yima,tolerance,r_num,r_scan,error)
      nchan = max(xima%gil%nchan,int(abs(xima%gil%ref(1))))
      warning = warning   &
           .or. abs(yima%gil%freq-xima%gil%freq).gt.tolerance(6)*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.tolerance(6)*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
      call check_consistency (lcheck,xima,yima,tolerance,r_num,r_scan,error)
      if (error) return
    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)
      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)
      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)
      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)
      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)
      endif
      warned = .true.
      !
      ! Test here the extra columns
    endif
    !
    ! Count polarizations status
    if (new_receivers) then
      do js=1, lsubb_out
        is = isubb_out(js)-mbands
        do ib=1, r_nbas
          new_pola = .true.
          if (npola.gt.0) then
            do i=1, npola
              if (r_code_stokes(ib,is).eq.pola(i)) &
                new_pola = .false.
            enddo
          endif
          if (new_pola) then
            npola = npola+1
            pola(npola) = r_code_stokes(ib,is)
          endif
        enddo 
      enddo
!      hpola = 0
!      lpola = 10 ! Arbitrary number > 4
!      do js = 1, lsubb_out
!        lpol = minval(r_lpolentry(1:r_nant,is))
!        hpol = maxval(r_lpolentry(1:r_nant,is))
!        lpola = min(lpola,lpol)
!        hpola = max(hpola,hpol)
!      enddo
!      npola = hpola-lpola+1
      if (polcode.lt.0) npola = 2
    else
      npola = 1
    endif
    !
    ! Check that data are complete for stokes parameter evaluation
    if (npola.eq.4) then
      add_scan = .true.
      if (n_pol_scan.gt.0) then
        do i=1,n_pol_scan
          if (pol_scan_list(i).eq.r_scan) then
            add_scan = .false.
            current_entry = i
          endif
        enddo
      endif
      if (add_scan) then
        n_pol_scan=n_pol_scan+1
        pol_scan_list(n_pol_scan) = r_scan
        current_entry = n_pol_scan
        n_vis = n_vis + r_nbas 
      endif
      if (pol_num_num(current_entry)+1.gt.16) then
        call message(6,4,'TABLE_STOKES',&
          'More than 16 sub-scans in polarisation scan')
        error = .true.
        return
      else
        pol_num_num(current_entry) = pol_num_num(current_entry)+1
        pol_num_list(current_entry, pol_num_num(current_entry)) = r_xnum
      endif
    else  
      !
      ! Not good here if polcode > 0
      if (polcode.lt.0) then
        n_vis = n_vis + r_nbas * npola
      else
        n_vis = n_vis + r_nbas 
      endif
    endif    
    !
    if (sic_ctrlc()) then
      error = .true.
      goto 200
    endif
    !
    ! Some extra counters
    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
  enddo
  !
  if (npola.eq.4) then
    do i=1,n_pol_scan
      print *," Polarisation scan ",pol_scan_list(i),", ", pol_num_num(i),&
              " sub-scans"
      print *,"       Sub-scan obs number:",pol_num_list(i,1:pol_num_num(i))
    enddo
  endif
  !
  n_visi(1:mnbb) = 1
  !
  ! Automatic sideband determination
  if (isideb_out.eq.5) then
    isid_auto(1:mnbb) = (3-r_isb)/2
  endif
  !
  ! Select all: refine the choice of subbands, depending on the
  ! table spectral parameters.
  if (all_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.458d0*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%nchan))
        enddo
      endif
      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)
    else
      call message(8,3,'TABLE','No matching subband')
      error = .true.
      return
    endif
  endif
  !
  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)
  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)
  write(chain,'(A,I12,A,F12.4,A)')   &
       ' NCHAN = ',xima%gil%nchan ,' X_REF1 = ',xima%gil%ref(1)
  call message(6,1,'TABLE',chain)
  !
  ! Create new file or append to existing one
  if (append) then
    !!Print *,'Calling newuvt_extend'
    call gdf_setuv(xima,error) ! Test
    call newuvt_extend(xima,file,n_vis,n_new,new_dates,new_scans,   &
          error,lcheck(5))
    o_vis = xima%gil%nvisi
    !!Print *,'FCOL ', xima%gil%fcol , xima%gil%lcol
    !!Print *,' VTYPE ',xima%gil%vtyp
  else
    Print *,'Calling NEWUVT_INIT ',xima%gil%vtyp
    ! POLCODE indicates if %nstokes is > 1
    ! We also need an option to set the %freqs array here
    ! for further processing of non-contiguous frequency bands
    call newuvt_create(xima,file,n_vis,npola,polcode,error)
    !!Print *,' VTYPE ',xima%gil%vtyp
    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
  if (npola.eq.4) then
    allocate (temp(xima%gil%dim(1),r_nbas), stat=ier)
    temp = 0
    iseq = 0
    pol_flagged = .false.
  endif
  !
  ! Loop on current index to write the visibilities
  myend = .false.
  nfl = 0
  if (npola.eq.4) then
    call get_first(.true.,error)
  else
    call get_first(.false.,error)
  endif
  if (error) goto 98
  nvis = 0
  skip = .false.
  !
  do while (.not.myend)
    if (frequency) call vel_scale_3 (newname,newfreq)
    call get_data (ldata_in,data_in,error)
    if (error) goto 98
    if (npola.eq.4) then
      iseq = iseq+1
      if (iseq.eq.1) then
        pol_scan=r_scan
        pol_flagged = .false.
      endif
      if (r_scan.ne.pol_scan) then
        write(chain,'(a,i0,a,i0,a,i0,a)') 'Scan ',r_scan,' (num ',r_num,  &
                                ') does not match polarisation scan (',  &
                                pol_scan,')'
        call message(6,3,'READ_DATA',chain(1:lenc(chain)))
        error = .true.
        return
      endif
    endif
    !
    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)
    !
    kin = gag_pointer(data_in, memory)
    kr = 1 ! Only the Header information, Scan averaged
    call spectral_dump(kr,0,0)
    ipk = kin + h_offset(kr)
    call decode_header (memory(ipk))
    call set_scaling(error)
    if (error) return
    !
    ! Get the required angles
    call get_angles(xang)
    !
    flagged = .false.
    if (isideb_out.le.2) then
      isb = isideb_out
    elseif (isideb_out.ge.3) then
      ! find the good sideband if declared LINE DSB
      isb = nint(3-(xima%gil%freq-r_flo1)/r_fif1)/2
      isb = min(2,max(1,isb))
    endif
    !
    kr = 1 ! Always, Scan averaged
    do ib = 1, r_nbas
      if (down_baseline(ib)) then
        flagged = .true.
        pol_flagged(ib) = .true.
        cycle
      endif
      !
      ! Take corrected or uncorrected
      call spectral_dump(kr,0,ib)
      ipkl = kin + l_offset(kr)
      !
      ! Do it for the accepted SideBand
      dvis = 1
      if (npola.eq.4) then
        call add_visiline (xima,npola,temp(1,ib), r_nsb, r_nband, r_nbas, r_lntch,   &
            ib, isb, xima%gil%val(1), memory(ipkl), passl, ndrop, &
            width, shape, resample, fft, error, dvis, polcode, xang)
      else
        call add_visiline (xima,npola,dima(1,nvis+1), r_nsb, r_nband, r_nbas, r_lntch,   &
            ib, isb, xima%gil%val(1), memory(ipkl), passl, ndrop, &
            width, shape, resample, fft, error, dvis, polcode, xang)
      endif
      if (error) goto 98
      ! NVIS is used to increment
      if (npola.ne.4)  then
        nvis = nvis + dvis ! Number of added visibilities found by add_visiline
      else
        if (iseq.eq.16)  then
          dvis = 1
!          if (stokes.lt.0) then
            !
            ! Native Stokes: normalize daps
            do i=1, xima%gil%nlead
              temp(i,ib) = temp(i,ib)/16.
            enddo    
            do i=xima%gil%dim(1), xima%gil%dim(1)-xima%gil%ntrail,-1
              temp(i,ib) = temp(i,ib)/16.
            enddo
            !
            ! and visibilities
            do i=1, xima%gil%nchan*xima%gil%nstokes
              ki = xima%gil%fcol+(i-1)*xima%gil%natom
              if (temp(ki+2,ib).ne.0) then
                temp(ki,ib) = temp(ki,ib)/temp(ki+2,ib)
                temp(ki+1,ib) = temp(ki+1,ib)/temp(ki+2,ib)
              else
                temp(ki,ib) = 0. 
                temp(ki+1,ib) = 0. 
              endif
            enddo
            !
            ! Dterm correction if needed
            if (do_corrected.and.polcode.gt.0) then
            ia = r_iant(ib)
            ja = r_jant(ib)
            ibb = r_bb(isubb_out(1)-mbands)
            do i=1, xima%gil%nchan
              do ipol=1, xima%gil%nstokes
                ki=xima%gil%fcol + xima%gil%natom*(i-1)+xima%gil%natom*xima%gil%nchan*(ipol-1)  
                select case (ipol)
                !
                ! First estimate complex I
                ! I=(HH+VV)/2
                case(1)   ! vv
                  est_i = cmplx(temp(ki,ib),temp(ki+1,ib))      
                case(2)   ! hh
                  est_i = (est_i+ cmplx(temp(ki,ib),temp(ki+1,ib)))/2
                !
                ! Then correct cross-products from D-terms
                case(3)   ! vh
                  prod = (r_dx(ia,ibb)+conjg(r_dy(ja,ibb)))*est_i
                  temp(ki,ib) = temp(ki,ib)-real(prod)
                  temp(ki+1,ib) = temp(ki+1,ib)-aimag(prod)
                case(4)   ! hv
                  prod = (r_dy(ia,ibb)+conjg(r_dx(ja,ibb)))*est_i
                  temp(ki,ib) = temp(ki,ib)-real(prod)
                  temp(ki+1,ib) = temp(ki+1,ib)-aimag(prod)
                end select
              enddo
            enddo
            endif
!          else
            !
            ! Derived Stokes
!          endif
          if (.not.pol_flagged(ib)) then
            call r4tor4(temp(1,ib),dima(1,nvis+1),xima%gil%dim(1))
            nvis = nvis + dvis
          endif
          temp(:,ib) = 0
        endif
      endif
      if (dvis.eq.0) flagged = .true.
    enddo
    if (iseq.eq.16) iseq=0
    if (flagged) nfl = nfl + 1
    !
    ! 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, nvis+o_vis, error
  Print *,' VTYPE ',xima%gil%vtyp
  nvis = nvis+o_vis
  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,file_uv_version,error)
  Print *,'Trying to deallocate '
  Print *,' VTYPE ',xima%gil%vtyp
!
200 continue
  deallocate (dima, stat=ier)
  Print *,'Done deallocation '
  call newuvt_close(xima)
  Print *,' VTYPE ',xima%gil%vtyp
  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 sg_table
!
subroutine uvt_extra_cols(line,nextra,extra,error)
  use gio_params
  use gkernel_interfaces
  use gbl_message
  !
  character(len=*), intent(in) :: line
  integer, intent(inout) :: nextra
  integer, intent(out) :: extra(*)
  logical, intent(out) :: error
  !
  character(len=*), parameter :: rname='SG_TABLE /ADD'
  character(len=12) :: argum, kw
  character(len=12), save :: items(code_uvt_last)
  logical, save :: first = .true.
  integer :: i, narg, nkey
  !
  if (first) then
    call uv_column_names(items)
    first = .false.
  endif

  !
  if (sic_narg(1).gt.nextra) then
    call clic_message(seve%e,rname,'Too many extra items')
    error = .true.
    return
  endif
  extra(1:nextra) = 0
  !
  error = .false.
  do i=1,sic_narg(1)
    call sic_ke (line,1,i,argum,narg,.true.,error)
    if (error) return
    call sic_ambigs('TABLE /ADD',argum,kw,nkey,items, code_uvt_last, error)
    if (error) return
    nextra = i
    extra(nextra) = nkey
  enddo
end subroutine uvt_extra_cols
!
subroutine newuvt_create (xima,name,nvis,npola,polcode,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
  integer, intent(in) :: npola          ! Number of polarisation
  integer, intent(in) :: polcode        ! Polarization treatment
  logical, intent(out) :: error         ! Error flag
  ! Local
  integer :: i,ier
  !
  ! 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 = 0
  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 of the basic "columns". The "extra"
  ! ones have been set outside already
  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
  where (xima%gil%column_pointer.ne.0)
    xima%gil%column_size = max(1,xima%gil%column_size)
  end where
  !
  xima%gil%natom = 3
  if (polcode.gt.0) then
    if (npola.eq.4) then
      xima%gil%nstokes = 4 
      xima%gil%order = code_chan_stok ! Channel / Stokes order
      allocate (xima%gil%stokes(xima%gil%nstokes), stat=ier)
      xima%gil%stokes(1) = code_stokes_vv
      xima%gil%stokes(2) = code_stokes_hh
      xima%gil%stokes(3) = code_stokes_vh
      xima%gil%stokes(4) = code_stokes_hv
    else
      xima%gil%nstokes = 2
      xima%gil%order = code_chan_stok ! Channel / Stokes order
      allocate (xima%gil%stokes(xima%gil%nstokes), stat=ier)
      xima%gil%stokes(1) = code_stokes_vv
      xima%gil%stokes(2) = code_stokes_hh
    endif
  else
    xima%gil%nstokes = 1
  endif
  xima%gil%nvisi = nvis
  xima%gil%type_gdf = code_gdf_uvt
  !
  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
  print *, 'Into newuvt_init Lead, Trail ', xima%gil%nlead, xima%gil%ntrail
  call gdf_create_image (xima,error)
  print *, 'Done newuvt_init '
end subroutine newuvt_create
!
subroutine check_consistency(lcheck,xima,yima,tolerance,r_num,r_scan,error)
  use gkernel_interfaces
  use image_def
  use classic_api
  include 'gbl_pi.inc'
  logical, intent(in) :: lcheck(4)
  real(8),  intent(in) :: tolerance(4)
  type(gildas), intent(in) :: xima
  type(gildas), intent(in) :: yima
  integer(kind=entry_length), intent(in) :: r_num
  integer, intent(in) :: r_scan
  logical, intent(out) :: error
  !
  character(len=72) :: chain
  character(len=13) :: xch, ych
  real(8), parameter :: sec=pi/180D0/3600.D0
  !
  error = .false.
  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(2) .and. abs(yima%gil%ra-xima%gil%ra).gt.tolerance(2)) 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.tolerance(2)) 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.tolerance(3)) 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.tolerance(3)) 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 (lcheck(4) .and. abs(yima%gil%epoc-xima%gil%epoc).gt.tolerance(4)) then
     write(6,*) 'Epoch :',yima%gil%epoc, xima%gil%epoc
     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',trim(chain))
  endif
end subroutine check_consistency
!
!      call add_visiline (xima,dima(1,nvis+1), r_nsb, r_nband, r_nbas, r_lntch,   &
!            ib, isb, xima%gil%val(1), &
!            memory(ipkc), memory(ipkl), passl, ndrop, &
!            width, shape, resample, fft, error, dvis, polcode, xang)
!
subroutine add_visiline (xima,npola,visi,qsb,qband,qbas,qntch,   &
    ibase,isb,frout,datal,passl,   &
    ndrop, width, shape, resample, fft, error, dvis, polcode, xang)
  use image_def
  use phys_const
  use classic_api
  !---------------------------------------------------------------------
  ! Called by SG_TABLE
  !
  ! creates one visibility point (i.e. one baseline and one band for a
  ! given scan), but many channels if in line mode.
  !
  ! Average Polarisations if needed, or split them, or concatenate them
  !---------------------------------------------------------------------
  type (gildas), intent(inout) :: xima  !
  integer, intent(in) :: npola      ! Number of requested polarization
  real, intent(out) :: visi(xima%gil%dim(1),npola)      ! Current visibilities
  integer :: qsb                    !
  integer :: qband                  !
  integer :: qbas                   !
  integer :: qntch                  !
  integer :: ibase                  ! Baseline number
  integer :: isb                    ! Sideband indicator
  real(8) :: frout                  !
  complex :: datal(qntch,qsb,qbas)  !
  complex :: passl(qntch,qsb,qbas)  !
  integer :: ndrop(2)               !
  real(4) :: width                  !
  character(len=*) :: shape         !
  logical :: resample               !
  logical :: fft                    !
  logical :: error                  !
  integer, intent(out) :: dvis      ! Number of visibilities added
  integer, intent(in) :: polcode    ! Code to handle polarizations
  real(8), intent(in) :: xang(5)    ! HA, Dec, Az, El, Parallactic Angle
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  !
  logical, external :: down_channel
  ! Local
  !
  integer :: inbc                   ! Sub-band indicator...
  complex :: zin(mlch), zout(mlch), zscale
  real :: wout(mlch),toto
  real :: w, tsys(2), ri, afac, factor, fr, save_res, rchan
  integer :: is, i, j, nw, k, ni, js, i1, i2, nd1, nd2, nch, iw
  integer :: ifirst, ilast, l, nchan, ia, ja, npol, ipol
  integer :: ibdata
  logical :: good
  real(8) :: f1, fn, fo1, fon, ff
  character(len=128) :: chain
  !
  integer ki, ioff
  integer ipola, jpola, opola
  !------------------------------------------------------------------------
  ! Code:
  rchan = xima%gil%ref(1)
  nchan = xima%gil%nchan
  !
  ! Here are the possibilities
  ! 1) Only one polarization
  ! 2) Two polarization, averaged for unpolarized signal
  !     a) equal
  !     b) with Tsys weighting
  ! 3) Two polarization, stored independently sequentially,
  !    in two separate visibilities, each with its Polarization flag
  ! 4) Mixed polarization status, stored in the same visibility, with
  !   possible holes, as some polarization stages can be void.
  !
  ! 5) Non contiguous frequencies (not yet available)
  !
  ! Code is only for Case 1,2,3 in this example...
  !
  dvis = 0      ! Reset number of written visibilities
  !
  !
  ia = r_iant(ibase)
  ja = r_jant(ibase)
  !
  if (dobs_0 .eq.0) then
    dobs_0 = mod(dh_obs+32768,65536)-32768
  endif
  !
  ! Initialize
!  visi(:,1:npola) = 0.0
  !
  ! U,V,W scaling factor
  ! Actually should be computed from the Doppler factor and other stuff..
  factor = 1.0
  !
  visi(xima%gil%column_pointer(code_uvt_u),1) = dh_uvm(1,ibase)*factor &
                           + visi(xima%gil%column_pointer(code_uvt_u),1) 
  visi(xima%gil%column_pointer(code_uvt_v),1) = dh_uvm(2,ibase)*factor &
                           + visi(xima%gil%column_pointer(code_uvt_v),1) 
  !! visi(xima%gil%column_pointer(code_uvt_w)) = 0.0
  visi(xima%gil%column_pointer(code_uvt_date),1) = dh_obs &
                           + visi(xima%gil%column_pointer(code_uvt_date),1) 
  visi(xima%gil%column_pointer(code_uvt_time),1) = dh_utc &
                           + visi(xima%gil%column_pointer(code_uvt_time),1) 
  visi(xima%gil%column_pointer(code_uvt_anti),1) = r_iant(ibase) &
                           + visi(xima%gil%column_pointer(code_uvt_anti),1) 
  visi(xima%gil%column_pointer(code_uvt_antj),1) = r_jant(ibase) &
                           + visi(xima%gil%column_pointer(code_uvt_antj),1) 
  !
  ! Extra Columns if specified...
  if (xima%gil%column_pointer(code_uvt_scan).ne.0) visi(xima%gil%column_pointer(code_uvt_scan),1) = r_scan  &
                           + visi(xima%gil%column_pointer(code_uvt_scan),1) 
  !
  ! There is an ambiguity between Pointing and Phase center. What happens in a MODIFY POSITION ?...
  if (xima%gil%column_pointer(code_uvt_loff).ne.0) visi(xima%gil%column_pointer(code_uvt_loff),1) = dh_offlam(1)*rad_per_sec 
  if (xima%gil%column_pointer(code_uvt_moff).ne.0) visi(xima%gil%column_pointer(code_uvt_moff),1) = dh_offbet(1)*rad_per_sec 
  if (xima%gil%column_pointer(code_uvt_xoff).ne.0) visi(xima%gil%column_pointer(code_uvt_xoff),1) = dh_offlam(1)*rad_per_sec 
  if (xima%gil%column_pointer(code_uvt_yoff).ne.0) visi(xima%gil%column_pointer(code_uvt_yoff),1) = dh_offbet(1)*rad_per_sec 
  !
  ! Doppler shift (for the baselines length...)
  ! This ones needs to filled SG
  if (xima%gil%column_pointer(code_uvt_topo).ne.0) then
    ! Conventions:
    ! we follow "frame-radio-redshift" convention where
    !    Obs = Rest * (1 + Doppler - Velocity/C)
    ! which is followed in all our codes (ASTRJ, RDI, CLASS)
    ! as the conversion between frequency is defined in cut_header.f90
    !    yima%gil%freq = yima%gil%val(1) / (1 + r_doppl)
    !
    ! However, until further notice, Doppler computed by MODIFY Doppler
    ! has the wrong sign
    !    r_doppl = (corr + r_veloc)/c    ! in clic_modify.f90
    !
    ! We should only put the topocentric to system velocity correction,
    ! not the local source velocity in its system
    visi(xima%gil%column_pointer(code_uvt_topo),1) = r_doppl - r_veloc/clight_kms &
                           + visi(xima%gil%column_pointer(code_uvt_topo),1) 
  endif
  ! Elevation and other angles
  if (xima%gil%column_pointer(code_uvt_el).ne.0) visi(xima%gil%column_pointer(code_uvt_el),1) = xang(4) &
                           + visi(xima%gil%column_pointer(code_uvt_el),1) 
  if (xima%gil%column_pointer(code_uvt_ha).ne.0) visi(xima%gil%column_pointer(code_uvt_ha),1) = xang(1) &
                           + visi(xima%gil%column_pointer(code_uvt_ha),1) 
  if (xima%gil%column_pointer(code_uvt_para).ne.0) visi(xima%gil%column_pointer(code_uvt_para),1) = xang(5) &
                           + visi(xima%gil%column_pointer(code_uvt_para),1) 
  if (xima%gil%column_pointer(code_uvt_int).ne.0) visi(xima%gil%column_pointer(code_uvt_int),1) = dh_integ &
                           + visi(xima%gil%column_pointer(code_uvt_int),1) 
  !
  ! Set the polarisation  / stokes column if needed
  ! Polarization codes have been chosen to verify the following equation.
  !   if (xima%gil%column_pointer(code_uvt_stok).ne.0) visi(xima%gil%column_pointer(code_uvt_stok),1) = &
  !   & = - (10*code_polar(ia) + code_polar(ja))
  ! but "code_polar" is not defined simply.  See r_lpolentry array, and debug conventions here...
  ! For the time being, put HH first, VV next
  if (xima%gil%column_pointer(code_uvt_stok).ne.0) visi(xima%gil%column_pointer(code_uvt_stok),1) = code_stokes_hh
  !
  ! Other extra columns could be added here...
  !
  if (xima%gil%column_size(code_uvt_ra).eq.1) then
    visi(xima%gil%column_pointer(code_uvt_ra),1) = r_lam &
                           + visi(xima%gil%column_pointer(code_uvt_ra),1) 
  elseif (xima%gil%column_size(code_uvt_ra).eq.2) then
    call r8tor8(r_lam, visi(xima%gil%column_pointer(code_uvt_ra),1), 1)
  endif
  if (xima%gil%column_size(code_uvt_dec).eq.1) then
    visi(xima%gil%column_pointer(code_uvt_dec),1) = r_bet &
                           + visi(xima%gil%column_pointer(code_uvt_dec),1) 
  elseif (xima%gil%column_size(code_uvt_dec).eq.2) then
    call r8tor8(r_bet, visi(xima%gil%column_pointer(code_uvt_dec),1), 1)
  endif
  !
  ! Spectrum out
  nw = 0
  !
  ! Spectrum from Continuum backend
  if (isubb_out(1).le.mbands) then
    call message(8,3,'FILL_VISI', 'Invalid selection : Continuum backend')
    error = .true.
    return
  endif
  !
  ! Spectrum from Line backend
  save_res = xima%gil%fres
  !
  opola = 0
  if (npola.eq.4) then
    npol = 1        ! Loop on polarisation done at higher level
  else
    npol = npola
  endif
  !
  ! Loop on polarisations.
  ! We assume here the polarization index gives the value of the polarization state.
  do ipola = 1,npol
    !
    good = .false.
    !
    ! Loop over all subbands, and see if their global polarization state matches
    do js = 1, lsubb_out
      !
      ! The band name
      is = isubb_out(js)-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
      !
      ! Is there any valid data ?
      if (is.gt.r_lband .or. down_channel(ibase,is+mbands)) cycle
      !
      ! Scaling and Tsys, possibly for dual-polarization receivers
      if ((npola.eq.4)) then
        select case (r_code_stokes(ibase,is))
        case (code_stokes_vv)
          ipol = 1  
        case (code_stokes_hh)
          ipol = 2  
        case (code_stokes_vh)
          ipol = 3  
        case (code_stokes_hv)
          ipol = 4  
        end select
      else
        if (ipola.ne.r_lpolentry(ia,is)) cycle
        ipol = ipola
      endif
      !
      inbc = r_bb(is)
      if (inbc.eq.0) cycle
      ! Compute scaling and Tsys if not already done
      if (ipola.ne.opola) then
        if (weight_tsys) 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
          where (tsys.eq.0.) tsys = 300.0**2
        else
          tsys = 300.0**2
        endif
        afac = 1.
        zscale = 1.
        call scaling (is,isb,ibase,zscale,afac,error)
        opola = ipola
      endif
      !
      !
      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.458d0*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)
      !
      ! Here one would put code to handle the non-contiguous frequency
      ! channels -- a little tricky though, so only a special mode
      ! will be needed.  TO BE DONE
      !
      ! Find out edge channels. Guard band for FFT
      if (fft) then
        ioff = 1
      else
        ioff = 0
      endif
      if (r_lrfres(isb,is)*xima%gil%fres.gt.0) then
        ifirst = nint(f1/xima%gil%fres+rchan+ioff)
        ilast  = nint(fn/xima%gil%fres+rchan-ioff)
      else
        ilast = nint(f1/xima%gil%fres+rchan-ioff)
        ifirst  = nint(fn/xima%gil%fres+rchan+ioff)
      endif
      !
      ! sub-band does not intersect current frequency window
      if ((ilast.lt.1) .or. (ifirst.gt.nchan)) then
        write(chain,2000) csub(is+mbands), ifirst, ilast
        call message(6,3,'FILL_VISI',trim(chain))
        cycle
      endif
      !
      ! First & Last definition depend on resampling method
      if (fft) then
        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+r_lrfres(isb,is)
          nd1 = nd1 + 1
        enddo
        ni = nint((ilast-ifirst+1)*abs(xima%gil%fres/r_lrfres(isb,is)))
      else
        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
        if (ipol.ne.5) then
          zin(i) = datal(j,ibdata,ibase)  * zscale
        else
          zin(i) = (1.,0.)
          toto =real(i,kind=4)/real(ni,kind=4)
          zin(i) = toto*(1,0.)
        endif
        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
      !
      ! Resample with appropriate method
      if (resample) then
        ff = (r_lvoff(isb,is)-xima%gil%voff)/299792.458d0*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, r_lrfres(isb,is),   &
            ri, r_lrfoff(isb,is),   &
            1., 'TPAR', error)
          if (error) cycle
        else
          call interpolate_2 (zout(ifirst),   &
            ilast-ifirst+1, xima%gil%fres,   &
            rchan-ifirst+1, xima%gil%freq+ff,   &
            wout(ifirst), zin, ni, r_lrfres(isb,is),   &
            ri, r_lrfoff(isb,is))
        endif
      else
        !
        ! Re-order in proper direction
        if (r_lrfres(isb,is)*xima%gil%fres.gt.0) then
          k = 1
          do i=ifirst, ilast
            zout(i) = zin(k)
            k = k+1
          enddo
        else
          k = 1
          do i=ilast, ifirst, -1
            zout(i) = zin(k)
            k = k+1
          enddo
        endif
        wout(ifirst:ilast) = 1.0
      endif
      !
      xima%gil%vres = -xima%gil%fres*299792.458d0/xima%gil%freq
      !
      ! Zout now contains the valid visibilities
      ! Wout have the valid relative weights, but not weighted
      ! time, Tsys or calibration factor yet
      !
      ! WEIGHT = 2 DELTA_NU DELTA_T / TSYS^2
      !
      if (weight_cal) then
        w = 2. / abs(zscale)**2 * abs(xima%gil%fres)
      else
        w = 2. * abs(xima%gil%fres)
      endif
      !
      ! zscale does not contains the Tsys and Integration time here ?
      w = w * dh_integ / tsys(isb) ! Tsys variable is actually Tsys^2
      !
      ! Now the weights are properly set
      wout = wout*w
      !
      ! Now fill the data by adding to the visibility
      !
      if (polcode.eq.0) then
        ! This code is for averaging the visibilities...
        do i=ifirst, ilast
          ki = xima%gil%fcol + xima%gil%natom*(i-1)
          visi(ki,1) =  visi(ki,1)+real(zout(i))*wout(i)
          visi(ki+1,1) = visi(ki+1,1)+aimag(zout(i))*wout(i)
          visi(ki+2,1) = visi(ki+2,1)+wout(i)
        enddo
      else if (polcode.lt.0) then
        !
        ! This code is for separating the visibilities...
        do i=ifirst, ilast
          ki = xima%gil%fcol + xima%gil%natom*(i-1)
          visi(ki,ipola) =  visi(ki,ipola)+real(zout(i))*wout(i)
          visi(ki+1,ipola) = visi(ki+1,ipola)+aimag(zout(i))*wout(i)
          visi(ki+2,ipola) = visi(ki+2,ipola)+wout(i)
        enddo
        !
        ! Put here the Polarization status ...
        ! Polarization codes have been chosen to verify the following equation.
        !   code_stoke = - (10*code_polar(ia) + code_polar(ja))
        ! but "code_polar" is not defined simply.
        ! See r_lpolentry array, and debug conventions here...
        !
        ! For the time being, by  construction, we have
        !  ipola = r_lpolentry(ia,is)
        ! so, by analogy
        jpola = r_lpolentry(ja,is)
        visi(xima%gil%column_pointer(code_uvt_stok),ipola) = - (10*ipola+jpola)
        !
      else if (polcode.gt.0) then
        ! This code is concatenating the visibilities with 2 Stokes...
        do i=ifirst, ilast
          ki = xima%gil%fcol + xima%gil%natom*(i-1) + xima%gil%natom*xima%gil%nchan*(ipol-1)
          visi(ki,1) =  visi(ki,1)+real(zout(i))*wout(i)
          visi(ki+1,1) = visi(ki+1,1)+aimag(zout(i))*wout(i)
          visi(ki+2,1) = visi(ki+2,1)+wout(i)
        enddo
      endif
      good = .true.
      !
    enddo ! Sub-bands
    !
    ! Increment if anything written
    if (good) then
      if (polcode.ge.0) then
        dvis = 1
      else
        dvis = dvis+1
      endif
    endif
    !
  enddo ! Polarisation
  !
  ! Renormalize ...
  !
!!  do j = 1,dvis
!!    do i = 1,xima%gil%nchan*xima%gil%nstokes
!!      ki = xima%gil%fcol + xima%gil%natom*(i-1)
!!      if (visi(ki+2,j).ne.0.0) then
!!        visi(ki,j) =  visi(ki,j)/visi(ki+2,j)
!!        visi(ki+1,j) = visi(ki+1,j)/visi(ki+2,j)
!!      else
!!        visi(ki,j) =  0.0
!!        visi(ki+1,j) = 0.0
!!      endif
!!    enddo
!!  enddo
  !
  ! Set header of all visibilities if needed
!!  do j = 2,dvis
!!    visi(1:xima%gil%fcol-1,j) = visi(1:xima%gil%fcol-1,1)
!!    do i = xima%gil%lcol+1,xima%gil%dim(1)
!!      if (xima%gil%column_pointer(code_uvt_stok).ne.i) then
!!        visi(i,j) = visi(i,1)
!!      else if (polcode.gt.0) then
!!        visi(i,j) = code_stokes_vv
!!      endif
!!    enddo
!!  enddo
  !
  ! Default weight...
  if (xima%gil%column_pointer(code_uvt_weig).ne.0) then
    do j = 1,dvis
      w = 0.0
      k = 0
      do i = 1,xima%gil%nchan*xima%gil%nstokes
        ki = xima%gil%fcol + xima%gil%natom*(i-1)
        w = w+visi(ki+2,j)
        k = k+1
      enddo
      w = w/k
      visi(xima%gil%column_pointer(code_uvt_weig),j) = w
    enddo
  endif
  !
  ! Final warning in case of rounding
  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',trim(chain))
  endif
  !
  return
2000 format('Subband ',a,' maps to output channels ',i9,' to ',i9)
end subroutine add_visiline
!
subroutine get_angles(x)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !     Return values of the descriptive angles
  !  Hour, Dec, Az, El, Parallactic
  !---------------------------------------------------------------------
  real(8), intent(out) :: x(5)
  ! Global
  include 'clic_parameter.inc'
  include 'gbl_pi.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  ! Local
  real(8) :: psi,the,phi ! Euler angles
  real(8) :: x_2(3), v_2(3), n_4(3), n_2(3), den, p_2(3), s_2
  real(8) :: trfm_24(3,3), lat, ho(2)
  !
  ! Well, this is ONLY for PdB...  We need it for other observatories
  ! sdm_* code does this slightly differently.
  ! CLIC or RDI should do it more properly.
  parameter (lat=(44+38d0/60d0+2d0/3600d0)*pi/180d0)
  !
  ! dh_svec is the source vector in hour-angle, dec coordinates (4)
  ! n_4 is the normal to the source meridian plane
  ! TRFM_24 goes from (4) to (2)
  ! n_2 is the normal to the source meridian plane, in horiz coords.(2)
  ! x_2 is the source vector in in horiz coords.
  ! v_2 is the intersection of the vertical plane of the source and
  ! the plane of the sky
  ! p_2 is the vector product of v_2 and n_2
  ! s_2 is the scalar product of p_2 and x_2
  psi=pi/2                   ! 90 degrees
  the=pi/2-lat               ! 90 degrees minus latitude
  phi=-pi/2                  ! -90 degrees
  call eulmat (psi,the,phi,trfm_24)
  call matvec (dh_svec, trfm_24, x_2)
  call spher(x_2, ho)
  !
  ! Return all 5 angles
  ! Hour Angle
  if (dh_svec(1).ne.0) then
    x(1) = atan2(-dh_svec(2),dh_svec(1)) !! *12./pi
  else
    call message(6,3,'VALUE','Error in hour-angle')
    x(1) = blank4
  endif
  ! Declination
  if (abs(dh_svec(3)).le.1.) then
    x(1) = asin(dh_svec(3))  !! *180./pi
  else
    call message(6,3,'VALUE','Error in declination')
    x(1) = blank4
  endif
  ho(1) = mod(ho(1)+3d0*pi,2d0*pi)-pi
  x(3) = -ho(1) !! *180d0/pi  ! Azimuth
  ho(2) = mod(ho(2)+3d0*pi,2d0*pi)-pi
  x(4) = ho(2)  !! *180d0/pi   ! Elevation
  !
  den = sqrt(dh_svec(1)**2+dh_svec(2)**2)
  n_4(1) = -dh_svec(2)/den
  n_4(2) = dh_svec(1)/den
  n_4(3) = 0
  call matvec (n_4, trfm_24, n_2)
  den = sqrt(x_2(1)**2+x_2(2)**2)
  v_2(1) = x_2(1)*x_2(3) / den
  v_2(2) = x_2(2)*x_2(3) / den
  v_2(3) = -den
  p_2(1) = v_2(2)*n_2(3)-v_2(3)*n_2(2)
  p_2(2) = v_2(3)*n_2(1)-v_2(1)*n_2(3)
  p_2(3) = v_2(1)*n_2(2)-v_2(2)*n_2(1)
  s_2 = p_2(1)*x_2(1)+p_2(2)*x_2(1)+p_2(3)*x_2(3) 
  ! Parallactic Angle
  x(5) = -pi/2+sign(acos(v_2(1)*n_2(1)+v_2(2)*n_2(2)+v_2(3)*n_2(3)),s_2)
end subroutine get_angles
!
subroutine vel_scale_3 (name,freq)
  use classic_api
  !---------------------------------------------------------------------
  ! Updates frequencies in header according to last 'SET FREQUENCY' command
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: name          !
  real(8), intent(in) :: freq                    !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  ! Local
  real(8) myfreq
  character(len=12) :: myname
  integer :: isb,isub
  !------------------------------------------------------------------------
  ! Code:
  ! Defaults from Input Header:
  if (name.eq.'*') then
    myname = r_line
  else
    myname = name
  endif
  if (freq.eq.0) then
    myfreq = r_restf
  else
    myfreq = freq
  endif
  ! Loop on sidebands
  do isb = 1, 2
    !
    ! Continuum
    r_crfoff(isb) = myfreq
    r_cnam(isb) = myname
    !
    ! Line
    do isub=1, r_lband
      r_lrfoff(isb,isub) = myfreq
      r_lnam(isb,isub) = myname
    enddo
  enddo
  !
  ! Reset velocity scale accordingly
  call vel_scale
end subroutine vel_scale_3
!
