subroutine sub_atmos (ldata_in,data,arg1,monitor,error,scale)
  use gkernel_interfaces
  use classic_params
  use clic_buffers
  !---------------------------------------------------------------------
  ! Process a scan of data depending on procedure
  !
  ! Arguments
  !     LDATA_IN      Integer Length of data array
  !     DATA(*)       (*)     Data array
  !     ARG1          C*(*)   'C' or 'D' for correlator or detector
  !                           'W'for 22 GHz water vapor radiometer
  !
  ! Call Tree
  !			READ_DATA,
  !	READ_SPEC,	SUB_READ_SPEC,
  !			CLIC_ATMOS,
  !---------------------------------------------------------------------
  include 'clic_parameter.inc'
  integer(kind=data_length) :: ldata_in               !
  real :: data(ldata_in)            !
  character :: arg1                 !
  logical :: monitor                !
  logical :: error                  !
  real :: scale(mnant,mnbb)      !
  ! Global
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_proc_par.inc'
  ! Local
  integer(kind=address_length) :: kin, k
  integer :: i, ia, mesure, dim(4),ip,ical,ic
  integer :: save_nrec
  logical :: nocal, mon_done
  character(len=160) :: message2, ch
  ! Code:
  do ia = 1, r_nant
    do ip = 1,mnbb
      if (scale(ia,ip).eq.0) then
        scale(ia,ip) = 1.
      endif
    enddo
  enddo
  error = .false.
  if (r_proc.eq.p_pass) return
  !
  ! What are we measuring ?
  mesure = 0
  if (r_scaty.eq.4) then
    call message(8,1,'SUB_ATMOS ','Ambient load')
    mesure = chop
  elseif (r_scaty.eq.7) then
    call message(8,1,'SUB_ATMOS ','Cold load')
    mesure = cold
  else
    mesure = sky
  endif
  nocal = .false.
  !
  ! Compute auto correlation in C_L, C_C
  ! and save corresponding total powers in s_lev for further scaling
  ! Buffers extended for polarisation
  !
  kin = r_ndump*r_ldump + 1
  call decode_header (data(kin))
  ! Not for Stability (P_STAB)
  if (r_proc.eq.p_cal .or. r_proc.eq.p_sky) then
    ! Reset only buffers remeasured (for polarimetric observations)
    do ia=1,r_nant
      do ical=1,r_nbb
        ic = r_mapbb(ical)
        ip = r_mappol(ia,ical)
        integ(ia,r_nrec,ic,ip,mesure) = 0
      enddo
    enddo
    k = kin + r_ldpar
    k = k + r_ldatc
    call do_autol (mesure,data(k), error)
    call cal_levels(arg1,mesure)
    do ia=1, r_nant
      do ical = 1, r_nbb
         ic = r_mapbb(ical)
         ip = r_mappol(ia,ical)
         s_lev(ia,r_nrec,ic,ip,mesure) = c_lev(ia,r_nrec,ic,ip,mesure)
         if (mesure.eq.1) then
           if (s_lev(ia,r_nrec,ic,ip,1).ne.0) then
             scale(ia,ic) = (r_tchop(ic,ia)+   &
               r_trec(ic,ia)) / s_lev(ia,r_nrec,ic,ip,1)
           endif
         endif
      enddo
    enddo
    !
    ! this is done to check for correlator setup changes (-> Check_atmos)
    !
    call r4tor4(r_lband,h_line(1,r_nrec),mlineset) 
    call r4tor4(r_nant,h_inter(1,r_nrec),minterc) 
  else
    call cal_levels(arg1,mesure)
  endif
  do ia = 1,r_nant
    do ic = 1,mnbb
      r_totscale(ic,ia) = scale(ia,ic)
    enddo
  enddo
  !
  ! on SKY, compute TSYS and atmospheric parameters.
  !    compute phase correction only if calibration.
  !
  if ((mesure.ne.cold).and.(mesure.ne.chop)) then
    call do_tsys(r_proc.eq.p_cal, error)
  endif
  !
  ! - Sky Autocorrelation Scan
  !
  if (r_proc.eq.p_onoff) then
    call check_atmos (nocal)
    if (nocal) return
    call load_atmos
    !
    ! Calibrate
    !
    do i=1, r_ndump
      kin = (i-1)*r_ldump + 1
      call decode_header (data(kin))
      k = kin + r_ldpar
      call do_auto_atmosc (data(k), error, i)  ! Get spectrum
      call encode_header (data(kin))
    enddo
    kin = r_ndump*r_ldump + 1
    call decode_header (data(kin))
    k = kin + r_ldpar
    k = k + r_ldatc
    call do_auto_atmosl (data(k), error, 1)    ! Get spectrum
    call encode_header (data(kin))
  !
  ! - Sky Correlation Scan
  elseif (r_proc.eq.p_source .or. r_proc.eq.p_delay   &
    .or. r_proc.eq.p_gain .or. r_proc.eq.p_focus   &
    .or. r_proc.eq.p_point.or. r_proc.eq.p_holog   &
    .or. r_proc.eq.p_five .or. r_proc.eq.p_flux   &
    .or. r_proc.eq.p_vlbi .or. r_proc.eq.p_vlbg   &
    .or. r_proc.eq.p_otf) then
    ! Load Atmospheric Parameters
    call check_atmos (nocal)
    if (nocal) return
    call load_atmos
    !
    ! Calibrate
    !
    do i = 1, r_ndump          ! Next record
      kin = (i-1)*r_ldump + 1
      call decode_header (data(kin))
      k = kin + r_ldpar
      call do_atmosc (data(k), error, i)   ! Get spectrum
      do ia = 1, r_nant
        do ical=1, r_nbb
          ic = r_mapbb(ical)
          dh_aflag(ia) = ior(dh_aflag(ia),sky_flags(ia,ic))
          r_dmaflag(ia) = dh_aflag(ia)
        enddo
      enddo
      call encode_header (data(kin))
    enddo
    kin = r_ldump*r_ndump + 1
    call decode_header (data(kin))
    k = kin + r_ldpar
    call do_atmosc (data(k), error, 0) ! Get spectrum
    k = k + r_ldatc
    call do_atmosl (data(k), error, 1) ! Get spectrum
    call encode_header (data(kin))
    !
    ! Corrected data if present
    if (r_ndatl.gt.1) then
      kin = r_ldump*r_ndump + r_ldpar+r_ldatc+r_ldatl+1
      call decode_header (data(kin))
      k = kin + r_ldpar
      call do_atmosc (data(k), error, 0)   ! Get spectrum
      k = k + r_ldatc
      call do_atmosl (data(k), error, 0)   ! Get spectrum
      call encode_header (data(kin))
    endif
  endif
  r_lfour = .true.
  r_presec(modify_sec) = .true.
  return
