subroutine clic_atmos(line,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! Command ATMOS [DETECTOR|CORRELATOR]
  ! This command  quasi real time amplitude and IF passband calibration.
  ! It processes CAL, AUTO, IFPB and CWVR scans as they are encountered.
  ! Option 1 /COMPRESS time uvmax
  ! Option 2 /RESET {CAL|IFPB:AUTO:ALL}
  ! Option 3 /NOWRITE
  ! Option 4 /NOMONITOR
  ! Option 5 /CMODE  wvrmode wvrcpol
  !
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: end, do_write, monitor
  integer :: i, ir, ia, ip, ic
  integer(kind=address_length) :: data_in, ip_data
  integer(kind=data_length) :: ndata, ldata_in
  integer :: isb, isub, nch
  character(len=7) :: done
  character(len=12) :: arg1, arg
  character(len=80) :: chain
  character(len=4) :: cproc,procname
  real :: scale(mnant,mnbb)
  integer :: mvoc1, mvoc2, mvoc3
  parameter (mvoc1=2, mvoc2=5, mvoc3=5)
  character(len=12) :: voc1(mvoc1), voc2(mvoc2), voc3(mvoc3)
  data voc1/'DETECTOR','CORRELATOR'/
  data voc2/'CAL','IFPB','AUTO','ALL','CWVR'/
  data voc3/'TR_GE','TR_GL','TRL_GC','TR_GC','NOCAL'/
  !------------------------------------------------------------------------
  ! Code:
  call check_input_file(error)
  if (error) return
  call check_index(error)
  if (error) return
  do_write = .not.sic_present(3,0)
  if (do_write) then
    call check_output_file(error)
    if (write_mode.eq.'UPDA') call check_equal_file(error)
    if (error) return
  endif
  arg1 = 'DETECTOR'
  call clic_kw(line,0,1,arg1,nch,voc1,mvoc1,.false.,error,.true.)
  if (error) return
  !
  ! Reset CAL, AUTO, ALL, and/or IFPB  : Option 2
  if (sic_present(2,0)) then
    do i=1, max(1,sic_narg(2))
      arg = 'ALL'
      call clic_kw(line,2,i,arg,nch,voc2,mvoc2,.true.,error,.true.)
      if (error) return
      if (arg.eq.'ALL') then
        do ia=1,mnant
          do ir=1,mnrec
            do ic=1, mnbb
              do ip=1, m_pol_rec
                integ(ia,ir,ic,ip,chop) = 0
                integ(ia,ir,ic,ip,cold) = 0
                integ(ia,ir,ic,ip,sky) = 0
              enddo
            enddo
          enddo
        enddo
        mon_scan = 0
      elseif (arg.eq.'AUTO') then
        do ia=1,mnant
          do ir=1,mnrec
            do ic=1, mnbb
              do ip=1, m_pol_rec
                integ(ia,ir,ic,ip,sky) = 0
              enddo
            enddo
          enddo
        enddo
      elseif (arg.eq.'CAL') then
        do ia=1,mnant
          do ir=1,mnrec
            do ic=1, mnbb
              do ip=1, m_pol_rec
                integ(ia,ir,ic,ip,chop) = 0
                integ(ia,ir,ic,ip,cold) = 0
              enddo
            enddo
          enddo
        enddo
      endif
    enddo
  endif
  !
  ! /NOMONITOR
  monitor = .not.sic_present(4,0)
  !
  ! Loop on current index
  call get_first(.true.,error)
  if (error) return
  end = .false.
  do while (.not.end)
    if (r_ndump.eq.0) goto 200
    r_nrec = max(1,r_nrec)
    do isb = 1, r_nsb
      if (c_line(isb).ne.'*') then
        r_crfoff(isb) = c_freq(isb)
        r_cnam(isb) = c_line(isb)
      elseif (r_restf.gt.0) then
        r_crfoff(isb) = r_restf
        r_cnam(isb) = r_line
      else
        r_crfoff(isb) = 100000.
        r_cnam(isb) = 'DUMMY'
      endif
      do isub=1, r_lband
        if (l_line(isub,isb).ne.'*') then
          r_lrfoff(isb,isub) = l_freq(isub,isb)
          r_lnam(isb,isub) = l_line(isub,isb)
        elseif (r_restf.gt.0) then
          r_lrfoff(isb,isub) = r_restf
          r_lnam(isb,isub) = r_line
        else
          r_lrfoff(isb,isub) = 100000.
          r_lnam(isb,isub) = 'DUMMY'
        endif
      enddo
    enddo
    !
    ! Get storage and data
    call get_data (ldata_in,data_in,error)
    if (error) goto 200
    ndata = ldata_in
    !
    ! Process (with atmospheric monitor)
    ip_data = gag_pointer(data_in,memory)
    call sub_atmos (ndata,memory(ip_data),arg1,monitor,error,   &
      scale)
    !         CALL SUB_ATMOS (LDATA_IN,MEMORY(IP_DATA),ARG1,WVRMODE,WVRCPOL,
    !     $   MONITOR,ERROR)
    if (error) goto 200
    !         CALL CHECK_FLUX(LDATA_IN, MEMORY(IP_DATA), FLUXOUT, ERRFLUX,
    !     &   PHCOROK, LOWFAC, ERROR)
    error = .false.
    !
    ! Write
    call loose_data
    if (do_write) then
      call ipb_write(write_mode,.true.,error)
      if (error) goto 200
      if (write_mode.eq.'UPDA') then
        call wgen(error)       ! section generale
        if (error) return
        call wpos(error)       ! position
        if (error) return
        call winterc(error)
        if (r_presec(rfset_sec)) then
          call wrfset(error)
          if (error) return
        endif
        if (r_presec(contset_sec)) then
          call wcontset(error)
          if (error) return
        endif
        if (r_presec(lineset_sec)) then
          call wlineset(error)
          if (error) return
        endif
        if (r_presec(atparm_sec)) then
          call watparm(error)
          if (error) return
        endif
        if (r_presec(wvr_sec)) then
          call wwvr(error)
          if (error) return
        endif
      endif
      call update_header       ! Missing in this circumstances
      ndata = ldata_in
      call wdata (ndata,memory(ip_data),.false.,error)
      if (error) goto 200
      call ipb_close(error)
      if (error) goto 200
      cproc = procname(r_proc)
      write(chain,'(A4,1X,I6,A,I6,A)') cproc ,r_num,   &
        ' '//done(write_mode)//' (',r_ndump,' records)'
      call message(4,1,'CLIC_ATMOS',chain(1:50))
    endif
    !
    ! Next observation
200 if (sic_ctrlc()) then
      error = .true.
      return
    endif
    error = .false.
    call get_next(end, error)
    if (error) return
  enddo
  return
end subroutine clic_atmos
!
subroutine load_atmos
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !	Load Atmospheric Parameters
  !---------------------------------------------------------------------
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  real :: airmas, current_el
  real*8 :: air_mass
  integer :: ia, ip
  !
  ! Setup atmospheric monitor section:
  !      CALL R4TOR4(H_MON(1,R_NREC),R_NREC_MON,MATMON)
  !
  ! Setup calibration parameters section:
  current_el = r_el
  ! just in case ...
  airmas = sngl(air_mass(current_el)-air_mass(r_el))
  do ia =1, r_nant
    do ip = 1, mnbb
      r_tsyss(ip,ia) = r_tsyss(ip,ia)*exp(r_taus(ip,ia)   &
        *airmas)
      r_tsysi(ip,ia) = r_tsysi(ip,ia)*exp(r_taui(ip,ia)   &
        *airmas)
    enddo
  enddo
end subroutine load_atmos
!
subroutine cal_levels(arg,mes)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     Show total power levels
  ! Input
  !	ARG C*(*)	'Detector' or 'Correlator'
  !---------------------------------------------------------------------
  character(len=*) :: arg           !
  integer :: mes                    !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_display.inc'
  include 'clic_clic.inc'
  ! Local
  real :: wk, tp(mnant)
  integer :: ia, ic, jc,  ip, ical
  character(len=200) :: chain
  logical :: error
  integer :: cold_scan(mnrec)
  character(len=2) :: ch(3)
  data ch/'Ch','Co','Sk'/
  save cold_scan
  data cold_scan/0,0,0,0/
  !------------------------------------------------------------------------
  ! Code:
  !
  ! Use "Temporal" data if correlator to be used
  ! Not necessarily the best thing (narrow band on some occasions ?)
  ! Get saved values from previous measurements in same scan
  !
  if (r_nbb.eq.0) then
      print *,"CAL_LEVELS, No unit connected to any IF"
      error = .true.
      return
  endif
  !
  ! New calibration scan : reset cold measurements to zero.
  !
  if (r_scan.ne.cold_scan(r_nrec) .and. mes.ne.cold) then
    do ia=1, r_nant
      do ic = 1, mnbb
         do ip = 1, m_pol_rec
           c_lev(ia,r_nrec,ic,ip,cold) = 0
         enddo
      enddo
    enddo
  endif
  if (mes.eq.cold) then
    cold_scan(r_nrec) = r_scan
  endif
  !
  do ia = 1, r_nant
    if (new_receivers) then
      !
      ! new receivers: use Tot power as it comes from correlator anyway.
      !
      ! Sky used to actually calibrate spectra, fill only what measured
      if (mes.eq.sky) then
        do ical = 1, r_nbb
          ic = r_mapbb(ical)
          ip = r_mappol(ia,ical)
          c_lev(ia,r_nrec,ic,ip,mes) = dh_total(ic, ia)
        enddo
      else
        !
        ! Temporary: fill both pol buffers since not measured in pol case.
        do ical = 1, r_nbb
          ic = r_mapbb(ical)
          ip = r_mappol(ia,ical)
            c_lev(ia,r_nrec,ic,ip,mes) = dh_total(ic, ia)
        enddo
      endif
    else
      !
      ! old receivers: use either Correl or Detector
      if (arg.eq.'C') then
        tp(ia) = 0
        wk = 0
        do jc = 1, l_subb(k_subb(1))
          ic = max(1,min(r_nband,i_subb(jc,k_subb(1))))
          ip = r_lpolentry(ia,ic)
          if (iand(dh_aflag(ia),ishft(1,ic-1)).eq.0) then
            wk = wk + r_cfwid(ic)
            tp(ia) = tp(ia)   &
              + c_c(ic,ia,r_nrec,ip,mes)*r_cfwid(ic)
          endif
        enddo
        if (wk.ne.0) then
          tp(ia) = tp(ia) / wk
        else
          write (chain,'(A,I0)')   &
            'No calibration data for Antenna ',ia
          call message(8,4,'CAL_LEVELS',chain(1:lenc(chain)))

!! TBA          integ(ia,r_nrec,1,ip,mes) = 0    ! may be one could use the other
          return               ! antennas ... ###
        endif
      elseif (arg.eq.'D') then
        !
        !     use the dh_total...
        tp(ia) = dh_total(1, ia)
        c_lev(ia,r_nrec,1,1,mes) = tp(ia)        !!! TBA
        c_lev(ia,2,1,1,mes) = dh_test1(2,ia)     !!! TBA
      endif
    endif
  enddo
  if (new_receivers) then
    do ical = 1,  r_nbb
      ic = r_mapbb(ical)
      write(chain,1001) arg, ch(mes), ic, (r_kant(ia), c_lev(ia,  &
        r_nrec,ic,r_mappol(ia,ical),mes), ia=1,r_nant)
      call message(1,1,'CAL_LEVELS',chain(1:lenc(chain)))
    enddo
1001 format(a1,1x,a2,' Cal.Unit',i0,12(' A',i0,':',f6.3))
  else
    write(chain,1000) arg,ch(mes),r_nrec, (r_kant(ia),tp(ia),ia=1   &
      ,r_nant)
1000 format(a1,1x,a2,' Rec',i0,12(' A',i0,':',f6.1))
    call message(1,1,'CAL_LEVELS',chain(1:lenc(chain)))
  endif
  return
end subroutine cal_levels
!
subroutine check_atmos (error)
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! Check that spectrum to be reduced is compatible with available
  ! calibration buffers.
  !---------------------------------------------------------------------
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  logical :: wrong
  integer :: i, ia, ip, ic, ical
  !------------------------------------------------------------------------
  ! Code:
  !
  ! Check configuration compatibility
  wrong = .false.
  call compare_sec(r_nant,h_inter(1,r_nrec),2,wrong)
  call compare_sec(r_lband,h_line(1,r_nrec),3+5*mrlband,wrong)
  !*
  ! Check Atmospheric calibration presence
  if (new_receivers) then
    do ia=1, r_nant
      do ical = 1, r_nbb
        ic = r_mapbb(ical)
        ip = r_mappol(ia,ical)
        if (integ(ia,r_nrec,ic,ip,chop).le.0 .or. wrong) then
            tcal_u(ia,ic) = 1.
            tcal_l(ia,ic) = 1.
          call message(6,2,'CHECK_ATMOS',   &
            'No Amplitude Calibration')
          sky_flags(ia,ic) = 0
          r_qual = min(r_qual,8)
          error = .true.
        else
          return
        endif
      enddo
    enddo
  else
    if (integ(1,r_nrec,1,1,chop).le.0 .or. wrong) then !! TBA
      do ia=1, r_nant
        tcal_u(ia,r_nrec) = 1.  !!! TBA
        tcal_l(ia,r_nrec) = 1.  !!! TBA
      enddo
      call message(6,2,'CHECK_ATMOS','No Amplitude Calibration')
      do i = 1, r_nant
        sky_flags(i,r_nrec) = 0
      enddo
      r_qual = min(r_qual,8)
      error = .true.
    else
      return
    endif
  endif
end subroutine check_atmos
!
subroutine real_to_complex(rel,cmpl,n)
  !---------------------------------------------------------------------
  ! Reverse storage order from:
  !	N real parts, N imaginary parts
  ! 	to:
  !	N complex numbers
  !---------------------------------------------------------------------
  integer :: n                      !
  real*4 :: rel(n,2)                !
  complex :: cmpl(n)                !
  ! Local
  integer :: i
  !------------------------------------------------------------------------
  ! Code:
  do i=1,n
    cmpl(i) = cmplx( rel(i,1), rel(i,2) )
  enddo
end subroutine real_to_complex
!
subroutine vel_scale
  use classic_api
  !---------------------------------------------------------------------
  ! CLIC
  !     Updates frequencies in header according to last
  !     'SET FREQUENCY' command
  !---------------------------------------------------------------------
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  ! Local
  integer :: isb, sky(2), isub
  real*8 :: x,y,c
  parameter (c=299792.458d0)
  data sky/+1,-1/              ! Usb, Lsb
  !------------------------------------------------------------------------
  ! Code:
  ! Loop on sidebands
  do isb = 1, 2
    !
    ! Continuum
    x = r_flo1_ref - sky(isb)*r_isb*r_fif1   &
      - sky(isb)*(r_crfoff(isb)-r_restf)*(1.+r_doppl)
    r_crch(isb) = 5.5+ (x-350.)/50.  ! reference channel
    r_crfres(isb) = -sky(isb)*50.    ! channel width
    r_cvoff(isb) = r_veloc   ! source velocity
    r_cvres(isb) = -r_crfres(isb)/r_crfoff(isb)*c
    !
    ! Line
    do isub=1, r_lband
      x = r_fif1 + r_isb *   &             ! New reference freq (I_F)
        (r_lrfoff(isb,isub) - r_restf)*(1.+r_doppl)
      y = r_flo2(isub) +r_band2(isub)* (r_flo2bis(isub) & ! Band reference freq (I_F)
        + r_band2bis(isub) * r_lfcen(isub))
      r_lrch(isb,isub) = (r_isb * x -  sky(isb) * y)   & 
        * sky(isb) * r_band2(isub) * r_band2bis(isub) / r_lfres(isub)   &
        + r_lcench(isub)
      r_lrfres(isb,isub) = sky(isb)*r_lfres(isub)   &
        *r_band2(isub) * r_band2bis(isub)
      r_lvoff(isb,isub) = r_veloc
      r_lvres(isb,isub) = -r_lrfres(isb,isub)   &
        /r_lrfoff(isb,isub)*c
    enddo
  enddo
end subroutine vel_scale
!
function prec_water(tamb,humidity)
  !---------------------------------------------------------------------
  ! CLIC
  !	Compute the precipitable water content
  !	Assumes scale height 2km
  ! Input
  !     TAMB       REAL	Ambiant Temperature in Kelvin
  !     HUMIDITY   REAL   Humidity in %
  ! Output
  !     PREC_WATER REAL   Water vapor in mm
  !---------------------------------------------------------------------
  real :: prec_water                !
  real :: tamb                      !
  real :: humidity                  !
  !------------------------------------------------------------------------
  ! Code:
  prec_water = 26.46*humidity/tamb   &
    * exp(25.22*(tamb-273)/tamb-5.31*alog(tamb/273.))
  return
end function prec_water
!
subroutine compare_sec(n1,n2,nn,ok)
  !---------------------------------------------------------------------
  ! CLIC: compare two memory areas
  !---------------------------------------------------------------------
  integer :: nn                     !
  integer :: n1(nn)                 !
  integer :: n2(nn)                 !
  logical :: ok                     !
  ! Local
  integer :: i
  !------------------------------------------------------------------------
  do i=1,nn
    ok = ok.and.(n1(i).eq.n2(i))
  enddo
  return
end subroutine compare_sec
!
subroutine check_flux(ndata, data, fluxout, errflux, phcorok,   &
    lowfac, error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use clic_rdata
  !---------------------------------------------------------------------
  ! Check the flux on a phase calibrator.
  ! Assume the efficiencies in r_jykel are correct.
  ! The best of corrected and uncorrected data is used.
  !
  ! Arguments
  !     LDATA_IN      Integer Length of data array
  !     DATA(*)       (*)     Data array
  !     Fluxout       R       Measured flux if procedure is flux measurement
  !     Errflux       R       Error on flux "  "             "      "
  !     phcorOK       L(mnant) true if flux with phcor is best
  !     floss         R(mnant) degradation factor for each ant. (0 to 1)
  !---------------------------------------------------------------------
  include 'clic_parameter.inc'
  integer(kind=data_length) :: ndata                  !
  real :: data(ndata)               !
  real :: fluxout                   !
  real :: errflux                   !
  logical :: phcorok(mnant)         !
  real :: lowfac(mnant)             !
  logical :: error                  !
  ! Global
  real :: effmax
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_proc_par.inc'
  include 'clic_sba.inc'
  include 'clic_display.inc'
  include 'clic_clic.inc'
  include 'gbl_memory.inc'
  ! Local
  integer(kind=address_length) :: data_in
  real :: effm, fr, fu(mnant), fc(mnant), wfu(mnant),ec(mnant)
  real :: eu(mnant), efc, efu, ft(mnant), wfc(mnant), afc, afu, wafc
  real :: wafu, fopt
  integer :: ib, isb, kh, ia, if,if1, i
  integer :: ind(mnant), nbest 
  character(len=132) :: chain
  complex :: z(mnbas), zant(mnant)
  real :: w(mnbas), want(mnant), frtol
  parameter (frtol=1e3)
  ! use the two best antennas for flux determination
  parameter (nbest = 2)
  logical :: save_atm(mnant), zero
  integer(kind=address_length) :: kin, ipkh
  integer(kind=data_length) :: h_offset
  !------------------------------------------------------------------------
  data_in = locwrd(data)
  kin = gag_pointer(data_in,memory)
  error = .false.
  if (r_itype.eq.1 .and. r_proc.ne.p_flux) then
    return
  endif
  if (r_proc.ne.p_source .and. r_proc.ne.p_flux) then
    return
  endif
  fr = r_flo1+r_isb*r_fif1
  effm = effmax(fr)
  do ib=1, r_nant
    fu(ib) = 0.
    fc(ib) = 0.
  enddo
  isb = 1+(1-r_isb)/2          !              (1 usb, 2 lsb)
  !
  ! Save atm phase status
  do i=1, mnant
    save_atm(i) = do_phase_atm(i)
  enddo
  !
  if (do_spidx) then
    call set_spidx(r_nsb,r_nband,r_nbas+r_ntri,   &
      r_lntch, spidc, spidl, r_spidx, error)
  endif  
  !
  ! Get average record (uncorrected) in zsba(isb,ib) (weights in wsba)
  if (r_ndatl.ne.1) then
    do i=1, mnant
      do_phase_atm(i) = .false.
    enddo
    kh = 1 + h_offset(r_ndump+1)
    !         KC = 1 + C_OFFSET(R_NDUMP+1)
    ipkh = kin+h_offset(r_ndump+1)
    call decode_header (memory(ipkh))
    call set_scaling(error)
    if (error) return
    zero = .true.
    !
    ! NGRX : Not sure if this is handling both polarizations, ...
    ! may be do each one at a time ?
    if (k_average.eq.1) then
      call line_average (r_lntch,r_nbas,r_lnsb,data_in,   &
        spidl,zero,error)
    else
      call cont_average (r_nband,r_nbas,data_in,   &
       spidc,zero,error)
    endif 
    if (error) return
    do ib = 1, r_nbas
      if (wsba(isb,ib).gt.0) then
        z(ib) = zsba(isb,ib)/wsba(isb,ib)
      else
        z(ib) = 0
      endif
      w(ib) = wsba(isb,ib)
    enddo
    call antgain (z,w,zant,want)
    do ia = 1, r_nant
      fu(ia) = 0
      wfu(ia) = 0
      if (want(ia).gt.0) then
        !               do ip = i, r_npol_rec
        !                  if (r_npol_rec.eq.1) then
        !                     ipol = r_lpolentry(1,1) ! To be patched when mixed unit
        !                  else
        !                     ipol = ip
        !                  endif
        fu(ia) = fu(ia) + abs(zant(ia)) * r_jykel(1,ia)
        if (r_jykel(1,ia).ne.0) then
          wfu(ia) = wfu(ia) + want(ia) / r_jykel(1,ia)**2
        else
          print *,"R_JYKEL ",1,ia," is ZERO"
        endif
        !              enddo
        !               if (r_npol_rec.ne.0) then
        !                  fu(ia) = fu(ia)/r_npol_rec
        !                  wfu(ia) = wfu(ia)/r_npol_rec
        !               else
        !                  print *,"R_NPOL_REC is ZERO"
        !               endif
        if (wfu(ia).ne.0) then
          eu(ia) = 1e-3 / sqrt(wfu(ia))
        else
          print *,"WFU ",ia," is ZERO"
        endif
      else
        fu(ia) = 0
        wfu(ia) = 0
        eu(ia) = -10.
      endif
    enddo
  endif
  !
  ! Get average record (corrected) in zsba(isb,ib) (weights in wsba)
  if (r_ndatl.ge.1) then
    do i=1, mnant
      do_phase_atm(i) = .true.
    enddo
    call spectral_dump(kh,0,0)
    ipkh = kin+h_offset(r_ndump+1)
    call decode_header (memory(ipkh))
    call set_scaling(error)
    if (error) return
    zero = .true.
    if (k_average.eq.1) then
      call line_average (r_lntch,r_nbas,r_lnsb,data_in,   &
        spidl,zero,error)
    else
      call cont_average (r_nband,r_nbas,data_in,   &
       spidc,zero,error)
    endif 
    if (error) return
    do ib = 1, r_nbas
      if (wsba(isb,ib).gt.0) then
        z(ib) = zsba(isb,ib)/wsba(isb,ib)
      else
        z(ib) = 0
      endif
      w(ib) = wsba(isb,ib)
    enddo
    call antgain (z,w,zant,want)
    do ia = 1, r_nant
      if (want(ia).gt.0) then
        !               do ip = i, r_npol_rec
        !                  if (r_npol_rec.eq.1) then
        !                     ipol = r_lpolentry(1,1) ! To be patched when mixed unit
        !                  else
        !                     ipol = ip
        !                  endif
        if (r_jykel(1,ia).ne.0) then
          fc(ia) = fc(ia) + abs(zant(ia)) * r_jykel(1,ia)
          wfc(ia) = wfc(ia) + want(ia) / r_jykel(1,ia)**2
        else
          print *,"R_JYKEL ",1,ia," is ZERO"
        endif
        !               enddo
        !               if (r_npol_rec.ne.0) then
        !                  fc(ia) = fc(ia)/r_npol_rec
        !                  wfc(ia) = wfc(ia)/r_npol_rec
        !               else
        !                  print *,"R_NPOL_REC is ZERO"
        !               endif
        if (wfc(ia).ne.0) then
          ec(ia) = 1e-3 / sqrt(wfc(ia))
        else
          print *,"WFC ",ia," is ZERO"
        endif
      else
        fc(ia) = 0
        wfc(ia) = 0
        ec(ia) = -10.
      endif
    enddo
  endif
  !
  ! Restore atm phase status
  do i=1, mnant
    do_phase_atm(i) = save_atm(i)
  enddo
  !
  ! Compute FLUX
  if (r_proc.ne.p_flux) then
    ! search for flux in the table
    if = 0
    do i = 1, n_flux
      if (c_flux(i).eq.r_sourc   &
        .and. abs(freq_flux(i)-r_restf).lt.1d3   &
        .and. abs(r_dobs-date_flux(i)).lt.3) then
        if = i
      endif
    enddo
    if (if.ne.0) then
      r_flux = abs(flux(if))
      fluxout = r_flux
      write (chain,'(a,f5.1,a,f6.3,a)')   &
        'Current flux of '//r_sourc//' at ',   &
        r_restf/1d3,' GHz is ', fluxout, ' Jy'
      call message(6,1,'CHECK_FLUX',chain(1:lenc(chain)))
    else
      fluxout = r_flux
      if (r_flux.eq.0) fluxout = 1.0
      write (chain,'(a,f5.1,a,f6.3,a)')   &
        'Default flux of '//r_sourc//' at ',   &
        r_restf/1d3,' GHz is ', fluxout, ' Jy'
      call message(4,2,'CHECK_FLUX',chain(1:lenc(chain)))
    endif
  else
    ! Use only the two best antennas.
    !
    !     NGRX: for the time being we average polarizations (assume
    !     unpolarized source)
    !     corrected
    afc = 0
    wafc = 0
    efc  = 0
    if (r_ndatl.ge.1) then
      call r4tor4(fc,ft,r_nant)
      call gr4_trie(ft,ind,r_nant,error)
      do ia= r_nant, r_nant-nbest+1, -1
        i = ind(ia)
        afc = afc + ft(ia)*wfc(i)
        wafc = wafc + wfc(i)
      enddo
      if (wafc.gt.0) then
        afc = afc / wafc
        efc = 1e-3 / sqrt(wafc)
      endif
    endif
    !     uncorrected
    afu = 0
    wafu = 0
    efu = 0
    if (r_ndatl.ne.1) then
      call r4tor4(fu,ft,r_nant)
      call gr4_trie(ft,ind,r_nant,error)
      do ia= r_nant, r_nant-nbest+1, -1
        i = ind(ia)
        afu = afu + ft(ia)*wfu(i)
        wafu = wafu + wfu(i)
      enddo
      if (wafu.gt.0) then
        afu = afu / wafu
        efu = 1e-3 / sqrt(wafu)
      endif
    endif
    if (afc.ge.afu) then
      fluxout = afc
      errflux = efc
    else
      fluxout = afu
      errflux = efu
    endif
    if (abs(fluxout).gt.1e6 .or. abs(fluxout).lt.1e-6) then
      write (chain,'(a,1pg12.5)')   &
        'Unlikely flux for '//r_sourc//' : ',fluxout
      call message (8,3,'CHECK_FLUX',chain(1:lenc(chain)))
    else
      write (chain,'(a,f5.1,a,f6.3,a,f5.3,a)')   &
        'Estimated flux of '//r_sourc//' at ',   &
        r_restf/1d3,' GHz is ',   &
        fluxout, ' Jy (',errflux,')'
      call message(6,1,'CHECK_FLUX',chain(1:lenc(chain)))
      r_flux= fluxout
      !
      ! put in our source list
      if1 = 0
      if (n_flux.ge.1) then
        do if =1, n_flux
          if (r_sourc.eq.c_flux(if)   &
            .and. abs(r_restf-freq_flux(if)).lt.frtol) then
            flux(if) = r_flux
            freq_flux(if) = r_restf
            date_flux(if) = r_dobs
            f_flux(if) = .false.
            if1 = if
          endif
        enddo
      endif
      if (if1.le.0 .and. n_flux.lt.m_flux) then
        n_flux = n_flux+1
        f_flux(n_flux) = .false.
        flux(n_flux) = r_flux
        c_flux(n_flux) = r_sourc
        date_flux(n_flux) = r_dobs
        freq_flux(n_flux) = r_restf
      endif
    !
    endif
  endif
  !
  ! Messages
  error = .false.
  do ia = 1, r_nant
    ! optimistic flux is measured+3sigma
    phcorok(ia) = fc(ia).ge.fu(ia)
    if (phcorok(ia)) then
      fopt = fc(ia)+ec(ia)
    else
      fopt = fu(ia)+eu(ia)
    endif
    if (fluxout.gt.0 .and. fopt.gt.0) then
      lowfac(ia) = fopt / fluxout
      if (fopt.lt.0.9*fluxout) then
        if (r_ndatl.eq.0) then
          write (chain,1002) 'Low flux on Ant ',r_kant(ia),   &
            ' Rec ',r_nrec,' : ', fu(ia), 'Jy (Unc.)'
        elseif (r_ndatl.eq.1) then
          write (chain,1002) 'Low flux on Ant ',r_kant(ia),   &
            ' Rec ',r_nrec,' : ', fc(ia), 'Jy (Cor.)'
        elseif (r_ndatl.eq.2) then
          write (chain,1002) 'Low flux on Ant ',r_kant(ia),   &
            ' Rec ',r_nrec,' : ', fu(ia), 'Jy (Unc.) ',   &
            fc(ia),'Jy (Cor.)'
        endif
        call message(4,2,'CHECK_FLUX',chain(1:lenc(chain)))
        error = .true.
      endif
    endif
  enddo
  return
1002 format(a,i1,a,i1,a,2(f6.3,a))
end subroutine check_flux
!
real function effmax(f)
  real :: f                         !
  effmax = 60.
  if (f.lt.120000.) then
    effmax = 30.
  endif
  return
end function effmax
