module cubefit_function_spectral_hfs
  use fit_minuit
  !
  use cubefit_messaging
  use cubefit_spectral_parameters
  use cubefit_spectral_obs
  !
  real(kind=para_k), parameter ::  hfs_tau_min = 0.1
  real(kind=para_k), parameter ::  hfs_tau_max = 100.0
  !
  integer(kind=npar_k),parameter :: npara = 4
  integer(kind=npar_k),parameter :: iarea   = 1
  integer(kind=npar_k),parameter :: ivelo   = 2
  integer(kind=npar_k),parameter :: ifwhm   = 3
  integer(kind=npar_k),parameter :: itau    = 4
  !
  public cubefit_function_spectral_hfs_init, cubefit_function_spectral_hfs_minimize
  public cubefit_function_spectral_hfs_extract, cubefit_function_spectral_hfs_residuals
  public cubefit_function_spectral_hfs_npar, cubefit_function_spectral_hfs_user2par
  public cubefit_function_spectral_hfs_par2spec, cubefit_function_spectral_hfs_spec2par
  public cubefit_function_spectral_hfs_iterate,cubefit_function_spectral_hfs_wind2par
  public cubefit_function_spectral_hfs_flags, cubefit_function_spectral_hfs_doprofile
  public cubefit_function_spectral_hfs_units
  private
  !
contains
    !
  subroutine cubefit_function_spectral_hfs_init(par,obs,minuit,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(spectral_pars_t), intent(inout) :: par
    type(spectral_obs_t),  intent(in)    :: obs
    type(fit_minuit_t),    intent(inout) :: minuit
    logical,               intent(inout) :: error
    !
    real(kind=coor_k) :: vsup,vinf
    real(kind=sign_k) :: val,area,ymin,ymax
    character(len=mess_l) :: mess
    integer(kind=4) :: ipara,ifunc
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname='SPECTRAL>HFS>INIT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')    
    !
    ! Starting values
    if (par%nfunc.eq.0) then
       par%leaders(:) = 0
       par%flag(:,:) = 0
       par%errs(:) = 0
       ymax=0.
       ymin=0.
       area=0.
       vinf=minval(obs%spec%v)
       vsup=maxval(obs%spec%v)
       do ichan=obs%ifirst+1,obs%ilast-1
          if (obs%wfit(ichan).ne.0) then
             val = ( obs%spec%t(ichan) +  &
                  obs%wfit(ichan-1)*obs%spec%t(ichan-1) +  &
                  obs%wfit(ichan+1)*obs%spec%t(ichan+1) )  &
                  / (1+obs%wfit(ichan-1)+obs%wfit(ichan+1))
             if (val.ge.ymax) then
                ymax = val
                vsup = obs%spec%v(ichan)
             endif
             if (val.le.ymin) then
                ymin = val
                vinf = obs%spec%v(ichan)
             endif
             area=area+val*abs((obs%spec%v(ichan+1)-obs%spec%v(ichan-1)))
          endif
       enddo
       area = area*0.5
       if (abs(ymin).lt.abs(ymax)) then
          par%pars(ivelo)=vsup
          par%pars(iarea)=ymax
       else
          par%pars(ivelo)=vinf
          par%pars(iarea)=ymin
       endif
       par%pars(ifwhm)=abs(area/par%pars(iarea)/1.064467)/2.    ! Take care of satellites
       par%pars(itau)=1.0                                       ! Standard Optical depth
       par%pars(iarea)=1.5*par%pars(iarea)*par%pars(itau)
       minuit%nu=npara
       !
       ! Take initial Guesses
    else
       minuit%nu=npara*par%nfunc
    endif
    !
    ! User feedback on parameters used, useful for debug only...
    write(mess,'(a)') 'Input Parameters T_ant * tau      Position         Width    Tau (main)'
    call cubefit_message(fitseve%others,rname,mess)
    ipara = 0
    do ifunc=1,max(par%nfunc,1)
       write (mess,1002) par%pars(ipara+iarea),par%pars(ipara+ivelo),par%pars(ipara+ifwhm),par%pars(ipara+itau)
       call cubefit_message(fitseve%others,rname,mess)
       ipara=ipara+npara
    enddo
    !
    ! Set Up Parameters
    ipara=1
    do ifunc=1,max(par%nfunc,1)
       !
       ! Temperature * Optical depth
       minuit%u(ipara)=par%pars(ipara)
       minuit%werr(ipara)=obs%sigbase
       if ( mod(par%flag(ifunc,iarea),2).ne.0 .and. par%nfunc.ne.0) minuit%werr(ipara)=0.
       if (minuit%u(ipara).ne.0.) then
          minuit%alim(ipara)=min(0.d0,8.d0*minuit%u(ipara))
          minuit%blim(ipara)=max(0.d0,8.d0*minuit%u(ipara))
       else
          minuit%lcode(ipara)=1
       endif
       ipara=ipara+1
       !
       ! Velocity
       minuit%u(ipara)=par%pars(ipara)
       minuit%werr(ipara)=obs%deltav
       if ( mod(par%flag(ifunc,ivelo),2).ne.0 .and. par%nfunc.ne.0) minuit%werr(ipara)=0.
       minuit%alim(ipara)=minuit%u(ipara)-0.15*obs%spec%n*obs%deltav
       minuit%blim(ipara)=minuit%u(ipara)+0.15*obs%spec%n*obs%deltav
       ipara=ipara+1
       !
       ! Line Widths
       minuit%u(ipara)=abs(par%pars(ipara))/1.665109d0
       if (minuit%u(ipara).lt.obs%deltav) minuit%u(ipara) = obs%deltav
       minuit%werr(ipara)=2*obs%deltav
       if ( mod(par%flag(ifunc,ifwhm),2).ne.0 .and. par%nfunc.ne.0 ) minuit%werr(ipara)=0.
       minuit%alim(ipara)=obs%deltav
       minuit%blim(ipara)=0.5*obs%spec%n*obs%deltav
       ipara=ipara+1
       !
       ! Optical depth
       minuit%u(ipara)=par%pars(ipara)
       minuit%werr(ipara)=0.1
       if ( mod(par%flag(ifunc,itau),2).ne.0 .and. par%nfunc.ne.0 ) minuit%werr(ipara)=0.
       minuit%alim(ipara)=hfs_tau_min
       minuit%blim(ipara)=hfs_tau_max
       ipara=ipara+1
    enddo
    !
