subroutine ini_base(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! Command MODIFY BASELINE  b1 x1 y1 x1 b2 x2 y2 z2 ...[/OFFSET]
  !                          [FITTED]
  ! Command MODIFY ANTENNA a1 x1 y1 x1 a2 x2 y2 z2 .. [/OFFSET]
  !                          [FITTED]
  !---------------------------------------------------------------------
  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_dheader.inc'
  include 'clic_display.inc'
  include 'clic_number.inc'
  include 'clic_stations.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data
  integer :: base_number
  logical :: fbnew(mnbas), fanew(mnant)
  logical :: antenna, offset
  real*8 :: bnew(3,mnbas), anew(3,mnant)
  real*8 :: bnew0(3,mnbas), anew0(3,mnant)
  integer(kind=address_length) :: data_in, kin, ipk
  integer(kind=data_length)    :: ndata, h_offset
  integer :: i, j, k, nch
  character(len=12) :: argum
  character(len=256) :: chain
  !      CHARACTER*1 ARG1
  real*8 :: f_to_k                ! (2*pi/clight)*1d6
  parameter (f_to_k = 2*pi/299792458.d-6)
  real :: x(mnbas)
  integer :: kb, ibas, ia, ja, id
  !
  integer :: mvoc1, nkey
  parameter (mvoc1=2)
  character(len=12) :: kw, voc1(mvoc1)
  data voc1/'BASELINE','ANTENNA'/
  data antenna/.false./, offset/.false./
  save antenna, offset, anew, anew0, fanew, bnew, bnew0, fbnew, id
  !------------------------------------------------------------------------
  ! Code:
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  kw = 'ANTENNA'
  call clic_kw(line,iopt,1,kw,nkey,voc1,mvoc1,.false.,error,.true.)
  antenna = kw.eq.'ANTENNA'
  offset = sic_present(3,0)
  !
  ! Mandatory argument (89 or 96 or 99 or 25)
  if (offset) then
    call sic_i4(line,3,1,id,.true.,error)
    if (id.ne.89 .and. id.ne.96 .and. id.ne.99 .and. id.ne.25) then
      call message(8,3,'MODIFY',   &
        '/OFFSET 89 or /OFFSET 96 or /OFFSET 99 or /OFFSET 25, please')
      error = .true.
      return
    endif
  else
    id = 0
  endif
  error = .false.
  do i=1, mnbas
    fbnew(i) = .false.
  enddo
  do i=1, mnant
    fanew(i) = .false.
  enddo
  call sic_ke(line,iopt,2,argum,nch,.true.,error)
  if (error) return
  if (argum(1:2) .eq. 'FITTED') then
    do i=1, r_nbas
      if (f_bfit(i)) then
        do j=1,3
          bnew0(j,i) = b_fit(j,i)
        enddo
        fbnew(i) = .true.
      elseif (f_afit(r_iant(i)) .and.   &
        f_afit(r_jant(i))) then
        do j=1,3
          bnew0(j,i) = a_fit(j,r_jant(i))-   &
            a_fit(j,r_iant(i))
        enddo
        fbnew(i) = .true.
      endif
    enddo
  elseif (.not.antenna) then
    i = 2
    do while(sic_present(iopt,i))
      call sic_ke(line,iopt,i,argum,nch,.true.,error)
      if (error) return
      call base_to_n(argum,j,error)
      if (error) then
        call message(8,4,'INI_BASE','Invalid baseline '//argum)
        error = .true.
        return
      endif
      fbnew(j) = .true.
      do k=1, 3
        call sic_r8(line,iopt,i+k,bnew0(k,j),.true.,error)
        if (error) return
      enddo
      i = i+4
    enddo
  elseif (antenna) then
    i = 2
    do while(sic_present(iopt,i))
      call sic_i4(line,iopt,i,j,.true.,error)
      if (error) return
      fanew(j) = .true.
      do k=1, 3
        call sic_r8(line,iopt,i+k,anew0(k,j),.true.,error)
        if (error) return
      enddo
      i = i+4
    enddo
  endif
  if (.not.antenna) then
    call message(6,1,'INI_BASE','Modifying baselines to :')
    do i=1, mnbas
      if (fbnew(i)) then
        write(chain,'(1x,a2,3f15.6)') cbas(i),(bnew0(j,i),j=1,3)
        call message(6,1,'INI_BASE',chain(1:lenc(chain)))
      else
        write(chain,'(1x,a2,a)') cbas(i), ' is not modified'
        call message(6,1,'INI_BASE',chain(1:lenc(chain)))
      endif
    enddo
  else
    call message(6,1,'INI_BASE','Modifying antennas to :')
    do i=1, mnant
      if (fanew(i)) then
        write(chain,'(1x,i0,3f15.6)') i,(anew0(j,i),j=1,3)
        call message(6,1,'INI_BASE',chain(1:lenc(chain)))
      else
        write(chain,'(1x,i0,a)') i,' is not modified'
        call message(6,1,'INI_BASE',chain(1:lenc(chain)))
      endif
    enddo
  endif
  if (offset) then
    write(chain,'(a,i2,a)') '(Offset relative to `',id,' values)'
    call message (6,1,'INI_BASE',chain(1:lenc(chain)))
  endif
  return
  !
entry mod_base(do_write,do_data,error)
  ! Get storage and data
  call get_data (ndata,data_in,error)
  kin = gag_pointer(data_in,memory)
  if (error) return
  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) goto 500
  if (r_lmode.ne.1) goto 500
  !
  ! Add station offsets if needed
  if (antenna) then
    do i=1, r_nant
      if (fanew(i)) then
        do j=1, 3
          anew(j,i) = anew0(j,i)
          if (offset) then
            if(id.eq.89) then
              anew(j,i) = anew(j,i)+dble(stat89(j,r_istat(i)))
            elseif(id.eq.96) then
              anew(j,i) = anew(j,i)+dble(stat96(j,r_istat(i)))
            elseif(id.eq.99) then
              anew(j,i) = anew(j,i)+dble(stat99(j,r_istat(i)))
            elseif(id.eq.25) then
              anew(j,i) = anew(j,i)+dble(stat25(j,r_istat(i)))
            endif
          endif
        enddo
      endif
    enddo
  else
    do i=1, r_nbas
      if (fbnew(i)) then
        do j=1, 3
          bnew(j,i) = bnew0(j,i)
          if (offset) then
            if(id.eq.89) then
              bnew(j,i) = bnew(j,i)   &
                +dble(stat89(j,r_istat(r_jant(i)))   &
                -stat89(j,r_istat(r_iant(i))))
            elseif(id.eq.96) then
              bnew(j,i) = bnew(j,i)   &
                +dble(stat96(j,r_istat(r_jant(i)))   &
                -stat96(j,r_istat(r_iant(i))))
            elseif(id.eq.99) then
              bnew(j,i) = bnew(j,i)   &
                +dble(stat99(j,r_istat(r_jant(i)))   &
                -stat99(j,r_istat(r_iant(i))))
            elseif(id.eq.25) then
              bnew(j,i) = bnew(j,i)   &
                +dble(stat25(j,r_istat(r_jant(i)))   &
                -stat25(j,r_istat(r_iant(i))))
            endif
          endif
        enddo
      endif
    enddo
  endif
  !
  ! load data header from average record:
  ipk = kin + h_offset(r_ndump+1)
  call decode_header (memory(ipk))
  !
  ! Compute phase factors
  do i = 1, r_nbas
    x(i) = 0
    !
    ! in antenna mode, use antenna data to compute baseline data:
    if (antenna) then
      ia = r_iant(i)
      ja = r_jant(i)
      fbnew(i) = .true.
      if (fanew(ja)) then
        do k=1, 3
          bnew(k,i) = anew(k,ja)
        enddo
      elseif (r_ant(1,ja).ne.0) then
        do k=1, 3
          bnew(k,i) = r_ant(k,ja)
        enddo
      else
        fbnew(i) = .false.
      endif
      if (fbnew(i) .and. fanew(ia)) then
        do k=1, 3
          bnew(k,i) = bnew(k,i)-anew(k,ia)
        enddo
      elseif (fbnew(i) .and. r_ant(1,ia).ne.0) then
        do k=1, 3
          bnew(k,i) = bnew(k,i)-r_ant(k,ia)
        enddo
      else
        fbnew(i) = .false.
      endif
    endif
    if (fbnew(i)) then
      do k=1, 3
        x(i) = x(i)   &
          - dh_svec(k)*(bnew(k,i)-r_bas(k,i))*f_to_k
      enddo
    endif
  enddo
  !
  ! Actually modify data and data headers:
  call modify_ph(memory(kin),x,0,.true.)
  !
  ! Update baselines
  do ibas = 1, r_nbas
    kb = base_number (r_iant(ibas), r_jant(ibas))
    if (fbnew(kb)) then
      do i=1, 3
        r_bas(i,ibas) = bnew(i,kb)
      enddo
    endif
  enddo
  if (antenna) then
    do i=1, r_nant
      if (fanew(i)) then
        do k=1, 3
          r_ant(k,i) = anew(k,i)
        enddo
      endif
    enddo
  endif
  do_data = .true.
500 return
!
end subroutine ini_base
!
subroutine ini_delay(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! Command MODIFY DELAY a1 d1 ... a2 x2 ... [/OFFSET] [INSTRUMENTAL]
  !         [/ALL] [/POL H|V] [/SWITCH DIRECT|CROSSED] [/BB bb] [/IF if] 
  !---------------------------------------------------------------------
  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_dheader.inc'
  include 'clic_display.inc'
  include 'clic_number.inc'
  include 'clic_stations.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data
  logical :: fanew(mnbb,mnant), process
  logical :: offset, new, rf, direct, crossed
  real*8 :: anew(mnbb,mnant),newval
  integer(kind=address_length) :: data_in, kin, ipk
  integer(kind=data_length)    :: ndata, h_offset
  integer :: i, j, ia, ja, nch, is, ipa, jpa, k, l, m
  integer :: ir, ibas, ibb, iif, jbb(mnbb), nbb, ipol
  integer :: mvoc,mvoc1,nkey
  parameter (mvoc = 3, mvoc1 = 2)
  character(len=12) :: voc(mvoc)
  character(len=12) :: voc1(mvoc1)
  character(len=12) :: argum,kw
  character(len=256) :: chain
  character(len=1) :: arg1
  real*8 :: f_to_k
  parameter (f_to_k = 2*pi/1000.)
  real :: x(mnbas), new_delay(mnbb,mnant)
  !
  save offset, anew, fanew, rf, direct, crossed
  !
  data offset/.false./, rf/.true./, direct/.false./, crossed/.false./
  data voc/'HORIZONTAL','VERTICAL','BOTH'/
  data voc1/'DIRECT','CROSSED'/
  !------------------------------------------------------------------------
  ! Code:
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  call sic_ke(line,iopt,1,arg1,nch,.false.,error)
  if (error) return
  if (arg1.ne.'D') then
    error = .true.
    return
  endif
  !
  ! /OFFSET option
  offset = sic_present(3,0)
  error = .false.
  do i=1, mnant
    do j = 1, mnbb
      fanew(j,i) = .false.
    enddo
  enddo
  !
  ! /INSTRUMENTAL option
  rf = .not.sic_present(9,0)
  !
  ! /ALL option
  if (sic_present(10,0)) then
    nbb = r_nbb
    do i=1, r_nbb
      jbb(i) = i
    enddo
  !
  ! /BBAND option
  elseif (sic_present(7,0)) then
    call sic_i4(line,7,1,ibb,.true.,error)
    nbb = 1
    jbb(nbb) = ibb 
  !
  ! /IF option
  elseif (sic_present(8,0)) then
    call sic_i4(line,8,1,iif,.true.,error)
    nbb=0
    do i=1, r_lband
      if (r_if(i).eq.iif) then
        new = .true.
        if (nbb.ge.1) then
          do j=1,nbb
            if (r_bb(i).eq.jbb(j)) new = .false.
          enddo
        endif
        if (new) then
          nbb = nbb+1
          jbb(nbb) = r_bb(i)
        endif
      endif
    enddo
  !
  ! /POLARISATION option
  elseif (sic_present(5,0)) then
     call sic_ke(line,5,1,argum,nch,.true.,error)
     if (error) return
     call sic_ambigs('MODIFY DELAY /POLARISATION',argum,kw,nkey,voc,   &
       mvoc,error)
     if (error) return
     if (kw.eq.'HORIZONTAL') then
       ipol = 1
     elseif (kw.eq.'VERTICAL') then
       ipol = 2
     elseif (kw.eq.'BOTH') then
       ipol = 3
     else
       call message(6,3,'MODIFY','Invalid polarisation '//argum)
       error = .true.
       return
     endif
     nbb=0
     do i=1, r_lband
       if (r_lpolentry(1,i).eq.ipol.or.ipol.eq.3) then
         new = .true.
         if (nbb.ge.1) then
           do j=1,nbb
             if (r_bb(i).eq.jbb(j)) new = .false.
           enddo
         endif
         if (new) then
           nbb = nbb+1
           jbb(nbb) = r_bb(i)
         endif
       endif
     enddo
  endif
  !
  ! /SWITCH option
  crossed = .false.
  direct = .false.
  if (sic_present(12,0)) then
    call sic_ke(line,12,1,argum,nch,.true.,error)
    if (error) return
    call sic_ambigs('MODIFY DELAY /SWITCH',argum,kw,nkey,voc1,mvoc1,error)
    if (error) return
    if (kw.eq.'DIRECT') then
      direct = .true.
      call message(6,1,'MODIFY', &
        'Selecting polarisation switch in '//kw//' mode')
    elseif (kw.eq.'CROSSED') then
      crossed = .true.
      call message(6,1,'MODIFY', &
        'Selecting polarisation switch in '//kw//' mode')
    else
      call message(6,3,'MODIFY','Invalid switch status '//argum)
      error = .true.
      return     
    endif
  endif
  if (nbb.le.0) then
      call message(6,3,'MODIFY','No valid baseband found')
      error = .true.
      return
  endif
  call sic_ke(line,iopt,2,argum,nch,.true.,error)
  if (error) return
  i = 2
  do while(sic_present(iopt,i))
    call sic_i4(line,iopt,i,j,.true.,error)
    if (error) return
    if (j.le.0 .or. j.gt.mnant) then
      write(argum,'(i6)')
      call message(8,4,'INI_DELAY',   &
        'Invalid antenna '//argum(1:lenc(argum)))
      error = .true.
      return
    endif
    call sic_r8(line,iopt,i+1,newval,.true.,error)
    if (error) return
    i = i+2
    do k=1, nbb
      ibb = jbb(k)
      fanew(ibb,j) = .true.
      anew(ibb,j) = newval
    enddo
  enddo
  call message(6,1,'INI_DELAY','Modifying antenna delays to :')
  do i=1, mnant
    if (fanew(ibb,i)) then
      write(chain,'(1x,i0,f15.6)') i,anew(ibb,i)
      call message(6,1,'INI_DELAY',chain(1:lenc(chain)))
    else
      write(chain,'(1x,i0,a)') i,' is not modified'
      call message(6,1,'INI_DELAY',chain(1:lenc(chain)))
    endif
  enddo
  write(chain,'(1x,8i2)'),(jbb(i),i=1,nbb)
  call message(6,1,'INI_DELAY','For basebands'//chain(1:lenc(chain)))
  if (offset) then
    call message (6,1,'INI_DELAY','(Offset values)')
  endif
  return
  !
entry mod_delay(do_write,do_data,error)
  !
  ! Get storage and data
  call get_data (ndata,data_in,error)
  if (error) return
  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 .and. r_proc.ne.p_pass) goto 500
  if (r_lmode.ne.1) goto 500
  kin = gag_pointer(data_in,memory)
  !
  ! load data header from average record:
  ipk = kin + h_offset(r_ndump+1)
  call decode_header (memory(ipk))
  do i=1, r_nant
    do  j = 1, r_nbb
      l = r_mapbb(j)
      process = fanew(l,i)
      m=(3-r_sb(l))/2
      if (direct) process = process.and.(r_polswitch(i,m).eq.0)
      if (crossed) process = process.and.(r_polswitch(i,m).ne.0)
      if (process) then
        if (offset) then
          new_delay(l,i) = dh_delay(l,i) + anew(l,i)
        else
          new_delay(l,i) = anew(l,i)
        endif
      else
        new_delay(l,i) = dh_delay(l,i)
      endif
      r_dmdelay(l,i) = new_delay(l,i)
    enddo
  enddo
  !
  ! Compute phase factors per subband (for crossed pol case)
  do is  = 1, lband_original
    do ibas = 1, r_nbas
      ia = r_iant(ibas)
      ja = r_jant(ibas)
      ipa = r_bb(is)
      jpa = r_bb(is)
      x(ibas) = f_to_k*((dh_delay(jpa,ja)-new_delay(jpa,ja))   &
        - (dh_delay(ipa,ia)-new_delay(ipa,ia)))
    enddo
    !
    ! Actually modify data:
    if (any(x.ne.0)) call modify_ph(memory(kin),x,is,rf)
  enddo
  !
  ! Save the new delays in the data headers:
  do ir = 1, r_ndump + max(1,r_ndatl)
    ipk = kin + h_offset(ir)
    call decode_header(memory(ipk))
    do ia = 1, r_nant
        call r4tor4(new_delay(1,ia),dh_delay(1,ia),1)
        call r4tor4(new_delay(2,ia),dh_delay(2,ia),1)
    enddo
    call encode_header(memory(ipk))
  enddo
  !
  do_data = .true.
500 return
end subroutine ini_delay
!
subroutine ini_position (line,iopt,error)
  use gkernel_interfaces
  use gbl_constant
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY POSITION Ra Dec
  !---------------------------------------------------------------------
  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_pi.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data
  integer :: lra,lde
  real*4 :: epoch
  real*8 :: lambda,beta,svec(3),snvec(3),sovec(3),dop,lsr
  character(len=20) :: cra,cde
  character(len=2) :: cs(7),cv(4)
  real*8 :: s_2(2), s_3(3), x_0(3), ut, xx, parang
  real*8 :: f_to_k                ! (2*pi/clight)*1d6
  parameter (f_to_k = 2*pi/299792458.d-6)
  integer :: ibas,i
  integer(kind=address_length) :: data_in,kin,ipk
  integer(kind=data_length)    :: ndata, h_offset
  integer :: itypec,dobs
  real :: x(mnbas)
  !
  integer :: mvoc1, nkey
  parameter (mvoc1=2)
  character(len=12) :: kw, voc1(mvoc1)
  data voc1/'EQUATORIAL','GALACTIC'/
  data cs /'UN','EQ','GA','HO','BD','EC','DA'/
  data cv /'LS','HE','EA','NU'/
  !------------------------------------------------------------------------
  save lambda,beta,epoch,itypec
  ! Code:
  call check_equal_file(error)
  if (error) return
  !
  ! Assume EQ with given epoch
  kw = 'EQUATORIAL'
  call clic_kw(line,iopt,2,kw,nkey,voc1,mvoc1,.false.,error,.true.)
  if (error) then
    call message(7,3,'INI_POSITION',   &
      'Only Equatorial or Galactic coordinates')
    return
  endif
  if (kw.eq.'EQUATORIAL') then
    itypec = type_eq
  elseif (kw.eq.'GALACTIC') then
    itypec = type_ga
  endif
  call sic_r4(line,iopt,3,epoch,.true.,error)
  if (error) return
  call sic_ke(line,iopt,4,cra,lra,.true.,error)
  if (error) return
  call sic_ke(line,iopt,5,cde,lde,.true.,error)
  if (error) return
  !
  call sic_sexa(cra,lra,lambda,error)
  if (error) return
  lambda = lambda*pi/12.0d0
  call sic_sexa(cde,lde,beta,error)
  if (error) return
  beta = beta*pi/180.0d0
  !
  call message (6,1,'INI_POSITION',   &
    'Modifying position to '   &
    //cra(1:lra)//' '//cde(1:lde))
  return
  !
entry mod_position(do_write,do_data,error)
  ! Test
  do_write = .false.
  do_data = .false.
  !
  ! Set time
  dobs = mod(r_dobs+32768,65536)-32768
  ut = dobs+2460549.5d0+r_ut/2d0/pi
  !
  ! new subroutine calls from astro
  call do_astro_time(ut, 0.0d0, 56.184d0, error)
  !      CALL CLIC_TIME(DOBS,R_UT,ERROR)
  if (error) return
  !
  call do_object(cs(r_typec), r_epoch, r_lam, r_bet,   &
    s_2, s_3, dop, lsr, sovec, x_0, parang, error)
  call do_object(cs(itypec), epoch, lambda, beta,   &
    s_2, s_3, dop, lsr, snvec, x_0, parang, error)
  !
  xx = 0
  do i=1,3
    svec(i) = snvec(i)-sovec(i)
    xx = xx+svec(i)**2
  enddo
  xx = sqrt(xx)*180d0*3600d0/pi
  if (abs(xx).lt.0.001) goto 500
  !
  r_lam = lambda
  r_bet = beta
  r_epoch = epoch
  r_typec = itypec
  !
  ! 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
  kin = gag_pointer(data_in,memory)
  !
  ! load data header from average record:
  ipk = kin + h_offset(r_ndump+1)
  call decode_header (memory(ipk))
  !
  ! Compute phase factors
  do ibas = 1, r_nbas
    x(ibas) = 0
    do i=1,3
      x(ibas) = x(ibas) - svec(i)*r_bas(i,ibas) * f_to_k
    enddo
  enddo
  !
  ! Actually modify data and data headers:
  call modify_ph(memory(kin),x,0,.true.)
  !
  ! Real life
  do_data = .true.
  do_write = .true.
500 continue
  return
end subroutine ini_position
!
subroutine ini_time (line,iopt,error)
  use gkernel_interfaces
  use gbl_constant
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! 	MODIFY TIME Dut1
  !---------------------------------------------------------------------
  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_pi.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data
  real*8 :: dut1
  real*8 :: svec(3),snvec(3),sovec(3),dop,lsr, parang
  character(len=80) :: chain
  character(len=2) :: cs(7),cv(4)
  real*8 :: f_to_k                ! (2*pi/clight)*1d6
  parameter (f_to_k = 2*pi/299792458.d-6)
  integer :: ibas,i
  integer(kind=address_length) :: data_in,kin,ipk
  integer(kind=data_length)    :: ndata, h_offset
  integer :: dobs
  real*8 :: s_2(2), s_3(3), x_0(3), ut, xx
  real :: x(mnbas)
  !
  save dut1
  !
  data cs /'UN','EQ','GA','HO','BD','EC','DA'/
  data cv /'LS','HE','EA','NU'/
  !------------------------------------------------------------------------
  ! Code:
  call check_equal_file(error)
  if (error) return
  !
  call sic_r8(line,iopt,2,dut1,.true.,error)
  if (error) return
  write(chain,'(F8.3)') dut1
  call message (6,1,'INI_TIME',   &
    'Modifying DUT1 by '//chain)
  dut1 = dut1*pi/12.d0/3600d0  ! In radians
  return
  !
entry mod_time (do_write,do_data,error)
  ! Test
  do_write = .false.
  do_data = .false.
  !
  ! Set time
  dobs = mod(r_dobs+32768,65536)-32768
  ut = dobs+2460549.5d0+r_ut/2d0/pi
  !
  ! new subroutine calls from astro
  call do_astro_time(ut, 0.0d0, 56.184d0, error)
  !      CALL CLIC_TIME(DOBS,R_UT,ERROR)
  if (error) return
  !
  ! new subroutine calls from astro
  call do_object(cs(r_typec), r_epoch, r_lam, r_bet,   &
    s_2, s_3, dop, lsr, sovec, x_0, parang, error)
  !
  ! Now correct the UT time
  r_ut = r_ut+dut1
  ut = mod(r_dobs+32768,65536)-32768+2460549.5d0+r_ut/2d0/pi
  call do_astro_time(ut, 0.0d0, 56.184d0, error)
  !      CALL CLIC_TIME(DOBS,R_UT,ERROR)
  if (error) return
  call do_object(cs(r_typec), r_epoch, r_lam, r_bet,   &
    s_2, s_3, dop, lsr, snvec, x_0, parang, error)
  !
  xx = 0
  do i=1,3
    svec(i) = snvec(i)-sovec(i)
    xx = xx+svec(i)**2
  enddo
  xx = sqrt(xx)*180d0*3600d0/pi
  if (abs(xx).lt.0.01) goto 500
  !
  ! 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
  kin = gag_pointer(data_in, memory)
  !
  ! load data header from average record:
  ipk = kin + h_offset(r_ndump+1)
  call decode_header (memory(ipk))
  !
  ! Compute phase factors
  do ibas = 1, r_nbas
    x(ibas) = 0
    do i=1,3
      x(ibas) = x(ibas) - svec(i)*r_bas(i,ibas) * f_to_k
    enddo
  enddo
  !
  ! Actually modify data and data headers:
  call modify_ph(memory(kin),x,0,.true.)
  !
  ! Real life
  do_data = .true.
  do_write = .true.
500 continue
  return
end subroutine ini_time
!
subroutine ini_axes(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! Command MODIFY AXES_OFFSET  a1 x1 a2 x2 a3 x3 ...
  ! correct the phases of antenna ai for the offset xi (in mm) between
  ! the qazimuth and elevation axes.
  !---------------------------------------------------------------------
  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_dheader.inc'
  include 'clic_display.inc'
  include 'clic_number.inc'
  include 'clic_stations.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data
  logical :: fanew(mnant)
  real*8 :: anew(mnant)
  integer(kind=address_length) :: data_in, kin
  integer(kind=data_length)    :: ndata
  integer :: i, j
  character(len=256) :: chain
  real*8 :: f_to_k                ! (2*pi/clight)*1d6
  parameter (f_to_k = 2*pi/299792458.d-6)
  real*8 :: bdiff
  real :: x(mnbas)
  integer :: i1, i2
  !
  save anew, fanew
  !------------------------------------------------------------------------
  ! Code:
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  do i=1, mnant
    fanew(i) = .false.
  enddo
  i = 2
  do while(sic_present(iopt,i))
    call sic_i4(line,iopt,i,j,.true.,error)
    if (error) return
    fanew(j) = .true.
    call sic_r8(line,iopt,i+1,anew(j),.true.,error)
    if (error) return
    i = i+2
  enddo
  call message(6,1,'INI_BASE','Modifying axes offsets to :')
  do i=1, mnant
    if (fanew(i)) then
      write(chain,'(1x,i0,f12.6)') i,anew(i)
      call message(6,1,'INI_BASE',chain(1:lenc(chain)))
    else
      write(chain,'(1x,i0,a)') i,' is not modified'
      call message(6,1,'INI_BASE',chain(1:lenc(chain)))
      anew(i) = 0d0
    endif
  enddo
  return
  !
entry mod_axes(do_write,do_data,error)
  ! Get storage and data
  call get_data (ndata,data_in,error)
  if (error) return
  kin = gag_pointer(data_in,memory)
  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) goto 500
  if (r_lmode.ne.1) goto 500
  !
  ! Compute baseline based axes offsets changes:
  do i = 1, r_nbas
    i1 = r_iant(i)
    i2 = r_jant(i)
    bdiff = 0
    if (fanew(i2)) bdiff = bdiff - (anew(i2)-r_axes(i2))
    if (fanew(i1)) bdiff = bdiff + (anew(i1)-r_axes(i1))
    x(i) = cos(r_el)*bdiff*f_to_k
  enddo
  !
  ! Actually modify data and data headers:
  call modify_ph(memory(kin),x,0,.true.)
  !
  ! Update header
  do i=1, r_nant
    if (fanew(i)) then
      r_axes(i) = anew(i)
    endif
  enddo
  do_data = .true.
500 return
!
end subroutine ini_axes
!
subroutine ini_focus(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  !---------------------------------------------------------------------
  ! Command MODIFY FOCUS ...
  ! correct the phases of antenna ai for the offset in focus
  ! if not (correctly) applied in real time:
  !
  ! if  DATE_OBS is before 29-may-1996 :
  !        focus offset was actually logged
  ! if  DATE_OBS is before 29-nov-1996 :
  !        no correction applied to phase from focus offset
  ! if  DATE_OBS is before 02-apr-1998 and if HIGH LOCK:
  !       the focus correction was wrong sign
  ! ->
  ! MODIFY FOCUS:
  !   - between 29-may-1996 and 29-nov-1996: apply correction in header
  !   - between 29-nov-1996 and 02-apr-1998: change sign of corr.in head.
  ! MODIFY FOCUS  a1 x1 a2 x2 a3 x3 :
  !   - any date: modify phases for the focus change and log value in head.
  !---------------------------------------------------------------------
  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_dheader.inc'
  include 'clic_display.inc'
  include 'clic_number.inc'
  include 'clic_stations.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data
  logical :: fanew(mnant)
  logical :: auto
  real*8 :: anew(mnant)
  integer(kind=address_length) :: data_in, kin
  integer(kind=data_length)    :: ndata
  integer :: i, j
  character(len=256) :: chain
  real*8 :: f_to_k                ! (2*pi/clight)*1d6
  parameter (f_to_k = 2*pi/299792458.d-6)
  real*8 :: bdiff
  real :: x(mnbas)
  integer :: i1, i2, autod(3)
  !
  save auto, anew, fanew
  !------------------------------------------------------------------------
  ! Code:
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  do i=1, mnant
    fanew(i) = .false.
  enddo
  i = 2
  do while(sic_present(iopt,i))
    call sic_i4(line,iopt,i,j,.true.,error)
    if (error) return
    fanew(j) = .true.
    call sic_r8(line,iopt,i+1,anew(j),.true.,error)
    if (error) return
    i = i+2
  enddo
  if (i.gt.2) then
    auto = .false.
    call message(6,1,'INI_FOCUS',   &
      'Modifying focus phase offsets to :')
    do i=1, mnant
      if (fanew(i)) then
        write(chain,'(1x,i0,f12.6)') i,anew(i)
        call message(6,1,'INI_BASE',chain(1:lenc(chain)))
      else
        write(chain,'(1x,i0,a)') i,' is not modified'
        call message(6,1,'INI_BASE',chain(1:lenc(chain)))
        anew(i) = 0d0
      endif
    enddo
  else
    auto = .true.
    call message(6,1,'INI_FOCUS',   &
      'Modifying focus phase offsets according to header')
    call cdate('29-may-1996',autod(1),error)
    call cdate('29-nov-1996',autod(2),error)
    call cdate('02-apr-1998',autod(3),error)
  endif
  return
  !
entry mod_focus(do_write,do_data,error)
  ! Get storage and data
  call get_data (ndata,data_in,error)
  if (error) return
  kin = gag_pointer(data_in,memory)
  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) goto 500
  if (r_lmode.ne.1) goto 500
  !
  ! Compute baseline based axes offsets changes:
  do i = 1, r_nbas
    i1 = r_iant(i)
    i2 = r_jant(i)
    bdiff = 0
    if (auto) then
      if (r_dobs.ge.autod(1).and.r_dobs.lt.autod(2)) then
        ! It was not applied ...
        bdiff = bdiff - 2*r_corfoc(i2)
        bdiff = bdiff + 2*r_corfoc(i1)
      elseif (r_dobs.ge.autod(2).and.r_dobs.lt.autod(3)) then
        if (r_lock.gt.0) then
          ! Apply twice: it was wrong way for HIGH LOCK ...
          bdiff = bdiff - 4*r_corfoc(i2)
          bdiff = bdiff + 4*r_corfoc(i1)
        endif
      endif
    else
      if (fanew(i2)) bdiff = bdiff - (anew(i2)-r_corfoc(i2))
      if (fanew(i1)) bdiff = bdiff + (anew(i1)-r_corfoc(i1))
    endif
    ! bdiff was in millimeters.
    x(i) = -bdiff*f_to_k*0.001
  enddo
  !
  ! Actually modify data and data headers:
  call modify_ph(memory(kin),x,0,.true.)  ! Could implement a differential
  ! correction here to account for
  ! different focuses. Has to know
  ! the differences in some way.
  !
  ! Update header
  if (.not.auto) then
    do i=1, r_nant
      if (fanew(i)) then
        r_corfoc(i) = anew(i)
      endif
    enddo
  endif
  do_data = .true.
500 return
!
end subroutine ini_focus
!
subroutine modify_ph(data,x,iunit,rf)
  use classic_api
  !---------------------------------------------------------------------
  ! Actually modify the data and keep track of the modify factors.
  ! X is a baseline dependent phase to frequency ratio (in radians/MHz)
  ! Add the possibility only one spectral unit
  !---------------------------------------------------------------------
  include 'clic_parameter.inc'
  real :: data(*)                   !
  real :: x(mnbas)                  !
  integer :: iunit                  ! <= 0 means all, else unit to modify
  logical :: rf
  ! Global
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  integer(kind=data_length) :: c_offset, l_offset
  integer :: k, k1, ir, ib, isb, is, i, isign
  integer :: iu1, iu2
  real :: x0, x1, cpha(2,mnbas,mcch), lpha(2,mnbas,mrlband)
  real :: ldph(2,mnbas,mrlband)
  real*8 ::  xph
  !-----------------------------------------------------------------------
  !
  ! Store data modifiers for LR+HR in all cases.
  if (iunit.le.0) then
    iu1 = 1
    iu2 = lband_original
  elseif (iunit.gt.r_nband.or.iunit.gt.lband_original) then
    call message(8,3,'MODIFY_PH','Spectral unit not in data')
    return
  else
    iu1 = iunit
    iu2 = iu1
  endif 
  do ib = 1, r_nbas
    do isb = 1, r_lnsb 
      do is = iu1, iu2
        isign = 3-2*r_lsband(isb,is)
        if (rf) then
          xph = x(ib)*(r_flo1+isign*(r_flo2(is)   &
            + r_band2(is) * (r_flo2bis(is)   &
            + r_band2bis(is)*r_cfcen(is))))
        else
          xph = x(ib)*isign*(r_flo2(is)   &
            + r_band2(is) * (r_flo2bis(is)   &
            + r_band2bis(is)*r_cfcen(is)))
        endif
        cpha(isb,ib,is) = xph
        r_dmcpha(isb,ib,is) = r_dmcpha(isb,ib,is)+xph
        if (rf) then
          x0 = x(ib)*(r_flo1+isign*(r_flo2(is)   &
            + r_band2(is) * (r_flo2bis(is)   &
            + r_band2bis(is)*r_lfcen(is))))
        else
          x0 = x(ib)*isign*(r_flo2(is) &
            + r_band2(is) * (r_flo2bis(is)   &
            + r_band2bis(is)*r_lfcen(is)))
        endif
        if (rf) then
          x1 = x(ib)*isign*r_band2(is)*r_band2bis(is)*r_lfres(is)
        else
          x1 = x(ib)*isign*r_band2(is)*r_band2bis(is)*r_lfres(is)
        endif
        lpha(isb,ib,is) = x0
        ldph(isb,ib,is) = x1
        r_dmlpha(isb,ib,is) = r_dmlpha(isb,ib,is) + x0
        r_dmldph(isb,ib,is) = r_dmldph(isb,ib,is) + x1
      enddo
    enddo
  enddo
  !
  ! In lowres mode, modify only LR data
  r_presec(modify_sec) = .true.
  if (lowres.and.iunit.gt.r_lband) return
  if (lowres.and.iunit.eq.0) iu2 = r_nbb
  !
  do ir = 1, r_ndump + max(1,r_ndatl)
    k = c_offset(ir) + 1
    ! Continuum
    do ib = 1, r_nbas
      do isb = 1, r_nsb
        k = k+ (iu1-1)*2
        do is = iu1, iu2
          xph = cpha(isb,ib,is)
          call rotate(data(k),xph)
          k = k+2
        enddo
        k = k + (r_nband-iu2)*2
      enddo
    enddo
    ! Line
    if (ir.gt.r_ndump) then
      k = l_offset(ir) + 1
      do ib = 1, r_nbas
        do isb = 1, r_lnsb
          do is = iu1, iu2
            k1 = k+2*r_lich(is)
            x0 = lpha(isb,ib,is)
            x1 = ldph(isb,ib,is)
            do i = 1, r_lnch(is)
              xph = x0+(i-r_lcench(is))*x1
              call rotate(data(k1),xph)
              k1 = k1+2
            enddo
          enddo
          k = k+2*r_lntch
        enddo
      enddo
    endif
  enddo
  return
end subroutine modify_ph
!
subroutine rotate(c,phi)
  !---------------------------------------------------------------------
  ! Rotate Phase of complex number C by PHI radians
  !---------------------------------------------------------------------
  complex :: c                      !
  real*8 :: phi                     !
  ! Local
  real*8 :: pi
  parameter (pi=3.141592653589d0)
  !------------------------------------------------------------------------
  ! Code:
  phi = mod(phi,2.*pi)
  c = c *cmplx(cos(phi), sin(phi))
  return
end subroutine rotate
!
subroutine clic_kw(line,iopt,iarg,kw,nkey,voc,mvoc,present,error,verbose)
  use gkernel_interfaces
  character(len=*) :: line          !
  integer :: iopt                   !
  integer :: iarg                   !
  character(len=*) :: kw            !
  integer :: nkey                   !
  integer :: mvoc                   !
  character(len=*) :: voc(mvoc)     !
  logical :: present                !
  logical :: error, verbose         !
  ! Local
  character(len=12) :: arg
  integer :: narg
  !-----------------------------------------------------------------------
  arg = kw
  call sic_ke(line,iopt,iarg,arg,narg,present,error)
  if (error.or.iarg.eq.0) return
  if (verbose) then
     call sic_ambigs('CLIC_KW',arg,kw,nkey,voc,mvoc,error)
  else
     call sic_ambigs('',arg,kw,nkey,voc,mvoc,error)
  endif
  return
end subroutine clic_kw
!
subroutine ini_phase(line,iopt,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_index
  use clic_virtual
  !---------------------------------------------------------------------
  ! Command MODIFY PHASE a1 d1 ... a2 x2 ... [/SWITCH DIRECT|CROSSED]
  !---------------------------------------------------------------------
  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_dheader.inc'
  include 'clic_display.inc'
  include 'clic_number.inc'
  include 'clic_stations.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  ! Local
  logical :: do_write, do_data, crossed, direct
  logical :: fanew(mnbb,mnant), process
  logical :: new
  real*8 :: anew(mnbb,mnant),newval
  integer(kind=address_length) :: data_in, kin
  integer(kind=data_length) :: ndata
  integer :: i, j, ia, ja, nch, is, ipa, jpa, k, l, m
  integer :: ibas, ibb, iif, jbb(mnbb), nbb, ipol
  integer :: mvoc,nkey, mvoc1
  parameter (mvoc = 3, mvoc1 = 2)
  character(len=12) :: voc(mvoc),voc1(mvoc1)
  character(len=12) :: argum,kw
  character(len=256) :: chain
  character(len=1) :: arg1
  real*8 :: f_to_k
  parameter (f_to_k = 2*pi/1000.)
  real :: x(mnbas), new_phase(mnbb,mnant)
  !
  save  anew, fanew, direct, crossed
  !
  data voc/'HORIZONTAL','VERTICAL','BOTH'/
  data voc1/'DIRECT','CROSSED'/
  !------------------------------------------------------------------------
  ! Code:
  if (write_mode.eq.'UPDA') call check_equal_file(error)
  if (error) return
  call sic_ke(line,iopt,1,arg1,nch,.false.,error)
  if (error) return
  if (arg1.ne.'P') then
    error = .true.
    return
  endif
  error = .false.
  do i=1, mnant
    do j = 1, mnbb
      fanew(j,i) = .false.
    enddo
  enddo
  !
  ! /ALL option
  if (sic_present(10,0)) then
    nbb = r_nbb
    do i=1, r_nbb
      jbb(i) = i
    enddo
  !
  ! /BBAND option
  elseif (sic_present(7,0)) then
    call sic_i4(line,7,1,ibb,.true.,error)
    nbb = 1
    jbb(nbb) = ibb 
  !
  ! /IF option
  elseif (sic_present(8,0)) then
    call sic_i4(line,8,1,iif,.true.,error)
    nbb=0
    do i=1, r_lband
      if (r_if(i).eq.iif) then
        new = .true.
        if (nbb.ge.1) then
          do j=1,nbb
            if (r_bb(i).eq.jbb(j)) new = .false.
          enddo
        endif
        if (new) then
          nbb = nbb+1
          jbb(nbb) = r_bb(i)
        endif
      endif
    enddo
  endif
  !
  ! /POLARISATION option
  if (sic_present(5,0)) then
    call sic_ke(line,5,1,argum,nch,.true.,error)
    if (error) return
    call sic_ambigs('MODIFY PHASE /POLARISATION',argum,kw,nkey,voc,   &
     mvoc,error)
    if (error) return
    if (kw.eq.'HORIZONTAL') then
      ipol = 1
    elseif (kw.eq.'VERTICAL') then
      ipol = 2
    elseif (kw.eq.'BOTH') then
      ipol = 3
    else
      call message(6,3,'MODIFY','Invalid polarisation '//argum)
      error = .true.
      return
    endif
    nbb=0
    do i=1, r_lband
      if (r_lpolentry(1,i).eq.ipol.or.ipol.eq.3) then
        new = .true.
        if (nbb.ge.1) then
          do j=1,nbb
            if (r_bb(i).eq.jbb(j)) new = .false.
          enddo
        endif
        if (new) then
          nbb = nbb+1
          jbb(nbb) = r_bb(i)
        endif
      endif
    enddo
  endif
  !
  ! /SWITCH option
  crossed = .false.
  direct = .false.
  if (sic_present(12,0)) then
    call sic_ke(line,12,1,argum,nch,.true.,error)
    if (error) return
    call sic_ambigs('MODIFY PHASE /SWITCH',argum,kw,nkey,voc1,mvoc1,error)
    if (error) return
    if (kw.eq.'DIRECT') then
      direct = .true.
      call message(6,1,'MODIFY', &
        'Selecting polarisation switch in '//kw//' mode')
    elseif (kw.eq.'CROSSED') then
      crossed = .true.
      call message(6,1,'MODIFY', &
        'Selecting polarisation switch in '//kw//' mode')
    else
      call message(6,3,'MODIFY','Invalid switch status '//argum)
      error = .true.
      return     
    endif
  endif
!
! Now code
  if (nbb.le.0) then
      call message(6,3,'MODIFY','No valid baseband found')
      error = .true.
      return
  endif
  call sic_ke(line,iopt,2,argum,nch,.true.,error)
  if (error) return
  i = 2
  do while(sic_present(iopt,i))
    call sic_i4(line,iopt,i,j,.true.,error)
    if (error) return
    if (j.le.0 .or. j.gt.mnant) then
      write(argum,'(i6)')
      call message(8,4,'INI_PHASE',   &
        'Invalid antenna '//argum(1:lenc(argum)))
      error = .true.
      return
    endif
    call sic_r8(line,iopt,i+1,newval,.true.,error)
    if (error) return
    i = i+2
    do k=1, nbb
      ibb = jbb(k)
      fanew(ibb,j) = .true.
      anew(ibb,j) = newval
    enddo
  enddo
  call message(6,1,'INI_PHASE','Modifying antenna phases by :')
  do i=1, mnant
    if (fanew(ibb,i)) then
      write(chain,'(1x,i0,f15.6)') i,anew(ibb,i)
      call message(6,1,'INI_PHASE',chain(1:lenc(chain)))
    else
      write(chain,'(1x,i0,a)') i,' is not modified'
      call message(6,1,'INI_PHASE',chain(1:lenc(chain)))
    endif
  enddo
  write(chain,'(1x,8i2)'),(jbb(i),i=1,nbb)
  call message(6,1,'INI_PHASE','For basebands'//chain(1:lenc(chain)))
  return
  !
entry mod_phase(do_write,do_data,error)
  !
  do_data = .false.
  if (error) return
  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 .and. r_proc.ne.p_pass) goto 500
  if (r_lmode.ne.1) goto 500
  !
  do i=1, r_nant
    do  j = 1, r_nbb
      l = r_mapbb(j)
      process = fanew(l,i)
      m=(3-r_sb(l))/2    
      if (direct)  process = process.and.(r_polswitch(i,m).eq.0)
      if (crossed) process = process.and.(r_polswitch(i,m).ne.0)
      if (process) then
        new_phase(l,i) = anew(l,i)
      else
        new_phase(l,i) = 0.0
      endif
    enddo
  enddo
  !
  ! Compute phase factors per subband (for crossed pol case)
  do is  = 1, lband_original
    do ibas = 1, r_nbas
      ia = r_iant(ibas)
      ja = r_jant(ibas)
      ipa = r_bb(is)
      jpa = r_bb(is)
      x(ibas) = new_phase(ipa,ia)-new_phase(jpa,ja)
      if (degrees) x(ibas) = x(ibas)*pi/180.
    enddo
    !
    ! Actually modify data:
    if (got_data(r_xnum)) then
      call get_data(ndata,data_in,error)
      kin = gag_pointer(data_in,memory)
    else
      kin = 0
    endif
    if (any(x.ne.0)) call modify_phase(memory(kin),x,is)
  enddo
  if (.not.got_data(r_xnum)) goto 500
  !
  do_data = .true.
500 return
end subroutine ini_phase
!
subroutine modify_phase(data,x,iunit)
  use classic_api
  use clic_index
  use clic_virtual
  !---------------------------------------------------------------------
  ! Actually modify the data and keep track of the modify factors.
  ! X is a baseline dependent phase offset.
  ! Add the possibility only one spectral unit.
  !---------------------------------------------------------------------
  include 'clic_parameter.inc'
  real :: data(*)                   !
  real :: x(mnbas)                  !
  integer :: iunit                  ! <= 0 means all, else unit to modify
  ! Global
  include 'clic_par.inc'
  include 'clic_clic.inc'
  ! Local
  integer(kind=data_length) :: c_offset, l_offset
  integer :: k, k1, ir, ib, isb, is, i, isign
  integer :: iu1, iu2
  real :: cpha(2,mnbas,mcch), lpha(2,mnbas,mrlband)
  real*8 ::  xph
  !-----------------------------------------------------------------------
  !
  ! Store data modifiers for LR+HR in all cases.
  if (iunit.le.0) then
    iu1 = 1
    iu2 = lband_original
  elseif (iunit.gt.r_nband.or.iunit.gt.lband_original) then
    call message(8,3,'MODIFY_PH','Spectral unit not in data')
    return
  else
    iu1 = iunit
    iu2 = iu1
  endif 
  do ib = 1, r_nbas
    do isb = 1, r_lnsb 
      do is = iu1, iu2
        isign = 3-2*r_lsband(isb,is)
        cpha(isb,ib,is) = x(ib)
        r_dmcpha(isb,ib,is) = r_dmcpha(isb,ib,is)+x(ib)
        lpha(isb,ib,is) = x(ib)
        r_dmlpha(isb,ib,is) = r_dmlpha(isb,ib,is) + x(ib)
      enddo
    enddo
  enddo
  !
  ! In lowres mode, modify only LR data
  r_presec(modify_sec) = .true.
  if (lowres.and.iunit.gt.r_lband) return
  if (lowres.and.iunit.eq.0) iu2 = r_nbb
  !
  ! Only modify data in memory
  if (.not.got_data(r_xnum)) return
  !
  do ir = 1, r_ndump + max(1,r_ndatl)
    k = c_offset(ir) + 1
    ! Continuum
    do ib = 1, r_nbas
      do isb = 1, r_nsb
        k = k+ (iu1-1)*2
        do is = iu1, iu2
          xph = cpha(isb,ib,is)
          call rotate(data(k),xph)
          k = k+2
        enddo
        k = k + (r_nband-iu2)*2
      enddo
    enddo
    ! Line
    if (ir.gt.r_ndump) then
      k = l_offset(ir) + 1
      do ib = 1, r_nbas
        do isb = 1, r_lnsb
          do is = iu1, iu2
            k1 = k+2*r_lich(is)
            xph = lpha(isb,ib,is)
            do i = 1, r_lnch(is)
              call rotate(data(k1),xph)
              k1 = k1+2
            enddo
          enddo
          k = k+2*r_lntch
        enddo
      enddo
    endif
  enddo
  return
end subroutine modify_phase
