subroutine smooth(set,line,r,t,error,user_function)
  use gildas_def
  use gbl_message
  use classcore_dependencies_interfaces
  use classcore_interfaces, except_this=>smooth
  use class_types
  !---------------------------------------------------------------------
  ! @ public
  ! CLASS Support routine for command
  ! SMOOTH [AUTO|BOX n|HANNING|GAUSS Width]
  !---------------------------------------------------------------------
  type(class_setup_t), intent(in)    :: set            !
  character(len=*),    intent(in)    :: line           !
  type(observation),   intent(inout) :: r,t            !
  logical,             intent(inout) :: error          !
  logical,             external      :: user_function  !
  ! Local
  character(len=*), parameter :: rname='SMOOTH'
  integer(kind=4) :: nx,nkey,nc
  integer(kind=4), parameter :: mvoc=4
  character(len=12) :: vocab(mvoc),method,key
  real(kind=4) :: w,space,ushift
  real(kind=8) :: hspace,hshift
  ! Data
  data vocab/'HANNING','GAUSS','BOX','NOISE'/
  !
  ! Command line parsing
  method = 'HANNING'
  call sic_ke (line,0,1,method,nc,.false.,error)
  if (error) return
  call sic_ambigs(rname,method,key,nkey,vocab,mvoc,error)
  if (error)  return
  !
  if (r%head%xnum.eq.0) then
    call class_message(seve%e,rname,'No R spectrum in memory')
    error = .true.
    return
  endif
  !
  select case (key)
  case ('HANNING')
    ! If all parameters are absent (default 0), the default engine will
    ! be used. Else use the generic one.
    w = 0.
    call sic_r4 (line,0,2,w,.false.,error)
    if (error) return
    w = abs(w/(r%datax(2)-r%datax(1)))  ! Current X unit to channels
    !
    space = 0.
    call sic_r4 (line,0,3,space,.false.,error)
    if (error) return
    space = abs(space/(r%datax(2)-r%datax(1)))  ! Current X unit to channels
    !
    ushift = 0.
    call sic_r4 (line,0,4,ushift,.false.,error)
    if (error) return
    ushift = ushift/abs(r%datax(2)-r%datax(1))  ! Current X unit to channels
    !
  case ('GAUSS')
    call sic_r4 (line,0,2,w,.true.,error)
    if (error) return
    w = w/(r%datax(2)-r%datax(1))  ! Current X unit to channels
    !
  case ('BOX')
    call sic_i4 (line,0,2,nx,.true.,error)
    if (error) return
    if (nx.lt.2) then
      call class_message(seve%e,rname,'Box width must be larger than 1')
      error = .true.
      return
    endif
    !
  case ('NOISE')
    call sic_r4 (line,0,2,w,.true.,error)
    if (error) return
    nx = (r%head%spe%nchan+1)/2
    call sic_i4 (line,0,3,nx,.false.,error)
    if (error) return
    nx = min(nx,(r%head%spe%nchan+1)/2)
    if (nx.lt.2) then
      call class_message(seve%e,rname,'Number of points out of range')
      error = .true.
      return
    endif
    !
  end select
  !
  if (key.eq.'HANNING') then
    call smhann(t%spectre,r%spectre,r%cnchan,r%cbad,w,space,ushift,error)
  elseif (key.eq.'GAUSS') then
    call smgauss(t%spectre,r%spectre,r%cnchan,r%cbad,w,error)
  elseif (key.eq.'BOX') then
    call smbox(t%spectre,r%spectre,r%cnchan,r%cbad,nx,error)
  elseif (key.eq.'NOISE') then
    call smnois(t%spectre,r%spectre,r%cnchan,nx,w,r%head%spe%bad)
  endif
  if (error)  return
  !
  ! New header parameters:
  if (key.eq.'HANNING') then
    if (w.eq.0. .and. space.eq.0.) then
      ! Default smoothing was used
      hspace = 2.d0
      hshift = 0.d0
    else
      hspace = space
      hshift = space/2.d0-0.5d0-ushift  ! Same as subroutine smhann
    endif
    if (r%head%gen%kind.eq.kind_spec) then
      r%head%spe%nchan = r%cnchan
      r%head%spe%vres = r%head%spe%vres*hspace
      r%head%spe%fres = r%head%spe%fres*hspace
      r%head%spe%rchan= (r%head%spe%rchan+hshift)/hspace
    else
      r%head%dri%npoin = r%cnchan
      r%head%dri%ares = r%head%dri%ares*hspace
      r%head%dri%rpoin = (r%head%dri%rpoin+hshift)/hspace
    endif
  elseif (key.eq.'BOX') then
    if (r%head%gen%kind.eq.kind_spec) then
      r%head%spe%nchan = r%cnchan
      r%head%spe%vres  = r%head%spe%vres*nx
      r%head%spe%fres  = r%head%spe%fres*nx
      r%head%spe%rchan = (2.d0*r%head%spe%rchan+nx-1.d0)/2.d0/nx
    else
      r%head%dri%npoin = r%cnchan
      r%head%dri%ares  = r%head%dri%ares*nx
      r%head%dri%tres  = r%head%dri%tres*nx
      r%head%dri%rpoin = (2.*r%head%dri%rpoin+nx-1.)/2/nx
    endif
  endif
  call newdat(set,r,error)
  if (error)  return
  !
  if (r%head%presec(class_sec_assoc_id)) then
    ! Also smooth Associated Arrays
    call smooth_assoc(r%assoc,key,w,space,ushift,nx,error)
    if (error) then
      call class_message(seve%w,rname,  &
        'Section Associated Array could not be smoothed. Removed.')
      r%head%presec(class_sec_assoc_id) = .false.
      call rzero_assoc(r)
      error = .false.  ! Not fatal
    endif
    call newdat_assoc(set,r,error)
    if (error)  return
  endif
  !
