subroutine merge(set,all,error,user_function)
  use gbl_constant
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>merge
  use class_index
  use class_types
  !----------------------------------------------------------------------
  ! @ public
  ! Support routine for command MERGE.
  ! Gather observations in the index into a single observations
  !
  ! * No consistency check is done
  ! * The resulting R buffer is labeled as "irregularly sampled"
  ! * time is sum(time)
  ! * Tsys is <Tsys> weighted by time
  ! * tau  is <tau>  weighted by time
  !----------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set
  type(observation),   intent(inout) :: all
  logical,             intent(inout) :: error
  logical,             external      :: user_function
  ! Local
  character(len=*), parameter :: proc='MERGE'
  type (observation) :: obs
  integer(kind=4) :: ier,npoin_final
  integer(kind=entry_length) :: iobs,i1,i2
  real(xdata_kind), allocatable :: wx(:)
  real(kind=4), allocatable :: wy(:),w4(:)
  integer(kind=4), allocatable :: wint(:)
  real(kind=4) :: total_time,newtsys,newtau
  !
  ! Verify if any input file
  if (.not.filein_opened(proc,error))  return
  if (cx%next.le.1) then
     call class_message(seve%e,proc,'Index is empty')
     error = .true.
     return
  endif
  !
  !
  knext= 1
  call init_obs(obs)
  !
  ! Read the first observation into OBS
  call get_first(set,obs,user_function,error)
  if (error) return
  !
  !
  if (obs%head%gen%kind.ne.kind_cont) then
     call class_message(seve%e,proc,'Only for continuum drifts')
     error = .true.
     return
  endif
  !
  ! if only one spectrum, make a copy
  if (cx%next.eq.2) then
     call class_message(seve%w,proc,'Only one spectrum in index!')
     call copy_obs(obs,all,error)
     if (error) then
        call class_message(seve%e,proc,'Could not copy input spectrum')
        return
     endif
  else
     !
     ! Compute final number of points
     i1 = 1
     i2 = obs%head%dri%npoin
     npoin_final = obs%head%dri%npoin
     do iobs = 2,cx%next-1
        call get_it(set,obs,cx%ind(iobs),user_function,error)
        if (error) return
        npoin_final = npoin_final + obs%head%dri%npoin
     enddo
     !
     ! Allocate working arrays
     allocate(wx(npoin_final),wy(npoin_final),wint(npoin_final),w4(npoin_final),stat=ier)
     if (failed_allocate(proc,'WX,WY,WINT,WW',ier,error)) return
     !
     ! Allocate ALL observation
     all%head  = obs%head
     call reallocate_obs(all,npoin_final,error)
     if (error) return
     all%head%dri%npoin = npoin_final
     !
     ! Loop over index
     i2 = 0
     total_time = 0.
     newtsys    = 0.
     newtau     = 0.
     do iobs = 1,cx%next-1
        call get_it(set,obs,cx%ind(iobs),user_function,error)
        if (error) exit
        call abscissa(set,obs,error)   ! Compute X arrays according to type and unit
        if (error) exit
        i1 = i2+1
        i2 = i1+obs%head%dri%npoin-1
        wx(i1:i2) = obs%datax
        wy(i1:i2) = obs%data1
        !
        ! Compute new header variables
        total_time = total_time + obs%head%gen%time
        newtsys    = newtsys + obs%head%gen%tsys*obs%head%gen%time
        newtau     = newtau  + obs%head%gen%tau*obs%head%gen%time
        call class_controlc(proc,error)
        if (error) return
     enddo
     !
     ! Sort arrays
     call gr8_trie(wx,wint,npoin_final,error)
     if (error) then
        call class_message(seve%e,proc,'Could not sort arrays')
        return
     endif
     call gr4_sort(wy,w4,wint,npoin_final)
     !
     all%datax = wx
     all%data1 = wy
  endif
  !
  ! Finalize the output observation
  if (.not.error) then
    !
    ! History will be used to keep list of summed spectra
    all%head%presec(class_sec_his_id) = .true.
    !
    ! The summed spectrum is generated by program:
    all%head%xnum = -1
    !
    ! Update header (calibration parameters)
    all%head%gen%time = total_time
    all%head%gen%tsys = newtsys / total_time
    all%head%gen%tau  = newtau / total_time
    !
    all%head%presec(class_sec_xcoo_id) = .true.
    call abscissa(set,all,error)
    if (error) return
    call newdat(set,all,error)
    call newdat_assoc(set,all,error)
    call newdat_user(set,all,error)
  endif
  !
  ! Free memory
  call free_obs(obs)
  deallocate(wx,wy,wint,w4)
end subroutine merge
