subroutine store_cal(line,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  !	Stores a calibration curve, in the source observations,
  !	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 'clic_dheader.inc'
  include 'gbl_pi.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  include 'clic_xy_code.inc'
  ! Local
  logical :: end, store_amp, store_phase
  logical :: self, do_it
  integer(kind=address_length) :: kh, data_in, kin
  integer(kind=data_length)    :: ldata_in, h_offset
  integer :: ib, isb, iy, oscan, nch, ipola
  integer :: ibmin(2), ibmax(2)
  integer :: spline(2,2,2,-mnant:mnbas), pol(2,2,2,-mnant:mnbas)
  integer :: kslot(2,2,2,-mnant:mnbas),pola(2,2,2,-mnant:mnbas)
  integer :: iy1, iy2, ksb, kpol
  integer :: lb, jw1, jw2, i, l, nc1, nc2, irec, jsb, krec
  integer :: kr, ks
  real :: xx, yy(4), coef(0:3), ww
  real :: y2(2,2,2,-mnant:mnbas)
  real :: w2(2,2,2,-mnant:mnbas)
  real*8 :: uvm,snu
  character(len=80) :: ch2,ch1
  character(len=12) :: argum
  integer :: ic_yes, ic_int, ic_intlast, ic_ext, ic_extlast
  integer :: ic_phalast, ic_amplast
  parameter (ic_yes=1, ic_amplast=2, ic_phalast=4,   &
    ic_int=8, ic_intlast=16,   &
    ic_ext=64, ic_extlast=128)
  !
  ! vocabulary
  integer :: mvx, mvoc1,mvoc2, nkey
  parameter (mvx=2, mvoc1=6, mvoc2 = 3)
  character(len=12) :: vx(mvx), kw, voc1(mvoc1), voc2(mvoc2)
  !
  data vx /'AMPLITUDE','PHASE'/
  data voc1/'AVERAGE','DSB','LOWER','LSB','UPPER','USB'/
  data voc2/'HORIZONTAL','VERTICAL','BOTH'/
  data coef/1.,1.,0.5,0.166666667/
  save end
  !------------------------------------------------------------------------
  ! Code:
  ! Y Faut initialiser SNU a zero DANS TOUS LES CAS !!!!!!!!!!!!!
  snu = 0d0
  self = sic_present(5,0)
  lb = l_subb(1)
  jw1 = iw1(1)
  jw2 = iw2(1)
  call check_input_file(error)
  if (error) goto 999
  call check_index(error)
  if (error) goto 999
  call get_first(.false.,error)    ! to initialise ...
  if (error) goto 999
  call check_output_file(error)
  if (error) goto 999
  call check_equal_file(error)
  if (error) goto 999
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) goto 999
  call sic_ke(line,0,1,argum,nch,.false.,error)
  if (error) goto 999
  call sic_ambigs('STORE_CAL',argum,kw,nkey,vx,mvx,error)
  if (error) goto 999
  store_amp = .false.
  store_phase= .false.
  do i=1, 2
    call sic_ke(line,0,i,argum,nch,.false.,error)
    if (error) goto 999
    call sic_ambigs('STORE_CAL',argum,kw,nkey,vx,mvx,error)
    if (error) goto 999
    store_amp = store_amp .or. (kw.eq.'AMPLITUDE')
    store_phase = store_phase  .or. (kw.eq.'PHASE')
  enddo
  if (store_amp .and. store_phase) then
    call message(4,1,'STORE_CAL',   &
      'Storing amplitude and phase calibration curves')
    iy1 = 1
    iy2 = 2
  elseif (store_amp) then
    call message(4,1,'STORE_CAL',   &
      'Storing amplitude calibration curves')
    iy1 = 1
    iy2 = 1
  elseif (store_phase) then
    call message(4,1,'STORE_CAL',   &
      'Storing phase calibration curves')
    iy1 = 2
    iy2 = 2
  endif
  ! Store /receiver krec
  krec = 0
  if (sic_present(6,0)) then
    call sic_i4(line,6,1,krec,.true.,error)
    if (error) goto 999
    if (krec.gt.mnrec .or. krec.lt.1) then
      call message(8,4,'STORE_CAL','Invalid receiver')
      goto 999
    endif
    write(argum(1:2),'(i2)') krec
    call message(6,1,'STORE_CAL',   &
      'Using calibration curves from receiver '//argum(1:2))
  endif
  ! Store /polar kpolar
  kpol = 0
  if (sic_present(7,0).and..not.self) then
    call sic_ke(line,7,1,argum,nch,.true.,error)
    if (error) goto 999
    call sic_ambigs('STORE CAL /POLARISATION',argum,kw,nkey,voc2,   &
      mvoc2,error)
    if (error) goto 999
    if (kw.eq.'HORIZONTAL') then
      kpol = 1
    elseif (kw.eq.'VERTICAL') then
      kpol = 2
    elseif (kw.eq.'BOTH') then
      kpol = 3
    else
      call message(6,3,'STORE_CAL','Invalid polarisation '//argum)
      error = .true.
      return
    endif
    call message(6,1,'STORE_CAL','Using '//cpol(kpol)   &
      //' calibration curves for both polarisation')
  else
    if (new_receivers.and..not.self) then
      call message(6,1,'STORE_CAL',   &
        'Using a specific calibration curve for each polarisation')
    endif
  endif
  !
  ! Stores horizontal polarisation for old receivers
  if (.not.new_receivers) then
    call message(6,1,'STORE_CAL',   &
      'Patching data for old receivers')
    kpol = 1
  endif
  !
  ! Store /band ksb
  ksb = 0
  if (sic_present(1,0)) then
    call sic_ke(line,1,1,argum,nch,.true.,error)
    if (error) goto 999
    call sic_ambigs('STORE CAL /BAND',argum,kw,nkey,voc1,mvoc1,   &
      error)
    if (error) goto 999
    if (kw.eq.'USB' .or. kw.eq.'UPPER') then
      ksb = 1
    elseif (kw.eq.'LSB'.or. kw.eq.'LOWER') then
      ksb = 2
    elseif (kw.eq.'AVERAGE' .or. kw.eq.'DSB') then
      ksb = 3
    else
      call message(6,3,'STORE_CAL','Invalid sideband '//argum)
      error = .true.
      return
    endif
    call message(6,1,'STORE_CAL','Using '//cband(ksb)   &
      //' calibration curves for both sidebands')
  else
    call message(6,1,'STORE_CAL',   &
      'Using a specific calibration curve for each sideband')
  endif
  !
  if (do_amplitude_antenna) then
    ibmin(1) = -r_nant
    ibmax(1) = -1
  else
    ibmin(1) = 1
    ibmax(1) = r_nbas
  endif
  !
  if (do_phase_antenna) then
    ibmin(2) = -r_nant
    ibmax(2) = -1
  else
    ibmin(2) = 1
    ibmax(2) = r_nbas
  endif
  ! current (default) receiver
  irec = r_nrec
  if (krec.ne.0) irec = krec
  !
  !     Check for presence of calibration curve
  do_it = .false.
  if (.not.self) then
    do iy = iy1, iy2
      nc1 = lenc(clab(iy))
      ch1 = 'No '//clab(iy)(1:nc1)//' calibration for '
      nc1 = lenc(ch1)+1
      do ib = ibmin(iy), ibmax(iy)
        if (ib.gt.0) then
          ch2 = ', Baseline '//cbas(ib)
        else
          ch2 = ', Antenna '//char(-ib+ichar('0'))
        endif
        ! (1) one sideband, one polar
        if (ksb.ne.0) then
          if (kpol.ne.0) then
            if (f_spline(iy,ksb,kpol,ib,irec).gt.0) then
              do isb=1,2
                do ipola=1,2
                  spline(iy,isb,ipola,ib) = ksb
                  pol (iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = kpol
                  kslot(iy,isb,ipola,ib) =   &
                    f_spline(iy,ksb,kpol,ib,irec)-1
                enddo
              enddo
              do_it = .true.
            elseif (f_pol(iy,ksb,kpol,ib,irec).gt.0) then
              do isb=1,2
                do ipola=1,2
                  pol (iy,isb,ipola,ib) = ksb
                  spline(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = kpol
                  kslot(iy,isb,ipola,ib) =   &
                    f_pol(iy,ksb,kpol,ib,irec)-1
                enddo
              enddo
              do_it = .true.
            else
              do isb=1,2
                do ipola=1,2
                  pol (iy,isb,ipola,ib) = 0
                  spline(iy,isb,ipola,ib) = 0
                  kslot(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = 0
                enddo
              enddo
              nc2 = lenc(cband(ksb))
              call message(4,2,'STORE_CAL',ch1(1:nc1)   &
                //cband(ksb)(1:nc2)//ch2 )
            endif
          else
            ! (2) one sideband, two polars
            do ipola=1,2
              if (f_spline(iy,ksb,ipola,ib,irec).gt.0) then
                do isb=1,2
                  spline(iy,isb,ipola,ib) = ksb
                  pol (iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = ipola
                  kslot(iy,isb,ipola,ib) =   &
                    f_spline(iy,ksb,ipola,ib,irec)-1
                enddo
                do_it = .true.
              elseif (f_pol(iy,ksb,ipola,ib,irec).gt.0) then
                do isb=1,2
                  pol (iy,isb,ipola,ib) = ksb
                  spline(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = ipola
                  kslot(iy,isb,ipola,ib) =   &
                    f_pol(iy,ksb,ipola,ib,irec)-1
                enddo
                do_it = .true.
              else
                do isb=1,2
                  pol (iy,isb,ipola,ib) = 0
                  spline(iy,isb,ipola,ib) = 0
                  kslot(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = 0
                enddo
                nc2 = lenc(cband(ksb))
                call message(4,2,'STORE_CAL',ch1(1:nc1)   &
                  //cband(ksb)(1:nc2)//ch2 )
              endif
            enddo
          endif
        else
          ! (3) two sidebands, one polar
          if (kpol.ne.0) then
            do ipola=1,2
              do isb= 1,2
                if (f_spline(iy,isb,kpol,ib,irec).gt.0) then
                  spline(iy,isb,ipola,ib) = isb
                  pol (iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = kpol
                  kslot(iy,isb,ipola,ib) =   &
                    f_spline(iy,isb,kpol,ib,irec)-1
                  do_it = .true.
                elseif (f_pol(iy,isb,kpol,ib,irec).gt.0) then
                  pol (iy,isb,ipola,ib) = isb
                  spline(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = kpol
                  kslot(iy,isb,ipola,ib) =   &
                    f_pol(iy,isb,kpol,ib,irec)-1
                  do_it = .true.
                else
                  pol (iy,isb,ipola,ib) = 0
                  spline(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = 0
                  nc2 = lenc(cband(isb))
                  kslot(iy,isb,ipola,ib) = 0
                  call message(4,2,'STORE_CAL',ch1(1:nc1)   &
                    //cband(isb)(1:nc2)//ch2 )
                endif
              enddo
            enddo
          else
            ! (4) two sidebands, two polars (we should not get in that mode)
            do ipola=1,2
              do isb= 1,2
                if (f_spline(iy,isb,ipola,ib,irec).gt.0) then
                  spline(iy,isb,ipola,ib) = isb
                  pol (iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = ipola
                  kslot(iy,isb,ipola,ib) =   &
                    f_spline(iy,isb,ipola,ib,irec)-1
                  do_it = .true.
                elseif (f_pol(iy,isb,ipola,ib,irec).gt.0) then
                  pol (iy,isb,ipola,ib) = isb
                  spline(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = ipola
                  kslot(iy,isb,ipola,ib) =   &
                    f_pol(iy,isb,ipola,ib,irec)-1
                  do_it = .true.
                else
                  pol (iy,isb,ipola,ib) = 0
                  spline(iy,isb,ipola,ib) = 0
                  pola (iy,isb,ipola,ib) = 0
                  nc2 = lenc(cband(isb))
                  kslot(iy,isb,ipola,ib) = 0
                  call message(4,2,'STORE_CAL',ch1(1:nc1)   &
                    //cband(isb)(1:nc2)//ch2 )
                endif
              enddo
            enddo
          endif
        endif
      enddo
    enddo
  else
    ! Self calibration
    do_it = .true.
    ch2 = ' '
    l = 1
    do i=1,l_subb(1)
      ch2 = ch2(1:l)//csub(i_subb(i,1))//' '
      l = l+4
    enddo
    l = lenc(ch2)
    call message(2,1,'STORE_CAL',   &
      'Self calibrating from '//ch2(1:l))
    save_scale = do_scale
    save_flux = do_flux
    save_amplitude = do_amplitude
    save_phase = do_phase
    if (store_amp .and. (do_amplitude .or. .not.do_scale   &
      .or. do_flux)) then
      do_scale = .true.
      do_amplitude = .false.
      do_flux = .false.
    endif
    if (store_phase .and. do_phase) then
      do_phase = .false.
    endif
  endif
  if (.not.do_it) then
    call message (8,4,'STORE_CAL','No calibration curve to store')
    print *,"KSB",ksb,"KPOL",kpol
    goto 999
  endif
  !
  ! Loop on current index
  end = .false.
  oscan = 0
  do while (.not.end)
    !
    ! Check for autocorrelation scans
    if (r_proc.eq.p_pass .or. r_proc.eq.p_skydip   &
      .or. r_proc.eq.p_sky .or. r_proc.eq.p_cal   &
      .or. r_proc.eq.p_onoff .or. r_proc.eq.p_pseudo) goto 98
    !
    ! Store calibration curves
    if (krec.ne.0 .and. krec.ne.r_nrec) then
      irec = krec
    else
      irec = r_nrec
    endif
    call set_corr(error)
    if (error) goto 999
    !
    ! Get data if data is present in file.
    ! [r_ut is not accurate in old data; is patched by COPY; therefore it is
    ! safe to assume that it is OK if COPY HEADERS was done.]
    if (.not.r_presec(file_sec)) then
      call get_data (ldata_in,data_in,error)
      if (error) goto 999
      kin = gag_pointer(data_in,memory)
      kr = r_ndump + 1
      kh = kin + h_offset(kr)
      call decode_header (memory(kh))
      xx = dh_utc/3600.   &
        +(mod(dh_obs+32768,65536)-mod(dobs_0+32768,65536))*24.
    else
      xx = (r_ut/2d0/pi   &
        +(mod(r_dobs+32768,65536)-mod(dobs_0+32768,65536)))*24.
    endif
    !
    ! Get self calibration (possibly from other receiver).
    if (self) then
      call get_self_cal(krec,iy1,iy2,ibmin,ibmax,ksb,y2,w2,error)
      if (error) goto 999
    endif
    !
    do iy = iy1, iy2
      do ib = ibmin(iy), ibmax(iy)
        do isb= 1,2
          do ipola= 1,2
            !
            ks = 0
            ! self calibration: use the first subband set as a reference
            ! works only for the same band
            if (self) then
              if (iy.eq.2) then
                if (irec.ne.r_nrec) then
                  ks = 1
                else
                  ks = 0
                endif
              else
                ks = 0
              endif
              ww = w2(iy,isb,ipola,ib)
              yy(1) = y2(iy,isb,ipola,ib)
              ! Planet Jupiter
              if (planet_model.eq.-3) then
                uvm = sqrt(dh_uvm(1,ib)**2+dh_uvm(2,ib)**2)
                call get_fluxspl(uvm,snu)
              else
                snu = 0.0
              endif
              ! End patch
              do i=2,4
                yy(i) = 0
              enddo
            ! Not Self Calibration
            else
              ww = 1.
              call get_cal(iy,irec,isb,ib,spline(iy,isb,ipola,ib)   &
                ,pol(iy,isb,ipola,ib),pola(iy,isb,ipola,ib),   &
                xx,yy,oscan,error)
              if (error) return
              if (iy.eq.2) then
                if (irec.ne.r_nrec) then
                  ks = 1
                else
                  ks = kslot(iy,isb,ipola,ib)
                endif
              else
                ks = 0
              endif
            endif
            ! baseline based:
            if (iy.eq.1 .and. .not.do_amplitude_antenna) then
              r_aic = iand(r_aic,not(ic_amplast))
              r_ic = ior(r_ic,ic_amplast)
              r_icamp(ipola,isb,ib,ks) = yy(1)*coef(0)
              ! I'm not sure why the following line was omitted, it is needed to use
              ! baseline amp  and antenna phase together.
              r_ic = ior(r_ic,ic_yes)
              r_icdeg = 3
              r_presec(ical_sec)=.true.
            elseif (iy.eq.2 .and. .not.do_phase_antenna) then
              r_aic = iand(r_aic,not(ic_phalast))
              r_ic = ior(r_ic,ic_phalast)
              r_icpha(ipola,isb,ib,ks) = yy(1)*coef(0)
              if (ks.eq.0) then
                r_ic = ior(r_ic,ic_yes+ic_int+ic_intlast)
                r_ic = iand(r_ic,not(ic_extlast))
              else
                r_ic = ior(r_ic,ic_yes+ic_ext+ic_extlast)
                r_ic = iand(r_ic,not(ic_intlast))
              endif
              r_icdeg = 3
              r_presec(ical_sec)=.true.
              !
              ! Jupiter patch
              if (snu.lt.0) then
                r_icpha(ipola,isb,ib,0) = r_icpha(ipola,   &
                  isb,ib,0)+pi
              endif
            endif
            ! Antenna  based:
            if (iy.eq.1 .and. do_amplitude_antenna   &
              .and. ww.gt.0) then
              r_ic = iand(r_ic,not(ic_amplast))
              r_aic = ior(r_aic,ic_amplast)
              ! I'm not sure why the following line was omitted, it is needed to use
              ! baseline amp  and antenna phase together.
              r_aic = ior(r_aic,ic_yes)
              r_aicamp(ipola,isb,-ib,ks) = yy(1)*coef(0)
              r_aicdeg = 3
              r_presec(aical_sec)=.true.
            elseif (iy.eq.2 .and. do_phase_antenna   &
              .and. ww.gt.0) then
              r_ic = iand(r_ic,not(ic_phalast))
              r_aic = ior(r_aic,ic_phalast)
              if (ks.eq.0) then
                r_aic = ior(r_aic,ic_yes+ic_int+ic_intlast)
                r_aic = iand(r_aic,not(ic_extlast))
              else
                r_aic = ior(r_aic,ic_yes+ic_ext+ic_extlast)
                r_aic = iand(r_aic,not(ic_intlast))
              endif
              r_aicpha(ipola,isb,-ib,ks) = yy(1)*coef(0)
              r_aicdeg = 3
              r_presec(aical_sec)=.true.
            endif
          enddo
        enddo
      ! end loop on 'baselines'
      enddo
      ! get rms: loop on TRUE baselines
      do ib = 1, r_nbas
        do isb = 1, 2
          ! forced side band
          if (ksb.ne.0) then
            jsb = ksb
          else
            jsb = isb
          endif
          do ipola = 1, 2
            if (do_amplitude_antenna .or.   &
              do_phase_antenna) then
              if (f_spline(iy,jsb,ipola,-r_iant(ib),irec)   &
                .gt.0) then
                r_aicrms(ipola,isb,ib,iy) =   &
                  rms_spline_ant(iy,jsb,ipola,ib,irec)
              elseif (f_pol(iy,jsb,ipola,-r_iant(ib),irec)   &
                .gt.0) then
                r_aicrms(ipola,isb,ib,iy) =   &
                  rms_pol_ant(iy,jsb,ipola,ib,irec)
              endif
            endif
            if (.not.do_amplitude_antenna .or.   &
              .not.do_phase_antenna) then
              if (f_spline(iy,jsb,ipola,ib,irec).gt.0) then
                r_icrms(ipola,isb,ib,iy) =   &
                  rms_spline_bas(iy,jsb,ipola,ib,irec)
              elseif (f_pol(iy,jsb,ipola,ib,irec).gt.0) then
                r_icrms(ipola,isb,ib,iy) =   &
                  rms_pol_bas(iy,jsb,ipola,ib,irec)
              endif
            endif
          enddo
        enddo
      enddo
    ! end loop on amp, phas
    enddo
    !
    ! Update  scan
    call write_scan (.false.,error)
    if (error) goto 999
    !
    ! Next observation
98  if (sic_ctrlc()) goto 999
    call get_next(end,error)
    if (error) goto 999
  enddo
  do_scale = save_scale
  do_flux = save_flux
  do_amplitude = save_amplitude
  do_phase = save_phase
  return
  !
999 error = .true.
  return
end subroutine store_cal
!
subroutine get_cal(iy,ir,isb,ib,ispline,ipol,pola,x,y,oscan,error)
  use gildas_def
  use gkernel_interfaces
  use classic_api  
  !---------------------------------------------------------------------
  ! Returns in Y the value and derivatives of the calibration curve
  ! at time X,
  ! for baseline IB, side band ISB.
  ! IX = 1 for amplitude and 2 for phase
  !---------------------------------------------------------------------
  integer :: iy                     !
  integer :: ir                     !
  integer :: isb                    !
  integer :: ib                     !
  integer :: ispline                !
  integer :: ipol                   !
  integer :: pola                   !
  real :: x                         !
  real :: y(4)                      !
  integer :: oscan                  !
  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_dheader.inc'
  ! Local
  real*8 :: xx, yy(4), aa(m_pol)
  integer :: jsb, ifail, nk, i
  character(len=80) :: ch
  real :: factor_i, factor_j
  real :: phmul
  !------------------------------------------------------------------------
  ! Code:
  xx = x
  error = .false.
  !
  ! Polarisation
  if (pola.lt.1.or.pola.gt.3) then
    call message (4,3,'GET_CAL','No such polarisation curve stored in memory')
    error = .true.
    return
  endif
  !
  ! Spline
  if (ispline.ne.0) then
    jsb = ispline
  elseif (ipol.ne.0) then
    jsb = ipol
  else
    call message(8,4,'GET_CAL','No calibration for '//cband(isb))
    error = .true.
    return
  endif
  !
  ! Convert from one receiver to the other:
  ! Normally one should also correct for the varying path as a fonction of freq,
  !
  if (iy.eq.2 .and. ir.ne.r_nrec) then
    if (ph_fac(jsb,pola,ib,ir).ne.0) then
      if (jsb.eq.1) then
        phmul = (r_flo1+r_fif1)/ph_fac(jsb,pola,ib,ir)
      elseif (jsb.eq.2) then
        phmul = (r_flo1-r_fif1)/ph_fac(jsb,pola,ib,ir)
      elseif (jsb.eq.3) then
        phmul = r_flo1/ph_fac(jsb,pola,ib,ir)
      endif
    else
      write(ch,'(i1)') ir
      call message(8,4,'GET_CAL',   &
        'Please do a RF passband for receiver '//ch(1:1))
      error = .true.
      return
    endif
  else
    phmul = 1.0
  endif
  !
  ! convert from one sideband to another:
  factor_i = 0.0
  factor_j = 0.0
  if (iy.eq.2 .and. jsb.ne.0 .and. .not. do_phase_ext) then
    if (jsb.ne.isb .or. ir.ne.r_nrec) then
      ! FACTOR_I from average band to target band ISB (current target receiver):
      call band_factor(ib,isb,r_nrec,factor_i,error)
      !
      ! FACTOR_J from average band to origin band JSB (origin receiver IR)
      call band_factor(ib,jsb,ir,factor_j,error)
    endif
  endif
  !
  ! Splines
  if (ispline.ne.0) then
    ifail = 1
    nk = n_knots(iy,jsb,pola,ib,ir)
    if (xx.lt.k_spline(4,iy,jsb,pola,ib,ir)) then
      if (k_spline(4,iy,jsb,pola,ib,ir)-xx .gt. 0.1) then
        if (r_scan.ne.oscan) then
          oscan = r_scan
          write(ch,'(a,1pg10.3,a,1pg10.3,a)')   &
            'Time ',xx,' below limit (',   &
            k_spline(4,iy,jsb,pola,ib,ir),')'
          call message (5,2,'GET_CAL',ch(1:lenc(ch)))
        endif
      endif
      xx = k_spline(4,iy,jsb,pola,ib,ir)
    elseif (xx.gt.k_spline(nk+5,iy,jsb,pola,ib,ir)) then
      if (xx-k_spline(nk+5,iy,jsb,pola,ib,ir).gt.0.1) then
        if (r_scan.ne.oscan) then
          oscan = r_scan
          write(ch,'(a,1pg10.3,a,1pg10.3,a)')   &
            'Time ',xx,' above limit (',   &
            k_spline(nk+5,iy,jsb,pola,ib,ir),')'
          call message (5,2,'GET_CAL',ch(1:lenc(ch)))
        endif
      endif
      xx = k_spline(nk+5,iy,jsb,pola,ib,ir)
    endif
    !
    ! Get spline and derivatives
    call mth_getspd('GET_CAL',nk+8, k_spline(1,iy,jsb,pola,ib,ir),   &
      c_spline(1,iy,jsb,pola,ib,ir), xx, 0, yy, error)
    if (error) return
    yy(2) = 0
    yy(3) = 0
    yy(4) = 0
  !
  ! Polynomials
  elseif (ipol.ne.0) then
    ifail = 1
    if (xx.lt.t_pol(1,iy,jsb,pola,ib,ir)) then
      if (t_pol(1,iy,jsb,pola,ib,ir)-xx .gt. 0.1) then
        if (r_scan.ne.oscan) then
          oscan = r_scan
          write(ch,'(a,1pg10.3,a,1pg10.3,a)')   &
            'Time ',xx,' below limit (',   &
            t_pol(1,iy,jsb,pola,ib,ir),')'
          call message (5,2,'GET_CAL',ch(1:lenc(ch)))
        endif
      endif
      xx = t_pol(1,iy,jsb,pola,ib,ir)
    elseif (xx.gt.t_pol(2,iy,jsb,pola,ib,ir)) then
      if (xx-t_pol(2,iy,jsb,pola,ib,ir).gt.0.1) then
        if (r_scan.ne.oscan) then
          oscan = r_scan
          write(ch,'(a,1pg10.3,a,1pg10.3,a)')   &
            'Time ',xx,' above limit (',   &
            t_pol(2,iy,jsb,pola,ib,ir),')'
          call message (5,2,'GET_CAL',ch(1:lenc(ch)))
        endif
      endif
      xx = t_pol(2,iy,jsb,pola,ib,ir)
    endif
    do i=1, n_pol(iy,jsb,pola,ib,ir)
      aa(i) = c_pol(i,iy,jsb,pola,ib,ir)
    enddo
    xx = ((xx-t_pol(1,iy,jsb,pola,ib,ir))   &
      -(t_pol(2,iy,jsb,pola,ib,ir)-xx))   &
      /(t_pol(2,iy,jsb,pola,ib,ir)-t_pol(1,iy,jsb,pola,ib,ir))
    xx = max(xx,-1d0)
    xx = min(xx,1d0)
    call mth_getpol ('GET_CAL',n_pol(iy,jsb,pola,ib,ir),   &
      aa,xx,yy,error)
    if (error) return
    yy(2) = 0
    yy(3) = 0
    yy(4) = 0
  else
    yy(1) = 0.
    yy(2) = 0
    yy(3) = 0
    yy(4) = 0
  endif
  if (iy.eq.2) then
    yy(1) = (mod((yy(1)-factor_j)+11*pi,2*pi)-pi)*phmul   &
      + factor_i
  endif
  do i=1, 4
    y(i) = yy(i)
  enddo
end subroutine get_cal
!
subroutine band_factor(ib,isb,ir,factor,error)
  use classic_api  
  !---------------------------------------------------------------------
  ! Compute the phase conversion factor (Complex) from band ISB to
  ! Average band, for receiver IR, baseline IB (or antenna -IB)
  ! _ if IR is the current one (IR=R_NREC) then one takes the bandpass data
  !   of the observation;
  ! _ if not, then the bandpass for receiver IR must be in program memory,
  !   or an error occurs.
  !---------------------------------------------------------------------
  integer :: ib                     !
  integer :: isb                    !
  integer :: ir                     !
  real :: factor                    !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  ! Local
  integer :: ia, ja, i
  complex :: z(mnbas), zant(mnant)
  real :: w(mnbas), want(mnant)
  real :: faz
  !-----------------------------------------------------------------------
  !
  if (isb.gt.2) then
    factor = 0.0
  elseif (ir.eq.r_nrec) then
    if (ib.gt.0 .and. r_bpc.ne.0) then
      factor = faz(r_bpcsba(1,isb,ib))
    elseif (ib.gt.0 .and. r_abpc.ne.0) then
      ia = r_iant(ib)
      ja = r_jant(ib)
      factor = faz(r_abpcsba(1,isb,ja)/r_abpcsba(1,isb,ia))
    elseif (ib.lt.0 .and. r_abpc.ne.0) then
      factor = faz(r_abpcsba(1,isb,-ib))
    elseif (ib.lt.0 .and. r_bpc.ne.0) then
      do i=1,r_nbas
        z(i) = r_bpcsba(1,isb,i)
        w(i) = 1.
      enddo
      call antgain(z,w,zant,want)
      factor = faz(zant(-ib))
    !
    ! Note: we assume that if we calibrate phase with no RF done and needed,
    ! the image side band is useless.
    elseif (.not.do_pass) then
      call message(4,1,'GET_CAL','No RF Passband available')
      factor = 1.0
    else
      call message(8,3,'GET_CAL','No RF Passband available')
      error = .true.
      return
    endif
  else
    ! should be the SBA used for the phase calibration
    factor = faz(icsba(isb,ib,ir))
  endif
  return
end subroutine band_factor
!
subroutine get_self_cal(krec,iy1,iy2,ibmin,ibmax,jsb,y2,w2,   &
    error)
  use gildas_def
  use gkernel_interfaces
  use classic_api
  use clic_find
  use clic_rdata
  !---------------------------------------------------------------------
  ! Get self calibration values (from current receiver or receiver krec)
  !---------------------------------------------------------------------
  include 'clic_parameter.inc'
  integer :: krec                   !
  integer :: iy1                    !
  integer :: iy2                    !
  integer :: ibmin(2)               !
  integer :: ibmax(2)               !
  integer :: jsb                    !
  real :: y2(2,2,2,-mnant:mnbas)    !
  real :: w2(2,2,2,-mnant:mnbas)    !
  logical :: error                  !
  ! Global
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'gbl_memory.inc'
  include 'gbl_pi.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  include 'clic_xy_code.inc'
  ! Local
  integer :: kb, kif
  integer(kind=address_length) :: data_in, kin
  integer(kind=address_length) :: kh, kl, kc
  integer(kind=data_length)    :: ldata_in, h_offset, l_offset, c_offset
  integer ::  ib, isb, iy, kr, isb1, isb2
  integer ::  iv, im, nff, jw1, jw2, ix, ir, ia, ja, i, ipola
  integer ::  js, isub, jspw, spw_pol
  integer ::  lb_sel(3,2), i_subsel(mrlband,3,2)
  integer(kind=entry_length) :: iff(2),kx,kxsave
  real :: wt(4,3), vt(4,3), phmul, factor_i, factor_j
  complex :: z(mnbas), zant(mnant)
  real :: w(mnbas), want(mnant)
  character(len=80) :: ch
  real :: y1(2,3,2,-mnant:mnbas)
  real :: w1(2,3,2,-mnant:mnbas)
  logical :: zero_average
  save kxsave
  !-----------------------------------------------------------------------
  ix = xy_time
  jw1 = iw1(1)
  jw2 = iw2(1)
  y1 = 0.
  w1 = 0.
  y2 = 0.
  w2 = 0.
  lb_sel = 0
  i_subsel = 0
  !
  ! patch
  kb = 1
  kif = 1
  if (r_lnsb.eq.1) then
    ib = i_subb(1,1)
    if (ib.gt.mbands) ib = ib-mbands
    isb1 = r_lsband(1,ib)
    isb2 = isb1
  else 
    isb1 = 1
    isb2 = 3
  endif
  isb1=1
  isb2=2
  !
  ! Need to spy the other receiver?
  kxsave = r_xnum
  if (krec.ne.0 .and. krec.ne.r_nrec) then
    !
    nff = 2
    fnum = .false.
    xscan(1) = r_scan
    yscan(1) = r_scan
    xnscan = 1
    fscan = .true.
    xrecei = krec
    call fix(nff,iff,.false.,.false.,error)
    error = .false.
    if (nff.lt.1) then
      call message(4,2,'GET_SELF_CAL',   &
        'Only one receiver available')
      error = .true.
      return
    endif
    kx = iff(1)
    call get_it(kx,error)
    if (error) return
    ir = krec
  else
    ir = r_nrec
  endif
  !
  if (do_pass) then
    if (r_bpc.eq.0.and..not.do_pass_memory   &
      .and. .not.do_pass_antenna.and..not.do_pass_spectrum) then
      call message(6,2,'GET_SELF_CAL',   &
        'No Baseline RF Passband Calibration, data ignored')
      error = .true.
      return
    endif
    if (r_abpc.eq.0.and..not.do_pass_memory   &
      .and. do_pass_antenna.and..not.do_pass_spectrum) then
      call message(6,2,'GET_SELF_CAL',   &
        'No Antenna RF Passband Calibration, data ignored')
      error = .true.
      return
    endif
    call set_pass (r_nsb,r_nband,r_nbas+r_ntri,   &
      r_lntch, passc, passl, error)
    if (error) return
  endif
  if (do_spidx) then
    call set_spidx(r_nsb,r_nband,r_nbas+r_ntri, &
     r_lntch,spidc,spidl,r_spidx,error)
    if (error) return
  endif
  if (do_pass) then
    if (do_spidx) then
      where (passc.ne.blankc)
        factc = passc * spidc
      else where
        factc = blankc
      end where
      where (passl.ne.blankc)
        factl = passl * spidl
      else where
        factl = blankc
      end where
    else
      factc = passc
      factl = passl
    endif
  elseif (do_spidx) then
    factc = spidc
    factl = spidl
  endif
  !
  call get_data (ldata_in,data_in,error)
  if (error) return
  !
  ! Average record only
  kin = gag_pointer(data_in,memory)
  call spectral_dump(kr,0,0)
  kh = kin + h_offset(kr)
  call decode_header (memory(kh))
  call set_scaling(error)
  if (error) return
  !
  ! Build the SPW list to use for each sideband and polarisation.
  ! The /SELF solution is still derived per record, but each call to
  ! ARECORD/BRECORD must see only the SPWs relevant to the requested
  ! sideband and polarisation.
  do js = 1, r_nbb
    jspw = js
    if (jspw.gt.mbands) jspw = jspw-mbands
    if (jspw.le.0 .or. jspw.gt.r_lband) cycle
    do ipola = 1, 2
      if (new_receivers .and. r_lpolmode(jspw).eq.1) then
        spw_pol = r_lpolentry(1,jspw)
        if (spw_pol.ge.1 .and. spw_pol.le.2) then
          if (spw_pol.ne.ipola) cycle
        endif
      endif
      lb_sel(3,ipola) = lb_sel(3,ipola) + 1
      i_subsel(lb_sel(3,ipola),3,ipola) = jspw
      isb = (3-r_sb(jspw))/2
      if (isb.ge.1 .and. isb.le.2) then
        lb_sel(isb,ipola) = lb_sel(isb,ipola) + 1
        i_subsel(lb_sel(isb,ipola),isb,ipola) = jspw
      endif
    enddo
  enddo
  if (r_lmode.eq.1) then       ! correlation only ...
    zero_average = .true.
    if (k_average.eq.1) then
      call line_average (r_lntch,r_nbas,r_lnsb,data_in,   &
        spidl,zero_average,error)
    else
      call cont_average (r_nband,r_nbas,data_in,   &
        spidc,zero_average,error)
    endif
    if (error) return
  endif
  !
  do iy = iy1, iy2
    do ib = ibmin(iy), ibmax(iy)
      if (new_receivers) then
        do ipola=1,2
          !NGRx: need the new parameters in data header (discussed with FG)
          ph_fac(1,ipola,ib,r_nrec) = r_flo1+r_fif1
          ph_fac(2,ipola,ib,r_nrec) = r_flo1-r_fif1
          ph_fac(3,ipola,ib,r_nrec) = r_flo1
        enddo
      else
        do ipola=1,2
          ph_fac(1,ipola,ib,r_nrec) = r_flo1+r_fif1
          ph_fac(2,ipola,ib,r_nrec) = r_flo1-r_fif1
          ph_fac(3,ipola,ib,r_nrec) = r_flo1
        enddo
      endif
      do isb= isb1, isb2
        do ipola=1,2
          if (lb_sel(isb,ipola).le.0) cycle
          do iv=1,4
            do im=1,3
              vt(iv,im) = 0
              wt(iv,im) = 0
            enddo
          enddo
          if (ib.lt.0) then
            call spectral_dump(kr,-ib,0)
            kl = kin + l_offset(kr)
            kc = kin + c_offset(kr)
            call arecord (   &
              r_nsb, r_nband, r_nbas, r_lntch,   &
              memory(kc), memory(kl), factc, factl,   &
              -ib,isb,ipola,kb, kif,lb_sel(isb,ipola),   &
              i_subsel(1,isb,ipola),jw1,jw2,ix,iy,   &
              vt,wt,.false.,error)
            if (error) return
            w1(iy,isb,ipola,ib) = wt(2,2)
            if (iy.eq.1) then
              if (wt(2,2).le.0) then
                y1(iy,isb,ipola,ib) = 0
              else
                y1(iy,isb,ipola,ib) = log(sqrt(vt(2,2)/wt(2,2)))
              endif
            elseif (iy.eq.2) then
              if (wt(2,2).le.0) then
                y1(iy,isb,ipola,ib) = 0
              else
                y1(iy,isb,ipola,ib) = vt(2,2)/wt(2,2)
              endif
            endif
            ! Not needed if JSB is zero (no band-to-band or rec-to-rec conversion)
            if (jsb.gt.0) then
              if (isb.gt.2) then
                icsba(isb,ib,r_nrec) = 1.0
              elseif (do_pass_memory) then
                icsba(isb,ib,r_nrec) = sba(isb,ib,r_nrec)
              elseif (r_abpc.ne.0) then
                icsba(isb,ib,r_nrec) = r_abpcsba(1,isb,-ib)
              elseif (r_bpc.ne.0) then
                do i=1,r_nbas
                  z(i) = r_bpcsba(1,isb,i)
                  w(i) = 1.
                enddo
                call antgain(z,w,zant,want)
                icsba(isb,ib,r_nrec) = zant(-ib)
              else
                call message(8,2,'GET_SELF_CAL',   &
                  'No RF Passband available')
              endif
            endif
          else
            call spectral_dump(kr,0,ib)
            kl = kin + l_offset(kr)
            kc = kin + c_offset(kr)
            call brecord (   &
              r_nsb, r_nband, r_nbas+r_ntri, r_lntch,   &
              memory(kc), memory(kl), factc, factl,   &
              ib,isb,ipola,kb,kif,lb_sel(isb,ipola),   &
              i_subsel(1,isb,ipola),jw1,jw2,ix,iy,   &
              vt,wt,error)
            if (error) return
            w1(iy,isb,ipola,ib) = wt(2,2)
            if (wt(2,2).le.0) then
              y1(iy,isb,ipola,ib) = 0
            else
              y1(iy,isb,ipola,ib) = vt(2,2)/wt(2,2)
            endif
            ! side band averages
            ! Not needed if JSB is zero (no band-to-band or rec-to-rec conversion)
            if (jsb.gt.0) then
              if (isb.gt.2) then
                icsba(isb,ib,r_nrec) = 1.0
              elseif (do_pass_memory) then
                icsba(isb,ib,r_nrec) = sba(isb,ib,r_nrec)
              elseif (r_bpc.ne.0) then
                icsba(isb,ib,r_nrec) = r_bpcsba(1,isb,ib)
              elseif (r_abpc.ne.0) then
                ia = r_iant(ib)
                ja = r_jant(ib)
                icsba(isb,ib,r_nrec) =   &
                  r_abpcsba(1,isb,ja)/r_abpcsba(1,isb,ia)
              else
                call message(8,2,'GET_SELF_CAL',   &
                  'No RF Passband available')
              endif
            endif
          endif
        enddo
      enddo
    enddo
  enddo
  !
  if (r_xnum.ne.kxsave) then
    call get_it(kxsave,error)
  endif
  !
  ! Phase (Iy=2) specifics:
  ! Convert from one receiver to the other (IR = origin receiver):
  ! Normally one should also correct for the varying path as a fonction of freq,
  !
  do iy=iy1, iy2
    if (iy.eq.1) then
      do ib = ibmin(iy), ibmax(iy)
        do isb= 1,2
          do ipola=1,2
            w2(1,isb,ipola,ib) = w1(1,isb,ipola,ib)
            y2(1,isb,ipola,ib) = y1(1,isb,ipola,ib)
          enddo
        enddo
      enddo
    else
      do ib = ibmin(iy), ibmax(iy)
        if (new_receivers) then
          do ipola=1,2
            !     Need the new parameters in data header (discussed with FG)
            ph_fac(1,ipola,ib,r_nrec) = r_flo1+r_fif1
            ph_fac(2,ipola,ib,r_nrec) = r_flo1-r_fif1
            ph_fac(3,ipola,ib,r_nrec) = r_flo1
          enddo
        else
          do ipola=1,2
            ph_fac(1,ipola,ib,r_nrec) = r_flo1+r_fif1
            ph_fac(2,ipola,ib,r_nrec) = r_flo1-r_fif1
            ph_fac(3,ipola,ib,r_nrec) = r_flo1
          enddo
        endif
        do isb= 1,2
          do ipola=1,2
            !
            ! in that case, JSB must not be Zero...
            if (ir.ne.r_nrec) then
              if (ph_fac(jsb,ipola,ib,ir).ne.0) then
                phmul = ph_fac(isb,ipola,ib,r_nrec)/   &
                  ph_fac(jsb,ipola,ib,ir)
              else
                write(ch,'(i1)') ir
                call message(8,4,'GET_SELF_CAL',   &
                  'Please do a RF passband for receiver '   &
                  //ch(1:1))
                error = .true.
                return
              endif
            else
              phmul = 1.0
            endif
            !
            ! convert from one sideband to another:
            factor_i = 0.0
            factor_j = 0.0
            if (jsb.ne.0 .and. .not. do_phase_ext) then
              if (jsb.ne.isb .or. ir.ne.r_nrec) then
                ! FACTOR_I from average band to target band ISB (current target receiver):
                call band_factor(ib,isb,r_nrec,factor_i,error)
                !
                ! FACTOR_J from average band to origin band JSB (origin receiver IR)
                call band_factor(ib,jsb,ir,factor_j,error)
              endif
              y2(2,isb,ipola,ib) =   &
                (mod(y1(2,jsb,ipola,ib)-factor_j+11*pi,2*pi)-pi)   &
                *phmul + factor_i
            else
              y2(2,isb,ipola,ib) = y1(2,isb,ipola,ib)
            endif
            w2(2,isb,ipola,ib) = w1(2,isb,ipola,ib)
          enddo
        enddo
      enddo
    endif
  enddo
  return
end subroutine get_self_cal
