subroutine solve_pass(line,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api  
  use clic_bpc
  !---------------------------------------------------------------------
  !     +	' SOLVE',	'/PLOT',	'/WEIGHT',	'/OUTPUT',
  !     +	'/RESET',	'/OFFSET',	'/COMPRESS',	'/SEARCH',
  !     +	'/BREAK',	'/POLYNOMIAL',
  !	Computes a passband based on the passband calibrator
  !	assumed to be in the current index.
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  include 'clic_sba.inc'
  include 'clic_xy_code.inc'
  include 'gbl_memory.inc'
  ! Local
  integer :: isb, iba, lb, kb, ib, i, nd, ndeg, ipol
  integer :: ic, i1,  ndeg1, ndeg2, iy, ix, inbc, ip
  logical :: plot, reset, ok, skip(mbox),spectrum
  character(len=132) :: chain
  integer :: m_pass, old_pen
  integer(kind=address_length) :: ipx,ipy,ipz,ipw,ipp,data_pass
  integer(kind=address_length) :: iwx,iwy,iww,iwi,iwk
  integer :: ir
  real*4 :: rms_err(mbox)
  !
  data m_pass /0/
  save rms_err
  save m_pass, data_pass
  !------------------------------------------------------------------------
  spectrum = .false.
  nd = 0
  if (sic_present(14,0)) spectrum = .true.
  call check_index(error)
  if (error) return
  call sic_delvariable ('RMS_ERR',.false.,error)
  call sic_def_real ('RMS_ERR',rms_err,1,n_boxes,.false.,error)
  !
  ! Selecting correlator input
  !
  if (.not.new_receivers) then
    inbc = 1
  else
    if (.not.bb_select.or.n_baseband.ne.1.or.l_baseband(1).ne.1) then
      call show_display('BBAND',.false.,error)
      write(chain,'(A)')   &
        'Select a single baseband using SET BBAND command'
      call message(6,3,'SOLVE_RF',chain)
      error = .true.
      return
    else
      inbc = i_baseband(1,1)
       write(chain,'(A,I1)')   &
            'Calibrating baseband ',inbc
       call message(6,1,'SOLVE_RF',chain)
    endif
  endif
  ! Code:
  ir=r_nrec
  if (sic_present(2,0) .or. sic_present(3,0) .or.   &
    sic_present(5,0) .or. sic_present(6,0) .or. sic_present(7,0) .or.   &
    sic_present(8,0) .or. sic_present(9,0)) then
    call message(6,3,'SOLVE_RF','Option invalid in this context')
    error = .true.
  endif
  if (i_base(1).gt.mnbas) then
    call message(8,4,'SOLVE_RF','Triangle mode not supported')
    error = .true.
  endif
  ! Check plot mode: loop on boxes
  ok = .false.
  do ib = 1, n_boxes
    isb = i_band(k_band(ib))
    iba = i_base(k_base(ib))
    kb = k_subb(ib)
    iy = i_y(k_y(ib))
    ix = i_x(k_x(ib))
    lb = l_subb(kb)
    if (isb.gt.2) then
      call message(4,2,'SOLVE_PASS','Band should be USB or LSB')
      skip(ib) = .true.
    elseif (iy.gt.xy_phase) then
      call message(4,2,'SOLVE_PASS',   &
        'Y axis should be Amplitude or Phase')
      skip(ib) = .true.
    elseif (ix.ne.xy_i_fre .and. do_pass_freq) then
      call message(4,2,'SOLVE_PASS',   &
        'X axis should be I_Freq. for frequency-based mode')
      skip(ib) = .true.
    elseif (ix.lt.xy_chann .or. ix.gt.xy_sky_f) then
      call message(4,2,'SOLVE_PASS',   &
        'X axis should be frequency-like for channel-based mode')
      skip(ib) = .true.
    elseif ((lb.ne.1) .and. (i_subb(1,kb).gt.mbands)   &
      .and. (.not. do_pass_freq)) then
      call message(8,4,'SOLVE_PASS',   &
        'Process line subbands separately in channel mode')
      skip(ib) = .true.
    else
      ok = .true.
      skip(ib)=.false.
    endif
    if (n_data(ib).gt.nd) nd = n_data(ib)
  enddo
50 if (.not.ok) then
    error = .true.
    return
  endif
  ! Reset option
  reset = sic_present(4,0)
  if (reset) then
    do ir=1, mnrec
      do iba = -mnant, mnbas
        do ip = 1,mnbb            ! Basebands 
          do isb = 1,2
            if (do_pass_freq) then
              bpf_deg(isb,ip,iba,ir) = 10
              fbp_famp(isb,ip,iba,ir) = .false.
              fbp_fpha(isb,ip,iba,ir) = .false.
              do i=1, bpf_deg(isb,ip,iba,ir)
                bp_famp(isb,ip,iba,i,ir)=0
                bp_fpha(isb,ip,iba,i,ir)=0
              enddo
            else
              bpc_band = 0
              do ic=1, mrlband
                bpc_deg(isb,ip,iba,ic,ir) = 4
                fbp_camp(isb,ip,iba,ir) = .false.
                fbp_cpha(isb,ip,iba,ir) = .false.
                fbp_lamp(isb,ip,iba,ic,ir) = .false.
                fbp_lpha(isb,ip,iba,ic,ir) = .false.
                do i=1, bpc_deg(isb,ip,iba,ic,ir)
                  bp_lamp(isb,ip,iba,ic,i,ir)=0
                  bp_lpha(isb,ip,iba,ic,i,ir)=0
                enddo
              enddo
            endif
            do ipol=1,3
              ph_fac(isb,ipol,iba,ir) = 0
            enddo
          enddo
        enddo
      enddo
    enddo
    bp_nant(:) = 0
    bp_ant(:,:) = 0
    bp_phys(:,:) = 0
    change_display = .true.
  endif
  if (do_pass) then
    call message(8,2,'SOLVE_RF','SET RF_PASSBAND reset to OFF')
    do_pass = .false.
    change_display = .true.
  endif
  !
  ! Remember antennas 
  bp_nant(inbc) = r_nant
  do i=1, r_nant
    bp_ant(i,inbc) = i
    bp_phys(i,inbc) = r_kant(i)
  enddo
  !
  ndeg1 = -1
  call sic_i4(line,0,2,ndeg1,.false.,error)
  if (error) goto 999
  if (ndeg1.gt.mbpcdeg) then
    write(chain,'(i3)') mbpcdeg
    call message(6,2,'SOLVE_RF','Degree reset to '//chain(1:3))
  endif
  ndeg1 = min(ndeg1,mbpcdeg)
  ndeg2 = ndeg1
  call sic_i4(line,0,3,ndeg2,.false.,error)
  if (error) goto 999
  if (ndeg2.gt.mbpcdeg) then
    write(chain,'(i3)') mbpcdeg
    call message(6,2,'SOLVE_RF','Degree reset to '//chain(1:3))
  endif
  ndeg2 = min(ndeg2,mbpcdeg)
  if (ndeg1.lt.0) ndeg1 = 0
  if (ndeg2.lt.0) ndeg2 = 1
  ndeg = max(ndeg1,ndeg2)
  if (change_display) then
    call read_spec('ALL',.true.,error) ! all scans in index
    plotted = .false.
    if (error) return
    change_display = .false.
  else
    plotted = .true.
  endif
  plot = sic_present(1,0)
  old_pen = -1
  if (plot) then
    clear = .true.
    if (.not. plotted) call sub_plot('A',.false.,.false.,0,error)
    if (error) return
    plotted = .true.
    old_pen = gr_spen(1)
    call gr_segm('FIT',error)
  endif
  !
  ! save the side band averages in complex array sba
  call save_averages(sba,error)
  if (error) goto 999
  !
  ! Loop on boxes
  ipx = gag_pointer(data_x,memory)
  ipy = gag_pointer(data_y,memory)
  ipz = gag_pointer(data_z,memory)
  ipw = gag_pointer(data_w,memory)
  ir=r_nrec
  if (spectrum) then
    !
    ! Get auxiliary storage
    if (nd*(2*r_nbas+3)*2.gt.m_pass) then
      if (m_pass .gt.0) then
        call free_vm(m_pass,data_pass)
      endif
      m_pass = nd*(2*r_nbas+3)*2
      error = sic_getvm(m_pass,data_pass).ne.1
      if (error) goto 999
    endif
    iwx = gag_pointer(data_pass,memory)
    iww = iwx + 2*nd
    iwy = iww + 2*nd*r_nbas
    iwk = iwy + 2*nd*r_nbas
    iwi = iwk + 2*nd           ! This one is INTEGER only ..
    !
    call solve_pass_spectrum(xy_ampli, m_data, m_boxes, &
      memory(ipx), memory(ipy), memory(ipw), &
      nd, r_nbas, r_nant, memory(iwx), memory(iwy),memory(iww), &
      memory(iwi),memory(iwk),plot,skip,error)

    if (error) goto 999
    call solve_pass_spectrum(xy_phase, m_data, m_boxes, &
      memory(ipx), memory(ipy), memory(ipw), &
      nd, r_nbas, r_nant, memory(iwx), memory(iwy),memory(iww), &
      memory(iwi),memory(iwk),plot,skip,error)
    if (error) goto 999
    isb = r_sb(inbc)
    if (isb.eq.-1) isb = 2
    call set_pass_spectrum(isb,inbc,r_nband,r_nsb,r_nbas+r_ntri,r_lntch,&
                           specc,specl,error)
  else
    do ib = 1, n_boxes
      isb = i_band(k_band(ib))
      iba = i_base(k_base(ib))
      kb = k_subb(ib)
      iy = i_y(k_y(ib))
      ix = i_x(k_x(ib))
      if (skip(ib)) goto 100
      if (sba(isb,iba,ir).eq.0 .and. iba.gt.0) then
        call message(4,2,'SOLVE_PASS',   &
          'No continuum reference for Bas '//cbas(iba)   &
          //' '//cband(isb))
        goto 100
      endif
      nd = n_data(ib)
      if (nd.eq.0) then
        call message(6,3,'SOLVE_PASS','No valid data point in reference box')
        error = .true.
        return
      endif
      i1 = i_subb(1,kb)
      lb = l_subb(kb)
      !
      ! Frequency-dependent passband:
      ! do a polynomial fit, as a function of IF frequency ...
      if (do_pass_freq) then
        if (iy.eq.xy_ampli) then
          ndeg = ndeg1
        elseif (iy.eq.xy_phase) then
          ndeg = ndeg2
        endif
        !
        ! Get auxiliary storage
        if (nd*12.gt.m_pass) then
          if (m_pass .gt.0) then
            call free_vm(m_pass,data_pass)
          endif
          m_pass = nd*12
          error = sic_getvm(m_pass,data_pass).ne.1
          if (error) goto 999
        endif
        ipp = gag_pointer(data_pass,memory)
        ! Do fit and plot
        call fit_polyc(m_data, m_boxes, ib, inbc, nd,   &
          memory(ipx), memory(ipy), memory(ipw), memory(ipz),   &
          memory(ipp), memory(ipp+6*nd),   &
          memory(ipp+8*nd), memory(ipp+10*nd),   &
          memory(ipp+2*nd), plot, ndeg, rms_err(ib), error)
        if (error) goto 999
      !
      ! Channel-based Continuum :
      elseif (i1.le.mbands) then
        if (ix.ne.xy_chann) then
          call message(4,2,'SOLVE_PASS',   &
            'X axis should Channel number, for continuum subbands')
          goto 100
        endif
        call channel_cont(m_data, m_boxes, ib, inbc, nd,   &
          memory(ipx), memory(ipy), memory(ipw), memory(ipz))
        rms_err(ib) = 0
      !
      ! Channel-based line : do polynomial fit
      else
        bpc_band = r_lband
        if (iy.eq.xy_ampli) then
          ndeg = ndeg1
        elseif (iy.eq.xy_phase) then
          ndeg = ndeg2
        endif
        !
        ! Get auxiliary storage
        if (nd*12.gt.m_pass) then
          if (m_pass .gt.0) then
            call free_vm(m_pass,data_pass)
          endif
          m_pass = nd*12
          error = sic_getvm(m_pass,data_pass).ne.1
          if (error) goto 999
        endif
        ipp = gag_pointer(data_pass,memory)
        ! Do fit and plot
        call fit_poly(m_data, m_boxes, ib, inbc, nd,   &
          memory(ipx), memory(ipy), memory(ipw), memory(ipz),   &
          memory(ipp), memory(ipp+6*nd),   &
          memory(ipp+8*nd),   &
          memory(ipp+10*nd), plot, ndeg, rms_err(ib), error)
        if (error) goto 999
      endif
100   continue
    enddo
  endif
998 continue
  if (old_pen.ge.0) then
    call gr_segm_close(error)
    i = gr_spen(old_pen)
  endif
  bp_source = r_sourc
  return
999 error = .true.
  goto 998
end subroutine solve_pass
!
subroutine channel_cont(md, mb, ib, inbc, nd,   &
    x_data, y_data, w_data, z_data)
  use gildas_def
  use classic_api  
  use clic_bpc
  !---------------------------------------------------------------------
  ! CLIC: passband calibration.
  ! store values as channel-by channel for continuum
  !---------------------------------------------------------------------
  integer :: md                     !
  integer :: mb                     !
  integer :: ib                     !
  integer :: inbc                   !
  integer :: nd                     !
  real :: x_data(md, mb)            !
  real :: y_data(md, mb)            !
  real :: w_data(md, mb)            !
  complex :: z_data(md, mb)         !
  ! Global
  real :: fillin
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  include 'clic_sba.inc'
  include 'clic_xy_code.inc'
  ! Local
  integer :: isb, iba, i, ic, iy, ix, ir
  real :: ynorm, data(mcch), faz, pha
  !------------------------------------------------------------------------
  ! Code:
  ! Just store data, normalize amplitudes and phases
  ir = r_nrec
  isb = i_band(k_band(ib))
  iba = i_base(k_base(ib))
  iy = i_y(k_y(ib))
  ix = i_x(k_x(ib))
  !      CALL GETXVALC(IX,ISB,XR,XV,XD)
  if (iy.le.xy_phase) then
    do i=1, r_nband
      data(i) = blank4
    enddo
    do i=1, n_data(ib)
      if (y_data(i,ib).ne.blank4) then
        ic = nint(x_data(i,ib))    ! channel number
        data(ic) = y_data(i,ib)
      endif
    enddo
  endif
  if (iy.eq.xy_ampli) then
    ynorm = abs(zrsba(inbc,isb,iba)/wrsba(inbc,isb,iba))
    do i=1, r_nband
      if (data(i).ne.blank4) then
        bp_camp(isb,inbc,iba,i,ir) = data(i)/ynorm
      else
        data(i) = fillin(data,i,1,r_nband,blank4)
        bp_camp(isb,inbc,iba,i,ir) = data(i)/ynorm
      endif
      !
      if (iba.lt.0) then
        bp_camp(isb,inbc,iba,i,ir) =   &
          sqrt(bp_camp(isb,inbc,iba,i,ir))
      endif
    !
    enddo
    do i=1, n_data(ib)
      ic = nint(x_data(i,ib))  ! channel number
      y_data(i,ib) = data(ic)
    enddo
    fbp_camp(isb,inbc,iba,ir) = sba(isb,iba,ir).ne.0
  elseif (iy.eq.xy_phase) then
    ynorm = faz(zrsba(inbc,isb,iba))
    do i=1, r_nband
      if (data(i).ne.blank4) then
        bp_cpha(isb,inbc,iba,i,ir) = data(i)
      else
        data(i) = fillin(data,i,1,r_nband,blank4)
        bp_cpha(isb,inbc,iba,i,ir) = data(i)
      endif
    enddo
    do i=1, n_data(ib)
      ic = nint(x_data(i,ib))  ! channel number
      y_data(i,ib) = data(ic)
    enddo
    do ic = 1, r_nband
      pha = bp_cpha(isb,inbc,iba,ic,ir)
      if (degrees) then
        pha = pha*pi/180.
      endif
      bp_cpha(isb,inbc,iba,ic,ir) = pha - ynorm
    enddo
    fbp_cpha(isb,inbc,iba,ir) = sba(isb,iba,ir).ne.0
  endif
  return
end subroutine channel_cont
!
subroutine fit_polyc (md,mb,ib,inbc,nd,x_data,y_data,w_data,   &
    z_data,work1,xx,yy,ww,ind,plot,ndeg,rss,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api  
  use clic_bpc
  !---------------------------------------------------------------------
  ! CLIC routine: Passband calibration
  !     Fit polynomial as a function of I_F frequency
  !---------------------------------------------------------------------
  integer :: md                     !
  integer :: mb                     !
  integer :: ib                     !
  integer :: inbc                   !
  integer :: nd                     !
  real :: x_data(md,mb)             !
  real :: y_data(md,mb)             !
  real :: w_data(md,mb)             !
  complex :: z_data(md,mb)          !
  real*8 :: work1(3*nd)             !
  real*8 :: xx(nd)                  !
  real*8 :: yy(nd)                  !
  real*8 :: ww(nd)                  !
  integer :: ind(nd)                !
  logical :: plot                   !
  integer :: ndeg                   !
  real :: rss                       !
  logical :: error                  !
  ! Global
  logical :: gr8_random
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  include 'clic_sba.inc'
  include 'clic_xy_code.inc'
  ! Local
  integer :: isb, iba, i, l, l1, l2, l3, iy, ix, ir
  real*8 :: a(0:mbpcdeg,0:mbpcdeg), s(0:mbpcdeg)
  real*8 :: work2(2*(mbpcdeg+1)), aa(0:mbpcdeg), x0, x1, x2
  real :: wnorm, faz, pha, ynorm
  character(len=132) :: chain
  !------------------------------------------------------------------------
  ! Code:
  isb = i_band(k_band(ib))
  iba = i_base(k_base(ib))
  iy = i_y(k_y(ib))
  ix = i_x(k_x(ib))
  ir = r_nrec
  !
  wnorm = 0.0                  ! SG was missing...
  if (iy.eq.xy_ampli) then
    !
    ! zrsba contains the associated weights
    ynorm = abs(zrsba(inbc,isb,iba)/wrsba(inbc,isb,iba))
  elseif (iy.eq.xy_phase) then
    ynorm = faz(zrsba(inbc,isb,iba))
  endif
  do i=1, nd
    xx(i) = x_data(i,ib)       ! Inter. freq.
    yy(i) = y_data(i,ib)
    ww(i) = w_data(i,ib)
    if (ww(i).le.0 .or. (abs(yy(i)-blank4).le.d_blank4) ) then
      ww(i) = 1d-10
      yy(i) = 0
    endif
    if (iy.eq.xy_ampli) then
      yy(i) = yy(i)/ynorm
      if (iba.lt.0) then
        yy(i) = sqrt(yy(i))
      endif
    elseif (iy.eq.xy_phase) then
      if (degrees) then
        yy(i) = pi/180.*yy(i)-ynorm
      else
        yy(i) = yy(i)-ynorm
      endif
    endif
    wnorm = wnorm + ww(i)**2
  enddo
  ! Sort if required
  if (gr8_random(xx,nd)) then
    call gr8_trie(xx,ind,nd,error)
    if (error) goto 999
    call gr8_sort(yy,work1,ind,nd)
    call gr8_sort(ww,work1,ind,nd)
  endif
  wnorm = sqrt(wnorm/nd)
  do i=1, nd
    ww(i) = ww(i)/wnorm
  enddo
  call mth_fitpol ('FIT_POLYC',nd,ndeg+1,mbpcdeg+1,xx,yy,ww,   &
    work1,work2,a,s,error)
  if (error) goto 999
  bp_flim(isb,inbc,iba,1,ir) = xx(1)
  bp_flim(isb,inbc,iba,2,ir) = xx(nd)
  if (iy.eq.xy_ampli) then
    do i = 0, ndeg
      bp_famp(isb,inbc,iba,i,ir)=a(ndeg,i)
    enddo
    if (ndeg.lt.bpf_deg(isb,inbc,iba,ir)) then
      do i=ndeg+1, bpf_deg(isb,inbc,iba,ir)
        bp_famp(isb,inbc,iba,i,ir) = 0
      enddo
    endif
    fbp_famp(isb,inbc,iba,ir) = .true.
  elseif (iy.eq.xy_phase) then
    do i=0, ndeg
      pha = a(ndeg,i)
      bp_fpha(isb,inbc,iba,i,ir) = pha
    enddo
    if (ndeg.lt.bpf_deg(isb,inbc,iba,ir)) then
      do i=ndeg+1, bpf_deg(isb,inbc,iba,ir)
        bp_fpha(isb,inbc,iba,i,ir) = 0
      enddo
    endif
    bpf_deg(isb,inbc,iba,ir) = ndeg
    fbp_fpha(isb,inbc,iba,ir) = .true.
  endif
  rss = s(ndeg)
  if (iy.eq.xy_phase .and. degrees) rss = rss*180.0/pi
  ! display results
  l = lenc(y_label(ib))
  l1 = max(3,lenc(header_1(ib)))   ! saves space on listing
  l2 = lenc(header_2(ib))
  l3 = lenc(header_3(ib))
  !
  write(chain,1000) y_label(ib)(1:3), header_1(ib)(1:l1),   &
    header_2(ib)(1:l2), header_3(ib)(1:l3), rss
1000 format(a,'. ',a,1x,' ',a,' ',a,' rms: ',1pg11.4)
  call message(6,1,'SOLVE_RF',chain(1:lenc(chain)))
  !
  if (plot) then
    do i=0, ndeg
      aa(i) = a(ndeg,i)
    enddo
    x0 = xx(1)
    x1 = xx(nd)
    do i=1, nd
      x2 = min(1d0,max(-1d0,(2d0*i-1d0-nd)/(nd-1d0)))
      call mth_getpol('FIT_POLYC',   &
        ndeg+1, aa, x2, yy(i), error)
      if (error) goto 999
      xx(i) = (x0*(1-x2)+x1*(1+x2))/2
      if (iy.eq.xy_ampli) then
        if (iba.lt.0) then
          yy(i) = yy(i)**2
        endif
        yy(i) = yy(i)*ynorm
      elseif (iy.eq.xy_phase) then
        yy(i) = yy(i) + ynorm
        if (degrees) then
          yy(i) = yy(i)*180./pi
        endif
      endif
    enddo
    write(chain,'(I4.4)') ib
    call gr_execl('CHANGE DIRECTORY BOX'//chain)
    error = gr_error()
    if (error) goto 999
    call gr8_connect (nd,xx,yy,0.0d0,-1.0d0)
    call gr_execl('CHANGE DIRECTORY')
  endif
  return
999 error = .true.
  return
end subroutine fit_polyc
!
subroutine fit_poly (md,mb,ib,inbc,nd,x_data,y_data,w_data,z_data,   &
    work1,xx,yy,ww,plot,ndeg,rss,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api  
  use clic_bpc
  !---------------------------------------------------------------------
  ! CLIC routine: Passband calibration
  !     Fit polynomial as a function frequency-like variable in an individual
  !     line subband.
  !---------------------------------------------------------------------
  integer :: md                     !
  integer :: mb                     !
  integer :: ib                     !
  integer :: inbc                   !
  integer :: nd                     !
  real :: x_data(md,mb)             !
  real :: y_data(md,mb)             !
  real :: w_data(md,mb)             !
  complex :: z_data(md,mb)          !
  real*8 :: work1(3*nd)             !
  real*8 :: xx(nd)                  !
  real*8 :: yy(nd)                  !
  real*8 :: ww(nd)                  !
  logical :: plot                   !
  integer :: ndeg                   !
  real :: rss                       !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'clic_display.inc'
  include 'gbl_pi.inc'
  include 'clic_sba.inc'
  include 'clic_xy_code.inc'
  ! Local
  integer :: isb, iba, i, l, l1, l2, l3, ic, iy, ix, ir
  real*8 :: a(0:mbpcdeg,0:mbpcdeg), s(0:mbpcdeg)
  real*8 :: work2(2*(mbpcdeg+1)), aa(0:mbpcdeg), x0, x1, x2
  real :: wnorm, faz, pha, xr, xv, xd, ynorm
  character(len=132) :: chain
  !------------------------------------------------------------------------
  ! Code:
  isb = i_band(k_band(ib))
  iba = i_base(k_base(ib))
  ic = i_subb(1,k_subb(ib))-mbands
  iy = i_y(k_y(ib))
  ix = i_x(k_x(ib))
  ir = r_nrec
  !
  wnorm = 0.0                  ! SG was missing...
  if (iy.eq.xy_ampli) then
    !*!         YNORM = ABS(ZRSBA(ISB,IBA))
    ynorm = abs(zrsba(inbc,isb,iba)/wrsba(inbc,isb,iba))
  elseif (iy.eq.xy_phase) then
    ynorm = faz(zrsba(inbc,isb,iba))
  endif
  call getxvall(ix,isb,ic,xr,xv,xd)
  do i=1, nd
    xx(i) = nint((x_data(i,ib)-xv)/xd+xr)+r_lich(ic)   ! channel number
    yy(i) = y_data(i,ib)
    ww(i) = w_data(i,ib)
    if (i.eq.1 .or. i.gt.nd-2 .or. ww(i).le.0   &
      .or. (abs(yy(i)-blank4).le.d_blank4) ) then
      ww(i) = 1d-10
      yy(i) = 0
    endif
    wnorm = wnorm + ww(i)      !**2   (?)
    if (iy.eq.xy_ampli) then
      yy(i) = yy(i)/ynorm
      if (iba.lt.0) then
        yy(i) = sqrt(yy(i))
      endif
    elseif (iy.eq.xy_phase) then
      if (degrees) then
        yy(i) = pi/180.*yy(i)-ynorm
      else
        yy(i) = yy(i)-ynorm
      endif
    endif
  enddo
  wnorm = wnorm/nd             ! SG itou
  do i=1, nd
    ww(i) = ww(i)/wnorm        !	/sqrt(wnorm)
  enddo
  call mth_fitpol('FIT_POLY',nd,ndeg+1,mbpcdeg+1,xx,yy,ww,   &
    work1,work2,a,s,error)
  if (error) goto 999
  if (iy.eq.xy_ampli) then
    do i = 0, ndeg
      bp_lamp(isb,inbc,iba,ic,i,ir)=a(ndeg,i)
    enddo
    if (ndeg.lt.bpc_deg(isb,inbc,iba,ic,ir)) then
      do i=ndeg+1, bpc_deg(isb,inbc,iba,ic,ir)
        bp_lamp(isb,inbc,iba,ic,i,ir) = 0
      enddo
    endif
    fbp_lamp(isb,inbc,iba,ic,ir) = .true.
  elseif (iy.eq.xy_phase) then
    do i=0, ndeg
      pha = a(ndeg,i)
      bp_lpha(isb,inbc,iba,ic,i,ir) = pha
    enddo
    if (ndeg.lt.bpc_deg(isb,inbc,iba,ic,ir)) then
      do i=ndeg+1, bpc_deg(isb,inbc,iba,ic,ir)
        bp_lpha(isb,inbc,iba,ic,i,ir) = 0
      enddo
    endif
    bpc_deg(isb,inbc,iba,ic,ir) = ndeg
    fbp_lpha(isb,inbc,iba,ic,ir) = .true.
  endif
  rss = s(ndeg)
  ! display results
  l = lenc(y_label(ib))
  l1 = lenc(header_1(ib))
  l2 = lenc(header_2(ib))
  l3 = lenc(header_3(ib))
  !
  write(chain,1000) y_label(ib)(1:3), header_1(ib)(1:l1),   &
    header_2(ib)(1:l2), header_3(ib)(1:l3), rss
1000 format(a,'. ',a,1x,' ',a,' ',a,' rms: ',1pg11.4)
  call message(6,1,'SOLVE_RF',chain(1:lenc(chain)))
  !
  if (plot) then
    do i=0, ndeg
      aa(i) = a(ndeg,i)
    enddo
    x0 = xx(1)
    x1 = xx(nd)
    do i=1, nd
      x2 = ((xx(i)-x0)-(x1-xx(i)))/(x1-x0)
      call mth_getpol('FIT_POLY',   &
        ndeg+1, aa, x2, yy(i), error)
      if (error) goto 999
      xx(i) = x_data(i,ib)
      if (iy.eq.xy_ampli) then
        if (iba.lt.0) then
          yy(i) = yy(i)**2
        endif
        yy(i) = yy(i)*ynorm
      elseif (iy.eq.xy_phase) then
        yy(i) = yy(i) + ynorm
        if (degrees) then
          yy(i) = yy(i)*180./pi
        endif
      endif
    enddo
    write(chain,'(I4.4)') ib
    call gr_execl('CHANGE DIRECTORY BOX'//chain)
    error = gr_error()
    if (error) goto 999
    call gr8_connect (nd,xx,yy,0.0d0,-1.0d0)
    call gr_execl('CHANGE DIRECTORY')
  endif
  return
999 error = .true.
  return
end subroutine fit_poly
!
subroutine getxvall(ix,isb,ic,xr,xv,xd)
  use classic_api  
  !---------------------------------------------------------------------
  ! CLIC
  !	Return conversion formula for the X axis of type IX
  !	Valid for spectral correlator
  ! Input:
  !	IX	Integer	Type of data (Chann, Veloc, I_fre, Sky_f)
  !	ISB	Integer	Sideband
  !	IC	Integer SubBand
  ! Output:
  !	XR	Real	Reference point
  !	XV	Real	Value at reference point
  !	XD	Real	Increment per point
  !---------------------------------------------------------------------
  integer :: ix                     !
  integer :: isb                    !
  integer :: ic                     !
  real :: xr                        !
  real :: xv                        !
  real :: xd                        !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_xy_code.inc'
  !------------------------------------------------------------------------
  ! Code:
  if (ix.eq.xy_chann) then
    xr = 0
    xv = 0
    xd = 1
  elseif (ix.eq.xy_veloc) then
    xr = r_lrch(isb,ic)
    xv = r_lvoff(isb,ic)
    xd = r_lvres(isb,ic)
  elseif (ix.eq.xy_i_fre) then
    xr = r_lcench(ic)
    xv = r_lfcen(ic)
    xd = r_lfres(ic)
  elseif (ix.eq.xy_sky_f) then
    xr = r_lrch(isb,ic)
    xv = r_lrfoff(isb,ic)
    xd = r_lrfres(isb,ic)
  endif
end subroutine getxvall
!
subroutine getxvalc(ix,isb,xr,xv,xd)
  use classic_api  
  !---------------------------------------------------------------------
  ! CLIC
  !	Return conversion formula for the X axis of type IX
  !	Valid for continuum correlator (old model)
  ! Input:
  !	IX	Integer	Type of data (Chann, Veloc, I_fre, Sky_f)
  !	ISB	Integer	Sideband
  ! Output:
  !	XR	Real	Reference point
  !	XV	Real	Value at reference point
  !	XD	Real	Increment per point
  !---------------------------------------------------------------------
  integer :: ix                     !
  integer :: isb                    !
  real :: xr                        !
  real :: xv                        !
  real :: xd                        !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_xy_code.inc'
  !------------------------------------------------------------------------
  !
  ! Channel number
  if (ix.eq.xy_chann) then
    xr = 0
    xv = 0
    xd = 1
  ! Velocity
  elseif (ix.eq.xy_veloc) then
    xr = r_crch(isb)
    xv = r_cvoff(isb)
    xd = r_cvres(isb)
  ! IF frequency
  elseif (ix.eq.xy_i_fre) then
    xr = 0.
    xv = 75.
    xd = 50.
  ! Sky Frequency
  elseif (ix.eq.xy_sky_f) then
    xr = r_crch(isb)
    xv = r_crfoff(isb)
    xd = r_crfres(isb)
  endif
end subroutine getxvalc
!
!
function fillin(r,ival,imin,imax,bad)
  !---------------------------------------------------------------------
  ! SAS	Internal routine
  !	Interpolate bad channel (if possible)
  ! Arguments
  !	R	R*4(*)	Array to be interpolated
  !	IVAL	I	Pixel to be interpolated
  !	IMIN	I	First pixel in array
  !	IMAX	I	Last pixel in array
  !	BAD	R*4	Blanking value
  ! Created	21-Mar-1986	S.Guilloteau
  !---------------------------------------------------------------------
  real :: fillin                    !
  integer :: imax                   !
  real :: r(imax)                   !
  integer :: ival                   !
  integer :: imin                   !
  real :: bad                       !
  ! Local
  integer :: i,if,il
  !
  do i=ival-1,imin,-1
    if (r(i).ne.bad) goto 10
  enddo
  !
  ! Rien en dessous, tout au dessus
  do i=ival+1,imax-1
    if (r(i).ne.bad) goto 10
  enddo
  !
  ! Tout mauvais, sauf peut-etre
  fillin = r(imax)
  return
  !
  ! Un bon au dessus ou au dessous
10 if = i
  do i=max(if+1,ival+1),imax
    if (r(i).ne.bad) goto 20
  enddo
  ! Un seul bon
  if (if.gt.ival .or. if.eq.imin) then
    fillin = r(if)
    return
  endif
  do i=if-1,imin,-1
    if (r(i).ne.bad) goto 20
  enddo
  fillin = r(if)
  return
  !
  ! Deux bons
20 il = i
  fillin = ( (ival-if)*r(il) + (il-ival)*r(if) ) / float(il-if)
end function fillin
!
subroutine solve_pass_spectrum(ly,md,mb,x_data,y_data,w_data,   &
    nd, dbas,nant,xx,yy,ww,ind,wk,plot,skip,error)
  use gildas_def
  use gkernel_interfaces
  use clic_bpc
  !---------------------------------------------------------------------
  ! CLIC routine: Passband calibration
  !     Derive antenna gain, that will be interpolated later
  !---------------------------------------------------------------------
  integer :: ly                     !
  integer :: md                     !
  integer :: mb                     !
  real :: x_data(md,mb)             !
  real :: y_data(md,mb)             !
  real :: w_data(md,mb)             !
  integer :: nd                     !
  integer :: dbas                   !
  integer :: nant                   !
  real*8 :: xx(nd)                  !
  real*8 :: yy(dbas,nd)             !
  real*8 :: ww(dbas,nd)             !
  integer :: ind(nd)                !
  real*8 :: wk(nd)                  !
  logical :: plot
  logical :: skip(mb)
  logical :: error                  !
  ! Global
  logical :: gr8_random
  include 'gbl_memory.inc'
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  include 'clic_sba.inc'
  include 'clic_xy_code.inc'
  ! Local
  logical :: my_do_rf, counting
  integer :: ib
  integer :: isb, iba, i, l, l1, l2, l3, iy, ix, ia, ja
  integer :: id, j, ir, mad, mad2, ibb, ibas, nbas, mynd
  parameter (mad=mnant*(mbpcdeg+1),mad2=mad**2)
  real*8 ::  yy1,yyy(m_data),xxx(m_data)
  integer :: iant(mnbas),jant(mnbas), ibsl(mnbas)
  !
  integer :: ier, subtract, nhole, ifirst(mmask),ilast(mmask)
  real :: wnorm, faz, pha, ynorm(mbox), turn
  real :: yp,ym, delta
  real*8 :: xcurs,ycurs
  character(len=132) :: chain
  !
  real*4 :: rms_err(mbox)
  save rms_err
  !------------------------------------------------------------------------
  !------------------------------------------------------------------------
  !
  ! Correlator input
  ! Selecting correlator input
  !
  if (.not.new_receivers) then
    ibb = 1
  else
    ibb = i_baseband(1,1)
  endif
  iba = 0
  !
  ! Loop on boxes to load data from plot buffers.
  wnorm = 0.0
  do ib = 1, n_boxes
    iy = i_y(k_y(ib))
    if (iy.eq.ly.and..not.skip(ib)) then
      ix = i_x(k_x(ib))
      isb = i_band(k_band(ib))
      ibas = i_base(k_base(ib))
      !
      ! Deal with ignored antennas
      ia = r_iant(ibas)
      ja = r_jant(ibas)
      if (my_do_rf(ia,ibb).and.my_do_rf(ja,ibb)) then
        iba = iba+1
        ibsl(ibas) = iba
        subtract = 0
        do i = 1, ia
          if (.not.my_do_rf(i,ibb)) subtract = subtract + 1
        enddo
        ia = ia-subtract
        subtract = 0
        do i = 1, ja
          if (.not.my_do_rf(i,ibb)) subtract = subtract + 1
        enddo
        ja = ja-subtract
        iant(iba) = ia
        jant(iba) = ja
      else
        cycle
      endif
      !
!      nd = n_data(ib)
      wnorm = 0.0
      if (zrsba(ibb,isb,ibas).ne.0) then
        if (iy.eq.xy_ampli) then
          ynorm(ib) =   &
            log(abs(zrsba(ibb,isb,ibas))/wrsba(ibb,isb,ibas))
        elseif (iy.eq.xy_phase) then
          ynorm(ib) = faz(zrsba(ibb,isb,ibas))
        endif
      else
        ynorm(ib) = -2.
      endif
      do i=1, nd
        xx(i) = x_data(i,ib)
        if (w_data(i,ib).gt.0) then
          if (iy.eq.xy_ampli.and.y_data(i,ib).gt.0) then
            yy(iba,i) = log(dble(y_data(i,ib)))
          elseif (iy.eq.xy_phase .and. degrees) then
            yy(iba,i) = y_data(i,ib)*pi/180d0
          else
            yy(iba,i) = y_data(i,ib)
          endif
          if (iy.eq.xy_ampli) then
            ww(iba,i) = w_data(i,ib)*y_data(i,ib)**2
            if (ww(iba,i).lt.2e-6) then
              ww(iba,i) = ww(iba,i)/100.
            endif
            yy(iba,i) = yy(iba,i)-ynorm(ib)
          else
            ww(iba,i) = w_data(i,ib)
            yy(iba,i) = yy(iba,i)-ynorm(ib)
          endif
          wnorm = wnorm + ww(i,iba)
        else
          ww(iba,i) = 0
          if (iy.eq.xy_ampli) then
            yy(iba,i) = blank4
          elseif (iy.eq.xy_phase) then
            yy(iba,i) = 0
          endif
        endif
      enddo
      wnorm = wnorm/nd
    endif
  enddo
  nbas = iba
  ! no amplitude or no phase
  if (wnorm.le.0) return
  ! Sort if required:
!! if needed, do it before transposition
!!  if (gr8_random(xx,nd)) then
!!    call gr8_trie(xx,ind,nd,error)
!!    if (error) goto 999
!!    do iba=1,nbas
!!      call gr8_sort(yy(1,iba),wk,ind,nd)
!!      call gr8_sort(ww(1,iba),wk,ind,nd)
!!    enddo
!!  endif
  !
  do ia =1,  nbas
    iba = ibsl(ia)
    if (ly.eq.xy_ampli) then
      do i = 1, nd
        if (yy(ia,i).eq.blank4) then
          bp_samp(isb,ibb,iba,i) = 0
        else
          bp_samp(isb,ibb,iba,i) = yy(ia,i)
        endif
      enddo
      fbp_samp(isb,ibb,iba) = .true.
    elseif (ly.eq.xy_phase) then
      do i = 1, nd
        bp_spha(isb,ibb,iba,i) = yy(ia,i)
      enddo
      fbp_spha(isb,ibb,iba) = .true.
    endif
  enddo
  ! Set number of points and frequencies
  ! Compute "holes" in spectrum and interpolate
  nhole = 0
  counting = .false.
  if (ly.eq.xy_ampli) then
    do i=1,nd
      bp_fsamp(isb,ibb,i) = xx(i)
      if (.not.counting) then
        if (bp_samp(isb,ibb,1,i).eq.0) then
          nhole = nhole + 1
          ifirst(nhole) = i
          counting  = .true.
        endif
      else
        if (bp_samp(isb,ibb,1,i).ne.0) then
          counting  = .false.
          ilast(nhole) = i-1
        endif
      endif
    enddo
    if (counting) ilast(nhole)=nd
    do i=1, nhole
      do ia =1, nbas
        iba = ibsl(ia)
        ym = 0
        yp = 0
        if (ifirst(i).gt.1) then
          ym=bp_samp(isb,ibb,iba,ifirst(i)-1)
        endif
        if (ilast(i).lt.nd) then
          yp=bp_samp(isb,ibb,iba,ilast(i)+1)
        endif
        if (ilast(i).ne.(ifirst(i)-2)) then
          delta = (yp-ym)/(ilast(i)-ifirst(i)+2)
        endif
        if (yp.ne.0.and.ym.ne.0) then
          do j=ifirst(i),ilast(i)
            if (imask.eq.1) then
              bp_samp(isb,ibb,iba,j) = bp_samp(isb,ibb,iba,ifirst(i)-1) &
                                     +(j-ifirst(i)+1)*delta
            else
              bp_samp(isb,ibb,iba,j) = blank4
            endif
          enddo
        endif
      enddo
    enddo
    !
    ! Add an extra extrapolated point
    mynd = nd+1
    bp_fsamp(isb,ibb,mynd) = 2*bp_fsamp(isb,ibb,mynd-1) &
                               -bp_fsamp(isb,ibb,mynd-2)
    do ia =1, nbas
      iba = ibsl(ia)
      if (bp_samp(isb,ibb,iba,mynd-1).ne.blank4.and. &
          bp_samp(isb,ibb,iba,mynd-2).ne.blank4) then
        bp_samp(isb,ibb,iba,mynd) = 2*bp_samp(isb,ibb,iba,mynd-1) &
                                    - bp_samp(isb,ibb,iba,mynd-2)
      else
        bp_samp(isb,ibb,iba,mynd) = blank4
      endif
    enddo
    !
    ! And set number of points
    nbp_samp(isb,ibb) = mynd
  elseif(ly.eq.xy_phase) then
    do i=1,nd
      bp_fspha(isb,ibb,i) = xx(i)
      if (.not.counting) then
        if (bp_spha(isb,ibb,1,i).eq.0) then
          nhole = nhole + 1
          ifirst(nhole) = i
          counting  = .true.
        endif
      else
        if (bp_spha(isb,ibb,1,i).ne.0) then
          counting  = .false.
          ilast(nhole) = i-1
        endif
      endif
    enddo
   if (counting) ilast(nhole)=nd
   do i=1, nhole
      do ia =1, nant
        iba = ibsl(ia)
        ym = 0
        yp = 0
        if (ifirst(i).gt.1) then
          ym=bp_spha(isb,ibb,iba,ifirst(i)-1)
        endif
        if (ilast(i).lt.nd) then
          yp=bp_spha(isb,ibb,iba,ilast(i)+1)
        endif
        if (ilast(i).ne.(ifirst(i)-2)) then
          delta = (yp-ym)/(ilast(i)-ifirst(i)+2)
        endif
        if (yp.ne.0.and.ym.ne.0) then
          do j=ifirst(i),ilast(i)
            if (imask.eq.1) then
              bp_spha(isb,ibb,iba,j) = bp_spha(isb,ibb,iba,ifirst(i)-1) &
                                     +(j-ifirst(i)+1)*delta
            else
              bp_spha(isb,ibb,iba,j) = blank4
            endif
          enddo
        endif
      enddo
    enddo
    !
    ! Add an extra extrapolated point
    mynd = nd+1
    bp_fspha(isb,ibb,mynd) = 2*bp_fspha(isb,ibb,mynd-1) &
                              -bp_fspha(isb,ibb,mynd-2)
    do ia =1, nbas
      iba = ibsl(ia)
      if (bp_spha(isb,ibb,iba,mynd-1).ne.blank4.and. &
          bp_spha(isb,ibb,iba,mynd-2).ne.blank4) then
        bp_spha(isb,ibb,iba,mynd) = 2*bp_spha(isb,ibb,iba,mynd-1) &
                                    - bp_spha(isb,ibb,iba,mynd-2)
      else
        bp_spha(isb,ibb,iba,mynd) = blank4
      endif
    enddo
    !
    ! And set number of points
    nbp_spha(isb,ibb) = mynd
  endif
  !
  if (plot) then
    do ib=1, n_boxes
      iy = i_y(k_y(ib))
      yyy = 0
      if (iy.eq.ly.and..not.skip(ib)) then
        iba = i_base(k_base(ib))
        isb = i_band(k_band(ib))
        ia = r_iant(iba)
        ja = r_jant(iba)
        if (my_do_rf(ia,ibb).and.my_do_rf(ja,ibb)) then
           do i=1, mynd
            if (ly.eq.xy_ampli) then
              yy1 = dble(bp_samp(isb,ibb,iba,i))
              if (yy1.eq.dble(blank4)) then
                yyy(i) = blank8
              else
                yyy(i) = exp(yy1+ynorm(ib))
              endif
              xxx(i) = bp_fsamp(isb,ibb,i)
            elseif (ly.eq.xy_phase) then
              yy1 = dble(bp_spha(isb,ibb,iba,i))
              if (yy1.eq.dble(blank4)) then
                yyy(i) = blank8
              else
                yyy(i) =yy1+ynorm(ib)
              endif
              if (degrees.and.yyy(i).ne.blank8) then
                yyy(i) = yyy(i)*180d0/pi
              endif
              xxx(i) = bp_fspha(isb,ibb,i)
            endif
          enddo
          write(chain,'(I4.4)') ib
          call gr_execl('CHANGE DIRECTORY BOX'//chain)
          error = gr_error()
          if (error) goto 999
          if (ly.eq.xy_phase) then
            turn = 2d0*pi
            if (degrees) turn = 360d0
            call phi_plot(gb1_y(ib),gb2_y(ib),   &
              mynd,xxx,yyy, turn)
          else
            call gr8_connect (mynd,xxx,yyy,blank8,1.0d0)
          endif
          call gr_execl('CHANGE DIRECTORY')
        else
          write(chain,'(I4.4)') ib
          call gr_execl('CHANGE DIRECTORY BOX'//chain)
          xcurs = 0.5*(gb2_x(ib)+gb1_x(ib))
          ycurs = 0.5*(gb2_y(ib)+gb1_y(ib))
          call relocate(xcurs,ycurs)
!          call putlabel(7,"IGNORED",5)
          call gr_execl('CHANGE DIRECTORY')
        endif
      endif
    enddo
  endif
  !
  bp_spectrum_memory = .false.
  return
  !
999 error = .true.
  return
end subroutine solve_pass_spectrum