1002 format((4(f14.3)))
  end subroutine cubefit_function_spectral_hfs_init
  !
  subroutine cubefit_function_spectral_hfs_minimize(npar,grad,chi2,pars,iflag,obs)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=npar_k),   intent(in)    :: npar        ! Number of parameters
    real(kind=grad_k),      intent(out)   :: grad(npar)  ! Gradientes
    real(kind=chi2_k),      intent(out)   :: chi2        ! chi squared
    real(kind=para_k),      intent(in)    :: pars(npar)  ! Parameter values
    integer(kind=4),        intent(in)    :: iflag       ! Code operation
    type(spectral_obs_t),   intent(inout) :: obs         ! Observation
    !
    integer(kind=chan_k) :: ichan
    integer(kind=func_k) :: nfunc
    real(kind=coor_k) :: xvel
    real(kind=sign_k), allocatable :: parsarea(:),parsvelo(:),parsfwhm(:),parstau(:),hfsarg(:),hfsexp(:)
    real(kind=8),      allocatable :: argexp(:)
    real(kind=chi2_k), allocatable :: parschi2(:)
    real(kind=grad_k), allocatable :: parsgrad(:)
    real(kind=8) :: arg,aux
    real(kind=chi2_k) :: chi2loc
    real(kind=grad_k) :: gradarea,gradvelo,gradfwhm,gradtau
    integer(kind=func_k) :: ifunc,ihfs
    logical :: dograd
    character(len=*), parameter :: rname='SPECTRAL>HFS>MINIMIZE'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    if (iflag.eq.code_minuit_rms) then
       call obs%sigma(cubefit_function_spectral_hfs_profile,.false.)
       return
    endif
    !
    dograd = iflag.eq.code_minuit_gradient
    nfunc = max(obs%par%nfunc,1)
    allocate(parsarea(nfunc),parsvelo(nfunc),parsfwhm(nfunc),parschi2(nfunc),argexp(nfunc),&
         parstau(nfunc),parsgrad(nfunc*npara),hfsarg(nfunc),hfsexp(nfunc))
    parsgrad = 0.
    do ifunc=1,nfunc
       parsarea(ifunc) = pars(iarea+npara*(ifunc-1)) ! Tant * Tau [K]
       parsvelo(ifunc) = pars(ivelo+npara*(ifunc-1)) ! Position   [km/s]
       parsfwhm(ifunc) = pars(ifwhm+npara*(ifunc-1)) ! FWHM       [km/s]
       parstau(ifunc)  = pars(itau+npara*(ifunc-1))  ! tau_main   []
    enddo
    chi2 = 0.
    !
    ! Fit of HFS lines
    do ichan=obs%ifirst,obs%ilast
       !
       ! Skip over masked area or bad channels
       if (obs%wfit(ichan).ne.0) then
          xvel = obs%spec%v(ichan)
          !
          ! Chi-2
          hfsarg  = 0.
          chi2loc = 0.
          do ifunc=1,nfunc
             do ihfs=1,obs%hfs%n
                arg = (xvel-obs%hfs%vel(ihfs)-parsvelo(ifunc))/parsfwhm(ifunc)
                if (abs(arg).lt.4.) then
                   hfsarg(ifunc) = hfsarg(ifunc) + parstau(ifunc)*obs%hfs%rel(ihfs)*exp(-arg**2)
                endif
             enddo
             hfsexp(ifunc) = exp(-hfsarg(ifunc))
             chi2loc = chi2loc + parsarea(ifunc)*(1-hfsexp(ifunc))/parstau(ifunc)
          enddo
          chi2loc = chi2loc - obs%spec%t(ichan)
          chi2 = chi2 + chi2loc**2
          !
          ! Compute gradients
          if (dograd) then
             chi2loc = 2.*chi2loc
             do ifunc=1,nfunc ! Loop on lines
                gradarea = (1. - hfsexp(ifunc)) / parstau(ifunc)  
                gradvelo = 0.
                gradfwhm = 0.
                gradtau = 0.
                do ihfs=1,obs%hfs%n
                   arg = (xvel-obs%hfs%vel(ihfs)-parsvelo(ifunc))/parsfwhm(ifunc)
                   if (abs(arg).lt.4.) then
                      aux = obs%hfs%rel(ihfs)*exp(-arg**2)
                      gradtau = gradtau + aux        ! / Tau
                      aux = 2.*parstau(ifunc)*arg/parsfwhm(ifunc)*aux
                      gradvelo = gradvelo + aux        ! / V lsr
                      gradfwhm = gradfwhm + aux*arg    ! / Delta V
                   endif
                enddo
                aux = parsarea(ifunc)*hfsexp(ifunc)/parstau(ifunc)
                parsgrad(iarea+npara*(ifunc-1)) = parsgrad(iarea+npara*(ifunc-1)) + chi2loc*gradarea
                parsgrad(ivelo+npara*(ifunc-1)) = parsgrad(ivelo+npara*(ifunc-1)) + chi2loc*gradvelo*aux
                parsgrad(ifwhm+npara*(ifunc-1)) = parsgrad(ifwhm+npara*(ifunc-1)) + chi2loc*gradfwhm*aux
                parsgrad(itau+npara*(ifunc-1))  = parsgrad(itau+npara*(ifunc-1))  + &
                     chi2loc*(gradtau*aux-parsarea(ifunc)*(1.-hfsexp(ifunc))/parstau(ifunc)/parstau(ifunc) )
             enddo
          endif
       endif
    enddo
    !
    ! Normalize
    do ifunc=1,nfunc
       grad(iarea+npara*(ifunc-1)) = parsgrad(iarea+npara*(ifunc-1))
       grad(ivelo+npara*(ifunc-1)) = parsgrad(ivelo+npara*(ifunc-1))
       grad(ifwhm+npara*(ifunc-1)) = parsgrad(ifwhm+npara*(ifunc-1))
       grad(itau+npara*(ifunc-1))  = parsgrad(itau+npara*(ifunc-1))
    enddo
  end subroutine cubefit_function_spectral_hfs_minimize
  !
  subroutine cubefit_function_spectral_hfs_extract(minuit,obs,par,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    type(fit_minuit_t),    intent(inout) :: minuit
    type(spectral_obs_t),  intent(inout) :: obs
    type(spectral_pars_t), intent(inout) :: par
    logical,               intent(inout) :: error
    !
    integer(kind=func_k) :: ifunc
    integer(kind=npar_k) :: ipara
    character(len=*), parameter :: rname='SPECTRAL>HFS>EXTRACT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ipara=0
    do ifunc=1,max(par%nfunc,1)
       par%pars(ipara+iarea) = minuit%u(ipara+iarea)
       par%pars(ipara+ivelo) = minuit%u(ipara+ivelo)
       par%pars(ipara+ifwhm) = minuit%u(ipara+ifwhm)*1.665109
       par%pars(ipara+itau)  = minuit%u(ipara+itau)
       par%errs(ipara+iarea) = minuit%werr(ipara+iarea)
       par%errs(ipara+ivelo) = minuit%werr(ipara+ivelo)
       par%errs(ipara+ifwhm) = minuit%werr(ipara+ifwhm)*1.665109
       par%errs(ipara+itau)  = minuit%werr(ipara+itau)
       ipara=ipara+npara
    enddo
  end subroutine cubefit_function_spectral_hfs_extract
  !
  subroutine cubefit_function_spectral_hfs_residuals(obs,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Compute the residuals of a hfs fit
    !------------------------------------------------------------------------
    type(spectral_obs_t), intent(inout) :: obs          
    type(spectrum_t),     intent(inout) :: spec         
    logical,              intent(inout) :: error
    !
    integer(kind=chan_k) :: ichan
    real(kind=coor_k) :: xvel
    real(kind=sign_k) :: pred
    character(len=*), parameter :: rname="SPECTRAL>HFS>RESIDUALS"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    do ichan=1, spec%n
       xvel = obs%spec%v(ichan)
       pred = cubefit_function_spectral_hfs_profile(obs,xvel,0)
       spec%t(ichan) = obs%spec%t(ichan) - pred
    enddo
  end subroutine cubefit_function_spectral_hfs_residuals
  !
  subroutine cubefit_function_spectral_hfs_doprofile(ifunc,obs,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Compute the doprofile of a hfs fit
    !------------------------------------------------------------------------
    integer(kind=func_k), intent(in)    :: ifunc
    type(spectral_obs_t), intent(inout) :: obs          
    type(spectrum_t),     intent(inout) :: spec         
    logical,              intent(inout) :: error
    !
    integer(kind=chan_k) :: ichan
    real(kind=coor_k) :: xvel
    real(kind=sign_k) :: pred
    character(len=*), parameter :: rname="SPECTRAL>HFS>DOPROFILE"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    do ichan=1, spec%n
       xvel = obs%spec%v(ichan)
       pred = cubefit_function_spectral_hfs_profile(obs,xvel,ifunc)
       spec%t(ichan) = pred
    enddo
  end subroutine cubefit_function_spectral_hfs_doprofile
  !
  subroutine cubefit_function_spectral_hfs_user2par(flag,pars,par,error)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=flag_k),  intent(in)    :: flag(:)
    real(kind=para_k),     intent(in)    :: pars(:)
    type(spectral_pars_t), intent(inout) :: par
    logical,               intent(inout) :: error
    !
    integer(kind=npar_k) :: ipara,jpara
    integer(kind=func_k) :: ifunc
    character(len=*), parameter :: rname='SPECTRAL>HFS>USER2PAR'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    par%leaders(:) = 0
    par%flag(:,:)  = 0
    par%errs(:)    = 0.
    !
    jpara = 1
    do ifunc=1,par%nfunc
       do ipara=1,npara
          par%flag(ifunc,ipara) = mod(flag(jpara),2)
          par%pars(jpara)       = pars(jpara)
          jpara=jpara+1
       enddo ! ipara
    enddo ! ifunc
    !
    call par%check_line(iarea,error)
    if (error) return
    call par%check_line(ivelo,error)
    if (error) return
    call par%check_line(ifwhm,error)
    if (error) return
    call par%check_line(itau,error)
    if (error) return
  end subroutine cubefit_function_spectral_hfs_user2par
  !
  subroutine cubefit_function_spectral_hfs_par2spec(par,spec,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectral_pars_t), intent(in)    :: par
    type(spectrum_t),      intent(inout) :: spec
    logical,               intent(inout) :: error
    !
    integer(kind=func_k) :: ifunc
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname='SPECTRAL>HFS>PAR2SPEC'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ichan = ndaps
    do ifunc=1,max(par%nfunc,1)
       ichan = ichan+1
       spec%t(ichan) = par%flag(ifunc,iarea) 
       ichan = ichan+1
       spec%t(ichan) = par%pars((ifunc-1)*npara+iarea)
       ichan = ichan+1
       spec%t(ichan) = par%errs((ifunc-1)*npara+iarea)
       ichan = ichan+1
       spec%t(ichan) = par%flag(ifunc,ivelo)
       ichan = ichan+1
       spec%t(ichan) = par%pars((ifunc-1)*npara+ivelo)
       ichan = ichan+1
       spec%t(ichan) = par%errs((ifunc-1)*npara+ivelo)
       ichan = ichan+1
       spec%t(ichan) = par%flag(ifunc,ifwhm)
       ichan = ichan+1
       spec%t(ichan) = par%pars((ifunc-1)*npara+ifwhm)
       ichan = ichan+1
       spec%t(ichan) = par%errs((ifunc-1)*npara+ifwhm)
       ichan = ichan+1
       spec%t(ichan) = par%flag(ifunc,itau)
       ichan = ichan+1
       spec%t(ichan) = par%pars((ifunc-1)*npara+itau)
       ichan = ichan+1
       spec%t(ichan) = par%errs((ifunc-1)*npara+itau)
    enddo
  end subroutine cubefit_function_spectral_hfs_par2spec
  !
  subroutine cubefit_function_spectral_hfs_spec2par(spec,par,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectrum_t),      intent(in)    :: spec
    type(spectral_pars_t), intent(inout) :: par
    logical,               intent(inout) :: error
    !
    integer(kind=func_k) :: ifunc
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname='SPECTRAL>HFS>SPEC2PAR'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ichan = ndaps
    do ifunc=1,max(par%nfunc,1)
       ichan = ichan+1
       par%flag(ifunc,iarea)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((ifunc-1)*npara+iarea) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((ifunc-1)*npara+iarea) = spec%t(ichan) 
       ichan = ichan+1                     
       par%flag(ifunc,ivelo)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((ifunc-1)*npara+ivelo) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((ifunc-1)*npara+ivelo) = spec%t(ichan) 
       ichan = ichan+1                     
       par%flag(ifunc,ifwhm)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((ifunc-1)*npara+ifwhm) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((ifunc-1)*npara+ifwhm) = spec%t(ichan)
       ichan = ichan+1                     
       par%flag(ifunc,itau)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((ifunc-1)*npara+itau) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((ifunc-1)*npara+itau) = spec%t(ichan) 
    enddo
  end subroutine cubefit_function_spectral_hfs_spec2par
  !
  subroutine cubefit_function_spectral_hfs_iterate(par,error)
    !----------------------------------------------------------------------
    ! This routine is empty as no transformation is needed when we are
    ! iterating an HFS fit
    !----------------------------------------------------------------------
    type(spectral_pars_t), intent(inout) :: par
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname='SPECTRAL>HFS>ITERATE'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
  end subroutine cubefit_function_spectral_hfs_iterate
  !
  subroutine cubefit_function_spectral_hfs_wind2par(obs,wind,par,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectral_obs_t),  intent(in)    :: obs
    integer(kind=chan_k),  intent(in)    :: wind(:)
    type(spectral_pars_t), intent(inout) :: par
    logical,               intent(inout) :: error
    !
    integer(kind=chan_k) :: first,last
    integer(kind=func_k) :: ifunc
    real(kind=para_k) :: area,velo,fwhm
    character(len=*), parameter :: rname='SPECTRAL>HFS>WIND2PAR'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    par%errs(:)    = 0
    par%leaders(:) = 0
    do ifunc=1,par%nfunc
       first = wind(2*ifunc-1)
       last  = wind(2*ifunc)
       par%flag(ifunc,:)  = 0
       !
       call obs%est_gauss(first,last,area,velo,fwhm,error)
       if (error) return
       if (fwhm.lt.obs%deltav) fwhm = obs%deltav
       par%pars((ifunc-1)*npara+iarea) = area 
       par%pars((ifunc-1)*npara+ivelo) = velo 
       par%pars((ifunc-1)*npara+ifwhm) = fwhm
       par%pars((ifunc-1)*npara+itau)  = 1.0
    enddo
  end subroutine cubefit_function_spectral_hfs_wind2par
  !
  !----------------------------------------------------------------------
  !
  function cubefit_function_spectral_hfs_profile(obs,xvel,ifunc) result(hfs)
    !----------------------------------------------------------------------
    ! Compute the value of a hyperfine line or a sum of hyperfine
    ! lines at xvel
    !----------------------------------------------------------------------
    type(spectral_obs_t),   intent(in)    :: obs         ! Observation
    real(kind=coor_k),      intent(in)    :: xvel        ! Coordinate to compute value
    integer(kind=func_k),   intent(in)    :: ifunc       ! Which hfs is to be computed
    !
    real(kind=sign_k) :: hfs
    !
    integer(kind=func_k) :: ifirst,ilast,jfunc,ihfs
    real(kind=4) :: arg,expo
    real(kind=para_k) :: area,velo,fwhm,tau
    !
    if (ifunc.eq.0) then
       ifirst = 1
       ilast = max(obs%par%nfunc,1)
    else
       ifirst = ifunc
       ilast = ifunc
    endif
    !
    hfs=0.
    !
    do jfunc = ifirst,ilast
       area=obs%par%pars(iarea+npara*(jfunc-1))              ! Tant*Tau
       velo=obs%par%pars(ivelo+npara*(jfunc-1))              ! Velocity
       fwhm=obs%par%pars(ifwhm+npara*(jfunc-1))/1.665109     ! Line width
       tau =obs%par%pars(itau+npara*(jfunc-1))               ! Opacity
       expo = 0.
       if (area.ne.0 .and. fwhm.ne.0) then
          do ihfs=1,obs%hfs%n
             arg = abs ((xvel-obs%hfs%vel(ihfs)-velo)/fwhm)
             if (arg.lt.4.) then
                expo = expo + tau*obs%hfs%rel(ihfs)*exp(-(arg**2))
             endif
          enddo
          hfs = hfs + area * (1.-exp(-expo)) / tau
       endif
    enddo
  end function cubefit_function_spectral_hfs_profile
  !
  subroutine cubefit_function_spectral_hfs_flags(ipara,funcflag,paraflag,error)
    use cubedag_allflags
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=npar_k), intent(in)    :: ipara
    type(flag_t),         intent(out)   :: funcflag
    type(flag_t),         intent(out)   :: paraflag
    logical,              intent(inout) :: error
    !
    integer(kind=func_k) :: ifunc
    character(len=*), parameter :: rname='SPECTRAL>HFS>FLAGS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ifunc  = ipara/npara+1
    select case(mod(ipara,npara))
    case(1)
       paraflag = flag_brightness
    case(2)
       paraflag = flag_velocity
    case(3)
       paraflag = flag_fwhm
    case(0)
       paraflag = flag_tau
       ifunc  = ifunc-1
    end select
    call cubefit_func2flag(ifunc,funcflag,error)
    if (error) return
  end subroutine cubefit_function_spectral_hfs_flags
  !
  subroutine cubefit_function_spectral_hfs_units(ipara,unit,error)
    use cubetools_unit_setup
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=npar_k), intent(in)    :: ipara
    character(len=*),     intent(out)   :: unit
    logical,              intent(inout) :: error
    !
    integer(kind=func_k) :: ifunc
    character(len=*), parameter :: rname='SPECTRAL>HFS>UNITS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ifunc  = ipara/npara+1
    select case(mod(ipara,npara))
    case(1)
       unit = strg_id
    case(2)
       unit = unit_velo%prog_name()
    case(3)
       unit = unit_velo%prog_name()
    case(0)
       unit = '---' ! no unit for opacity
    end select
  end subroutine cubefit_function_spectral_hfs_units
  !
  function cubefit_function_spectral_hfs_npar(nfunc) result(npar)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=func_k), intent(in) :: nfunc
    !
    integer(kind=npar_k) :: npar
    !
    npar = npara*nfunc
  end function cubefit_function_spectral_hfs_npar
end module cubefit_function_spectral_hfs
