subroutine solve_spidx(line,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use clic_rdata
  !---------------------------------------------------------------------
  ! 	Calculate the flux of sources in the current index,
  !	or the efficiency (JY_TO_KEL) if the flux is known
  !       /RESET : reset all unknown fluxes to zero.
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'gbl_pi.inc'
  include 'clic_par.inc'
  include 'gbl_memory.inc'
  ! Local
  character(len=6) :: ch
  character(len=80) :: snam,filnam
  logical :: new, output, iznogoud, usereal
  integer :: iband, iant, ix, iy, jw1, jw2, old_base, p_lun, ipol, kb, kif
  integer :: i, ia, ns,  if, is, if1, ier, nch, ir, ignored, ifr, iif, ibb
  real :: frtol
  integer :: dtol
  parameter (frtol=1e3, dtol=7)    ! 1 GHz ... 1 week ...
  real :: visi(mnif,mnant,m_spidx), wisi(mnif,mnant,m_spidx),solspidx(mnant,m_spidx)
  real :: eff_in(2,mnant,m_spidx),fif(2)
  real :: aspidx, sspidx(m_spidx), weff(2,mnant), seff(2,mnant), seffs(2,mnant),wspidx
  real :: fff(mnant), wfff(mnant), ssp(2), wsp(2), weffs(2,mnant)
  real :: vsspidx, wsspidx, vt(4,3), wt(4,3), fspidx(m_spidx)
  real :: sseff(mnant)
  logical :: end, do_phcorr, reset
  logical :: do_reference, is_sorted, checked
  character(len=132) :: chain
  character(len=12) :: argum, sname(m_spidx), tsource, rf_chain
  integer(kind=address_length) :: k, ipk, ipkc, ipkl, data_in, kin
  integer(kind=data_length)    :: ldata_in, h_offset, c_offset, l_offset
  integer :: sdate(m_spidx), iv, im, n_best, ind(mnant), nbb(mnif),nsp(2)
  integer(kind=index_length) :: dim(4)
  !
  integer :: mvoc1, mvoc2, nkey, iscan
  parameter (mvoc1=6, mvoc2=3)
  character(len=12) :: kw, voc1(mvoc1), voc2(mvoc2)
  data voc1/'CORRECTED','UNCORRECTED','REFERENCED',   &
    'NOREFERENCED','BEST','REAL'/
  data voc2/'OLD','NEW','FLUX'/
  !
  common /thespidx/  seff, sspidx, ns
  save /thespidx/
  save sname
  !------------------------------------------------------------------------
  ! Code:
  ipol = 1 ! Dummy
  kb = 1   
  kif =1 
  checked = .false.
  save_scale = do_scale
  ! Verify if any input file
  call check_input_file(error)
  if (error) return
  !
  call check_index(error)
  if (error) return
  !
  output = .false.
  do_phcorr = .false.
  do_reference = .true.
  n_best = 3
  usereal = .false.
  if (sic_narg(0).ge.2) then
    i = 2
    do while (i.le.sic_narg(0))
      argum = 'UNCORRECTED'
      call sic_ke(line,0,i,argum,nch,.false.,error)
      i = i+1
      if (error) goto 999
      call sic_ambigs('SOLVE FLUX',argum,kw,nkey,voc1,mvoc1,error)
      if (error) goto 999
      if (kw.eq.'CORRECTED') then
        do_phcorr = .true.
      elseif (kw.eq.'UNCORRECTED') then
        do_phcorr = .false.
      elseif (kw.eq.'REFERENCED') then
        do_reference = .true.
      elseif (kw.eq.'NOREFERENCED') then
        do_reference = .false.
      elseif (kw.eq.'BEST') then
        call sic_i4(line,0,i,n_best,.true.,error)
        i = i+1
      elseif (kw.eq.'REAL') then
        usereal = .true.
        write (chain,'(a,i1,a)') 'Using visibility real part'   &
          //' instead of amplitude'
        call message(8,2,'SOLVE_INDEX',chain(1:lenc(chain)))
      endif
    enddo
  endif
  write (chain,'(a,i0,a)') 'Average spidx will use the best ',   &
    n_best,' antennas'
  call message(8,1,'SOLVE_INDEX',chain(1:lenc(chain)))
  !
  reset = sic_present(4,0)
  !
  output = sic_present(3,0)
  if (output) then
    call sic_ch(line,3,1,snam,nch,.true.,error)
    if (error) goto 999
    new = .false.
    i = 2
    do while (i.le.sic_narg(3))
      call sic_ke(line,3,i,ch,nch,.true.,error)
      if (error) goto 999
      call sic_ambigs('SOLVE_INDEX',ch,kw,nkey,voc2,mvoc2,error)
      if (error) goto 999
      new = new.or.(kw.eq.'NEW')
      i = i+1
    enddo
    call sic_parsef(snam,filnam,' ','.int')
    ier = sic_getlun(p_lun)
    if (new) then
      ier = sic_open (p_lun,filnam,'NEW',.false.)
      if (ier.eq.0) then
        call user_info(snam)
        write(p_lun,2001) '! '
        write(p_lun,2001) '! CLIC\SOLVE FLUX /OUT '   &
          //filnam(1:lenc(filnam))//   ' FLUX NEW '
        write(p_lun,2001) '! '//snam(1:70)
        write(p_lun,2010)
      endif
    else
      ier = sic_open (p_lun,filnam,'APPEND',.false.)
    endif
    if (ier.ne.0) then
      call message(6,3,'SOLVE_INDEX','Cannot open file '//filnam)
      call messios(6,3,'SOLVE_INDEX',ier)
      error = .true.
      call sic_frelun(p_lun)
      return
    endif
  endif
  !
  if (reset) then
    k = 1
    do i=1, n_spidx
      if (f_spidx(i)) then
        f_spidx(k) = .true.
        spidx(k) = spidx(i)
        c_spidx(k) = c_spidx(i)
        freq_spidx(k) = freq_spidx(i)
        date_spidx(k) = date_spidx(i)
        k = k+1
      endif
    enddo
    n_spidx = k-1
  endif
  ! check if spidx list contains a reference spidx
  if (do_reference) then
    k = 0
    do i=1, n_spidx
      if (f_spidx(i)) then
        k = k+1
      endif
    enddo
    if (k.eq.0) then
      call message(6,3,'SOLVE_INDEX',   &
        'No source of known spidx in spidx list')
      error = .true.
      return
    endif
  else
    call message(4,1,'SOLVE_INDEX',   &
      'Using stored efficiencies to compute spidx')
  endif
  jw1 = iw1(k_subb(1))
  jw2 = iw2(k_subb(1))
  !
  ! Select either real part (IY=3) or amplitude (IY=1, default)
  ix = 10
  iy = 1
  if (usereal) then
    iy = 3
  endif
  iband = i_band(k_band(1))
  ignored = 0
  !
  do_scale = .true.
  do_amplitude = .false.
  do_flux = .false.
  call show_general('AMPLITUDE',.false.,line,error)
  if (error) goto 999
  !
  old_base = i_base(1)
  if (i_base(1).gt.0) call switch_antenna
  call set_display(error)
  !
  ! Count sources in current index, store known spidxes and visibilities
  call get_first(.true.,error)
  if (error) goto 999
  call check_subb(1,.true.,error)
  if (error) goto 999
  ns = 0
  tsource = ' '
  end = .false.
  do while (.not. end)
    is = 0
    if (ns.ge.1) then
      do i=1, ns
        if (r_sourc.eq.sname(i)   &
          .and. abs(r_restf-fspidx(i)).lt.frtol) then
          is = i
        endif
      enddo
    endif
    if (is.eq.0) then
      ns = ns + 1
      sname(ns) = r_sourc
      fspidx(ns) = r_restf
      sdate(ns) = r_dobs
      sspidx(ns) = r_spidx+200
      !
      ! Check if by chance spidx is already known
      do if = 1, n_spidx
        if (f_spidx(if) .and. c_spidx(if).eq.sname(ns) .and.   &
          ((freq_spidx(if).le.0)  .or.   &
          (abs(fspidx(ns)-freq_spidx(if)).lt.frtol)) .and.   &
          ((date_spidx(if).lt.-100000)   &
          .or. (abs(date_spidx(if)-sdate(ns)).le.dtol))) then
          sspidx(ns) = spidx(if)
        endif
      enddo
      !
      ! Compute average sideband efficiencies and frequencies
      do ia = 1, r_nant
        nbb(:) = 0
        fif(:) = 0
        do ibb = 1, r_nbb
          iif = r_if(ibb)
          if (r_sb(ibb).eq.1) then
            ifr = 2
          else
            ifr = 1
          endif
          eff_in(ifr,ia,ns) = eff_in(ifr,ia,ns)+r_jykel(ibb,ia)
          fif(ifr) = fif(ifr)+r_flo1+r_sb(ibb)*(r_flo2(ibb)+ &
                     r_band2(ibb)*r_lfcen(ibb))

          nbb(ifr) = nbb(ifr)+1 
        enddo
        do iif = 1, r_nif
          visi(iif,ia,ns) = 0
          wisi(iif,ia,ns) = 0
        enddo
        !
        ! Need both sidebands
        do ifr = 1, 2
          if (nbb(ifr).ne.0) then
            eff_in(ifr,ia,ns) = eff_in(ifr,ia,ns)/nbb(ifr)
            fif(ifr) = fif(ifr)/nbb(ifr)
          else 
            call message(8,3,'SOLVE_INDEX',   &
                         'Missing sideband')
            error = .true.
            return
          endif
        enddo
        !
      enddo
      is = ns
    endif
    ! Following to check
    if (do_pass.and..not.do_pass_memory) then
      if (do_pass_spectrum.and..not.checked) then
        iscan = 0
        call get_pass_scan(rf_chain,iscan,error)
        if (error) then
          call message(8,2,'SOLVE_FLUX','No BANDPASS scan found')
          ignored = ignored + 1
          goto 200
        endif
        checked = .true.
      else
        if (do_pass_antenna .and. r_abpc.eq.0) then
          call message(6,2,'SOLVE_INDEX',   &
            'No Antenna RF Passband Calibration, data ignored')
          ignored = ignored + 1
          goto 200
        elseif (.not.do_pass_antenna .and. r_bpc.eq.0) then
          call message(6,2,'SOLVE_INDEX',   &
            'No Baseline RF Passband Calibration, data ignored')
          ignored = ignored + 1
          goto 200
        endif
      endif
    endif
    if (r_lmode.gt.1) then
      call message(6,2,'SOLVE_INDEX',   &
        'Autocorrelation scan ignored.')
      ignored = ignored + 1
      goto 200
    endif
    call get_data (ldata_in,data_in,error)
    if (error) goto 200
    if (do_pass) then
      call set_pass(r_nsb,r_nband,r_nbas+r_ntri,   &
        r_lntch, passc, passl, error)
      if (error) goto 200
    endif
    call set_corr(error)
    !
    ! Do not loop on records : use average for scan
    !
    call spectral_dump(ir,0,0)
    kin = gag_pointer(data_in,memory)
    ipk = kin  + h_offset(ir)
    call decode_header(memory(ipk))
    call set_scaling (error)
    if (error) return
    !
    do ia = 1, n_base
      iant = -i_base(ia)
      call spectral_dump(ir,iant,0)
      ipkc = kin + c_offset(ir)
      ipkl = kin + l_offset(ir)
      do iif = 1, r_nif
        n_if = 1
        l_if(n_if) = 1
        i_if(n_if,l_if(n_if)) =  iif
        call set_if_subbands(error)
        iband = 1
        if (r_ifname(iif)(2:2).eq."L") iband = 2 
        if (error) return
        do iv=1,4
          do im=1,3
            vt(iv,im) = 0
            wt(iv,im) = 0
          enddo
        enddo
        call arecord (r_nsb, r_nband, r_nbas, r_lntch,   &
          memory(ipkc),memory(ipkl),   &
          passc, passl, iant, iband, ipol, kb, iif, l_subb(1), i_subb(1,1),   &
          jw1,jw2,ix,iy, vt, wt, do_phcorr,error)
        if (error) goto 999
        visi(iif,ia,is) = visi(iif,ia,is) + vt(2,2)
        wisi(iif,ia,is) = wisi(iif,ia,is) + wt(2,2)
      enddo
      !
      ! For flux output : printout 2 lines for each scan, and each antenna
      ! (compatibility with CLASS printouts)
!!      if (output.and.wt(2,2).gt.0) then
!!        call datec (r_dobs,chain,error)
!!        fl = vt(2,2)/wt(2,2)*abs(sflux(is))
!!        efl = abs(sflux(is))*1e-3/sqrt(wt(2,2))
!!        !cc NGRX: Give the efficiency for Polar 1 !!!!!!!!!!!!!!!
!!        do k=1,0,-1
!!          write(p_lun,2011) r_num, r_scan, k, 0d0, 0d0, 0d0,   &
!!            0.0, 0.0, iant, 1.0, 0.0, fl, efl,   &
!!            r_gim(1,iant), ff, fi, sname(is),chain(1:11)
!!        enddo
!!      endif
    enddo
200 error = .false.
    call get_next(end,error)
    if (error) goto 999
    if (sic_ctrlc()) then
      error = .true.
      goto 900
    endif
  enddo
  if (ignored.gt.0) then
    write(chain,'(i6,a)') ignored, ' ignored scans.'
    call message(6,2,'SOLVE_INDEX',chain(1:lenc(chain)))
  endif
  !
!!2011 format(1x,i8,i6,i3,3(1x,f8.3),1x,   &
!!    f9.2,1x,f8.2,1x,i2,1x,f9.2,1x,f8.2,1x,   &
!!    1pg10.3,1x,1pg10.3,1x,0pf6.2,2(1x,f8.3),1x,'''',a,'''',   &
!!    1x,'''',a,'''')
  do i = 1, ns
    do ia = 1, n_base
      do iif = 1, r_nif
        if (wisi(iif,ia,i).ne.0) then
          visi(iif,ia,i) = visi(iif,ia,i)/wisi(iif,ia,i)
        elseif (sspidx(i).le.100) then
          write(chain,'(a,i2,a)') sname(i)//' antenna ',ia,   &
            ' cannot be used'
          call message(4,2,'SOLVE_INDEX',chain(1:lenc(chain)))
        endif
      enddo
    enddo
  enddo
  !
  ! Get efficiencies (for sources with known spidx)
  if (do_reference) then
    call sic_delvariable ('JY_PER_K_IF',.false.,error)
    dim(1) = r_nif
    dim(2) = n_base
    call sic_def_real ('JY_PER_K_IF',seff,2,dim,.false.,error)
    do ia = 1, n_base
      do ifr=1, 2
        weff(ifr,ia) = 0
        seff(ifr,ia) = 0
      enddo
    enddo
    if (do_phcorr) call message(6,1,'SOLVE_INDEX',   &
      'Amplitudes are corrected for r.m.s. phase errors')
    call message(6,1,'SOLVE_INDEX','Reference sources:')
    !
    ! Compute "efficiencies" (relative to LSB)
    sseff(:) = 0
    do i=1, ns
      if (sspidx(i).lt.100) then
        write(chain,1000) sname(i),sspidx(i)
        call message(6,1,'SOLVE_INDEX',chain(1:lenc(chain)))
        ! Original formula  [ (visi/flux)*(wisi*flux**2) ]
        ! and in Scaled mode [ Scale*wisi ]
        seffs(:,:) = 0 
        weffs(:,:) = 0
        do ia=1, n_base
          do iif=1, r_nif
            if (r_ifname(iif)(2:2).eq."L") then
              ifr = 1
            else
              ifr =2
            endif
            ! Compute Stokes I
            seffs(ifr,ia) = seffs(ifr,ia) + visi(iif,ia,i) 
            weffs(ifr,ia) = weffs(ifr,ia) + 1
            sseff(ia) = sseff(ia)+visi(iif,ia,i)
          enddo
          !
          ! Normalize by LSB amp and correct for spectral index
          if (any(weffs(:,ia).eq.0).or.any(seffs(:,ia).eq.0)) then
            call message(8,3,'SOLVE_INDEX',   &
            'Cannot compute efficiencies')
            error = .true.
            return
          else
            seffs(:,ia) = seffs(:,ia)*weffs(1,ia)/seffs(1,ia)/weffs(:,ia)   
            seff(:,ia) = seffs(:,ia)*(fif(:)/fif(1))**(-sspidx(i))                   
            weff(:,ia) = weff(:,ia) + 1
          endif
        enddo
      endif
    enddo
    !
    ! Check if any good efficiency:
    iznogoud = .true.
    do ia=1, n_base
      do ifr=1, 2
        iznogoud = iznogoud .and. weff(ifr,ia).le.0
      enddo
    enddo
    if (iznogoud) then
      call message(8,3,'SOLVE_INDEX',   &
        'No usable data with known spidx')
      error = .true.
      if (output) then
        close (unit=p_lun)
        call sic_frelun(p_lun)
      endif
      do_scale = save_scale
      return
    endif
    call message(6,1,'SOLVE_INDEX','Average efficiencies:')
    !
    do ia=1, n_base
      do ifr=1, 2
        if (weff(ifr,ia).gt.0) then
          iant = -i_base(ia)
          seff(ifr,ia) = seff(ifr,ia)/weff(ifr,ia)
          write(chain,1001,iostat=ier)   &
            iant, ifr, seff(ifr,ia)
          call message(6,1,'SOLVE_INDEX',chain(1:lenc(chain)))
        else
          seff(iif,ia) = 0
          write(chain,'(a,i2,a)') 'Efficiency for antenna ',ia,   &
            ' cannot be computed'
          call message(4,2,'SOLVE_INDEX',chain(1:lenc(chain)))
        endif
      enddo
    enddo
  endif
  !
  ! Get spidxes (for other sources)
  is_sorted = .false.
  do ia = 1, n_base
    if (sseff(ia).ne.0) then
      sseff(ia)=1/sseff(ia)
    else
      sseff(ia)=1.23456e34
    endif
  enddo
  call message(6,1,'SOLVE_INDEX','Sources, Spidxes and errors : ')
  do is=1, ns
    aspidx = 0
    wspidx = 0
    do ia=1, n_base
      iant = -i_base(ia)
      ! Average polarisation (this is Stokes I)
      ssp(:) = 0
      wsp(:) = 0
      do iif = 1, r_nif
        if (r_ifname(iif)(2:2).eq."L") then
          ifr = 1
        else
          ifr =2
        endif
        ssp(ifr) = ssp(ifr)+visi(iif,ia,is)
        wsp(ifr) = wsp(ifr)+1
        nsp(ifr) = nsp(1)+1
      enddo
      ! Use "efficiencies"
        if (do_reference) then ! .and. seff(ifr,ia).gt.0) then
          eff_in(:,ia,is) = seff(:,ia)
        endif
        if (all(eff_in(:,ia,is).ne.0)) then
          ssp(:) = ssp(:)/eff_in(:,ia,is)
        else
          error = .true.
          return
        endif
      !
      if (all(wsp(:).ne.0).and.ssp(1).ne.0)  ssp(:)=ssp(:)*wsp(1)/ssp(1)/wsp(:)
      vsspidx = log(ssp(2)/ssp(1))/log(fif(2)/fif(1))
      wsspidx = 1
      if (wsspidx.ne.0) then
        write(chain,1004,iostat=ier) sname(is), iant, vsspidx
        call message(6,1,'SOLVE_INDEX',chain(1:lenc(chain)))
      endif
      fff(ia) = vsspidx
      solspidx(ia,is)= vsspidx
      wfff(ia) = wsspidx
    enddo
    !         CALL GR4_TRIE(FFF,IND,N_BASE,ERROR)
    if (.not.is_sorted) then
      call gr4_trie(sseff,ind,n_base,error)
      is_sorted = .true.
    endif
    !
    do ia= 1, n_best           !N_BASE, MAX(1,N_BASE-N_BEST+1), -1
      i = ind(ia)
      aspidx = aspidx + fff(i)*wfff(i)
      wspidx = wspidx + wfff(i)
    enddo
    if (wspidx.ne.0) then
      aspidx = aspidx / wspidx
      write(chain,1003,iostat=ier)   &
        sname(is), aspidx
      call message(6,1,'SOLVE_INDEX',chain(1:lenc(chain)))
    endif
    !
    ! Compute the new spidxes for "free" sources
    if (sspidx(is).gt.100) then
      sspidx(is) = aspidx
      if1 = 0
      do if = 1, n_spidx
        if (.not.f_spidx(if) .and. c_spidx(if).eq.sname(is)   &
          .and. (freq_spidx(if).le.0 .or.   &
          (abs(freq_spidx(if)-fspidx(is)).lt.frtol))) then
          spidx(if) = sspidx(is)
          if (freq_spidx(if).le.0) freq_spidx(if) = fspidx(is)
          date_spidx(if) = sdate(is)
          f_spidx(if) = .false.
          if1 = if
        endif
      enddo
      if (if1.le.0 .and. n_spidx.lt.m_spidx) then
        n_spidx = n_spidx+1
        f_spidx(n_spidx) = .false.
        spidx(n_spidx) = sspidx(is)
        freq_spidx(n_spidx) = fspidx(is)
        c_spidx(n_spidx) = sname(is)
        date_spidx(if) = sdate(is)
      endif
    endif
  enddo
  !
  ! Keep the results in variables for calibration procedures.
  call sic_delvariable ('SOLVED',.false.,error)
  call sic_delvariable ('N_SOLVED',.false.,error)
  call sic_delvariable ('F_SOLVED',.false.,error)
  call sic_delvariable ('AF_SOLVED',.false.,error)
  call sic_def_inte    ('N_SOLVED',ns,0,0,.false.,error)
  call sic_def_charn   ('SOLVED',sname,1,ns,.false.,error)
  call sic_def_real    ('F_SOLVED',sspidx,1,ns,.false.,error)
  dim(2) = ns
  dim(1) = mnant
  call sic_def_real    ('AF_SOLVED',solspidx,2,dim,.false.,error)
  call sort_spidx(error)
!  do i=1, n_base
!    iant = -i_base(i)
!    jy_to_kel(iant) = eff_in(iant,is)
!  enddo
  !
900 if (old_base.gt.0) call switch_baseline
  call set_display(error)
  if (output) then
    close (unit=p_lun)
    call sic_frelun(p_lun)
  endif
  do_scale = save_scale
  return
  !
999 error = .true.
  goto 900
  !
1000 format(1x,a,1x,'Spidx = ',f8.4)
1001 format(1x,'Ant. ',i0,' IF ',i0,2x,f7.3)
1003 format(1x,a,' Aver.',1x,f8.4)
1004 format(1x,a,' Ant ',i0,1x,f8.4)
2010 format(   &
    '!   Obs.#  Scan Code Azimuth   Elevation  Time  ',   &
    '     Position  ..  A#     Width      ..     Intensity',   &
    '     ..  Gain   Fsignal  Fimage Source  Date')
2001 format(a)
end subroutine solve_spidx
