subroutine clic_copy(line,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_file
  use clic_index
  !---------------------------------------------------------------------
  ! Command COPY = MODIFY NOTHING
  !     well not so simple
  ! COPY DATA|HEADERS [ANT | NOANT] [BASE | NOBASE]
  ! 1:
  !     DATA     data and headers are copied
  !     HEADERS  headers only
  ! 2 and/or 3:
  !     ANT      Antenna calibration section created
  !     BASE     Baseline calibration section created
  !     NOANT    Antenna calibration sections  NOT created
  !     NOBASE   Baseline calibration sections NOT created
  ! otherwise sections are copied if and only if present.
  ! default is "ANT"
  ! Bure copy Job does "NOANT NOBASE"
  !---------------------------------------------------------------------
  character(len=*) :: line          !
  logical :: error                  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_clic.inc'
  include 'clic_par.inc'
  include 'clic_dheader.inc'
  include 'clic_proc_par.inc'
  include 'gbl_memory.inc'
  include 'gbl_pi.inc'
  include 'clic_virtual.inc'
  ! Local
  logical :: end, check, extract
  integer(kind=address_length) :: data_in, ip_data, kh, data_out
  integer(kind=data_length) :: ndata,ndata_out, h_offset
  integer :: narg, ii, esb
  character(len=80) :: chain
  character(len=7) :: done
  character(len=12) :: argum, argum2
  logical :: do_write_saved, acopy, bcopy, askip, bskip,do_list,norf
  integer :: mvoc1, mvoc2,mvoc3
  parameter (mvoc1=5, mvoc2=6,mvoc3=2)
  character(len=12) :: voc1(mvoc1), voc2(mvoc2),voc3(mvoc3)
  data voc1/'HEADERS','NOHEADERS','DATA','NODATA','LIST'/
  data voc2/'ANTENNA','NOANTENNA','BASELINE','NOBASELINE','NOCHECK',&
            'NORF'/
  data voc3/'USB','LSB'/
  !------------------------------------------------------------------------
  ! Code:
  do_write_saved = do_write_data
  extract = .false.
  do_list = .false.
  if (sic_present(1,0)) then
    call clic_kw(line,1,1,argum,narg,voc3,mvoc3,.true.,error,.true.)
    if (error) return
    extract = .true.
    esb = narg
  endif 
  argum = 'HEADERS'
  call clic_kw(line,0,1,argum,narg,voc1,mvoc1,.true.,error,.true.)
  if (error) return
  if (argum.eq.'HEADERS' .or. argum.eq.'NODATA') then
    do_write_data = .false.
    if (extract) then
      call message(6,3,'CLIC_COPY','Option /EXTRACT not compatible with'// &
&       'COPY HEADERS')
      error = .true.
      return
    endif
  elseif (argum.eq.'NOHEADERS' .or. argum.eq.'DATA') then
    do_write_data = .true.
  elseif (argum.eq.'LIST') then
    do_list = .true.
    r_presec(bpcal_sec) = .false.
    r_presec(ical_sec) =  .false.
    r_presec(abpcal_sec) =  .false.
    r_presec(aical_sec) =  .false.
  endif
  ! FULL BASELINE or ANTENNA
  acopy = .true.
  bcopy = .false.
  askip = .false.
  bskip = .false.
  check = .true.
  norf  = .false.
  do ii=2, sic_narg(0)
    argum2 = 'ANTENNA'
    call clic_kw(line,0,ii,argum2,narg,voc2,mvoc2,.false.,error,.true.)
    if (error) return
    if (argum2.eq.'ANTENNA') then
      acopy = .true.
      askip = .false.
    elseif (argum2.eq.'NOANTENNA') then
      askip = .true.
      acopy = .false.
    elseif (argum2.eq.'BASELINE') then
      bcopy = .true.
      bskip = .false.
    elseif (argum2.eq.'NOBASELINE') then
      bskip = .true.
      bcopy = .false.
    elseif (argum2.eq.'NOCHECK') then
      check = .false.
    elseif (argum2.eq.'NORF') then
      norf = .true.
    endif
  enddo
  !
  call check_input_file(error)
  if (error) goto 99
  call check_index(error)
  if (error) goto 99
  call check_output_file(error)
  if (error) goto 99
  call check_different_file(error)
  if (error) goto 99
  call show_general('COPY',.false.,line,error)
  if (error) goto 99
  !
  ! Loop on current index
100 call get_first(.true.,error)
  if (error) goto 99
  end = .false.
  got_data = .false.
  do while (.not.end)
    ! Get storage and data
    if (.not.do_list) then 
      call get_data (ndata,data_in,error)
      if (error) goto 99
      ip_data = gag_pointer(data_in,memory)
      ! Write
      kh = ip_data + h_offset(r_ndump + 1)
      call decode_header (memory(kh))
      ! this is the only reason to acess tha data itself.
      ! Only needed for data older than 11 feb 1997.
      ! Sould be tested.
      ! For time consistency
      r_ut = dh_utc*2*pi/86400.
      r_dobs = dh_obs
      !
      ! Reserve space for ANTENNA based sections only by default.
      r_bpcdeg = 40
      r_abpcdeg = 40
      r_icdeg = 3
      r_aicdeg = 3
      if (r_proc.ne.p_pass .and. r_proc.ne.p_skydip   &
        .and. r_proc.ne.p_sky .and. r_proc.ne.p_cal   &
        .and. r_proc.ne.p_onoff .and. r_proc.ne.p_pseudo) then 
        r_presec(bpcal_sec)=((r_presec(bpcal_sec).and..not.bskip)  &
          .or. bcopy)  .and. .not. norf
        r_presec(ical_sec)=(r_presec(ical_sec).and..not.bskip)   &
          .or. bcopy
        r_presec(abpcal_sec)=((r_presec(abpcal_sec).and..not.askip) &
           .or. acopy) .and. .not. norf
        r_presec(aical_sec)=(r_presec(aical_sec).and..not.askip)   &
          .or. acopy
      else
        r_presec(bpcal_sec) = .false.
        r_presec(ical_sec) =  .false.
        r_presec(abpcal_sec) =  .false.
        r_presec(aical_sec) =  .false.
      endif
      if (extract) then
        write(chain,'(a,i0,a,i0,a)') 'Extracting band '//voc3(esb)
        call message(6,1,'COPY',chain(1:lenc(chain)))
        !
        ! Extract desired sideband
        call extract_data(data_in,ndata,data_out,ndata_out,esb,error)
        if (error) return
        !
        ! Point to new data
        ip_data = gag_pointer(data_out,memory)
        data_in = data_out    ! Required if subsequent update
        ndata = ndata_out
        !
        ! Update data address in buffer for further use
        v_data_length(r_xnum) = ndata
        v_data(r_xnum) = data_out      
      endif
      if (e%version.ne.version_current.and.do_write_data) then
        !
        ! New file: update data header to latest version
        write(chain,'(a,i0,a,i0,a)') 'Updating observation version from ', &
            e%version,' to current version (',version_current,')'
        call message(6,1,'COPY',chain(1:lenc(chain)))
        call update_observation(data_in,ndata,data_out,ndata_out,error)
        if (error) return
        !
        ! Point to new data
        ip_data = gag_pointer(data_out,memory)
        ndata = ndata_out
        !
        ! Update data address in buffer for further use
        v_data_length(r_xnum) = ndata
        v_data(r_xnum) = data_out
      endif
    endif
    call ipb_write(write_mode,check,error)
    if (.not.error) then
      if (.not.do_list) call wdata (ndata,memory(ip_data),.true.,error)
      if (error) goto 99
      call ipb_close(error)
      if (error) goto 99
      write(chain,'(a,i6,a,i6,a)') 'Observation ',r_num,   &
        ' '//done(write_mode)//' (',r_ndump,' records)'
      call message(4,1,'CLIC_COPY',chain(1:50))
    endif
200 if (sic_ctrlc()) then
      error = .true.
      goto 99
    endif
    call get_next(end,error)
    if (error) goto 99
  enddo
99 do_write_data = do_write_saved
  return
end subroutine clic_copy
!
subroutine extract_data(data_in,ndata_in,data_out,ndata_out,esb,error)
  use gkernel_interfaces
  use gildas_def
  use classic_api
  use clic_index
  !
  ! Routine to extract one sideband from the data
  !
  integer(kind=address_length) :: data_in   ! Data in address
  integer(kind=data_length)    :: ndata_in  ! Data length  
  integer(kind=address_length) :: data_out  ! Data out address 
  integer(kind=data_length)    :: ndata_out ! Data length  
  integer(kind=4)              :: esb       ! Sideband to extract 
  logical                      :: error     ! Error flag
  !
  ! Global
  include 'clic_parameter.inc'
  include 'clic_par.inc'
  include 'gbl_memory.inc'
  !
  ! Local
  integer(kind=data_length) :: h_offset, c_offset, l_offset
  integer :: ir, ibas, isb, isub
  integer :: kin, ipk, kou, opk
  integer :: ldatc, ldatl, ldump
  !
  ! Do nothing on autocorrelation
  if (r_lmode.ne.1) then
    data_out  = data_in 
    ndata_out = ndata_in
    return
  endif
  !   
  ! Return an error if only one SB present
  if (r_lnsb.lt.2) then
    call message(8,3,'EXTRACT','Data have only one sideband')
    error = .true.
    return
  endif
  ! 
  ! Out sizes
  ldatc   = r_ldatc/2        ! Continuum data length
  ldatl   = r_ldatl/2        ! Line data length
  ldump   = ldatc+r_ldpar  ! Continuumm record dump length
  if (r_ndatl.ge.1) then
    ndata_out = (r_ndump+r_ndatl)*ldump+r_ndatl*ldatl 
  else
    ndata_out = (r_ndump+1)*ldump+ldatl
  endif
  !
  ! Get some memory 
  call get_memory(ndata_out,data_out,error)
  if (error) then
    call message(6,3,'EXTRACT','Problems with getting memory')
    return
  endif
  !
  ! First temporal dumps
  kin = gag_pointer(data_in,memory)
  kou = gag_pointer(data_out,memory)
  opk = kou
  do ir = 1, r_ndump
    ipk = kin + h_offset(ir)
    call decode_header(memory(ipk))
    ! Place here modifications to data header
    call encode_header(memory(opk))
    opk = opk + r_ldpar
    !
    ! Extract continuum data
    ipk = kin + c_offset(ir)
    do ibas = 1, r_nbas
      if (esb.eq.2) ipk = ipk + 2*r_nband
      call w4tow4(memory(ipk),memory(opk),2*r_nband)
      ipk = ipk + 2*r_nband
      opk = opk + 2*r_nband
      if (esb.eq.1) ipk = ipk + 2*r_nband
    enddo    
  enddo
  !
  ! Then time averaged dumps
  do ir = r_ndump+1, r_ndump+max(1, r_ndatl)
    ipk = kin + h_offset(ir)
    call decode_header(memory(ipk))
    ! Place here modifications to data header
    call encode_header(memory(opk))
    opk = opk + r_ldpar
    !
    ! Extract continuum data
    ipk = kin + c_offset(ir)
    do ibas = 1, r_nbas
      if (esb.eq.2) ipk = ipk + 2*r_nband
      call w4tow4(memory(ipk),memory(opk),2*r_nband)
      ipk = ipk + 2*r_nband
      opk = opk + 2*r_nband
      if (esb.eq.1) ipk = ipk + 2*r_nband
    enddo 
    !
    ! Extract line data   
    ipk = kin + l_offset(ir)
    do ibas = 1, r_nbas
      if (esb.eq.2) ipk = ipk + 2*r_lntch
      call w4tow4(memory(ipk),memory(opk),2*r_lntch)
      ipk = ipk + 2*r_lntch
      opk = opk + 2*r_lntch
      if (esb.eq.1) ipk = ipk + 2*r_lntch
    enddo
  enddo
  !
  ! Update data descriptor
  r_ldatc = ldatc
  r_ldatl = ldatl
  r_ldump = ldump
  !
  ! Update continuum and line sections
  r_nsb = 1
  r_sband(1,1:r_nsb)  = esb
  r_lnsb = 1
  r_lsband(1,1:r_lnsb) = esb
  return
end subroutine extract_data
