subroutine read_data(arg,sort,init,error)
  use gildas_def
  use gkernel_interfaces, no_interface1=>gr4_trie_i4,  &
                          no_interface2=>gr4_sort
  use classic_api
  use clic_rdata
  use gio_params
  !---------------------------------------------------------------------
  ! CLIC
  !	Fill in the display data buffers from current index.
  !	arg : 'A' all scans in current index
  !	      'N' next scan in current index
  !---------------------------------------------------------------------
  character(len=*) :: arg           !
  logical :: sort                   !
  logical :: init                   !
  logical :: error                  !
  ! Global
  include 'clic_constant.inc'
  include 'clic_parameter.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  include 'gbl_pi.inc'
  ! Local
  logical :: end, corr, auto, flag, noloop
  integer :: i, ib, ix, iy, ibase, iband, ipol, istokes, jb
  integer :: ir, jw1, jw2,  nnn, k_ident
  integer :: nfl, itri, iant, kb, lb
  real*4 :: vtemp(4,3,mbox), wtemp(4,3,mbox), t, time_max
  real*4 :: vtemp_stokes(4,3,4,mbox), wtemp_stokes(4,3,4,mbox)
  character(len=80) :: ch
  integer :: i_loop
  integer :: r_pol, code_stokes_1, code_stokes_2, pol_scan
  logical :: stokes_required, stokes_computed, needed, stokes_correct
  logical :: pol_linear, pol_antenna, direct
  real*4  :: fw(mnbas,mbox),w(mnbas,mbox),wp
  complex :: z(mnbas,mbox),idx,idy,jdx,jdy
  ! Function
  logical :: down_antenna, down_baseline, down_channel, doit
  logical :: auto_data, corr_data, zero_average, unused, skip
  logical :: do_get_data, header_data, any_corr, any_auto
  !
  integer(kind=address_length) :: ko, kw,  data_in, ipr
  integer(kind=address_length) :: ip0, ipk, ipkc, ipkl, ipx, ipy, ipw, ipu, ips, ipi, kin, kr
  integer(kind=address_length) :: ip_data
  integer(kind=data_length)    :: ldata_in,  h_offset, c_offset, l_offset
  integer :: ignored(0:2)
  integer :: iv, im, is, mdump, nout, iseq, ibb
  integer :: iaver, naver
  logical :: proceed
  !------------------------------------------------------------------------
  !     Code:
  iseq = 0 
  naver = 0
  flag = .false.
  !
  ! Verify if any input file
  call check_input_file(error)
  if (error) return
  !
  call check_index(error)
  if (error) return
  !
  ! Loop on current index
  end = .false.
  skip = .false.
  time_max = 0.
  !
  if (arg.eq.'COMPRESS') then
    time_max = -1.
  endif
  if (arg.eq.'NEXT') then
    call get_next(end,error)
    if (error) return
    if (end) then
      call message(8,3,'READ_DATA','End of current index')
      return
    endif
    goto 100
  elseif (arg.eq.'CURRENT') then
    call get_num(r_xnum,error)
    if (error) return
    end = .false.
    goto 100
  elseif (arg.ne.'ALL' .and. arg.ne.'COMPRESS'   &
    .and. arg.ne.'FIRST') then
    read(arg(1:lenc(arg)),*,err=999) nnn
    call get_sub(nnn,0,error)
    if (error) return
    end = .false.
    goto 100
  endif
  if (do_spec.or.s_average.gt.1.or. &
     (i_stokes(1).ne.code_stokes_none.and.&
      (i_base(1).lt.0.or.do_corrected))) then
    call get_first(.true.,error)
  else
    call get_first(.false.,error)
  endif
  if (error) return
  if (arg.eq.'FIRST') end = .false.
  !
100 continue
  !
  ! Initialize
  if (init) then
    ip0 = gag_pointer(data_x,memory)
    call init_data(m_data*m_boxes,memory(ip0),0)
    ip0 = gag_pointer(data_y,memory)
    call init_data(m_data*m_boxes,memory(ip0),blank4)
    ip0 = gag_pointer(data_w,memory)
    call init_data(m_data*m_boxes,memory(ip0),0)
    ip0 = gag_pointer(data_i,memory)
    call init_data(m_data*m_boxes,memory(ip0),0)
    ip0 = gag_pointer(data_u,memory)
    call init_data(m_data*m_boxes,memory(ip0),0)
    ip0 = gag_pointer(data_r,memory)
    call init_data(m_data*m_boxes,memory(ip0),0)
    do_get_data = .false.
    any_corr = .false.
    any_auto = .false.
    do i = 1, n_boxes
      n_data(i) = 0
      do iv=1,4
        do im=1,3
          wtemp(iv,im,i) = 0
          vtemp(iv,im,i) = 0
          do is=1,4
            wtemp_stokes(iv,im,is,i) = 0
            vtemp_stokes(iv,im,is,i) = 0
          enddo
        enddo
      enddo
      f_sres(i) = .false.
      f_bres(i) = .false.
      ix = i_x(k_x(i))
      iy = i_y(k_y(i))
      do_get_data = do_get_data   &
        .or.(.not.header_data(ix))   &
        .or.(.not.header_data(iy))
      any_corr = any_corr &
        .or.corr_data(ix,iy)
      any_auto = any_auto &
        .or.auto_data(ix,iy)
    enddo
    do  i=1, m_ident
      ch_ident (i) = ' '
    enddo
    n_ident = 0
    k_ident = 0
    zero_average = .true.
    do i=0,2
      ignored(i) = 0
    enddo
  endif
  !
  ! Do not use logics provided by "do_get_data" anymore, ie always access IPB file
  ! even to plot variables stored in the HPB file -- because the flags are in the
  ! IPB! 05-05-2004
  if (.not.skip_flag) do_get_data = .true.
  !
  ! Stokes parameter checks
  ! Observation frame deduced from first antenna first baseband
  ! Will not handle "mixed" cases. 
  stokes_required = .false.  
  stokes_computed = .false.
  stokes_correct = .false.
  if (n_stokes.gt.1.or.i_stokes(1).ne.code_stokes_none) then
    stokes_required = .true.
    call message(6,1,'READ_DATA','Stokes parameter required')
    !
    r_pol = r_mappol(1,1)
    if (r_pol.eq.code_polar_h.or.r_pol.eq.code_polar_v) then
      pol_linear = .true.
      pol_antenna = .true.
      code_stokes_1 = code_stokes_vh
      code_stokes_2 = code_stokes_hh
    elseif (r_pol.eq.code_polar_x.or.r_pol.eq.code_polar_x) then
      pol_linear = .true.
      pol_antenna = .false.
      code_stokes_1 = code_stokes_yx
      code_stokes_2 = code_stokes_xx
    elseif (r_pol.eq.code_polar_r.or.r_pol.eq.code_polar_l) then
      pol_linear = .false.
      pol_antenna = .true.
      code_stokes_1 = code_stokes_lr
      code_stokes_2 = code_stokes_rr
    elseif (r_pol.eq.code_polar_d.or.r_pol.eq.code_polar_s) then
      pol_linear = .false.
      pol_antenna = .false.
      code_stokes_1 = code_stokes_sd
      code_stokes_2 = code_stokes_dd
    endif 