end subroutine sub_atmos
!
subroutine do_tsys (monitor, error)
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! Compute TSYS from a sky measurement in r_csky.
  !---------------------------------------------------------------------
  logical :: monitor                !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  integer :: ia, ip, ical, ic
  logical :: again
  !-----------------------------------------------------------------------
  !
  ! Get current values of cold, chop sky.
  !
  if (r_nbb.le.0) then
      print *,"No unit connected to any IF"
      error = .true.
      return
  endif
  do ia=1, r_nant
! Fill the data format with appropriate calibration buffer
    do ical = 1, r_nbb
      ic = r_mapbb(ical)
      ip = r_mappol(ia,ical)
      r_cchop(ic, ia) = c_lev(ia, r_nrec, ic, ip, chop)
      r_ccold(ic, ia) = c_lev(ia, r_nrec, ic, ip, cold)
      r_csky (ic, ia) = c_lev(ia, r_nrec, ic, ip, sky)
    enddo
  enddo
  !
  ! Do calibration
  !
  call do_calib (error)        ! compute TSYS
  if (error) print *,"erreur do_calib"
  if (error) return
  !
  ! do h2o monitor
  !
  if (new_receivers) return !! TBA adapt monitor section
  !
  if (monitor .and. r_presec(atmon_sec)) then
    again = mon_scan.eq.r_scan
    if (again) then
      call r4tor4(h_mon(1,3-r_nrec),r_nrec_mon,matmon)
    else
      !
      ! Get current values of cold, chop sky for monitor.
      !
      do ia=1, r_nant
        r_cchop_mon(ia) = c_lev(ia,2,1,1,chop) !! TBA
        r_ccold_mon(ia) = c_lev(ia,2,1,1,cold) !! TBA
        r_csky_mon(ia)  = c_lev(ia,2,1,1,sky)  !! TBA
      enddo
      mon_scan = r_scan
    endif
    call do_monitor(again, error)
    call r4tor4(r_nrec_mon,h_mon(1,r_nrec),matmon)
  else
    call r4tor4(h_mon(1,r_nrec),r_nrec_mon,matmon)
  endif
