subroutine clic_modify(line,error)
  use gildas_def
  use gkernel_interfaces
  !---------------------------------------------------------------------
  ! Command MODIFY args
  ! options :
  ! 1 	/BEFORE
  ! 2 	/AFTER
  ! 3	[ANTENNA|BASELINE] /OFFSET
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_display.inc'
  ! Local
  logical :: end, do_data, do_write
  integer :: mvocab, nkey, nch
  parameter (mvocab=22)
  character(len=12) :: vocab(mvocab), argum, keywor
  ! Data
  data vocab/   &
    'BASELINE',    'HEADER',  'RECORD',   'FREQUENCIES',       &  !4
    'FLUX',        'SCALE',   'DOPPLER',  'REFERENCE',         &  !8
    'SIGN_PHASE',  'ANTENNA', 'VELOCITY', 'POSITION',          &  !12
    'TIME',        'DATA',    'DELAY',    'CABLE',             &  !16
    'BUG',         'AXES_OFFSET',         'TELESCOPE', 'FOCUS',&  !20
    'SPIDX',       'PHASE' /                                      !22
  !------------------------------------------------------------------------
  ! Code:
  call check_input_file(error)
  if (error) return
  call check_index(error)
  if (error) return
  call check_output_file(error)
  if (error) return
  !
  ! Get argument
  call sic_ke(line,0,1,argum,nch,.true.,error)
  if (error) return
  call sic_ambigs('MODIFY',argum,keywor,nkey,vocab,mvocab,error)
  ! Variable
  if (error) return
  !
  ! Get first observation
  call get_first(.true.,error)
  if (error) return
  !
  !      GOTO (1,2,3,4,5,6,7,8,6,1,9,10,11,3,12,13,18,19) NKEY
  ! Baseline & Antenna
  if (keywor.eq.'BASELINE' .or. keywor.eq.'ANTENNA') then
    call ini_base(line,0,error)
    if (error) return
  ! Header
  elseif (keywor.eq.'HEADER') then
    call ini_header(line,0,error)
    if (error) return
  ! Record & Data
  elseif (keywor.eq.'RECORD' .or. keywor.eq.'DATA') then
    call ini_data(line,0,error)
    if (error) return
  !
  ! Frequencies
  elseif (keywor.eq.'FREQUENCIES') then
    call ini_freq(line,0,error)
    if (error) return
  ! Flux
  elseif (keywor.eq.'FLUX') then
    call ini_flux(line,0,error)
    if (error) return
  ! Scale & Phase_Sign
  elseif (keywor.eq.'SCALE' .or. keywor.eq.'SIGN_PHASE') then
    call ini_scale(line,0,error)
    if (error) return
  ! Doppler
  elseif (keywor.eq.'DOPPLER') then
    call ini_doppler(line,0,error)
    if (error) return
  ! Reference channel
  elseif (keywor.eq.'REFERENCE') then
    call ini_reference(line,0,error)
    if (error) return
  ! Velocity
  elseif (keywor.eq.'VELOCITY') then
    call ini_velocity(line,0,error)
    if (error) return
  ! Position
  elseif (keywor.eq.'POSITION') then
    call ini_position(line,0,error)
    if (error) return
  ! Time
  elseif (keywor.eq.'TIME') then
    call ini_time(line,0,error)
    if (error) return
  ! Delay
  elseif (keywor.eq.'DELAY') then
    call ini_delay(line,0,error)
    if (error) return
  ! Cable
  elseif (keywor.eq.'CABLE') then
    call ini_cable(line,0,error)
    if (error) return
  ! Focus
  elseif (keywor.eq.'FOCUS') then
    call ini_focus(line,0,error)
    if (error) return
  ! Bug
  elseif (keywor.eq.'BUG') then
    call ini_bug(line,0,error)
    if (error) return
  ! Axes
  elseif (keywor.eq.'AXES_OFFSET') then
    call ini_axes(line,0,error)
    if (error) return
  ! Telescope
  elseif (keywor.eq.'TELESCOPE') then
    call ini_telescope(line,0,error)
    if (error) return
  ! Spectral index
  elseif (keywor.eq.'SPIDX') then
    call ini_spidx(line,0,error)
    if (error) return
  ! Phase
  elseif (keywor.eq.'PHASE') then
    call ini_phase(line,0,error)
    if (error) return
  ! Other
  else
    call message(6,3,'CLIC_MODIFY',keywor//' not implemented')
    error = .true.
    return
  endif
  !
  ! For delays and phases stop there if /NOWRITE
  if ((keywor.eq.'DELAY'.and.sic_present(13,0)).or. &
      (keywor.eq.'PHASE'.and.sic_present(13,0))) then
    call message(6,1,'CLIC_MODIFY',' No data update')
    return
  endif
  !
  ! Loop on current index
  end = .false.
  do_write = .true.
  do_data = .false.
  do while (.not.end)
    if (keywor.eq.'BASELINE' .or. keywor.eq.'ANTENNA') then
      call mod_base(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'HEADER') then
      call mod_header(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'RECORD') then
      call mod_data_r(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'FREQUENCIES') then
      call mod_freq(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'FLUX') then
      call mod_flux(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'SCALE' .or. keywor.eq.'SIGN_PHASE') then
      call mod_scale(argum,do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'DOPPLER') then
      call mod_doppler(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'REFERENCE') then
      call mod_reference(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'VELOCITY') then
      call mod_velocity(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'POSITION') then
      call mod_position(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'TIME') then
      call mod_time(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'DATA') then
      call mod_data_a(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'DELAY') then
      call mod_delay(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'CABLE') then
      call mod_cable(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'FOCUS') then
      call mod_focus(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'BUG') then
      call mod_bug(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'AXES_OFFSET') then
      call mod_axes(do_write,do_data,error)
      if (error) return
    elseif (keywor.eq.'TELESCOPE') then
      call mod_telescope(error)
      if (error) return
    elseif (keywor.eq.'SPIDX') then
      call mod_spidx(error)
      if (error) return
    elseif (keywor.eq.'PHASE') then
      call mod_phase(do_write,do_data,error)
      if (error) return
    endif
    !
    ! Next observation
    if (do_write) call write_scan (do_data,error)
    if (error) return
    if (sic_ctrlc()) error = .true.
    call get_next(end,error)
    if (error) return
  enddo
  return
error = .true.
  return
!
end subroutine clic_modify
!
subroutine ini_header(line,iopt,error)
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY HEADER [procedure]
  !	Execute a SIC procedure (involving variables) for
  !	each header read in the index, and rewrite.
  !	default is "HEADER.CLIC"
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  ! Local
  common /modify/ loaded
  logical :: do_write, do_data, local_do_data
  integer :: nch
  integer(kind=data_length)    :: ndata
  integer(kind=address_length) :: data_in
  logical :: loaded, end
  character(len=160) :: command
  save command,local_do_data
  !------------------------------------------------------------------------
  ! Code:
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  call sic_ch(line,iopt,2,command,nch,.true.,error)
  if (error) return
  local_do_data = .true.
  if (sic_present(11,0))  local_do_data = .false.
  if (.not.loaded) then
    call load_modify
    loaded = .true.
  endif
  return
  !
entry mod_header(do_write,do_data,error)
  ! Get storage and data
  if (write_mode.eq.'NEW') call get_data (ndata,data_in,error)
  if (error) return
  end = .false.
  do_write = .false.
  do_data = local_do_data
  call exec_modify('@ '//command(1:lenc(command)),end,do_write)
  if (.not.end) then
    call message(8,4,'MOD_HEADER','Operation aborted')
    error = .true.
    return
  endif
  return
!
end subroutine ini_header
!
subroutine ini_data(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_rdata
  !---------------------------------------------------------------------
  ! 	MODIFY DATA [procedure] /ATM
  !	Execute a SIC command procedure (involving variables) for
  !	each data average record read in the index, and rewrite.
  !	default is "DATA.CLIC"
  ! 	MODIFY RECORD [procedure]
  !       same thing but every data record ...
  ! 24-oct-01, RM: add possibility to modify record by record :
  !       MODIFY RECORD [procedure]  /record idump
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  include 'gbl_memory.inc'
  common /modify/ loaded
  ! Local
  logical :: do_write, do_data
  integer(kind=address_length) :: data_in, kin, ipk
  integer(kind=data_length)    :: ndata, h_offset
  integer :: i, ir, k, isb, ib, nch
  logical :: loaded, end, atm_rec
  real*8 :: t, before, after, test
  character(len=160) :: command
  character(len=80) :: chain
  integer :: idump,irmin,irmax
  !
  save atm_rec
  save before,after
  save command
  ! RM
  save irmin,irmax
  ! Data
  data before/32767./, after/-32768./
  !------------------------------------------------------------------------
  ! Code:
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  if (.not.do_write_data) then
    call message (8,4,'INI_DATA',   &
      'MODIFY DATA needs the SET WRITE DATA mode')
    error = .true.
    return
  endif
  command = 'DATA'
  ! /BEFORE date time
  if (sic_present(1,1)) then
    call sic_ke(line,1,1,chain,nch,.true.,error)
    if (error) return
    call cdate(chain,i,error)
    t = 0.
    call sic_ke(line,1,2,chain,nch,.false.,error)
    if (error) return
    call sic_sexa(chain,lenc(chain),t,error)
    before = t/24d0 + i        ! in days
  else
    before = 32767.
  endif
  ! /AFTER date time
  if (sic_present(2,1)) then
    call sic_ke(line,2,1,chain,nch,.true.,error)
    if (error) return
    call cdate(chain,i,error)
    t = 0.
    call sic_ke(line,2,2,chain,nch,.false.,error)
    if (error) return
    call sic_sexa(chain,lenc(chain),t,error)
    after = t/24d0 + i         ! in days
  else
    after = -32768.
  endif
  call sic_ch(line,iopt,2,command,nch,.true.,error)
  if (error) return
  if (.not.loaded) then
    call load_modify
    loaded = .true.
  endif
  ! /RECORD idump
  idump = 0
  irmin = 1
  irmax = r_ndump
  if (sic_present(4,1)) then
    call sic_i4(line,4,1,idump,.true.,error)
    if (error) return
    irmin = idump
    irmax = idump
  endif
  ! /ATM
  if (sic_present(6,0)) then
    atm_rec = .true.
    call message(4,1,'INI_DATA',   &
      'Modifying atm. phase corrected record')
  else
    atm_rec = .false.
    call message(4,1,'INI_DATA',   &
      'Modifying no atm. average record')
  endif
  return
  !
entry mod_data_r(do_write,do_data,error)
  ! Prepare passband
  if (do_pass) call set_pass (r_nsb,r_nband,r_nbas+r_ntri,   &
    r_lntch, passc, passl, error)
  if (error) return
  call get_data (ndata,data_in,error)
  if (irmin.ne.irmax) irmax = r_ndump
  if (error) return
  do_data = .true.
  ! Loop on records (not including average record)
  do ir = irmin, irmax
    !
    ! Next record
    ipk = gag_pointer(data_in,memory)+h_offset(ir)
    call decode_header(memory(ipk))
    test = dble(dh_obs)+dh_utc/86400.d0
    if (test.le.before .and. test.gt.after) then
      ipk = ipk + r_ldpar
      k = 1
      do ib = 1, r_nbas
        do isb=1, r_nsb
          call r4tor4 (memory(ipk),datac(k),2*r_nband)
          k = k + r_nband
          ipk = ipk+2*r_nband
        enddo
      enddo
      call data_variables(.true.)
      call data_variables(.false.)
      end = .false.
      do_write = .false.
      call exec_modify('@ '//command(1:lenc(command)),   &
        end,do_write)
      if (.not.end) then
        call message(8,4,'MOD_HEADER','Operation aborted')
        error = .true.
        return
      endif
      ipk = gag_pointer(data_in,memory)+h_offset(ir)
      call encode_header (memory(ipk))
      ipk = ipk + r_ldpar
      k = 1
      do ib = 1, r_nbas
        do isb=1, r_lnsb
          call r4tor4 (datac(k),memory(ipk),2*r_nband)
          k = k + r_nband
          ipk = ipk+2*r_nband
        enddo
      enddo
    endif
  enddo
  do_data = .true.
  return
  !
entry mod_data_a(do_write,do_data,error)
  ! Prepare passband
  if (do_pass) call set_pass (r_nsb,r_nband,r_nbas+r_ntri,   &
    r_lntch, passc, passl, error)
  if (error) return
  call get_data (ndata,data_in,error)
  if (error) return
  kin = gag_pointer(data_in,memory)
  do_data = .true.
  ! Get only average record
  if (atm_rec) then
    if (r_ndatl.eq.2) then
      ir = r_ndump + 2
    else
      call message(6,3,'MOD_HEADER',   &
        'no pha. corrected average record')
      error = .true.
      return
    endif
  else
    ir = r_ndump + 1
  endif
  ipk = kin + h_offset(ir)
  call decode_header(memory(ipk))
  test = dble(dh_obs)+dh_utc/86400.d0
  if (test.le.before .and. test.gt.after) then
    ipk = ipk + r_ldpar
    k = 1
    do ib = 1, r_nbas
      do isb=1, r_nsb
        call r4tor4 (memory(ipk),datac(k),2*r_nband)
        k = k + r_nband
        ipk = ipk+2*r_nband
      enddo
    enddo
    ! line data on average record
    k = 1
    do ib = 1, r_nbas
      do isb=1, r_lnsb
        call r4tor4 (memory(ipk),datal(k),2*r_lntch)
        k = k + r_lntch
        ipk = ipk+2*r_lntch
      enddo
    enddo
    call data_variables(.true.)
    call data_variables(.false.)
    end = .false.
    do_write = .false.
    call exec_modify('@ '//command(1:lenc(command)),   &
      end,do_write)
    if (.not.end) then
      call message(8,4,'MOD_HEADER','Operation aborted')
      error = .true.
      return
    endif
    kin = data_in + h_offset(ir)*4
    ipk = gag_pointer(kin,memory)
    call encode_header (memory(ipk))
    ipk = ipk + r_ldpar
    k = 1
    do ib = 1, r_nbas
      do isb=1, r_nsb
        call r4tor4 (datac(k),memory(ipk),2*r_nband)
        k = k + r_nband
        ipk = ipk+2*r_nband
      enddo
    enddo
    k = 1
    do ib = 1, r_nbas
      do isb=1, r_lnsb
        call r4tor4 (datal(k),memory(ipk),2*r_lntch)
        k = k + r_lntch
        ipk = ipk+2*r_lntch
      enddo
    enddo
    do_data = .true.
  endif
  return
end subroutine ini_data
!
subroutine ini_reference(line,iopt,error)
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY REFERENCE UPPER|LOWER r1 r2 r3 r4
  ! 	       VELOCITY  UPPER|LOWER v1 v2 v3 v4
  !	       NOTHING
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  logical :: do_write, do_data
  integer :: i, nref(2), j, ij, nch, mvoc1
  parameter (mvoc1=2)
  real*4 :: new_ref(2,mrlband)
  character(len=12) :: arg, arg1
  character(len=80) :: chain
  !------------------------------------------------------------------------
  ! Code:
  call check_equal_file(error)
  if (error) return
  call sic_ke(line,iopt,1,arg1,nch,.false.,error)
  if (error) return
  i=1
  j = 0
  nref(1) = 0
  nref(2) = 0
  do while (sic_present(iopt,i+1))
    call sic_ke(line,iopt,i+1,arg,nch,.false.,error)
    if (error) return
    if (arg(1:1).eq.'U') then
      if (j.gt.0) nref(j) = ij
      j = 1
      ij = 0
    elseif (arg(1:1).eq.'L') then
      if (j.gt.0) nref(j) = ij
      j = 2
      ij = 0
    elseif (j.gt.0) then
      call sic_r4(line,iopt,i+1,new_ref(j,ij+1),.true.,error)
      if (error) return
      ij = ij + 1
    endif
    i = i + 1
  enddo
  if (j.gt.0) then
    nref(j) = ij
  else
    error = .true.
    return
  endif
  if (arg1.eq.'R') then
    call message (6,1,'INI_REFERENCE',   &
      'Modifying reference channels to :')
  endif
  if (nref(1).gt.0) then
    write(chain,*) 'UPPER ',(new_ref(1,i),i=1,nref(1))
    call message(6,1,'INI_REFERENCE',chain(1:lenc(chain)))
  endif
  if (nref(2).gt.0) then
    write(chain,*) 'LOWER ',(new_ref(2,i),i=1,nref(2))
    call message(6,1,'INI_REFERENCE',chain(1:lenc(chain)))
  endif
  return
  !
entry mod_reference(do_write,do_data,error)
  do i=1, 2
    if (nref(i).gt.0) then
      do j=1, min(nref(i),r_lband)
        r_lrch(i,j) = new_ref(i,j)
      enddo
    endif
  enddo
  return
end subroutine ini_reference
!
subroutine ini_velocity(line,iopt,error)
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY VELOCITY value
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  logical :: do_write, do_data
  real*4 :: new_vel
  character(len=80) :: chain
  save new_vel
  ! Data
  data new_vel/0.0/
  !------------------------------------------------------------------------
  ! Code:
  call check_equal_file(error)
  if (error) return
  call sic_r4(line,iopt,2,new_vel,.true.,error)
  if (error) return
  write(chain,*) new_vel,' km/s LSR'
  call message (6,1,'INI_VELOCITY',   &
    'Modifying velocity to '//chain(1:lenc(chain)))
  return
  !
entry mod_velocity(do_write,do_data,error)
  ! Doesm't depend on side band ...
  r_restf = r_restf+(new_vel-r_veloc)*r_restf/299792.458
  r_veloc = new_vel
  call vel_scale
  return
end subroutine ini_velocity
!
subroutine ini_flux(line,iopt,error)
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY FLUX new_value
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  logical :: do_write, do_data
  real*4 :: new_flux
  !------------------------------------------------------------------------
  save new_flux
  ! Data
  data new_flux/0.0/
  ! Code:
  call check_equal_file(error)
  if (error) return
  call sic_r4(line,iopt,2,new_flux,.true.,error)
  if (error) return
  if (new_flux.le.0) then
    call message (8,4,'INI_FLUX','Invalid argument')
    error = .true.
    return
  endif
  return
  !
entry mod_flux(do_write,do_data,error)
  r_flux = new_flux
  return
end subroutine ini_flux
!
subroutine ini_freq(line,iopt,error)
  use classic_api
  !---------------------------------------------------------------------
  ! MODIFY FREQUENCIES
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  ! Local
  logical :: do_write, do_data
  integer :: isb, isub
  !------------------------------------------------------------------------
  ! Code:
  call check_equal_file(error)
  if (error) return
  return
  !
entry mod_freq(do_write,do_data,error)
  do isb=1, 2
    if (c_line(isb).ne.'*') then
      r_crfoff(isb) = c_freq(isb)
      r_cnam(isb) = c_line(isb)
    elseif (r_restf.gt.0) then
      r_crfoff(isb) = r_restf
      r_cnam(isb) = r_line
    else
      r_crfoff(isb) = 100000.
      r_cnam(isb) = 'DUMMY'
    endif
    do isub=1, r_lband
      if (l_line(isub,isb).ne.'*') then
        r_lrfoff(isb,isub) = l_freq(isub,isb)
        r_lnam(isb,isub) = l_line(isub,isb)
      elseif (r_restf.gt.0) then
        r_lrfoff(isb,isub) = r_restf
        r_lnam(isb,isub) = r_line
      else
        r_lrfoff(isb,isub) = 100000.
        r_lnam(isb,isub) = 'DUMMY'
      endif
    enddo
  enddo
  call vel_scale
  return
end subroutine ini_freq
!
subroutine ini_scale(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! Command MODIFY SCALE amplitude phase
  ! Multiply all data by the given scale factor (complex)
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  include 'clic_display.inc'
  include 'gbl_memory.inc'
  ! Local
  integer(kind=address_length) :: data_in, kin, ipk
  integer(kind=data_length)    :: ndata, l_offset, c_offset
  character(len=*) :: arg
  logical :: do_write, do_data
  integer :: nch, ir, ibas, isb, is
  character(len=80) :: chain
  character(len=4) :: arg1
  real*4 :: amp_factor, phase_factor
  complex :: factor
  save amp_factor, phase_factor, factor
  !------------------------------------------------------------------------
  ! Code:
  call sic_ke(line,iopt,1,arg1,nch,.false.,error)
  if (error) return
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  error = .false.
  if (arg1.eq.'SCAL') then
    phase_factor = 0.
    call sic_r4(line,iopt,2,amp_factor,.true.,error)
    if (error) return
    call sic_r4(line,iopt,3,phase_factor,.false.,error)
    if (error) return
    if (degrees) then
      phase_factor = phase_factor * pi / 180.
    endif
    factor = amp_factor * exp(cmplx(0.,phase_factor))
    call message(6,1,'INI_SCALE','Multiplying data by : ')
    write(chain,'(2(a,1pg12.5),a,2(1pg12.5))')   &
      ' Amplitude : ',amp_factor,'   Phase : ',phase_factor,   &
      '   Complex : ',factor
    call message(6,1,'INI_SCALE',chain(1:lenc(chain)))
  else
    if (.not.do_write_data) then
      call message (8,4,'INI_DATA',   &
        'MODIFY PHASE_SIGN needs the SET WRITE DATA mode')
      error = .true.
      return
    endif
    write (chain,*) 'Changing the sign of all phases'
    call message(6,1,'INI_SCALE',chain(1:lenc(chain)))
  endif
  return
  !
entry mod_scale(arg,do_write,do_data,error)
  !
  ! Get storage and data
  call get_data (ndata,data_in,error)
  if (error) return
  !
  ! Loop on records
  kin = gag_pointer(data_in,memory)
  do ir = 1, r_ndump + max(1,r_ndatl)
    ipk = kin + c_offset(ir)
    call sub_scale(arg,r_ldatc/2,factor,memory(ipk))
  enddo
  ! line data
  do ir = 1, max(1,r_ndatl)
    ipk = kin + l_offset(r_ndump+ir)
    call sub_scale(arg,r_ldatl/2,factor,memory(ipk))
  enddo
  !
  !     Save factors
  !
  !     This is most probably ly unused, and is wrong for the phases
  !     (adding a phase factor to all phases will destroy the closure
  !     relations).
  !
  do ibas = 1, r_nbas
    do isb = 1, 2
      do is =1, r_nband
        r_dmcamp(isb,ibas,is) = r_dmcamp(isb,ibas,is   &
          ) * amp_factor
        r_dmcpha(isb,ibas,is) = r_dmcpha(isb,ibas,is   &
          ) + phase_factor
      enddo
      do is = 1, r_lband
        r_dmlamp(isb,ibas,is) = r_dmlamp(isb,ibas,is   &
          ) * amp_factor
        r_dmlpha(isb,ibas,is) = r_dmlpha(isb,ibas,is   &
          ) + phase_factor
      enddo
    enddo
  enddo
  do_data = .true.
  return
end subroutine ini_scale
!
subroutine sub_scale(arg,n,f,c)
  !---------------------------------------------------------------------
  ! Multiply complex array C of length N by factor F, or take its complex
  !  conjugate, according to ARG.
  !---------------------------------------------------------------------
  character(len=*) :: arg           !
  integer :: n                      !
  complex :: f                      !
  complex :: c(n)                   !
  ! Local
  integer :: i
  !------------------------------------------------------------------------
  ! Code:
  if (arg(1:2).eq.'SC') then
    do i=1, n
      c(i) = c(i) * f
    enddo
  elseif (arg(1:2).eq.'PH') then
    do i=1, n
      c(i) = conjg(c(i))
    enddo
  endif
  return
end subroutine sub_scale
!
subroutine ini_doppler(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! Command MODIFY DOPPLER
  ! Recompute Doppler correction
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'gbl_pi.inc'
  include 'clic_display.inc'
  ! Local
  logical :: do_write, do_data
  logical :: old
  integer :: nh, isub, isb, sky(2), nch, nt
  real*8 :: dop, lsr, test, corr, svec(3), f100mhz
  real*8 :: c, s_2(2), s_3(3), x_0(3), ut, parang
  parameter (c=299792.458d0)
  character(len=80) :: chain
  character(len=3) :: argum
  character(len=2) :: cs(7),cv(4)
  !
  save old
  !
  data cs /'UN','EQ','GA','HO','BD','EC','DA'/
  data cv /'LS','HE','EA','NU'/
  data sky/+1,-1/              ! Usb, Lsb
  data old/.false./
  !------------------------------------------------------------------------
  !
  ! Code:
  if (write_mode.eq.'UPDA') then
    call check_equal_file(error)
    if (error) return
  else
    call message(8,4,'MOD_DOPPLER','Write Mode must be UPDATE')
    error = .true.
    return
  endif
  argum = '*'
  call sic_ke(line,iopt,2,argum,nch,.false.,error)
  if (error) return
  old = argum(1:3).eq.'OLD'    ! actually VERY old ....
  return
  !
entry mod_doppler(do_write,do_data,error)
  ! Set time
  ut = mod(r_dobs+32768,65536)-32768+2460549.5d0+r_ut/2d0/pi
  !
  ! new subroutine calls from astro
  call do_astro_time(ut, 0.0d0, 56.184d0, error)
  if (error) return
  call do_object(cs(r_typec), r_epoch, r_lam, r_bet,   &
    s_2, s_3, dop, lsr, svec, x_0, parang, error)
  if (r_typev .eq. 1) then
    corr = dop + lsr
  elseif (r_typev .eq. 2) then
    corr = dop
  else
    corr = 0
  endif
  r_doppl = (corr + r_veloc) / c
  write(chain,'(2A3,4(A,1PG12.5))')   &
    cs(r_typec), cv(r_typev),' DOP ',   &
    dop,' LSR ', lsr,' COR ',corr,' FACT ', r_doppl
  call message(4,1,'MOD_DOPPLER',chain(1:lenc(chain)))
  nt = 1
  if (r_flo1.gt.200000.) nt = 3
  nh = nint((r_flo1/nt+100.175*r_lock)/r_flo1_ref)
  ! compute f100mhz since it was not so constant after all... (2001-10-15)
  f100mhz = (nh*r_flo1_ref-r_flo1/nt)/r_lock
  if (f100mhz .gt. 100.175) then
    f100mhz = 100.25d0
  else
    f100mhz = 100.09765625d0
  endif
  ! now check that it works exactly ...
  nh = nint((r_flo1/nt+r_lock*f100mhz)/r_flo1_ref)
  test = (r_flo1_ref*nh-r_lock*f100mhz)*nt
  if ((abs(test-r_flo1)/test).gt.1d-10) then
    write(chain,*) 'Wrong FLO1 ',r_flo1, test
    call message(6,2,'MOD_DOPPLER',chain(1:lenc(chain)))
  endif
  do isb = 1, 2
    !
    ! Continuum
    if (c_line(isb).ne.'*') then
      r_crfoff(isb) = c_freq(isb)
      r_cnam(isb) = c_line(isb)
    elseif (r_restf.gt.0) then
      r_crfoff(isb) = r_restf
      r_cnam(isb) = r_line
    else
      r_crfoff(isb) = 100000.
      r_cnam(isb) = 'DUMMY'
    endif
    r_crfres(isb) = -sky(isb)*50.  ! channel width
    r_cvoff(isb) = r_veloc     ! source velocity
    r_cvres(isb) = -r_crfres(isb)/r_crfoff(isb)*c
    r_crch(isb) = 5.5   &
      + (r_crfoff(isb)*(1.-r_doppl)   &
      - r_flo1-sky(isb)*(r_flo1_ref-350.))   &
      !     +	    + (r_crfoff(isb)*(1.-r_doppl)-test-sky(isb)*(r_flo2-350.))
      /r_crfres(isb)
    !
    ! Line
    do isub=1, r_lband
      if (l_line(isub,isb).ne.'*') then
        r_lrfoff(isb,isub) = l_freq(isub,isb)
        r_lnam(isb,isub) = l_line(isub,isb)
      elseif (r_restf.gt.0) then
        r_lrfoff(isb,isub) = r_restf
        r_lnam(isb,isub) = r_line
      else
        r_lrfoff(isb,isub) = 100000.
        r_lnam(isb,isub) = 'DUMMY'
      endif
      r_lrfres(isb,isub) = sky(isb)*r_lfres(isub)   &
          * r_band2(isub) * r_band2bis(isub)
      r_lvoff(isb,isub) = r_veloc  ! source velocity
      r_lvres(isb,isub) = -r_lrfres(isb,isub)   &
        /r_lrfoff(isb,isub)*c
      if (new_receivers) then
        print *,"E-MODIFY DOPPLER not yet implemented for NGRx"
        return
      else
        if(.not.old .or. r_lrfres(isb,isub).gt.0) then
          r_lrch(isb,isub) = r_lcench(isub) +   &  ! CEN in channel 1
            (r_lrfoff(isb,isub)*(1.-r_doppl)-r_flo1   &
            !     $         (R_LRFOFF(ISB,ISUB)*(1.-R_DOPPL)-TEST
            - sky(isb)*(r_flo1_ref-r_lfcen(isub)))   &
            / r_lrfres(isb,isub)
        else
          r_lrch(isb,isub) = 0.0 +   &
            (r_lrfoff(isb,isub)*(1.-r_doppl)-r_flo1   &
            !     $         (R_LRFOFF(ISB,ISUB)*(1.-R_DOPPL)-TEST
            - sky(isb)*(r_flo1_ref-r_lfcen(isub)))   &
            / r_lrfres(isb,isub)
        endif
      endif
    enddo
  enddo
  return
!
end subroutine ini_doppler
!
subroutine exec_modify (buffer,end,write)
  use gkernel_interfaces
  character(len=*) :: buffer        !
  logical :: end                    !
  logical :: write                  !
  ! Local
  character(len=1) :: argum
  character(len=255) :: line
  character(len=12) :: comm,lang
  logical :: error
  integer :: icode, ocode, nch
  !------------------------------------------------------------------------
  ! Code:
  !
  call gprompt_set('MODIFY')
  line = buffer
  icode = -1
  goto 10
  !
entry play_modify(buffer)
  line = buffer
  icode = 2
  goto 10
  !
entry enter_modify
  icode = 1
  goto 10
  !
10 call sic_run(line,lang,comm,error,icode,ocode)
  if (ocode.ne.0) then
    call gprompt_set('CLIC')
    return
  endif
  icode = 0
if (lang.eq. 'MODIFY') then
    if (comm.eq.'GO') then
      end = .true.
      write = .false.
      call sic_ke(line,0,1,argum,nch,.false.,error)
      if (error) goto 10
      write = argum(1:1).eq.'W'
    else
      call message(8,4,'EXEC_MODIFY','No code for '//comm)
      error = .true.
    endif
  elseif (lang.eq. 'CLIC') then
    if (comm.eq.'DUMP') then
      argum = ' '
      call sic_ke(line,0,1,argum,nch,.false.,error)
      if (error) goto 10
      if (argum(1:1) .eq. 'F') then
        call filedump(error)
      elseif (argum(1:1) .eq. 'I') then
        call idump(error)
      elseif (argum(1:1) .eq. 'D') then
        call dhdump(error)
      elseif (argum(1:1) .eq. 'C') then
        call dcdump(line,error)
      elseif (argum(1:1) .eq. 'L') then
        call dldump(line,error)
      elseif (argum(1:1) .eq. 'V') then
        call vdump(error)
      else
        call rdump(line,error)
      endif
    elseif (comm.eq.'MINMAX') then
      call clic_minmax(error)
    elseif (comm.eq.'FLAG') then
      call clic_flag(line,error)
    elseif (comm.eq.'HEADER') then
      call clic_header(line,error)
    elseif (comm.eq.'SHOW') then
      call clic_show(line,error)
    else
      call message(8,4,'EXEC_MODIFY','No code for '//comm)
      error = .true.
    endif
  elseif (lang.eq.'SIC') then
    call run_sic(line,comm,error)
  else
    call message(8,4,'EXEC_MODIFY',   &
      'Language invalid in this context '//lang)
    error = .true.
  endif
  goto 10
end subroutine exec_modify
!
subroutine load_modify
  use gkernel_interfaces
  integer :: mmodify
  parameter (mmodify=1)
  character(len=*) :: vers
  parameter (vers='1.1-01 05-JAN-1990   R.Lucas')
  character(len=12) :: vocab(mmodify)
  data vocab /' GO'/
  !------------------------------------------------------------------------
  ! Code:
  call sic_load ('MODIFY','GAG_HELP_CLIC',mmodify,vocab,vers)
end subroutine load_modify
!
subroutine clic_minmax(error)
  use classic_api
  use clic_rdata
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  !------------------------------------------------------------------------
  ! Code:
  call sub_minmax (r_nsb, r_nband, r_nbas, r_lntch,   &
    datac, datal, passc, passl,error)
  if (error) return
  error = .false.
  return
end subroutine clic_minmax
!
subroutine sub_minmax (qsb, qband, qbas, qntch,   &
    data_c, data_l, pass_c, pass_l, error)
  use classic_api
  use clic_rdata
  integer :: qsb                       !
  integer :: qband                     !
  integer :: qbas                      !
  integer :: qntch                     !
  complex :: data_c(qsb, qband, qbas)  !
  complex :: data_l(qntch, qsb, qbas)  !
  complex :: pass_c(qsb, qband, qbas)  !
  complex :: pass_l(qntch, qsb, qbas)  !
  logical :: error                     !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  integer :: ib, is, isb, i, k
  real :: afac
  complex :: zz(2)
  !------------------------------------------------------------------------
  ! Code:
  call set_scaling(error)
  do ib=1, mnbas
    campmaxu(ib) = 0
    campminu(ib) = 1e37
    campmaxl(ib) = 0
    campminl(ib) = 1e37
    lampmaxu(ib) = 0
    lampminu(ib) = 1e37
    lampmaxl(ib) = 0
    lampminl(ib) = 1e37
    do is = 1, r_nband
      do isb = 1,2
        zz(isb) = data_c(isb,is,ib)
        if (do_pass) then
          zz(isb) = zz(isb)*pass_c(isb,is,ib)
        endif
        call scaling (is,isb,ib,zz(isb),afac,error)
        if (.not.error) then
          if (isb.eq.1) then
            campmaxu(ib) = max(campmaxu(ib),abs(zz(1)))
            campminu(ib) = min(campminu(ib),abs(zz(1)))
          else
            campmaxl(ib) = max(campmaxl(ib),abs(zz(2)))
            campminl(ib) = min(campminl(ib),abs(zz(2)))
          endif
        endif
      enddo
    enddo
    k = 0
    do is =1, r_lband
      do i = 1, r_lnch(is)
        k = k + 1
        do isb = 1,2
          zz(isb) = data_l(k,isb,ib)
          if (do_pass) then
             zz(isb) = zz(isb)*pass_l(k,isb,ib)
          endif
          call scaling (is,isb,ib,zz(isb),afac,error)
          if (.not.error) then
            if (isb.eq.1) then
              lampmaxu(ib) = max(lampmaxu(ib),abs(zz(1)))
              lampminu(ib) = min(lampminu(ib),abs(zz(1)))
            else
              lampmaxl(ib) = max(lampmaxl(ib),abs(zz(2)))
              lampminl(ib) = min(lampminl(ib),abs(zz(2)))
            endif
          endif
        enddo
      enddo
    enddo
  enddo
  return
end subroutine sub_minmax
!
subroutine ini_cable (line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY Cable a1 a2 a3 a4 :
  !        correct for a permutation of the cables to the phasemeters
  ! 	MODIFY Cable CONTINUUOUS :
  !        correct the cable phases to be continuous
  !        (should use only the correlations, without LOCK flag,
  !          for which the phases have a meaning)
  ! 	MODIFY Cable FACTOR f:
  !        Assume the phase correction applied  has to be multiplied by f
  !        (replaces the old MODIFY CABL2)
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_constant.inc'
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  include 'gbl_pi.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data
  character(len=80) :: chain, nombre
  real*8 :: fi2, f, x
  integer :: ir,ibas,i,isub,iside
  integer(kind=address_length) :: data_in,kin,ipk, ipk1
  integer(kind=data_length)    :: ndata,h_offset, c_offset, l_offset

  integer :: ia, ja
  integer :: iconn(mnant), nch, isign
  real :: used(mnant), old(mnant), f_factor
  logical :: continuous, factor
  save iconn, continuous, old, factor, f_factor, nharm
  real*8 :: f100mhz
  real*4 :: blhvhl, if2_hiq, lo2_ant, f100mhz_mult
  integer :: nharm, mult, ref_mult
  parameter(blhvhl=9.92)
  ! Data
  data old/mnant*0.0/
  !------------------------------------------------------------------------
  ! Code:
  call check_equal_file(error)
  if (error) return
  if (.not.do_write_data) then
    call message (8,4,'INI_DATA',   &
      'MODIFY CABLE needs the SET WRITE DATA mode')
    error = .true.
    return
  endif
  !
  call sic_ke(line,iopt,2,chain,nch,.true.,error)
  if (chain(1:2).eq.'CO') then
    continuous = .true.
    call message (6,1,'INI_CABLE',   &
      'Assuming cable phase was continuous')
  elseif (chain(1:2).eq.'FA') then
    factor = .true.
    call sic_r4(line,iopt,3,f_factor,.true.,error)
    write (nombre,'(F6.3)') f_factor
    call message (6,1,'INI_CABLE',   &
      'Multiply the phase correction by '//nombre(1:lenc(nombre)))
  else
    continuous = .false.
    do i=1, mnant
      iconn(i) = i
      call sic_i4(line,iopt,1+i,iconn(i),.false.,error)
      if (error) return
    enddo
    chain = ' '
    write (chain,'(6i3)') iconn
    call message (6,1,'INI_CABLE',   &
      'Assuming phasemeters 1 2 3 4 5 6 connected to '//chain)
  endif
  return
  !
entry mod_cable (do_write,do_data,error)
  ! Test
  !      DO_WRITE = .FALSE.
  !      DO_DATA = .FALSE.
  !
  ! Set time
  ! Modify observation
  if (r_proc.ne.p_source .and. r_proc.ne.p_delay   &
    .and. r_proc.ne.p_gain .and. r_proc.ne.p_focus   &
    .and. r_proc.ne.p_point .and. r_proc.ne.p_holog   &
    .and. r_proc.ne.p_five .and. r_proc.ne.p_flux    &
    .and. r_proc.ne.p_otf) then
    goto 500
  endif
  if (r_lmode.ne.1) then
    goto 500
  endif
  ! Get storage and data
  call get_data (ndata,data_in,error)
  if (error) return
  !
  ! See what frequency plan/cabling applies
  ! OGR or NGR ?
  if (new_receivers) then
    if2_hiq = 0.0           ! Signal transported back through optical fibers
    lo2_ant = 0.0           ! LO2 conversion in IF processor
    mult = 3
    if (r_nrec.eq.2) mult = 2
    if (r_nrec.eq.1) mult = 1
  else
    if2_hiq = 1.0           ! Signal transported back through high-q cable
    lo2_ant = 1.0           ! LO2 conversion in IF antenna
    mult = 1
    if (r_nrec.eq.2) mult = 3
  endif
  ! New LO system in 2010
  if (r_dobs.lt.-5109) then ! New LO on 01-sep-2010
    f100mhz_mult = blhvhl   ! 100 MHz carried by low-Q 
    ref_mult    = 1         ! FLO1_REF = FSYNT-0.5MHz
  else
    f100mhz_mult = 1        ! 100 MHz carried by
    ref_mult    = 8         ! FLO1_REF = 8*(FSYNT-0.5 MHz)
  endif
  ! Now gets harmonic number
  nharm = nint((r_flo1/mult+100.175*r_lock)/r_flo1_ref)
  ! compute f100mhz since it was not so constant after all... (2001-10-15)
  f100mhz = (nharm*r_flo1_ref-r_flo1/mult)/r_lock
  if (f100mhz .gt. 100.175) then
    f100mhz = 100.25d0
  else
    f100mhz = 100.09765625d0
  endif
  ! Loop on records (including average)
  ! a corrected record may be present
  kin = gag_pointer(data_in,memory)
  do ir = 1, r_ndump + max(1,r_ndatl)
    ipk = kin + h_offset(ir)
    call decode_header (memory(ipk))
    do i=1, r_nant
      used(i) = dh_cable(i)
      if (continuous .and. old(i).eq.0) then
        old(i) = used(i)
      endif
    enddo
    do i=1, r_nant
      if (continuous) then
        dh_cable(i) = mod(used(i)-old(i)+100.25,0.5)-0.25+old(i)
      elseif (factor) then
        dh_cable(i) = used(i)*f_factor
      else
        dh_cable(i) = used(iconn(i))
      endif
    enddo
    call encode_header(memory(ipk))
    ipk = kin + c_offset(ir)
    ! Continuum
    ! Loop on baselines
    do ibas = 1, r_nbas
      ia = r_iant(ibas)
      ja = r_jant(ibas)
      x = dh_cable(ja)-used(ja)-dh_cable(ia)+used(ia)
      do iside=1, r_nsb
        do isub =1, r_nband
          fi2 = r_cfcen(i)
          isign = 3-2*r_lsband(iside,isub)
          ! these are the various terms as applied in delay_phase_total (task correl)
          f =  r_lock*nharm*ref_mult*mult               & ! LO1
              -f100mhz*ref_mult/r_flo1_ref*f100mhz_mult & ! 100MHz signal
              -isign*fi2/r_flo1_ref*if2_hiq             & ! IF2
              -isign*lo2_ant                              ! LO2
          call rotate(memory(ipk),2*3.14159*f*x)
          ipk = ipk + 2        ! 1 complex
        enddo
      enddo
    enddo
  enddo
  ! Line ...
  ! Loop on baselines
  ! do uncorrected and corrected data
  do ir = 1, max(1,r_ndatl)
    ipk = kin + l_offset(ir+r_ndump)
    if (r_lfour) then
      do ibas = 1, r_nbas
        ia = r_iant(ibas)
        ja = r_jant(ibas)
        x = dh_cable(ja)-used(ja)-dh_cable(ia)+used(ia)
        do iside = 1, r_lnsb
          do isub = 1, r_lband
            ipk1 = ipk+2*r_lich(isub)
            do i = 1, r_lnch(isub)
              fi2 = (r_lfcen(isub)+   &
                (i-r_lcench(isub))*r_lfres(isub))
              isign = 3-2*r_lsband(iside,isub)
              ! these are the various terms as applied in delay_phase_total (task correl)
              f =  r_lock*nharm*ref_mult*mult                &
                  -f100mhz*ref_mult/r_flo1_ref*f100mhz_mult  &
                  -isign*fi2/r_flo1_ref*if2_hiq              & 
                  -isign*lo2_ant
              call rotate(memory(ipk1),2*3.14159*f*x)
              ipk1 = ipk1 + 2  ! 1 complex
            enddo
          enddo
          ipk = ipk+2*r_lntch
        enddo
      enddo
    endif
  enddo
  !
  ! Real life
  do_data = .true.
  do_write = .true.
500 continue
  return
end subroutine ini_cable
!
subroutine ini_bug (line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! 	MODIFY BUG number
  ! NUMBER   DATE         Description
  !
  ! 1        11/Nov 95    C02 to C06 badly calibrated.
  !                       (counter CC not init.d properly in DO_AUTOL)
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_constant.inc'
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_clic.inc'
  include 'gbl_pi.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data, need_action, rf, rfhr, some_mod
  character(len=80) :: chain
  integer :: number
  integer :: i,isign
  integer(kind=address_length) :: data_in,kin,k,ipk,ipk1
  integer(kind=data_length)    :: ndata,h_offset,c_offset,l_offset
  integer :: istart, iend, ia, ical, ic, ip, ir, ibas, iside, isub
  integer :: ib, is, isb
  real(kind=8)    :: ns, phi0,phi
  real :: x(mnbas), x0(mnbas, mrlband), x0p(mnbas, mrlband)
  real :: x1(mnbas, mrlband), df, lpha, ldph 
  parameter (ns=220/299792458d0)
  real(kind=8) :: freqcorr(mrlband), f0, f0p 
  real, parameter :: tol = 1e-4
  !
  save number
  !------------------------------------------------------------------------
  ! Code:
  call check_equal_file(error)
  if (error) return
  call sic_i4(line,iopt,2,number,.true.,error)
  if (error) return
!  number= min(1,max(1,number))
  write(chain,'(A,I4.4,A)') 'Correcting BUG number ', number
  call message (6,1,'INI_BUG',chain)
  return
  !
entry mod_bug (do_write,do_data,error)
  ! Test
  do_write = .false.
  do_data = .false.
  !
  if (number.eq.1) then
    call cdate('11-nov-1995',istart,error)
    call cdate('09-jan-1996',iend,error)
    ! NOte: the hour is not checked,
    ! actually the correction was introduced at 3pm on 09-jan-1996.
    if (r_dobs.lt.istart .or. r_dobs.gt.iend) return
    !
    !  Calibration scan
    ! Modify observation
    if (r_proc.eq.p_cal.and.r_scaty.eq.4) then
      ! Get storage and data
      call get_data (ndata,data_in,error)
      if (error) return
      ! average record
      kin = gag_pointer(data_in,memory)+r_ndump*r_ldump
      call decode_header (memory(kin))
      k = kin+r_ldpar+r_ldatc
      do ia = 1, r_nant
        do ical = 1, r_nbb
          ic = r_mapbb(ical)
          ip = r_mappol(ia,ical)
          integ(ia,r_nrec,ic,ip,chop) = 0
        enddo
      enddo
      k = kin + r_ldpar
      k = k + r_ldatc
      call redo_autol (chop,memory(k), error)
      if (error) return
    elseif (r_proc.eq.p_source .or. r_proc.eq.p_delay   &
      .or. r_proc.eq.p_gain .or. r_proc.eq.p_focus   &
      .or. r_proc.eq.p_point .or. r_proc.eq.p_holog   &
      .or. r_proc.eq.p_five .or. r_proc.eq.p_flux    &
      .and. r_proc.ne.p_otf) then
      !
      ! Get storage and data
      call get_data (ndata,data_in,error)
      if (error) return
      do i = 1, r_ndump          ! Next record
        kin = gag_pointer(data_in,memory)+ (i-1)*r_ldump
        call decode_header (memory(kin))
        k = kin + r_ldpar
        call redo_atmosc (memory(k), error, i)
        if (error) return
      enddo
      kin = gag_pointer(data_in,memory)+r_ldump*r_ndump
      call decode_header (memory(kin))
      k = kin + r_ldpar
      call redo_atmosc (memory(k), error, 0)
      if (error) return
      k = k + r_ldatc
      ! Corrected data if present
      if (r_ndatl.gt.1) then
        kin = gag_pointer(data_in,memory)+r_ldump*r_ndump   &
          + r_ldpar+r_ldatc+r_ldatl
        call decode_header (memory(kin))
        k = kin + r_ldpar
        call redo_atmosc (memory(k), error, 0)
        if (error) return
      endif
    endif
    ! 
    ! Real life
    do_data = .true.
    do_write = .true.
continue
    return
  elseif (number.eq.2) then
    call cdate('26-jan-2015',istart,error)
    call cdate('05-mar-2015',iend,error)
    !
    if (r_dobs.lt.istart .or. r_dobs.gt.iend) then
      call message(3,2,'MODIFY_BUG','Data not affected')
      return
    endif
    !
    ! Only deals with cross-correlation
    if (r_proc.ne.p_source .and. r_proc.ne.p_delay   &
      .and. r_proc.ne.p_gain .and. r_proc.ne.p_focus   &
      .and. r_proc.ne.p_point .and. r_proc.ne.p_holog   &
      .and. r_proc.ne.p_five .and. r_proc.ne.p_flux    &
      .and. r_proc.ne.p_otf) then
      goto 501
    endif
    if (r_lmode.ne.1) then
      goto 501
    endif
    ! Get storage and data
    call get_data (ndata,data_in,error)
    if (error) return
    ! Loop on records (including average)
    ! a corrected record may be present
    kin = gag_pointer(data_in,memory)
    !
    ! First compute frequencies
    do i = 1, r_lband
      freqcorr(i)=r_band2bis(i)*r_flo2bis(i)+r_flo3(i)-r_flo4(i)
    enddo
    !
    ! Correct data
    do ir = 1, r_ndump + max(1,r_ndatl)
      ipk = kin + h_offset(ir)
      call decode_header (memory(ipk))
      !
      ! Ensure that correction is applied only once
      if (dh_test0(6).ne.0) then
        call message(3,2,'MODIFY_BUG','Data already corrected')
        return
      endif
      dh_test0(6) = 2
      call encode_header (memory(ipk))
      ipk = kin + c_offset(ir)
      ! Continuum
      ! Loop on baselines
      do ibas = 1, r_nbas
        phi0 = ns*r_bas(2,ibas)*dh_svec(2)*2*pi
        do iside=1,2
          isign = 3-2*iside
          do isub =1, r_nband
            phi = phi0*freqcorr(isub)*isign
            call rotate(memory(ipk),phi)
            ipk = ipk + 2        ! 1 complex
          enddo
        enddo
      enddo
    enddo
    ! Line 
    ! Loop on baselines
    ! do uncorrected and corrected data
    do ir = 1, max(1,r_ndatl)
      ipk = kin + l_offset(ir+r_ndump)
      if (r_lfour) then
        do ibas = 1, r_nbas
          phi0 = ns*r_bas(2,ibas)*dh_svec(2)*2*pi
          do iside = 1, 2
            isign = 3-2*iside
            do isub = 1, r_lband
              phi = phi0*freqcorr(isub)*isign
              ipk1 = ipk+2*r_lich(isub)
              do i = 1, r_lnch(isub)
                call rotate(memory(ipk1),phi)
                ipk1 = ipk1 + 2  ! 1 complex
              enddo
            enddo
            ipk = ipk+2*r_lntch
          enddo
        enddo
      endif
    enddo
    !
    ! Compute data modifiers
    do ibas = 1, r_nbas
      phi0 = ns*r_bas(2,ibas)*dh_svec(2)*2*pi
      do iside = 1, 2
        isign = 3-2*iside
        do isub = 1, r_nband
          r_dmcpha(iside,ibas,isub) = r_dmcpha(iside,ibas,isub) &
              + phi0*freqcorr(isub)*isign
        enddo       
        do isub = 1, r_lband
          r_dmlpha(iside,ibas,isub) = r_dmlpha(iside,ibas,isub) &
              + phi0*freqcorr(isub)*isign
        enddo       
      enddo
    enddo
    !
    ! Real life
    do_data = .true.
    do_write = .true.
501 continue
    return
  elseif (number.eq.3) then
    call cdate('15-jun-2023',istart,error)
    !
    ! No back to the future
    if (r_dred.lt.istart) then
      call message(3,2,'MODIFY_BUG','Data not affected')
      return
    endif
    !
    ! Only deals with cross-correlation
    if (r_proc.ne.p_source .and. r_proc.ne.p_delay   &
      .and. r_proc.ne.p_gain .and. r_proc.ne.p_focus   &
      .and. r_proc.ne.p_point .and. r_proc.ne.p_holog   &
      .and. r_proc.ne.p_five .and. r_proc.ne.p_flux    &
      .and. r_proc.ne.p_otf) then
      goto 502
    endif
    if (r_lmode.ne.1) then
      goto 502
    endif
    ! Nothing to do if no HR spw 
    if (r_lband.le.r_nbb) return
    !
    x0 = 0 
    x0p = 0
    x1 = 0
    x =  0
    ! Get storage and data
    call get_data (ndata,data_in,error)
    if (error) return
    ! Loop on records (including average)
    ! a corrected record may be present
    kin = gag_pointer(data_in,memory)
    ipk = kin + h_offset(r_ndump+1)
    call decode_header (memory(ipk))
    !
    ! First compute x0,x0p and x1 from lpha and ldph
    do is=1, lband_original
      do ib=1, r_nbas
        isb = r_lsband(1,is)
        df = (3-2*isb)*r_band2bis(is)*r_band2(is)*r_lfres(is) 
        f0 =  r_flo1+(3-2*isb)*(r_flo2(is)   &
            + r_band2(is) * (r_flo2bis(is)   &
            + r_band2bis(is)*r_lfcen(is)))
        f0p = (3-2*isb)*(r_flo2(is)          &
            + r_band2(is) * (r_flo2bis(is)   &
            + r_band2bis(is)*r_lfcen(is)))
        if (f0.ne.0)  x0(ib,is) =r_dmlpha(1,ib,is)/f0
        if (f0p.ne.0) x0p(ib,is)=r_dmlpha(1,ib,is)/f0p
        if (df.ne.0)  x1(ib,is) =r_dmldph(1,ib,is)/df
      enddo
    enddo
    !
    ! Check if hr spw have the same x than lr
    ! If not, if hr was modified and how (rf or not)
    need_action = .false.
    some_mod = .false.
    do is=r_nbb+1, lband_original
      ical = r_bb(is)
      if (.not.nearly_equal(x0(1:r_nbas,is),x0(1:r_nbas,ical),int(r_nbas,kind=size_length),tol)) then
        need_action = .true.
        if (any(x0(1:r_nbas,is).ne.0)) some_mod = .true.
        if (some_mod) then
          if (nearly_equal(x0(1:r_nbas,is),x1(1:r_nbas,is),int(r_nbas,kind=size_length),tol)) then
            rfhr = .true.
          elseif(nearly_equal(x0p(1:r_nbas,is),x1(1:r_nbas,is),&
                   int(r_nbas,kind=size_length),tol)) then
            rfhr = .false.
          else
            call message(3,3,'MODIFY_BUG','Cannot correct bug')
            error = .true.
            return 
          endif  
        endif 
      endif
    enddo
    if (.not.need_action) then 
       goto 502   
    endif
    call message(3,1,'MODIFY_BUG','Bug is present in data')
    !
    ! Compute phase factors per subband (for crossed pol case)
    do is  = r_nbb+1,lband_original
      ical = r_bb(is)
      isb = r_lsband(1,ical)
      isign = 3-2*isb
      do ib = 1, r_nbas
        ldph = r_dmldph(1,ib,ical)
        lpha = r_dmlpha(1,ib,ical)
        if (some_mod) then
        ! 1) remove correction already applied in hr from lr
          df = (3-2*isb)*r_band2bis(ical)*r_band2(ical)*r_lfres(ical) 
          f0 =  r_flo1+(3-2*isb)*(r_flo2(ical)   &
              + r_band2(ical) * (r_flo2bis(ical)   &
              + r_band2bis(ical)*r_lfcen(ical)))
          f0p = (3-2*ical)*(r_flo2(ical)   &
              + r_band2(ical) * (r_flo2bis(ical)   &
              + r_band2bis(ical)*r_lfcen(ical)))
          ldph = ldph-df*x1(ib,is)
          if (rfhr) then
            lpha = lpha-f0*x0(ib,is)
          else
            lpha = lpha-f0p*x0p(ib,is)
          endif
        endif
        ! 2) check if remaining is rf, not rf, or a problem
        x(ib) =  &
                ldph*isign*r_band2bis(ical)*r_band2(ical)/r_lfres(ical)
        if (abs(lpha).gt.tol) then    ! nearly_equal does not do the job here
          if (nearly_equal(lpha, &
              real(x(ib)*(r_flo1+isign*(r_flo2(ical)   &
              + r_band2(ical) * (r_flo2bis(ical)   &
              + r_band2bis(ical)*r_lfcen(ical)))),kind=4),tol)) then
            rf = .true.
          elseif (nearly_equal(lpha, &
              real(x(ib)*isign*(r_flo2(ical)   &
              + r_band2(ical) * (r_flo2bis(ical)   &
              + r_band2bis(ical)*r_lfcen(ical))),kind=4),tol)) then
            rf = .false.
          else
            call message(3,2,'MODIFY_BUG','This is wrong')
            error = .true.
            return
          endif
        else
          x(ib)=0
        endif
      enddo
      !
      ! Actually modify data:
      if (any(x.ne.0)) call modify_ph(memory(kin),x,is,rf)
    enddo
    ! 
    ! Real life
    do_data = .true.
    do_write = .true.
502 continue
    return
  else
    return
  endif 
end subroutine ini_bug
!
subroutine ini_spidx(line,iopt,error)
  use gkernel_interfaces
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY SPIDX value
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  integer :: iopt                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  logical :: do_write, do_data
  real*4 :: new_spidx
  character(len=80) :: chain
  save new_spidx
  ! Data
  data new_spidx/0.0/
  !------------------------------------------------------------------------
  ! Code:
  call check_equal_file(error)
  if (error) return
  call sic_r4(line,iopt,2,new_spidx,.true.,error)
  if (error) return
  write(chain,*) new_spidx
  call message (6,1,'INI_VELOCITY',   &
    'Modifying spectral index to '//chain(1:lenc(chain)))
  return
  !
entry mod_spidx(do_write,do_data,error)
  ! Doesm't depend on side band ...
  r_spidx = new_spidx
  return
end subroutine ini_spidx
!
subroutine redo_autol  (mes, data, error)
  use gildas_def
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     Read in auto correlation function
  !     Increment the C_L and C_C buffers for the specified cal phase "mes".
  ! Input
  !     mes      I           Calibration phase
  !     DATA     REAL(*)     The data.
  !---------------------------------------------------------------------
  integer :: mes                    !
  real :: data(*)                   !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_display.inc'
  include 'clic_proc_par.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  ! Local
  real :: calli(mlch)
  real :: c1, c2, cs, cc, ccwrong
  integer :: ia, ic, k, nc, n1, n2, is, n3, n4, kk, ncwrong, ip, ical
  !------------------------------------------------------------------------
  ! Code:
  ! Increment autocorrelation buffers
  ! The right values are in CHOP, the wrong ones in COLD
  k = 1
  do ia=1, r_nant
    do ic =1, r_lntch
      c2 = dh_integ
      call pol_chan(ip,ical,ic,error)
      if (error) return
      c1 = integ(ia,r_nrec,ical,ip,mes)
      integ(ia,r_nrec,ical,ip,mes) = c1 + c2
      cs = c1+c2
      if (cs.eq.0) then
        error = .true.
        return
      endif
      c1 = c1/cs
      c2 = c2/cs
      calli(ic) = data(k)
      k = k + 1
      c_l(ic,ia,r_nrec,ip,mes) =   &
        c1 * c_l(ic,ia,r_nrec,ip,mes) + c2 * calli(ic)
    enddo
    ! Ne doit pas etre ici         CC = 0
    ! Ne doit pas etre ici         NC = 0
    ccwrong = 0
    ncwrong = 0
    kk = 0
    do is = 1, r_lband
      !
      ! With polarisation, not factorized anymore
      ical = r_bb(is)
      ip = r_lpolentry(ia,is)
      c1 = integ(ia,r_nrec,ical,ip,mes)
      c2 = dh_integ
      cs = c1+c2
      c1 = c1/cs
      c2 = c2/cs
      !
      cc = 0.0                 ! Doit etre ici 09-Jan-1996
      nc = 0                   ! Doit etre ici 09-Jan-1996
      !
      ! avoid center and edges ...
      n1 = nint(r_lnch(is)*0.1)
      n2 = r_lnch(is)/2-1
      n3 = r_lnch(is)/2+2
      n4 = nint(r_lnch(is)*0.9)
      do ic=1, r_lnch(is)
        kk = kk + 1
        if ((ic.ge.n1 .and. ic.le.n2) .or.   &
          (ic.ge.n3 .and. ic.le.n4)) then
          cc = cc + calli(kk)
          nc = nc + 1
          ccwrong = ccwrong + calli(kk)
          ncwrong = ncwrong + 1
        endif
      enddo
      c_c(is,ia,r_nrec,ip,chop) =   &
        c1*c_c(is,ia,r_nrec,ip,chop) + c2*cc/nc
      c_c(is,ia,r_nrec,ip,cold) =   &
        c1*c_c(is,ia,r_nrec,ip,cold) + c2*ccwrong/ncwrong
    enddo
  enddo
  return
end subroutine redo_autol
!
!
subroutine redo_atmosc (data, error, ido)
  use classic_api
  use clic_buffers
  !---------------------------------------------------------------------
  ! CLIC
  !     REProcess temporal data: after a BUG # 1
  !     The right calibration factor is in CHOP, the wrong in COLD.
  ! Input
  !     DATA    COMPLEX(*)
  !---------------------------------------------------------------------
  complex :: data(*)                !
  logical :: error                  !
  integer :: ido                    !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  ! Local
  integer :: ib, ia, ja, is, k, ip
  real :: norm
  !------------------------------------------------------------------------
  ! Code:
  ! Continuum
  k = 1
  do ib=1, r_nbas
    ia = r_iant(ib)
    ja = r_jant(ib)
    do is = 1, r_nband
      ip = r_lpolentry(ia,is)
      if (c_c(is,ia,r_nrec,ip,cold).ne.0   &
        .and. c_c(is,ja,r_nrec,ip,cold).ne.0) then
        norm = sqrt(abs(c_c(is,ia,r_nrec,ip,chop)   &
          *c_c(is,ja,r_nrec,ip,chop)   &
          /c_c(is,ia,r_nrec,ip,cold)   &
          /c_c(is,ja,r_nrec,ip,cold)))
        if (ido.eq.1) then
          r_dmcamp(1,ib,is) = r_dmcamp(1,ib,is) /norm
          r_dmcamp(2,ib,is) = r_dmcamp(2,ib,is) /norm
        endif
        data(k) = data(k) / norm
        data(k+r_nband) = data(k+r_nband) / norm
      endif
      k = k + 1
    enddo
    k = k + r_nband
  enddo
  return
end subroutine redo_atmosc

subroutine pol_chan(ipola,inbc,ichan,error)
  use classic_api
  integer :: ipola                  ! Output: polarisation
  integer :: inbc                   ! Output: correlator entry
  integer :: ichan                  ! Input: channel
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  integer :: i, ifirst, ilast, isub
  logical :: found
  found = .false.
  isub = 0
  !
  ! If old receivers, always return horizontal polarisation
  if (.not.new_receivers) then
  ! TBA
    ipola = 1
    return
  endif
  !
  ! Determine unit to which the channel belongs to
  do i = 1, r_lband
    ifirst = r_lich(i)+ 1
    ilast = r_lich(i) + r_lnch(i)
    if (ichan.ge.ifirst.and.ichan.le.ilast) then
      if (found) then
        if (isub.ne.i) then
          call message(2,3,'POL_CHAN',   &
            'Channel belonging to more than 1 unit')
          error = .true.
          return
        endif
      endif
      found = .true.
      isub = i
    endif
  enddo
  !
  ipola = r_lpolentry(1,isub)  ! Same pol. entry for all antennas
  inbc = r_bb(isub)
end subroutine pol_chan