!!   print *,"n_stokes",n_stokes,"i_stokes",i_stokes(1:n_stokes),"code_1",&
!!          code_stokes_1,"code_2",code_stokes_2 
   if (any((i_stokes(1:n_stokes).lt.code_stokes_1).or. &
           (i_stokes(1:n_stokes).gt.code_stokes_2)).or. &
           i_base(1).lt.0.or.do_corrected) then
      stokes_computed = .true.
      iseq = 0
      call message(6,1,'READ_DATA','Stokes parameter needs to be computed')
    else
      call message(6,1,'READ_DATA','Stokes parameter is native')
    endif
  endif
  if (stokes_required.or.do_leakage) then
     stokes_correct = .true.
  endif
  do while (.not.end)
    !
    ! Read data
    unused = .false.
    nfl = 0
    if (n_ident .eq. 0) then
      n_ident = 1
      ch_ident(n_ident) = r_sourc
      k_ident = 1
    elseif (ch_ident(k_ident) .ne. r_sourc) then
      k_ident = 0
      do i=1, n_ident
        if (ch_ident(i) .eq. r_sourc) then
          k_ident = i
        endif
      enddo
      if (k_ident.eq.0) then
        if (n_ident.lt.m_ident) then
          n_ident = n_ident+1
          ch_ident(n_ident) = r_sourc
          k_ident = n_ident
        else
          ch_ident(n_ident) = 'Other'
          k_ident = n_ident
        endif
      endif
    endif
    if (s_average.gt.1) then
      proceed = k_ident.ne.iaver.and.naver.gt.0
      if (proceed) then  
        do ib=1, n_boxes
          call aver(ib, vtemp(1,1,ib), wtemp(1,1,ib),   &
            k_ident, r_num, dh_dump, error)
          if (error) return
        enddo
        naver = 0
      endif
    endif
    if (do_get_data) call get_data (ldata_in,data_in,error)
    if (error) return
    !
    !
    !cc+ 2003-11-11
    if (time_max.lt.0) then
      ip_data = gag_pointer(data_in,memory)
      mdump = r_ndump
      call compress(time_max, 7.5, memory(ip_data),nout,error)
      if (error) goto 999
      r_ndump = nout
      call loose_data
    endif
    !cc- 2003-11-11
    call check_cal(skip)
    if (skip) then
      ignored(r_lmode) = ignored(r_lmode) + 1
      skip = .false.
      goto 180
    endif
    if (do_pass.and.any_corr) then
      call set_pass (r_nsb,r_nband,r_nbas+r_ntri,   &
        r_lntch, passc, passl, error)
      if (error) return
    endif
    if (do_spidx.and.any_corr) then
      call set_spidx(r_nsb,r_nband,r_nbas+r_ntri,   &
        r_lntch, spidc, spidl, r_spidx, error)
    endif
    if (do_pass.and.any_corr) then
      if (do_spidx) then
        where (passc.ne.blankc)
          factc = passc * spidc
        else where
          factc = blankc
        end where
        where (passl.ne.blankc)
          factl = passl * spidl
        else where
          factl = blankc
        end where
      else
        factc = passc
        factl = passl
      endif
    elseif (do_spidx.and.any_corr) then
      factc = spidc
      factl = spidl
    endif
    if (r_presec(atmon_sec).and.any_corr) call set_corr(error)
    !
    ! Compute side band averages (for averaging sidebands), 
    ! using average record.
    ! Only if all switches are in direct mode
    direct = all(r_polswitch(1:r_nant,:).eq.0)
    if (do_get_data) then
      kin = gag_pointer(data_in,memory)
      call spectral_dump(kr,0,0)
      ipk = kin + h_offset(kr)
      call decode_header (memory(ipk))
      call set_scaling(error)
      if (error) return
      if (r_lmode.eq.1.and.any_corr.and.direct) then ! correlation only ...
        if (k_average.eq.1) then
          call line_average (r_lntch,r_nbas,r_lnsb,data_in,   &
                spidl,zero_average,error)
        else
          call cont_average (r_nband,r_nbas,data_in,   &
                spidc,zero_average,error)
        endif
        if (error) return
      endif
    endif
    !
    ! Check
    if (stokes_computed) then
      iseq = iseq+1
      if (iseq.eq.1) pol_scan=r_scan
      if (r_scan.ne.pol_scan.and.iseq.ne.16) then
        write(ch,'(a,i0,a,i0,a,i0,a)') 'Scan ',r_scan,' (num ',r_num,  &
                                ') does not match polarisation scan (',  &
                                pol_scan,')'
        call message(8,3,'READ_DATA',ch(1:lenc(ch)))
        error = .true.
        return
      endif
    endif
    !
    !
    ! Loop on Boxes
    do ib = 1, n_boxes
      ix = i_x(k_x(ib))
      iy = i_y(k_y(ib))
      corr = corr_data(ix,iy)
      auto = auto_data(ix,iy)
      if (auto.and.r_lmode.eq.1) then
        unused = .true.
        goto 150
      elseif (corr.and.r_lmode.eq.2) then
        unused = .true.
        goto 150
      endif
      ibase = i_base(k_base(ib))
      ipol = k_polar(ib)
      itri = ibase-mnbas
      iant = -ibase
      if (ibase.le.mnbas .and. ibase.gt.r_nbas) then
        call message(6,3,'READ_DATA',   &
          'Baseline '//cbas(ibase)//' not available in data')
        error = .true.
        return
      elseif (itri.gt.0 .and. itri.gt.r_ntri) then
        call message(6,3,'READ_DATA',   &
          'Triangle '//ctri(itri)//' not available in data')
        error = .true.
        return
      endif
      if (iant.gt.r_nant) then
        write(ch,'(a,i0,a)') 'Antenna ',iant,   &
          ' not available in data'
        call message(6,3,'READ_DATA',ch(1:lenc(ch)))
        error = .true.
        return
      endif
      iband = i_band(k_band(ib))
      kb = k_subb(ib)
      lb = l_subb(kb)
      if (corr .or. auto) then
        jw1 = iw1(kb)
        jw2 = iw2(kb)
        ! one does not check  the bandwith changes ...
        call check_subb(n_subb,.true.,error)
        if (error) return
      endif
      !
      ! Check if data needed
      needed = .true.
      if (stokes_required.and..not.stokes_computed) then
        if (i_stokes(k_stokes(ib)).ne. &
            r_code_stokes(ibase,mod(i_subb(1,kb),mbands))) then
          needed = .false.
        endif
      endif
      !
      ! Loop on records
      noloop = .false.
      do i_loop = 1, n_loop
        do ir = rec_1(i_loop), min(r_ndump,rec_2(i_loop)),   &
            rec_3(i_loop)
          ! Read only the average record if needed
          if (noloop) goto 150
          noloop = ((corr.or.auto).and.(i_subb(1,kb).gt.mbands))   &
            .or. (i_average.eq.1) .or.stokes_computed  ! scan averaging
          if (do_get_data) then
            if (noloop) then
              call spectral_dump(kr,iant,ibase)
            else
              kr = ir
            endif
            ipk = kin + h_offset(kr)
            ipkc = kin + c_offset(kr)
            ipkl = kin + l_offset(kr)
            call decode_header (memory(ipk))
            flag = .false.
            ! count flagged records
            if (ibase.lt.0) then
              flag = flag .or. down_antenna(abs(ibase))
            else
              flag = flag .or. down_baseline(ibase)
              do i=1,lb
                flag = flag .or.   &
                  down_channel(ibase,i_subb(i,kb))
              enddo
            endif
          else
            dh_integ = max(r_time,1.)
            dh_obs = r_dobs
            dh_utc = r_ut/pi*43200.
            dh_dump = 1.0
          endif
          !
          ! Get the desired value
          if (needed) then
            if (stokes_computed.and.ibase.gt.0) then
              select case (r_code_stokes(ibase,mod(i_subb(1,kb),mbands))) 
              case (code_stokes_hh)
                istokes = 1
              case (code_stokes_vv)
                istokes = 2 
              case (code_stokes_hv)
                istokes = 3 
              case (code_stokes_vh)
                istokes = 4 
              end select
              call r4tor4(vtemp_stokes(1,1,istokes,ib),vtemp(1,1,ib),12)
              call r4tor4(wtemp_stokes(1,1,istokes,ib),wtemp(1,1,ib),12)
            endif
            if (ibase.lt.0) then
              if (stokes_computed) then
                do jb = 1, r_nbas
                  if ((.not.down_baseline(jb)) .and. &
                      (i_stokes(k_stokes(ib)).eq. &
                       r_code_stokes(jb,mod(i_subb(1,kb),mbands)))) then
                    call zrecord(   &
                      r_nsb, r_nband, r_nbas+r_ntri, r_lntch,   &
                      memory(ipkc), memory(ipkl), factc, factl, jb, iband,   &
                      lb, i_subb(1,kb), jw1, jw2, z(jb,ib),  &
                      fw(jb,ib), wp,error)
                    if (error) return
                    w(jb,ib) = fw(jb,ib)
                  endif
                enddo 
              else
                call arecord (   &
                  r_nsb, r_nband, r_nbas, r_lntch,   &
                  memory(ipkc), memory(ipkl), factc, factl,   &
                  -ibase,iband,ipol,k_baseband(ib),k_if(ib), &
                  lb,i_subb(1,kb),jw1,jw2,ix,iy,  &
                  vtemp(1,1,ib),wtemp(1,1,ib),.false.,error)
              endif
            else
              call brecord (   &
                r_nsb, r_nband, r_nbas+r_ntri, r_lntch,   &
                memory(ipkc), memory(ipkl), factc, factl,   &
                ibase,iband,ipol,k_baseband(ib),k_if(ib), &
                lb,i_subb(1,kb),jw1,jw2,ix,iy,   &
                vtemp(1,1,ib),wtemp(1,1,ib),error)
              if (stokes_correct) then
                if (stokes_required) then
                  call correct_stokes(i_stokes(k_stokes(ib)), &
                                    vtemp(1,1,ib),wtemp(1,1,ib),error)
                else
                  call correct_stokes(r_code_stokes(mod(i_subb(1,kb),mbands),1), &
                                    vtemp(1,1,ib),wtemp(1,1,ib),error)
                endif
              endif
            endif
            if (stokes_computed.and.ibase.gt.0) then
              select case (r_code_stokes(ibase,mod(i_subb(1,kb),mbands))) 
              case (code_stokes_hh)
                istokes = 1
              case (code_stokes_vv)
                istokes = 2 
              case (code_stokes_hv)
                istokes = 3 
              case (code_stokes_vh)
                istokes = 4 
              end select
              call r4tor4(vtemp(1,1,ib),vtemp_stokes(1,1,istokes,ib),12)
              call r4tor4(wtemp(1,1,ib),wtemp_stokes(1,1,istokes,ib),12)
            endif
          endif
          if (error) return
          if (((i_average.eq.0) .or.   &
            (i_average.eq.2 .and. wtemp(3,1,ib).ge.t_average))   &
            .and. .not.stokes_computed)            &
            then
            call aver(ib, vtemp(1,1,ib), wtemp(1,1,ib),   &
              k_ident, r_num, dh_dump, error)
            if (error) return
          endif
        enddo
      enddo                    ! end loop on records
      if (flag) nfl = nfl + 1
150   continue
    enddo
    if (unused) ignored(r_lmode) = ignored(r_lmode) + 1
    ! End of scan
180 if (nfl.ne.0) then
      write(ch,'(i4,a)') nfl,' records flagged'
      call message(4,2,'READ_DATA',ch(1:lenc(ch)))
      nfl = 0
    endif
    ! Data ignored : check ^C and 'A' argument
    if (arg.ne.'ALL' .and. arg.ne.'COMPRESS') goto 200
    if (sic_ctrlc()) then
      error = .true.
      goto 200
    endif
    if (s_average.gt.1) then
      naver = naver+1
      if (naver.eq.1) then
        iaver = k_ident
      endif
      if (naver.ge.s_average) then  
        do ib=1, n_boxes
          call aver(ib, vtemp(1,1,ib), wtemp(1,1,ib),   &
            k_ident, r_num, dh_dump, error)
          if (error) return
        enddo
        naver = 0
      endif
    else
      if (stokes_computed) then
        doit = .false.
        if (iseq.eq.16) then
          !
          ! End of scan, compute required stokes parameter
          do ib=1, n_boxes
            ibase = i_base(k_base(ib))
            if (ibase.gt.0) then
              kb = k_subb(ib)
              lb = l_subb(kb)
              do is=1,lb
              ibb = r_bb(mod(i_subb(is,kb),mrlband))
              enddo
              idx=r_dx(r_iant(ibase),ibb)
              idy=r_dy(r_iant(ibase),ibb)
              jdx=r_dx(r_jant(ibase),ibb)
              jdy=r_dy(r_jant(ibase),ibb)
              call stokes_visi(i_stokes(k_stokes(ib)),&
                           idx,idy,jdx,jdy, &
                           vtemp_stokes(1,1,1,ib),wtemp_stokes(1,1,1,ib), &
                           vtemp(1,1,ib),wtemp(1,1,ib))
              ix = i_x(k_x(ib))
              iy = i_y(k_y(ib))
              !
              ! Reset stokes buffers
              do iv=1,4
                do im=1,3
                  do is=1,4
                    wtemp_stokes(iv,im,is,ib) = 0
                    vtemp_stokes(iv,im,is,ib) = 0
                  enddo
                enddo
              enddo
            else
              !
              ! Compute antenna gain
               call arecord_compute(z(1,ib),w(1,ib),    &
                 -ibase,iband,ipol,k_baseband(ib),k_if(ib), &
                 ix,iy,  &
                 vtemp(1,1,ib),wtemp(1,1,ib),error)
            endif
          enddo
          !
          ! Data are ready to be processed further
          doit = .true.
          iseq = 0
        endif
      else
        doit = .true.
      endif
      do ib=1, n_boxes
        if ((i_average.ne.0.and.doit) .and. wtemp(3,1,ib).gt.0) then
          call aver(ib, vtemp(1,1,ib), wtemp(1,1,ib),   &
            k_ident, r_num, dh_dump, error)
          if (error) return
        endif
      enddo
      if (i_average.eq.0.and.stokes_computed.and.doit) then
        do ib=1, n_boxes
          if (wtemp(3,1,ib).gt.0) then
            call aver(ib, vtemp(1,1,ib), wtemp(1,1,ib),   &
              k_ident, r_num, dh_dump, error)
            if (error) return
          endif
        enddo
      endif
    endif
    call get_next(end,error)
    if (error) return
  enddo
  !
  ! If multiple scan average, plot pending data
  if (s_average.gt.0.and.naver.ne.0) then
    do ib=1, n_boxes
      if (i_average.ne.0 .and. wtemp(3,1,ib).gt.0) then
        call aver(ib, vtemp(1,1,ib), wtemp(1,1,ib),   &
          k_ident, r_num, dh_dump, error)
        if (error) return
      endif
    enddo
  endif
  !
  ! Optionnally bin data
200 continue
  if (ignored(1).ne.0) then
    write(ch,'(i4,a)') ignored(1),' ignored correlations'
    call message(4,2,'READ_DATA',ch(1:lenc(ch)))
  endif
  if (ignored(2).ne.0) then
    write(ch,'(i4,a)') ignored(2),' ignored autocorrelations'
    call message(4,2,'READ_DATA',ch(1:lenc(ch)))
  endif
  if (do_bin) then
    call bin(error)
    if (error) return
  endif
  !
  ! Order data in each box according to x_data ...	! z_data not sorted
  if (sort) then
    kw = m_data
    ko = 0                     ! Was missing, presumably
    ipx = gag_pointer(data_x,memory)
    ipy = gag_pointer(data_y,memory)
    ipw = gag_pointer(data_w,memory)
    ipi = gag_pointer(data_i,memory)
    ipu = gag_pointer(data_u,memory)
    ipr = gag_pointer(data_r,memory)
    ips = gag_pointer(data_s,memory)
    do ib=1, n_boxes
      call gr4_trie_i4(memory(ipx+ko),memory(ips),   &
        n_data(ib),error)
      if (error) return
      call gr4_sort(memory(ipy+ko),memory(ips+kw),   &
        memory(ips),n_data(ib))
      call gr4_sort(memory(ipw+ko),memory(ips+kw),   &
        memory(ips),n_data(ib))
      call gr4_sort(memory(ipi+ko),memory(ips+kw),   &
        memory(ips),n_data(ib))
      call gr4_sort(memory(ipu+ko),memory(ips+kw),   &
        memory(ips),n_data(ib))
      call gr4_sort(memory(ipr+ko),memory(ips+kw),   &
        memory(ips),n_data(ib))
      ko = ko+kw               ! Was also missing, I presume
    enddo
    sorted = .true.
  else
    sorted = .false.
  endif
  !
  ! Process phases
  call reset_phases
  !
  ! Redimension variables
  call resetvar(error)
  return
  !
999 ch = 'Error decoding '//arg
  call message(8,3,'READ_DATA',ch)
  error = .true.
  return
end subroutine read_data
!
subroutine stokes_visi(istoke,idx,idy,jdx,jdy,vt_stokes,wt_stokes,vt,wt)
  use gkernel_interfaces
  use gio_params
  integer, intent(in)         :: istoke
  complex, intent(in)         :: idx
  complex, intent(in)         :: idy
  complex, intent(in)         :: jdx
  complex, intent(in)         :: jdy
  real(kind=4), intent(inout) :: vt_stokes(4,3,4)
  real(kind=4), intent(in)    :: wt_stokes(4,3,4)
  real(kind=4), intent(out)   :: vt(4,3)
  real(kind=4), intent(out)   :: wt(4,3)
  !
  include 'clic_xy_code.inc'
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  !
  ! Local
  logical :: error
  integer :: iv,im,is
  real    :: parangle,wv,sin2chi,cos2chi,s_i(4,3),w_i(4,3)
  complex :: dummy, est_i(3)
  ! Code
  ! 
  do iv=3,4
    do im=1,3
      do is=1,4
        if (wt_stokes(iv,im,is).gt.0) then
          vt_stokes(iv,im,is) = vt_stokes(iv,im,is)/wt_stokes(iv,im,is)
        endif
      enddo
    enddo
  enddo
  if (do_corrected) then
    ! Stokes I: [HH+VV]/2
    do iv=3,4
      do im=1,3
        s_i(iv,im)=(vt_stokes(iv,im,1)+vt_stokes(iv,im,2))/2
        w_i(iv,im)=(wt_stokes(iv,im,1)+wt_stokes(iv,im,2))/2
      enddo
    enddo
    do im=1,3
      est_i(im)=cmplx(s_i(3,im),s_i(4,im))
    enddo
  endif
  select case (istoke)
  case (code_stokes_ratio) 
    ! Stokes ratio: [HH-VV]/[HH+VV]
    do iv=1,2
      do im=1,3
        vt(iv,im)=(vt_stokes(iv,im,1)+vt_stokes(iv,im,2))/2
        wt(iv,im)=(wt_stokes(iv,im,1)+wt_stokes(iv,im,2))/2
      enddo
    enddo
    do iv=3,4
      do im=1,3
        vt(iv,im)=(abs(vt_stokes(iv,im,1))-abs(vt_stokes(iv,im,2))) / &
                  (abs(vt_stokes(iv,im,1))+abs(vt_stokes(iv,im,2)))
        wt(iv,im)=(wt_stokes(iv,im,1)+wt_stokes(iv,im,2))/2
      enddo
    enddo
  case (code_stokes_i) 
    ! Stokes I: [HH+VV]/2
    do iv=3,4
      do im=1,3
        vt(iv,im)=(vt_stokes(iv,im,1)+vt_stokes(iv,im,2))/2
        wt(iv,im)=(wt_stokes(iv,im,1)+wt_stokes(iv,im,2))/2
      enddo
    enddo
  case (code_stokes_q) 
    ! Stokes Q: [cos(2chi)HH -sin(2chi)HV-sin(2chi)VH-cos(2chi)VV]/2
    call value(xy_parang,dummy,1,1,1,1,1,parangle,wv,error)
    cos2chi = cos(2*parangle)
    sin2chi = -sin(2*parangle)
    do iv=1,1
      do im=1,3
        vt(iv,im)=(vt_stokes(iv,im,1)+vt_stokes(iv,im,2) &
                  +vt_stokes(iv,im,3)+vt_stokes(iv,im,4))/4
        wt(iv,im)=(wt_stokes(iv,im,1)+wt_stokes(iv,im,2) &
                  +wt_stokes(iv,im,3)+wt_stokes(iv,im,4))/4
      enddo
    enddo
    do iv=3,4
      do im=1,3
!        vt(iv,im)=(vt_stokes(iv,im,1)-vt_stokes(iv,im,2))/ &
!                  (vt_stokes(iv,im,1)+vt_stokes(iv,im,2))
        vt(iv,im)=(cos2chi*vt_stokes(iv,im,1)-cos2chi*vt_stokes(iv,im,2) &
                  -sin2chi*vt_stokes(iv,im,3)-sin2chi*vt_stokes(iv,im,4))/2
        wt(iv,im)=(cos2chi**2*wt_stokes(iv,im,1)+cos2chi**2*wt_stokes(iv,im,2) &
                  +sin2chi**2*wt_stokes(iv,im,3)+sin2chi**2*wt_stokes(iv,im,4))/2
      enddo
    enddo
  case (code_stokes_u)
    ! Stokes U: [sin(2chi)HH +cos(2chi)HV+cos(2chi)VH-sin(2chi)VV]/2
    call value(xy_parang,dummy,1,1,1,1,1,parangle,wv,error)
    sin2chi = sin(2*parangle)
    cos2chi = cos(2*parangle)
    do iv=1,2
      do im=1,3
        vt(iv,im)=(vt_stokes(iv,im,1)+vt_stokes(iv,im,2))/2
        wt(iv,im)=(wt_stokes(iv,im,1)+wt_stokes(iv,im,2))/2
      enddo
    enddo
    do iv=3,4
      do im=1,3
        vt(iv,im)=(sin2chi*vt_stokes(iv,im,1)-sin2chi*vt_stokes(iv,im,2) &
                  +cos2chi*vt_stokes(iv,im,3)+cos2chi*vt_stokes(iv,im,4))/2
        wt(iv,im)=(sin2chi**2*wt_stokes(iv,im,1)+sin2chi**2*wt_stokes(iv,im,2) &
                  +cos2chi**2*wt_stokes(iv,im,3)+cos2chi**2*wt_stokes(iv,im,4))/2
      enddo
    enddo
  case (code_stokes_v)
    ! Stokes V: [-iHV+iVH]
!!  case (code_stokes_leakage) 
    ! Leakage: HV+Qsin(2chi)-Ucos(2chi)-iV
    !          VH+Qsin(2chi)-Ucos(2chi)+iV
  case (code_stokes_hv)
    !
    if (do_leakage) then
      call value(xy_parang,dummy,1,1,1,1,1,parangle,wv,error)
      cos2chi = cos(2*parangle)
      sin2chi = sin(2*parangle)
      do iv=1,2
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,3) 
          wt(iv,im)=wt_stokes(iv,im,3)
        enddo
      enddo
      do iv=3,4
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,3) &
                   +r_stokes_q*cos2chi-r_stokes_u*sin2chi
          wt(iv,im)=wt_stokes(iv,im,3)
          if (r_stokes_i.ne.0) then
            vt(iv,im)=vt(iv,im)/r_stokes_i
            wt(iv,im)=wt(iv,im)/r_stokes_i
          endif
        enddo
      enddo
    endif
    if (do_corrected) then
      do iv=1,2
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,3) 
          wt(iv,im)=wt_stokes(iv,im,3)
        enddo
      enddo
      do iv=3,3
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,3) &
                   -(real(est_i(im)*(idy+conjg(jdx))))
          wt(iv,im)=wt_stokes(iv,im,3)+w_i(iv,im)*real(idy+jdx)
        enddo
      enddo
      do iv=4,4
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,3) &
                   -(aimag(est_i(im)*(idy+conjg(jdx))))
          wt(iv,im)=wt_stokes(iv,im,3)+w_i(iv,im)*aimag(idy-jdx)
        enddo
      enddo
    endif
  case (code_stokes_vh)
    !
    if (do_leakage) then
      call value(xy_parang,dummy,1,1,1,1,1,parangle,wv,error)
      cos2chi = cos(2*parangle)
      sin2chi = -sin(2*parangle)
      do iv=1,4
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,4) &
                   +r_stokes_q*cos2chi-r_stokes_u*sin2chi
          wt(iv,im)=wt_stokes(iv,im,4)
          if (r_stokes_i.ne.0) then
            vt(iv,im)=vt(iv,im)/r_stokes_i
            wt(iv,im)=wt(iv,im)/r_stokes_i
          endif
        enddo
      enddo
    endif
    if (do_corrected) then
      do iv=1,2
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,4) 
          wt(iv,im)=wt_stokes(iv,im,4)
        enddo
      enddo
      do iv=3,3
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,4) &
                   -(real(est_i(im)*(idx+conjg(jdy))))
          wt(iv,im)=wt_stokes(iv,im,4)+w_i(iv,im)*real(idx+jdy)
        enddo
      enddo
      do iv=4,4
        do im=1,3
          vt(iv,im)=vt_stokes(iv,im,4) &
                   -(aimag(est_i(im)*(idx+conjg(jdy))))
          wt(iv,im)=wt_stokes(iv,im,4)+w_i(iv,im)*aimag(idx-jdy)
        enddo
      enddo
    endif
  case default
  end select 
  do iv=3,4
    do im=1,3
      if (wt(iv,im).gt.0) then
       vt(iv,im) = vt(iv,im)*wt(iv,im)
      endif
    enddo
  enddo
  return