end subroutine do_tsys
!
subroutine do_calib (error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! Processes a CAL scan. Autocorrelations on ambient choppper and
  ! Sky have been read in by READ_AUTO.
  ! The chopper standard program is called for each antenna,
  ! in the mode selected in OBS.
  ! The autocorrelation gains are stored in C_C and C_L arrays.
  ! do_test : test the linearity correlator versus total power.
  !---------------------------------------------------------------------
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_proc_par.inc'
  ! Local
  integer :: ia, ntrec, ilevel, ip, iunit, ic, ical
  real*4 :: awater, tcals, tcali, prec_water
  real*4 :: fmin(mnbb), fmax(mnbb), fs(mnbb), fi(mnbb)
  real*4 :: fcen(mnbb), fif
  logical :: first(mnbb)
  character(len=160) :: ch
  integer :: mode_au,mode_tr
  character(len=2) :: chcode
  !------------------------------------------------------------------------
  ! Code:
  call chtoby('AU  ',mode_au,4)
  call chtoby('TR  ',mode_tr,4)
  ! message level
  ilevel = 0
  if (r_proc.eq.p_cal) ilevel = 6
  ! 
  if (r_nbb.eq.0) then
      print *,"No unit connected to any IF"
      error = .true.
      return
  endif
  !
  ! Force input values if desired
  do ia = 1, r_nant
    do ip = 1, mnbb
      !
      ! Reset flags !!
      sky_flags(ia,ip) = 0
      !
      ! Water
      if (atm_mode(ia).eq.'AUTO') then
        if (atm_water.eq.0) then
          r_h2omm(ip,ia) =  prec_water(r_tamb,r_humid)
        elseif (atm_water.gt.0) then
          r_h2omm(ip,ia) = atm_water
        endif
        r_cmode(ip,ia) = mode_au
      elseif (atm_mode(ia).eq.'TREC') then
        if (atm_trec(ia).gt.0) then
          r_trec(ip,ia) = atm_trec(ia)
        endif
        r_cmode(ip,ia) = mode_tr
      endif
      !
      ! Gain Image
      ! we should be able to specify ATM_GIM this for polarization...
      if (atm_gim(ia).gt.0) then
        r_gim(ip,ia) = atm_gim(ia) !! TBA yes we should
      endif
    enddo
  enddo
  ! Compute calibration entries IF1 center frequencies
  first = .true.
  do iunit = 1, r_lband
    ic = r_bb(iunit)
    fif = r_flo2(iunit)+r_band2(iunit)*(r_flo2bis(iunit)+r_band2bis(iunit) &
           *r_lfcen(iunit))
    if (first(ic)) then
      fmin(ic) = fif
      fmax(ic) = fif
      first(ic) = .false.
    else
      fmin(ic) = min(fmin(ic),fif) 
      fmax(ic) = max(fmax(ic),fif) 
    endif
  enddo
  do ical = 1, r_nbb
    ic = r_mapbb(ical)
    fcen(ic) = (fmin(ic)+fmax(ic))/2.
    fs(ic)  = (r_flo1+r_sb(ical)*fcen(ic))/1000.
    fi(ic)  = (r_flo1-r_sb(ical)*fcen(ic))/1000.
  enddo 
  r_qual = 1
  !
  ! TREC antennas
  ntrec = 0
  awater = 0
  do ia=1, r_nant
    do ical = 1, r_nbb
      ic = r_mapbb(ical)
      ip = r_mappol(ia,ical)
      if (r_cmode(ic,ia).eq.mode_tr) then
        error = .false.
        call chopper (ic,ia, fs(ic), fi(ic), tcals, tcali, error)
        if (error) then
          integ(ia, r_nrec, ic, ip, chop) = 0
        !                  RETURN
        endif
        write(ch,1000) r_kant(ia), ic, chcode(r_cmode(ic,ia)),   &
          r_h2omm(ic,ia),r_trec(ic,ia), r_tsyss(ic,ia),   &
          r_tsysi(ic,ia)
1000    format('A',i0,1x,'Cal.Unit ',i1,1x,a2,' H2O=',f6.2,' Tr=',f6.2,   &
          ' Ts(S,I)=',2f8.1)
        call message(ilevel,1,'DO_CALIB  ',ch(1:lenc(ch)))
        awater = awater+r_h2omm(ic,ia)
        ntrec = ntrec+1
        !     New version
        if ((r_cchop(ic,ia)-r_csky(ic,ia)).ne.0) then
          tcals = tcals*r_csky(ic,ia) / (r_cchop(ic,ia)   &
            -r_csky(ip,ia))
          tcali = tcali*r_csky(ic,ia) / (r_cchop(ic,ia)   &
            -r_csky(ic,ia))
        else
!          error = .true.
!          return
          tcals = 1.
          tcali = 1.
          print *,"Calibration error Ant. ",ia," input ",ical
        endif
        !     End new version
      endif
    enddo
  enddo
  if (ntrec.gt.0) awater = awater / ntrec
  !
  ! Then other modes
  do ia = 1, r_nant
    do ical = 1, r_nbb
      ic = r_mapbb(ical)
      ip = r_mappol(ia,ical)
      if (r_cmode(ic,ia).eq.mode_au) then
        if (ntrec.gt.0) r_h2omm(ic,ia) = awater
      endif
      if (r_cmode(ic,ia).ne.mode_tr) then
        error = .false.
        call chopper (ic,ia, fs(ic), fi(ic), tcals, tcali, error)
        if (error) then
          integ(ia,r_nrec,ic,ip,chop) = 0
        endif
        write(ch,1000) r_kant(ia), ic, chcode(r_cmode(ic,ia)),   &
          r_h2omm(ic,ia),r_trec(ic,ia), r_tsyss(ic,ia),   &
          r_tsysi(ic,ia)
        call message(ilevel,1,'DO_CALIB  ',ch(1:lenc(ch)))
        tcals = tcals*r_csky(ic,ia) / (r_cchop(ic,ia)   &
          -r_csky(ic,ia))
        tcali = tcali*r_csky(ic,ia) / (r_cchop(ic,ia)   &
          -r_csky(ic,ia))
      endif
    enddo
    !
  enddo
  !
  do ical =1, r_nbb
    ic = r_mapbb(ical)
    write(ch,1001) ic, (r_kant(ia), r_h2omm(ic,ia), ia=1,r_nant   &
      )
1001 format(' H2O Cal.Unit',i1,12(' A',i0,':',f6.1))
    call message(ilevel,1,'DO_CALIB  ',ch(1:lenc(ch)))
    write(ch,1002) ic, (r_kant(ia),  r_tsyss(ic,ia), ia=1   &
      ,r_nant)
1002 format('TSYS Cal.Unit',i1,12(' A',i0,':',f6.0))
    call message(ilevel,1,'DO_CALIB  ',ch(1:lenc(ch)))
  enddo
  !
  return
end subroutine do_calib
!
subroutine do_test(error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! check subbands for low gain after a sky measurement.
  !---------------------------------------------------------------------
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  ! Local
  integer :: ia, nfl, ic, i, is, i1, ifl(10), ip, ical
  real*4 :: test
  character(len=80) :: ch
  !-----------------------------------------------------------------------
  !
  ! NOT CALLED ANYMORE ....
  !
  ! Flag subbands with low gain
  do ia=1, r_nant
    nfl = 0
    do ic = 1, r_nband
      ical = r_bb(ic)
      ip = r_lpolentry(ia,ic)
      test = c_c(ic,ia,r_nrec,ip,chop)/c_c(ic,ia,r_nrec,ip,sky)   &
        / (r_cchop(ip,ia)/r_csky(ip,ia))
      !     This will cause the calibration to be declared invalid
      if (test .lt. 0.2) then
        sky_flags(ia,ip) =   &
          ior(sky_flags(ia,ip),ishft(1,ic-1))
        write (ch,'(a,i2.2,a,i0,a,i1,a)') 'Subband C',ic,   &
          ' (Ant ',ia,' Pol',ip,') has low gain'
        call message(8,3,'DO_TEST   ',ch(1:lenc(ch)))
        nfl = nfl + 1
        sky_flags(ia,ip) =   &
          ior(sky_flags(ia,ip),ishft(1,ic-1))
        error = .true.
      !     Here we get a flag, but we may go on.
      elseif (test .lt. 0.7 .or. test.gt.1.3) then
        sky_flags(ia,ip) =   &
          ior(sky_flags(ia,ip),ishft(1,ic-1))
        write (ch,'(a,i2.2,a,i0,a,i1,a)') 'Subband C',ic,   &
          ' (Ant ',ia,' Pol',ip,   &
          ') has a linearity problem'
        call message(8,2,'DO_TEST   ',ch(1:lenc(ch)))
        nfl = nfl + 1
        sky_flags(ia,ip) =   &
          ior(sky_flags(ia,ip),ishft(1,ic-1))
        ifl(nfl) = ic
      endif
    enddo
    if (nfl.gt.0) then
      write(ch,'(I2,A,I2,A,20(1X,A))')   &
        nfl,' subbands flagged for antenna ',ia,':',   &
        (csub(ifl(i)),i=1, nfl)
      call message(8,3,'DO_TEST   ',ch(1:lenc(ch)))
    endif
    !     Patch line channels close to LO3's (2 on each side)
    do is=1, r_lband
      ip = r_lpolentry(ia,is)
      i1 = nint(r_lcench(is)-0.5)+r_lich(is)
      if (r_lfres(is).gt.0.1) then
        do i=i1-1, i1
          c_l(i,ia,r_nrec,ip,sky) =   &
            (i-i1+3)*c_l(i1-2,ia,r_nrec,ip,sky)   &
            -(i-i1+2)*c_l(i1-3,ia,r_nrec,ip,sky)
        enddo
        do i=i1+1, i1+2
          c_l(i,ia,r_nrec,ip,sky) =   &
            -(i-i1-4)*c_l(i1+3,ia,r_nrec,ip,sky)   &
            +(i-i1-3)*c_l(i1+4,ia,r_nrec,ip,sky)
        enddo
      endif
    enddo
  enddo
  !
  return
end subroutine do_test
!
subroutine do_atmosc (data, error, ido)
  use classic_params
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     Process temporal data: apply atmospheric calibration
  ! Input
  !     DATA    COMPLEX(*)
  !     ERROR   LOGICAL      error return
  !     IDO     INTEGER     1 to update the datamodifier section
  !                     (do it only once for the cont and once for the line).
  !---------------------------------------------------------------------
  complex :: data(*)                !
  logical :: error                  !
  integer :: ido                    !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  ! Local
  integer(kind=data_length) :: k
  integer :: ib, ia, ja, is, ip, ic, ical, jp
  real :: tcalu, tcall, t1, t2, norm, dd, scale
  integer :: ffffff
  data ffffff/z'FFFFFF'/
  !------------------------------------------------------------------------
  ! Code:
  !
  if (r_nbb.le.0) then
      print *,"No unit connected to any IF"
      error = .true.
      return
    endif
  ! Get antenna subband Flags from last autocorrelation or calibration
  ! flags may be an issue (how do we specify one polar is down?)
  do ia = 1, r_nant
    do ical = 1, r_nbb
      ip = r_mapbb(ical)
      dh_aflag(ia) = ior(dh_aflag(ia),   &
        iand(sky_flags(ia,ip),ffffff))
      r_dmaflag(ia) = dh_aflag(ia)
      !
      !     New way: use the ratio Tsys / TPower ;
      if (r_sb(ical).eq.1) then
        tcal(ip,1,ia) = r_tsyss(ip,ia)
        tcal(ip,2,ia) = r_tsysi(ip,ia)
      else
        tcal(ip,1,ia) = r_tsysi(ip,ia)
        tcal(ip,2,ia) = r_tsyss(ip,ia)
      endif
      !
      t1 = tcal(ip,1,ia)
      t2 = tcal(ip,2,ia)
      if (r_lfour) then        ! cal done previously
        tcal(ip,1,ia) = t1/dh_atfac(ip,1,ia)
        tcal(ip,2,ia) = t2/dh_atfac(ip,2,ia)
      endif
      dh_atfac(ip,1,ia) = t1
      dh_atfac(ip,2,ia) = t2
      r_dmatfac(ip,1,ia) = t1
      r_dmatfac(ip,2,ia) = t2
    enddo
  enddo
  !
  ! Continuum
  k = 1
  do ib=1, r_nbas
    ia = r_iant(ib)
    ja = r_jant(ib)
    ! nothing to do on flagged DATA
    if ((iand(dh_bflag(ib),ishft(1,31)).eq.0)   &
      .and. (iand(dh_aflag(ia),ishft(1,31)).eq.0)   &
      .and. (iand(dh_aflag(ja),ishft(1,31)).eq.0)) then
      do is = 1, r_nband
        ic = r_bb(is)
        ip = r_lpolentry(ia,is)
        jp = r_lpolentry(ja,is)
        if (r_csky(ic,ia)*r_csky(ic,ja).ne.0) then
          scale = sqrt( s_lev(ia,r_nrec,ic,ip,sky)/r_csky(ic,ia)   &
            * s_lev(ja,r_nrec,ic,jp,sky)/r_csky(ic,ja))
        else
          scale = 1.
        endif
        tcalu = sqrt( abs(tcal(ic,1,ia)*tcal(ic,1,ja)) )   &
          * scale
        tcall = sqrt( abs(tcal(ic,2,ia)*tcal(ic,2,ja)) )   &
          * scale
        dd = abs(data(k))
        if (dd.gt.1e8) then
          dh_bflag(ib) = ior(dh_bflag(ib),ishft(1,31))
        else
          if (r_nsb.eq.2.or.r_sb(is).eq.1) then
            data(k) = data(k) * tcalu
          else
            data(k) = data(k) * tcall
          endif
        endif
        if (r_nsb.eq.2) then
          dd = abs(data(k+r_nband))
          if (dd.gt.1e8) then
            dh_bflag(ib) = ior(dh_bflag(ib),ishft(1,31))
          else
            data(k+r_nband) = data(k+r_nband) * tcall
          endif
        endif
        if (ido.eq.1) then
          r_dmcamp(1,ib,is) = r_dmcamp(1,ib,is)   &
            * tcalu
          r_dmcamp(2,ib,is) = r_dmcamp(2,ib,is)   &
            * tcall
        endif
        if (.not.r_lfour .and. c_c(is,ia,r_nrec,ip,sky).ne.0   &
          .and. c_c(is,ja,r_nrec,jp,sky).ne.0) then
          norm = sqrt(abs(c_c(is,ia,r_nrec,ip,sky)   &
            *c_c(is,ja,r_nrec,jp,sky)))
          if (norm.gt.1e8 .or. norm.lt.1e-8) then
            dh_bflag(ib) = ior(dh_bflag(ib),ishft(1,31))
          else
            data(k) = data(k) / norm
            if (r_nsb.eq.2) data(k+r_nband) = data(k+r_nband) / norm
          endif
        endif
        k = k + 1
      enddo
      if (r_nsb.eq.2) k = k + r_nband
    else
      k = k+r_nsb*r_nband
    endif
  enddo
  do ia = 1, r_nant
    do ip = 1, mnbb
      dh_aflag(ia) = ior(dh_aflag(ia),sky_flags(ia,ip))
      r_dmaflag(ia) = dh_aflag(ia)
    enddo
  enddo
  return
end subroutine do_atmosc
!
subroutine do_atmosl (data, error, ido)
  use classic_params
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     Process spectral data, after unclipping and fourier transform:
  !     apply atmospheric calibration.
  ! Input
  !     DATA     COMPLEX(*)
  !     ERROR   OGICAL      error return
  !     IDO     INTEGER     1 to update the datamodifier section
  !                     (do it only once for the cont and once for the line
  !---------------------------------------------------------------------
  complex :: data(*)                !
  logical :: error                  !
  integer :: ido                    !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  ! Local
  integer(kind=data_length) :: k
  integer :: ich, ib, ia, ja, is, icc,ip,jp,ic
  real :: tcalu, tcall, norm, dd, scale
  !------------------------------------------------------------------------
  ! Code:
  if (r_nbb.le.0) then
      print *,"No unit connected to any IF"
      error = .true.
      return
  endif
  !
  ! Apply to spectral data
  k = 1
  do ib=1, r_nbas
    icc = 1
    ia = r_iant(ib)
    ja = r_jant(ib)
    ! nothing to do on flagged data
    if ((iand(dh_bflag(ib),ishft(1,31)).eq.0)   &
      .and. (iand(dh_aflag(ia),ishft(1,31)).eq.0)   &
      .and. (iand(dh_aflag(ja),ishft(1,31)).eq.0)) then
      do is = 1, r_lband
        ic = r_bb(is)
        ip = r_lpolentry(ia,is)
        jp = r_lpolentry(ja,is)
        if (r_csky(ic,ia)*r_csky(ic,ja).ne.0) then
          scale = sqrt( s_lev(ia,r_nrec,ic,ip,sky)/r_csky(ic,ia)   &
            * s_lev(ja,r_nrec,ic,jp,sky)/r_csky(ic,ja))
        else
          write(6,*) 'ia, ja, r_csky(ic,ia), r_csky(ic,ja)'
          write(6,*) ia, ja, r_csky(ic,ia), r_csky(ic,ja)
          scale = 1.
        endif
        tcalu = sqrt( abs(tcal(ic,1,ia)*tcal(ic,1,ja)) )   &
          *scale
        tcall = sqrt( abs(tcal(ic,2,ia)*tcal(ic,2,ja)) )   &
          *scale
        if (ido.eq.1) then
          r_dmlamp(1,ib,is) = r_dmlamp(1,ib,is)   &
            * tcalu
          r_dmlamp(2,ib,is) = r_dmlamp(2,ib,is)   &
            * tcall
        endif
        do ich = 1, r_lnch(is)
          dd = abs(data(k))
          if (dd.gt.1e8 )  then
            dh_bflag(ib) = ior(dh_bflag(ib),ishft(1,31))
          else
            if (r_lnsb.eq.2.or.r_sb(is).eq.1) then
              data(k) = data(k) * tcalu
            else
              data(k) = data(k) * tcall
            endif
          endif
          if (r_lnsb.eq.2) then
            dd = abs(data(k+r_lntch))
            if (dd.gt.1e8 ) then
              dh_bflag(ib) = ior(dh_bflag(ib),ishft(1,31))
            else
              data(k+r_lntch) = data(k+r_lntch) * tcall
            endif
          endif
          if (.not.r_lfour .and. c_l(icc,ia,r_nrec,ip,sky).ne.0   &
            .and. c_l(icc,ja,r_nrec,jp,sky).ne.0) then
            if (is.gt.r_nbb.and.mod(ich,1024).eq.1) then
              norm = sqrt(abs(c_l(icc+1,ia,r_nrec,ip,sky)   &
                *c_l(icc+1,ja,r_nrec,jp,sky)))
            elseif (is.gt.r_nbb.and.mod(ich,1024).eq.513) then
              norm = sqrt(abs((c_l(icc+1,ia,r_nrec,ip,sky)   &
                 +c_l(icc-1,ia,r_nrec,ip,sky))                &
                *(c_l(icc+1,ja,r_nrec,jp,sky)                &
                 +c_l(icc-1,ja,r_nrec,jp,sky))/4.))
            else
              norm = sqrt(abs(c_l(icc,ia,r_nrec,ip,sky)   &
                *c_l(icc,ja,r_nrec,jp,sky)))
            endif
            if (norm.gt.1e8 .or. norm.lt.1e-8) then
              dh_bflag(ib) = ior(dh_bflag(ib),ishft(1,31))
            else
              data(k) = data(k) / norm
              if (r_lnsb.eq.2) data(k+r_lntch) = data(k+r_lntch) / norm
            endif
          endif
          k = k + 1
          icc = icc +1
        enddo
      enddo
      if (r_lnsb.gt.1) k = k + r_lntch
    else
      k = k + r_lnsb*r_lntch
    endif
  enddo
  !
  do ia = 1, r_nant
    do ip = 1, mnbb
      dh_aflag(ia) = ior(dh_aflag(ia),sky_flags(ia,ip))
      r_dmaflag(ia) = dh_aflag(ia)
    enddo
  enddo
  return
end subroutine do_atmosl
!
subroutine do_auto_atmosc (data, error, ido)
  use classic_params
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     Process temporal data from a sky autocorrelation spectrum
  ! Input
  !     DATA    REAL(*)
  !     ERROR   LOGICAL      error return
  !     IDO     INTEGER     1 to update the datamodifier section
  !                     (do it only once for the cont and once for the line).
  !---------------------------------------------------------------------
  real :: data(*)                   !
  logical :: error                  !
  integer :: ido                    !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  ! Local
  integer(kind=data_length) :: k
  integer :: ia, is, ip,ical,ic
  real :: t, scale
  !------------------------------------------------------------------------
  ! Code:
  if (r_nbb.le.0) then
      print *,"No unit connected to any IF"
      error = .true.
      return
  endif
  !
  ! Get calibration factor
  do ia=1, r_nant
    do ical = 1, r_nbb
      ic = r_mapbb(ical)
      ip = r_mappol(ia,ical)
      !
      ! New way: use the ratio Tsys / TPower ;
      if (r_csky(ic,ia).ne.0) then
        scale = s_lev(ia,r_nrec,ic,ip,sky)/r_csky(ic,ia)
      else
        write(6,*) 'ia, r_csky(ia) : ',ia, r_csky(ic,ia)
        scale = 1.
      endif
      tcal(ic,1,ia) = r_tsyss(ic,ia)
      !
      t = tcal(ic,1,ia)
      if (r_lfour) then
        if (dh_atfac(ic,1,ia).ne.0) then
          tcal(ic,1,ia) = t/dh_atfac(ic,1,ia)
        else
          write(6,*) 'ia, ic, DH_ATFAC(ic,,1,IA) : ',   &
            ia, ic, dh_atfac(ic,1,ia)
        endif
      endif
      dh_atfac(ic,1,ia) = t
      r_dmatfac(ic,1,ia) = t
    enddo
  enddo
  !
  ! Apply to temporal data
  k = 1
  do ia = 1, r_nant
    ! nothing to do on flagged data
    if (iand(dh_aflag(ia),ishft(1,31)).eq.0) then
      do is = 1, r_nband
        ic = r_bb(is)
        ip = r_lpolentry(ia,is)
        if (ido.eq.1) then
          r_dmcamp(1,ia,is) =   &
            r_dmcamp(1,ia,is)*tcal(ic,1,ia)*scale
        endif
        data(k) = data(k) * tcal(ic,1,ia)
        if (.not.r_lfour .and. c_c(is,ia,r_nrec,ip,sky).ne.0)   &
          then
          data(k) = data(k) / c_c(is,ia,r_nrec,ip,sky)
        endif
        k = k + 1
      enddo
    endif
  enddo
end subroutine do_auto_atmosc
!

subroutine do_auto_atmosl (data, error, ido)
  use classic_params
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     Process a sky autocorrelation spectrum, after unclipping and fourier
  !     transform: apply atmospheric calibration.
  ! Input
  !     DATA     REAL(*)
  !     ERROR   LOGICAL      error return
  !     IDO     INTEGER     1 to update the datamodifier section
  !                     (do it only once for the cont and once for the line).
  !---------------------------------------------------------------------
  real :: data(*)                   !
  logical :: error                  !
  integer :: ido                    !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  ! Local
  integer(kind=data_length) :: k
  integer ::  ia, is, ic, ip,icc, ical
  real :: scale
  !------------------------------------------------------------------------
  !     Code:
  if (r_nbb.le.0) then
      print *,"No unit connected to any IF"
      error = .true.
      return
  endif
  !
  ! Apply to spectrum
  k = 1
  do ia = 1, r_nant
    icc = 1
    ! nothing to do on flagged data
    if (iand(dh_aflag(ia),ishft(1,31)).eq.0) then
      do is = 1, r_lband
        ical = r_bb(is)
        ip = r_lpolentry(ia,is)
        if (r_csky(ical,ia).ne.0) then
          scale = s_lev(ia,r_nrec,ical,ip,sky)/r_csky(ical,ia)
        else
          scale = 1.
        endif
        if (ido.eq.1) then
          r_dmlamp(1,ia,is) = r_dmlamp(1,ia,is)   &
            *tcal(ical,1,ia)*scale
        endif
        do ic = 1, r_lnch(is)
          data(k) = data(k)*tcal(ical,1,ia)*scale
          if (.not.r_lfour .and. c_l(icc,ia,r_nrec,ip,sky).ne.0) then
            data(k) = data(k) / c_l(icc,ia,r_nrec,ip,sky)
          endif
          k = k + 1
          icc = icc +1
        enddo
      enddo
    endif
  enddo
  return
end subroutine do_auto_atmosl
!
subroutine do_autol  (mes, data, error)
  use gkernel_interfaces
  use gildas_def
  use classic_params
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     Read in auto correlation function
  !     Increment the C_L and C_C buffers for the specified cal phase "mes".
  ! Input
  !     mes      I           Calibration phase
  !     DATA     REAL(*)     The data.
  !---------------------------------------------------------------------
  integer :: mes                    !
  real :: data(*)                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_display.inc'
  include 'clic_proc_par.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  ! Local
  real :: calli(mlch)
  real :: c1, c2, cs, cc
  integer(kind=data_length) :: k
  integer :: ia, ic, nc, n1, n2, is, n3, n4, kk, ip, ical
  character(len=80) :: ch
  !------------------------------------------------------------------------
  ! Code:
  ! Increment autocorrelation buffers
  k = 1
  do ia=1, r_nant
    !
    ! First spectra
    do ic =1, r_lntch
      c2 = dh_integ
      call pol_chan(ip,ical,ic,error)
      if (error) return
      c1 = integ(ia,r_nrec,ical,ip,mes)
      !
      cs = c1+c2
      c1 = c1/cs
      c2 = c2/cs
      calli(ic) = data(k)
      if (calli(ic).eq.0) then
2000    format(a,i4,a,i4,a)
        write (ch,2000) 'autocorrelation channel ',ic,' / ',   &
          r_lntch,' is zero'
!        call message(8,1,'DO_AUTOL  ',ch(1:lenc(ch)))
      endif
      k = k + 1
      c_l(ic,ia,r_nrec,ip,mes) =   &
        c1 * c_l(ic,ia,r_nrec,ip,mes) + c2 * calli(ic)
    enddo
    ! Ne doit pas etre ici         CC = 0
    ! Ne doit pas etre ici         NC = 0
    kk = 0
    !
    ! Then continuum
    do is = 1, r_lband
      !
      ! With polarisation, not factorized anymore
      ical = r_bb(is)
      ip = r_lpolentry(ia,is)
      c1 = integ(ia,r_nrec,ical,ip,mes)
      c2 = dh_integ
      cs = c1+c2
      c1 = c1/cs
      c2 = c2/cs
      !
      cc = 0.0                 ! Doit etre ici 09-Jan-1996
      nc = 0                   ! Doit etre ici 09-Jan-1996
      !
      ! avoid center and edges ...
      n1 = nint(r_lnch(is)*0.1)
      n2 = r_lnch(is)/2-1
      n3 = r_lnch(is)/2+2
      n4 = nint(r_lnch(is)*0.9)
      do ic=1, r_lnch(is)
        kk = kk + 1
        if ((ic.ge.n1 .and. ic.le.n2) .or.   &
          (ic.ge.n3 .and. ic.le.n4)) then
          cc = cc + calli(kk)
          nc = nc + 1
        endif
      enddo
      ip = r_lpolentry(ia,is)
      c_c(is,ia,r_nrec,ip,mes) =   &
        c1*c_c(is,ia,r_nrec,ip,mes) + c2*cc/nc
    enddo
    !
    ! ... and sets buffer integration times now
    do ic = 1, r_nbb
      ical = r_mapbb(ic)
      ip = r_mappol(ia,ic)
      ! Sky is polarisation dependent
      if (mes.eq.sky) then
        integ(ia,r_nrec,ical,ip,mes) = integ(ia,r_nrec,ical,ip,mes) &
           + dh_integ
      else
        ! Temp fix. We need cali for each pol each tweak
        do ip = 1, m_pol_rec
          integ(ia,r_nrec,ical,ip,mes) = integ(ia,r_nrec,ical,ip,mes) &
             + dh_integ
        enddo
      endif
    enddo
  enddo
  return
end subroutine do_autol
!
subroutine protect_double(ldata_in,data)
  use classic_api
  !---------------------------------------------------------------------
  ! --- protect total power from occasional doubled values
  !---------------------------------------------------------------------
  integer :: ldata_in               !
  real :: data(ldata_in)            !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  ! Local
  integer :: i, ia, kin, nav2, k, ip
  real :: tt(300,m_pol_rec,mnant),ttav, ttav2, ttt(m_pol_rec,mnant)
  !-----------------------------------------------------------------------
  do i=1, r_ndump
    kin = (i-1)*r_ldump+1
    call decode_header(data(kin))
    do ia=1, r_nant
      do ip=1, r_npol_rec
        if (r_npol_rec.eq.1) then
          k = r_lpolentry(1,1) ! To be patched when mixed unit
        else
          k = ip
        endif
        tt(i,k,ia) = dh_total(k,ia)
      enddo
    enddo
  enddo
  do ia=1, r_nant
    do ip=1, r_npol_rec
      if (r_npol_rec.eq.1) then
        k = r_lpolentry(1,1)   ! To be patched when mixed unit
      else
        k= ip
      endif
      ttav = 0
      do i=1, r_ndump
        ttav = ttav + tt(i,k,ia)
      enddo
      ttav = ttav/r_ndump
      nav2 = 0
      ttav2 = 0
      do i=1, r_ndump
        if (tt(i,k,ia)/ttav.lt.1.5 .and. tt(i,k,ia).gt.0.75) then
          ttav2 = ttav2 + tt(i,k,ia)
          nav2 = nav2 + 1
        endif
      enddo
      ttav2 = ttav2/nav2
      ttt(k,ia) = ttav2
    enddo
  enddo
  kin = r_ndump*r_ldump + 1
  call decode_header (data(kin))
  do ia=1, r_nant
    dh_total(k,ia) = ttt(k,ia)
  enddo
  call encode_header (data(kin))
end subroutine protect_double
!
function n_input(error)
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! Determines the number of correlator entries connected to any unit
  !---------------------------------------------------------------------
  integer :: n_input                !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  logical :: first
  integer :: i, nbc, savenbc
  !------------------------------------------------------------------------
  ! Code:
  error = .false.
  first = .true.
  n_input = 0
  !
  do i = 1,r_lband
    nbc = 0
    if (r_lpolmode(i).ne.1) then
      n_input = 2 ! Polarization requires TWO inputs..
      return
    endif
    if (r_iunit(i).lt.9) then
       nbc = r_bb(i)
    endif
    if (first) then
      if (nbc.ne.0) then
        n_input = 1
        savenbc = nbc
        first = .false.
      endif
    endif
    if (nbc.ne.savenbc.and.nbc.ne.0) then
      n_input = 2
      return
    endif
  enddo
  return
end function n_input