end subroutine smooth
!
subroutine smnois(yin,yout,ny,nx,seuil,bad)
  !---------------------------------------------------------------------
  ! @ private
  ! CLASS
  !	Noise cheating smoothing routine
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)  :: ny        ! Number of pixels
  real(kind=4),    intent(in)  :: yin(ny)   ! Input spectrum
  real(kind=4),    intent(out) :: yout(ny)  ! Output spectrum
  integer(kind=4), intent(in)  :: nx        ! Maximum number of pixels smoothed
  real(kind=4),    intent(in)  :: seuil     ! Smoothing threshold
  real(kind=4),    intent(in)  :: bad       ! Blanking value
  ! Local
  integer(kind=4) :: i,k,n
  real(kind=4) :: y
  !
  do i=1,ny
    if (yin(i).eq.bad) then
      y = 0.0
      n = 0
    else
      y = yin(i)
      n = 1
    endif
    k = 1
    do while(y.lt.seuil .and. k.lt.nx)
      if (i-k.ge.1) then
        if (yin(i-k).ne.bad) then
          n = n+1
          y = y+yin(i-k)
        endif
      endif
      if (i+k.le.ny) then
        if (yin(i+k).ne.bad) then
          n = n+1
          y = y+yin(i+k)
        endif
      endif
      k = k+1
    enddo
    if (n.ne.0) then
      yout(i) = y/n
    else
      yout(i) = bad
    endif
  enddo