end subroutine stokes_visi
!
subroutine correct_stokes(istoke,vt,wt,error)
  use gkernel_interfaces
  use gio_params
  integer, intent(in)         :: istoke
  real(kind=4), intent(inout)   :: vt(4,3)
  real(kind=4), intent(inout)   :: wt(4,3)
  logical :: error
  !
  include 'clic_xy_code.inc'
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  !
  ! Local
  integer :: iv,im,is
  real    :: parangle,wv,sin2chi,cos2chi
  complex :: dummy
  !
  do iv=3,4
    do im=1,3
      if (wt(iv,im).gt.0) then
        vt(iv,im) = vt(iv,im)/wt(iv,im)
      endif
    enddo
  enddo
  if (do_leakage) then
    call value(xy_parang,dummy,1,1,1,1,1,parangle,wv,error)
    sin2chi = sin(2*parangle)
    cos2chi = cos(2*parangle)
  endif
  select case(istoke)
  case(code_stokes_vv)
    if (do_leakage) then
      do iv=3,4
        do im=1,3
          if (r_stokes_i.ne.0) &
          vt(iv,im)=vt(iv,im)/(1+cos2chi*r_stokes_q/r_stokes_i+sin2chi*r_stokes_u/r_stokes_i)
        enddo
      enddo
    endif
  case(code_stokes_hh)
    if (do_leakage) then
      do iv=3,4
        do im=1,3
          if (r_stokes_i.ne.0) &
          vt(iv,im)=vt(iv,im)/(1-cos2chi*r_stokes_q/r_stokes_i-sin2chi*r_stokes_u/r_stokes_i)
        enddo
      enddo
    endif
  case(code_stokes_vh)
    if (do_leakage) then
      do im=1,3
        if (r_stokes_i.ne.0) then
          vt(3,im)=(vt(3,im)+sin2chi*r_stokes_q-cos2chi*r_stokes_u)/r_stokes_i
          vt(4,im)=(vt(4,im))/r_stokes_i
          wt(2,im)=wt(2,im)*r_stokes_i**2 ! wt(2,2) used for plots
          wt(3,im)=wt(3,im)*r_stokes_i**2
          wt(4,im)=wt(4,im)*r_stokes_i**2
        endif
      enddo
    endif
  case(code_stokes_hv)
    if (do_leakage) then
      do im=1,3
        if (r_stokes_i.ne.0) then
          vt(3,im)=(vt(3,im)+sin2chi*r_stokes_q-cos2chi*r_stokes_u)/r_stokes_i
          vt(4,im)=(vt(4,im))/r_stokes_i
          wt(2,im)=wt(2,im)*r_stokes_i**2 ! wt(2,2) used for plots
          wt(3,im)=wt(3,im)*r_stokes_i**2
          wt(4,im)=wt(4,im)*r_stokes_i**2
        endif
      enddo
    endif
  case default
  end select
  do iv=3,4
    do im=1,3
      if (wt(iv,im).gt.0) then
        vt(iv,im) = vt(iv,im)*wt(iv,im)
      endif
    enddo
  enddo
  return
end subroutine correct_stokes
!
subroutine init_data(n,x,v)
  !---------------------------------------------------------------------
  ! CLIC
  !     Initialise array X(N) with variable V
  !---------------------------------------------------------------------
  integer :: n                      !
  real :: x(n)                      !
  real :: v                         !
  ! Local
  integer :: i
  !------------------------------------------------------------------------
  ! Code:
  do i=1, n
    x(i) = v
  enddo
  return
end subroutine init_data
!
subroutine brecord (qsb, qband, qbt, qntch,   &
    datac, datal, passc, passl,   &
    ibase,iband,ipol,kbb,kif,nch,ich,jw1,jw2,ix,iy,vt,wt,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !     Get baseline-based parameters to be plotted as a function of
  !     a time-like variable
  !     QSB     INTEGER   Number of sidebands (2)
  !     QBAND   INTEGER   Number of temporal data
  !     QBT     INTEGER   Number of baseline+triangles
  !     QNTCH   INTEGER   Number of channels (in total per baseline)
  !     DATAC(QBAND,QSB,QBT)  COMPLEX  Temporal data
  !     DATAL(QNTCH,QSB,QBT)  COMPLEX  Spectral data
  !     PASSC(QBAND,QSB,QBT)  COMPLEX  PassBand of temporal data
  !     PASSL(QNTCH,QSB,QBT)  COMPLEX  PassBand of spectral data
  !     IBASE   INTEGER   Baseline number
  !     IBAND   INTEGER   Subband number
  !     ICH1    INTEGER   First subband
  !     ICH2    INTEGER   Last subband
  !     IX      INTEGER   X variable type
  !     IY      INTEGER   Y variable type
  !     JW1,JW2 INTEGER   Lowest and Highest channel in window subband
  !---------------------------------------------------------------------
  integer :: qsb                    !
  integer :: qband                  !
  integer :: qbt                    !
  integer :: qntch                  !
  complex :: datac(qband,qsb,qbt)   !
  complex :: datal(qntch,qsb,qbt)   !
  complex :: passc(qband,qsb,qbt)   !
  complex :: passl(qntch,qsb,qbt)   !
  integer :: ibase                  !
  integer :: iband                  !
  integer :: ipol                   ! Polarization
  integer :: kbb                    ! Baseband backpointer
  integer :: kif                    ! IF backpointer
  integer :: nch                    !
  integer :: ich(nch)               !
  integer :: jw1                    !
  integer :: jw2                    !
  integer :: ix                     !
  integer :: iy                     !
  real*4 :: vt(4,3)                 !
  real*4 :: wt(4,3)                 !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'gbl_pi.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_constant.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_xy_code.inc'
  ! Local
  integer :: iv, im
  real :: vadd(4), wadd(4), wmult(3), t
  ! Functions
  logical :: down_baseline, corr_data
  !------------------------------------------------------------------------
  ! Code:
  do im=1,3
    wmult(im) = 1.0
  enddo
  do iv=1,4
    vadd(iv) = 0.0
    wadd(iv) = 1.0
  enddo
  !
  ! Get data values if needed
  if (corr_data(ix,iy)) then
    wmult(2) = 0
    if (.not. down_baseline(ibase)) then
      call zrecord (   &
        r_nsb, r_nband, r_nbas+r_ntri, r_lntch,   &
        datac, datal, passc, passl, ibase, iband, &
        nch, ich, jw1, jw2, vadd(3), wmult(2), wmult(3), error)
      if (error) return
    endif
  endif
  call value(ix,vadd(3),ibase,iband,ipol,kbb,kif,vadd(1),wadd(1),error)
  call value(iy,vadd(3),ibase,iband,ipol,kbb,kif,vadd(2),wadd(2),error)
  t = dh_integ
  do im=1, 3
    do iv=1, 4
      vt(iv,im) = vt(iv,im) + vadd(iv)*wadd(iv)*wmult(im)*t
      wt(iv,im) = wt(iv,im) + wadd(iv)*wmult(im)*t
    enddo
  enddo
  return
end subroutine brecord
!
subroutine arecord (qsb, qband, qbas, qntch,   &
    datac, datal, passc, passl,   &
    iant, iband, ipol, kb, kif, nch, ich, jw1, jw2, ix, iy,   &
    vt, wt, phcorr,error)
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !     Get antenna-based parameters to be plotted from a record,
  !     as a function of a time-like variable.
  !     QSB     INTEGER   Number of sidebands (2)
  !     QBAND   INTEGER   Number of temporal data
  !     QBAS    INTEGER   Number of baselines
  !     QNTCH   INTEGER   Number of channels (in total per baseline)
  !     DATAC(QBAND,QSB,QBT)  COMPLEX  Temporal data
  !     DATAL(QNTCH,QSB,QBT)  COMPLEX  Spectral data
  !     PASSC(QBAND,QSB,QBT)  COMPLEX  PassBand of temporal data
  !     PASSL(QNTCH,QSB,QBT)  COMPLEX  PassBand of spectral data
  !     IANT    INTEGER   Antenna number
  !     IBAND   INTEGER   Subband number
  !     ICH1    INTEGER   First subband
  !     ICH2    INTEGER   Last subband
  !     IX      INTEGER   X variable type
  !     IY      INTEGER   Y variable type
  !     JW1,JW2 INTEGER   Lowest and Highest channel in window subband
  !     WPT     REAL      Positive weight
  !     WT      REAL      Total weight
  !     XT      REAL      X value
  !     YT      REAL      Y value
  !     TT      REAL      Signed integration time
  !     ZT      COMPLEX   Complex output
  !     PHCORR  LOGICAL   Correct amplitude for rms phase ?
  ! Call Tree
  !	SOLVE_POINT	...	FILL_VISI_POSI
  !	SOLVE_FOCUS	...	FILL_VISI_POSI
  !	...		READ_DATA
  !	SOLVE_FLUX
  !---------------------------------------------------------------------
  integer :: qsb                    !
  integer :: qband                  !
  integer :: qbas                   !
  integer :: qntch                  !
  complex :: datac(qband,qsb,qbas)  !
  complex :: datal(qntch,qsb,qbas)  !
  complex :: passc(qband,qsb,qbas)  !
  complex :: passl(qntch,qsb,qbas)  !
  integer :: iant                   !
  integer :: iband                  !
  integer :: ipol                   ! Polarization
  integer :: kb                     ! Baseband group
  integer :: kif                    ! IF group
  integer :: nch                    !
  integer :: ich(nch)               !
  integer :: jw1                    !
  integer :: jw2                    !
  integer :: ix                     !
  integer :: iy                     !
  real*4 :: vt(4,3)                 !
  real*4 :: wt(4,3)                 !
  logical :: phcorr                 !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'gbl_pi.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_constant.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  ! Functions
  logical :: down_antenna, down_baseline, auto_data, corr_data
  ! Local
  real*4 :: fw(mnbas), want(mnant)
  real*4 :: w(mnbas), copha, rms, wp, t
  complex :: z(mnbas), zant(mnant)
  integer :: ib, ibbb, iv, im
  real :: vadd(4), wadd(4), wmult(3)
  !------------------------------------------------------------------------
  ! Code:
  do im=1,3
    wmult(im) = 1.0
  enddo
  do iv=1,4
    vadd(iv) = 0.0
    wadd(iv) = 1.0
  enddo
  !
  ! Test for masks
  if (down_antenna(iant)) return
  !
  if (auto_data(ix,iy)) then
    call irecord (r_nband, r_nant, r_lntch, datac, datal,   &
      iant, iband, nch, ich, jw1, jw2, vadd(3),wmult(2),wmult(3))
  endif
  if (corr_data(ix,iy)) then
    do ib = 1, r_nbas
      if (down_baseline(ib)) then
        z(ib) = 0
        w(ib) = 0
      else
        call zrecord(   &
          r_nsb, r_nband, r_nbas+r_ntri, r_lntch,   &
          datac, datal, passc, passl, ib, iband,   &
          nch, ich, jw1, jw2, z(ib), fw(ib), wp,error)
        if (error) return
        if (phcorr) then
          ibbb = min(iband,2)
          rms = dh_rmspha(1,ibbb,ib)
          copha = exp(0.5*rms**2)
          z(ib) = z(ib)*copha
          fw(ib) = fw(ib)/copha**2
        endif
        w(ib) = fw(ib)
      endif
    enddo
    call antgain (z,w,zant,want)
    wmult(2) = want(iant)
    wmult(3) = want(iant)
    vadd(3) = real(zant(iant))
    vadd(4) = aimag(zant(iant))
  endif
  !
  call value(ix,vadd(3),-iant,iband,ipol,kb,kif,vadd(1),wadd(1),error)
  call value(iy,vadd(3),-iant,iband,ipol,kb,kif,vadd(2),wadd(2),error)
  if (error) return
  t = dh_integ
  do im=1, 3
    do iv=1, 4
      vt(iv,im) = vt(iv,im) + vadd(iv)*wadd(iv)*wmult(im)*t
      wt(iv,im) = wt(iv,im) + wadd(iv)*wmult(im)*t
    enddo
  enddo
  return
end subroutine arecord
!
subroutine arecord_compute (z,w,&
    iant, iband, ipol, kb, kif, ix, iy,   &
    vt, wt, error)
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !     Get antenna-based parameters to be plotted from a record,
  !     as a function of a time-like variable.
  !     IANT    INTEGER   Antenna number
  !     IBAND   INTEGER   Subband number
  !     ICH1    INTEGER   First subband
  !     ICH2    INTEGER   Last subband
  !     IX      INTEGER   X variable type
  !     IY      INTEGER   Y variable type
  !     JW1,JW2 INTEGER   Lowest and Highest channel in window subband
  !     WPT     REAL      Positive weight
  !     WT      REAL      Total weight
  !     XT      REAL      X value
  !     YT      REAL      Y value
  !     TT      REAL      Signed integration time
  !     ZT      COMPLEX   Complex output
  !     PHCORR  LOGICAL   Correct amplitude for rms phase ?
  ! Call Tree
  !	SOLVE_POINT	...	FILL_VISI_POSI
  !	SOLVE_FOCUS	...	FILL_VISI_POSI
  !	...		READ_DATA
  !	SOLVE_FLUX
  !---------------------------------------------------------------------
  ! Global
  include 'clic_parameter.inc'
  include 'gbl_pi.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_constant.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  ! Parameters
  complex :: z(mnbas)
  real*4  :: w(mnbas)
  integer :: iant                   !
  integer :: iband                  !
  integer :: ipol                   ! Polarization
  integer :: kb                     ! Baseband group
  integer :: kif                    ! IF group
  integer :: ix                     !
  integer :: iy                     !
  real*4 :: vt(4,3)                 !
  real*4 :: wt(4,3)                 !
  logical :: phcorr                 !
  logical :: error                  !
  ! Functions
  logical :: down_antenna, down_baseline, auto_data, corr_data
  ! Local
  real*4  :: want(mnant)
  real*4  :: t
  complex :: zant(mnant)
  integer :: ib, ibbb, iv, im
  real :: vadd(4), wadd(4), wmult(3)
  !------------------------------------------------------------------------
  ! Code:
  do im=1,3
    wmult(im) = 1.0
  enddo
  do iv=1,4
    vadd(iv) = 0.0
    wadd(iv) = 1.0
  enddo
  !
  ! Test for masks
  if (down_antenna(iant)) return
  !
  if (corr_data(ix,iy)) then
    call antgain (z,w,zant,want)
    wmult(2) = want(iant)
    wmult(3) = want(iant)
    vadd(3) = real(zant(iant))
    vadd(4) = aimag(zant(iant))
  endif
  !
  call value(ix,vadd(3),-iant,iband,ipol,kb,kif,vadd(1),wadd(1),error)
  call value(iy,vadd(3),-iant,iband,ipol,kb,kif,vadd(2),wadd(2),error)
  if (error) return
  t = dh_integ
  do im=1, 3
    do iv=1, 4
      vt(iv,im) = vt(iv,im) + vadd(iv)*wadd(iv)*wmult(im)*t
      wt(iv,im) = wt(iv,im) + wadd(iv)*wmult(im)*t
    enddo
  enddo
  return
end subroutine arecord_compute
!
subroutine check_cal(error)
  use classic_api
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  integer :: ic_yes, ic_int, ic_intlast, ic_ext, ic_extlast
  integer :: ic_phalast, ic_amplast, ic, pc_yes, pc_last, pc, ic2, pc2
  character(len=10) :: ch
  parameter (ic_yes=1, ic_amplast=2, ic_phalast=4,   &
    ic_int=8, ic_intlast=16,   &
    ic_ext=64, ic_extlast=128,   &
    pc_yes=1, pc_last=2)
  !-----------------------------------------------------------------------
  if (do_phase) then
    if (.not.do_phase_antenna) then
      ic = r_ic
      ic2 = r_aic
      ch = ' Baseline '
    else
      ic = r_aic
      ic2 = r_ic
      ch = ' Antenna '
    endif
    ! first check if calibration is stored
    if (iand(ic,ic_yes).eq.0) then
      call message(6,2,'CHECK_CAL',   &
        'No'//ch//'Phase Calibration, data ignored')
      error = .true.
    elseif (iand(ic2,ic_phalast).ne.0) then
      call message(6,1,'CHECK_CAL',   &
        'Is'//ch//'Phase Calibration really preferred?')
    ! internal or external stored ?
    !         ELSEIF (DO_PHASE_EXT.AND.(IAND(IC,IC_EXT).EQ.0)) THEN
    !            CALL MESSAGE(6,1,'CHECK_CAL',
    !     $      'No'//CH//'Ext. Phase Calibration?')
    !         ELSEIF (.NOT.DO_PHASE_EXT.AND.(IAND(IC,IC_INT).EQ.0)) THEN
    !            CALL MESSAGE(6,1,'CHECK_CAL',
    !     $      'No'//CH//'Int. Phase Calibration?')
    ! internal or external LAST stored ?
    elseif (do_phase_ext.and.(iand(ic,ic_intlast).ne.0)) then
      call message(6,1,'CHECK_CAL',   &
        'Is'//ch//'Ext. Phase Calibration really preferred?')
    elseif (.not.do_phase_ext.and.(iand(ic,ic_extlast).ne.0)) then
      call message(6,1,'CHECK_CAL',   &
        'Is'//ch//'Int. Phase Calibration really preferred?')
    endif
  endif
  !
  if (do_amplitude) then
    if (.not.do_amplitude_antenna) then
      ic = r_ic
      ic2 = r_aic
      ch = ' Baseline '
    else
      ic = r_aic
      ic2 = r_ic
      ch = ' Antenna '
    endif
    if (iand(ic,ic_yes).eq.0) then
      call message(6,2,'CHECK_CAL',   &
        'No'//ch//'Amplitude Calibration, data ignored')
      error = .true.
    elseif (iand(ic2,ic_amplast).ne.0) then
      call message(6,1,'CHECK_CAL',   &
        'Is'//ch//'Amplitude Calibration really preferred?')
    endif
  endif
  !
  if (do_scale .and. r_flux.eq.0) then
    call message(6,2,'CHECK_CAL',   &
      'No Flux in header, data ignored')
    error = .true.
  endif
  if (do_pass.and..not.do_pass_memory.and..not.do_pass_spectrum) then
    if (.not.do_pass_antenna) then
      pc = r_bpc
      pc2 = r_abpc
      ch = ' Baseline '
    else
      pc = r_abpc
      pc2 = r_bpc
      ch = ' Antenna '
    endif
    if (iand(pc,pc_yes).eq.0) then
      call message(6,2,'CHECK_CAL',   &
        'No'//ch//'RF Passband Calibration, data ignored')
      error = .true.
    elseif (iand(pc2,pc_last).ne.0) then
      call message(6,1,'CHECK_CAL',   &
        'Is'//ch//'RF Passband Calibration really preferred?')
    endif
  endif
  return
end subroutine check_cal
!
subroutine spectral_dump(kr,iant,ibase)
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !     Get the dump of spectral data. It depends on phase correction.
  !     iant.gt.0  -> antenna mode
  !     ibase.gt.0 -> baseline mode
  !---------------------------------------------------------------------
  integer :: kr                     !
  integer :: iant                   !
  integer :: ibase                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  ! Local
  logical :: ok(mnant)
  integer :: i
  !------------------------------------------------------------------------
  kr = r_ndump + 1
  if (r_ndatl.le.1) return
  !
  ! OK(i) means real-time phase correction wanted for antenna i
  ! --> read the phase-corrected dump
  !
  do i=1, mnant
    ok(i) = do_phase_atm(i).and.(r_ok_mon(i).or.do_phase_nofile)
  enddo
  !
  if (ibase.gt.0) then
    if (ok(r_iant(ibase)) .and. ok(r_jant(ibase))) then
      kr = r_ndump+2
    endif
  elseif (iant.gt.0) then
    if (ok(iant)) then
      kr = r_ndump+2
    endif
  endif
  return
end subroutine spectral_dump