end subroutine smnois
!
subroutine smhann_default(ty,ry,cnchan,cbad,error)
  use gildas_def
  use gbl_message
  use classcore_interfaces, except_this=>smhann_default
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   SMOOTH HANNING (no arguments)
  ! Makes a Hanning smoothing of the input data with a window width of
  ! 4 channels.
  !---------------------------------------------------------------------
  integer(kind=4), intent(inout) :: cnchan      ! Updated in return
  real(kind=4),    intent(in)    :: ty(cnchan)  !
  real(kind=4),    intent(out)   :: ry(cnchan)  !
  real(kind=4),    intent(in)    :: cbad        !
  logical,         intent(inout) :: error       !
  ! Local
  character(len=*), parameter :: rname='SMOOTH'
  integer(kind=4) :: j,i,w
  character(len=message_length) :: mess
  !
  j = 0
  if (cnchan.lt.5) then
    write(mess,'(A,I0,A)')  'Too few channels (',cnchan,')'
    call class_message(seve%e,rname,mess)
    error = .true.
    return
  endif
  !
  if (ty(1).ne.cbad) then
    ry(1) = ty(1)
    w = 1
  else
    ry(1) = 0.0
    w = 0
  endif
  j = 1
  do i=2,cnchan-1,2
    if (ty(i).ne.cbad) then
      ry(j) = ry(j)+2.0*ty(i)
      w = w+2
    endif
    if (ty(i+1).ne.cbad) then
      ry(j) = ry(j)+ty(i+1)
      w = w+1
      ry(j) = ry(j)/w
      j = j+1
      ry(j) = ty(i+1)
      w = 1
    elseif (w.ne.0) then
      ry(j) = ry(j)/w
      w = 0
      j = j+1
      ry(j) = 0.0
    else
      ry(j) = cbad
      j = j+1
      ry(j) = 0.0
    endif
  enddo
  cnchan = j-1
end subroutine smhann_default
!
subroutine smhann(ty,ry,cnchan,cbad,width,space,ushift,error)
  use phys_const
  use gildas_def
  use gbl_message
  use classcore_interfaces, except_this=>smhann
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   SMOOTH HANNING
  ! Makes a Hanning smoothing of the input data
  !---------------------------------------------------------------------
  integer(kind=4), intent(inout) :: cnchan      ! Updated in return
  real(kind=4),    intent(in)    :: ty(cnchan)  !
  real(kind=4),    intent(out)   :: ry(cnchan)  !
  real(kind=4),    intent(in)    :: cbad        !
  real(kind=4),    intent(in)    :: width       ! [channels] Hann window width
  real(kind=4),    intent(in)    :: space       ! [channels] Output channel spacing
  real(kind=4),    intent(in)    :: ushift      ! [channels] User custom shift
  logical,         intent(inout) :: error       !
  ! Local
  character(len=*), parameter :: rname='SMOOTH'
  integer(kind=4) :: ic,ochan
  real(kind=4) :: ichan,lichan,fichan,wichan,wochan,shift
  !
  if (width.eq.0. .and. space.eq.0.) then
    call smhann_default(ty,ry,cnchan,cbad,error)
    return
  endif
  !
  ! Sanity check
  if (width.le.1.) then
    call class_message(seve%e,rname,'Hanning window must be larger than 1 channel')
    error = .true.
    return
  endif
  if (space.gt.cnchan) then
    call class_message(seve%e,rname,  &
      'Output channel width is larger than the input spectrum bandwidth')
    error = .true.
    return
  endif
  !
  ! Generic relationship between the input and output grids:
  !   ochan = (ichan+shift)/space
  ! where
  ! - 'space' is the channel spacing (number input channels per output
  !   channel)
  ! - 'shift' defines the starting point of first output channel. By default,
  !   it is chosen such that the start of the input and output spectra are
  !   aligned (namely the left boundaries of first input and output channels).
  !   In the above formula this gives: 0.5 = (0.5+shift)/space
  !   User can override this default by providing a non-zero "user-shift"
  !   (in input channel units, positive means shift to the right).
  !   Beware this shift is also to be taken into account when defining the
  !   output spectral axis description.
  shift = space/2. - 0.5 - ushift
  !
  ochan = 1
  do
    ry(ochan) = 0.
    wochan = 0.
    ichan = ochan*space-shift  ! Center of output channel (floating point)
    fichan = ichan-width/2.    ! First input channel contributing to output channel
    lichan = ichan+width/2.    ! Last  input channel contributing to output channel
    if (ichan.gt.cnchan)  exit  ! Stop criterion
    do ic=max(1,ceiling(fichan)),min(cnchan,floor(lichan))
      if (ty(ic).ne.cbad) then
        wichan = 0.5-0.5*cos(2*pi*(ic-lichan)/width)
        ry(ochan) = ry(ochan)+wichan*ty(ic)
        wochan = wochan+wichan
      endif
    enddo
    if (wochan.eq.0.) then
      ry(ochan) = cbad
    else
      ry(ochan) = ry(ochan)/wochan
    endif
    ochan = ochan+1
  enddo
  cnchan = ochan-1
end subroutine smhann
!
subroutine smgauss(ty,ry,cnchan,cbad,ax,error)
  use gildas_def
  use phys_const
  use classcore_interfaces, except_this=>smgauss
  !---------------------------------------------------------------------
  ! @ private
  ! Support routine for command
  !   SMOOTH GAUSS Width
  ! Makes a Gaussian smoothing of the input data
  !---------------------------------------------------------------------
  integer(kind=4), intent(in)    :: cnchan      !
  real(kind=4),    intent(in)    :: ty(cnchan)  !
  real(kind=4),    intent(out)   :: ry(cnchan)  !
  real(kind=4),    intent(in)    :: cbad        !
  real(kind=4),    intent(in)    :: ax          ! [channels] Input FWHM of Gaussian
  logical,         intent(inout) :: error       !
  ! Local
  complex(kind=4), allocatable :: cmpl(:), work(:)
  integer(kind=4) :: i, nxm, ier
  real(kind=4) :: val,wx,fact
  !
  allocate (cmpl(cnchan),work(cnchan),stat=ier)
  do i=1,cnchan
    if (ty(i).ne.cbad) then
      val = ty(i)
    else
      val = obs_fillin(ty,i,1,cnchan,cbad)
    endif
    cmpl(i) = cmplx(val,0.0)
  enddo
  call fourt(cmpl,cnchan,1,1,0,work)
  wx = ax*pi/(2.*sqrt(log(2.)))/cnchan
  nxm = nint(4.5/abs(wx))+1
  do i=1,cnchan/2+1
    if (i.le.nxm) then
      fact = exp ( -((i-1)*wx)**2 )
    else
      fact = 0.0
    endif
    cmpl(i) = cmpl(i)*fact
    if (cnchan-i+1.gt.i) cmpl(cnchan-i+1)= cmpl(cnchan-i+1)*fact
  enddo
  call fourt(cmpl,cnchan,1,-1,1,work)
  do i=1,cnchan
    ry(i) = real(cmpl(i))/cnchan
  enddo
  deallocate(cmpl,work)
end subroutine smgauss
!
subroutine smbox(ty,ry,cnchan,cbad,nbox,error)
  use gbl_message
  use classcore_interfaces, except_this=>smbox
  !---------------------------------------------------------------------
  ! @ private
  !  Support routine for command
  !   SMOOTH BOX Nchan
  !---------------------------------------------------------------------
  integer(kind=4), intent(inout) :: cnchan      ! Updated in return
  real(kind=4),    intent(in)    :: ty(cnchan)  !
  real(kind=4),    intent(out)   :: ry(cnchan)  !
  real(kind=4),    intent(in)    :: cbad        !
  integer(kind=4), intent(in)    :: nbox        ! Number of channels averaged
  logical,         intent(inout) :: error       !
  ! Local
  character(len=*), parameter :: rname='SMOOTH'
  integer(kind=4) :: i,j,np
  real(kind=4) :: w
  !
  if (cnchan.lt.2*nbox) then
    call class_message(seve%e,rname,'Too few channels (minimum 2*Nchan)')
    error = .true.
    return
  endif
  !
  np = cnchan/nbox
  do i=1,np
    ry(i) = 0.0
    w = 0
    do j=(i-1)*nbox+1,i*nbox
      if (ty(j).ne.cbad) then
        ry(i) = ry(i)+ty(j)
        w = w+1
      endif
    enddo
    if (w.ne.0) then
      ry(i) = ry(i)/w
    else
      ry(i) = cbad
    endif
  enddo
  cnchan = np
end subroutine smbox
