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 :: nparline = 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) :: ipar,iline
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname='SPECTRAL>HFS>INIT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')    
    !
    ! Starting values
    if (par%nline.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=nparline
       !
       ! Take initial Guesses
    else
       minuit%nu=nparline*par%nline
    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)
    ipar = 0
    do iline=1,max(par%nline,1)
       write (mess,1002) par%pars(ipar+iarea),par%pars(ipar+ivelo),par%pars(ipar+ifwhm),par%pars(ipar+itau)
       call cubefit_message(fitseve%others,rname,mess)
       ipar=ipar+nparline
    enddo
    !
    ! Set Up Parameters
    ipar=1
    do iline=1,max(par%nline,1)
       !
       ! Temperature * Optical depth
       minuit%u(ipar)=par%pars(ipar)
       minuit%werr(ipar)=obs%sigbase
       if ( mod(par%flag(iline,iarea),2).ne.0 .and. par%nline.ne.0) minuit%werr(ipar)=0.
       if (minuit%u(ipar).ne.0.) then
          minuit%alim(ipar)=min(0.d0,8.d0*minuit%u(ipar))
          minuit%blim(ipar)=max(0.d0,8.d0*minuit%u(ipar))
       else
          minuit%lcode(ipar)=1
       endif
       ipar=ipar+1
       !
       ! Velocity
       minuit%u(ipar)=par%pars(ipar)
       minuit%werr(ipar)=obs%deltav
       if ( mod(par%flag(iline,ivelo),2).ne.0 .and. par%nline.ne.0) minuit%werr(ipar)=0.
       minuit%alim(ipar)=minuit%u(ipar)-0.15*obs%spec%n*obs%deltav
       minuit%blim(ipar)=minuit%u(ipar)+0.15*obs%spec%n*obs%deltav
       ipar=ipar+1
       !
       ! Line Widths
       minuit%u(ipar)=abs(par%pars(ipar))/1.665109d0
       if (minuit%u(ipar).lt.obs%deltav) minuit%u(ipar) = obs%deltav
       minuit%werr(ipar)=2*obs%deltav
       if ( mod(par%flag(iline,ifwhm),2).ne.0 .and. par%nline.ne.0 ) minuit%werr(ipar)=0.
       minuit%alim(ipar)=obs%deltav
       minuit%blim(ipar)=0.5*obs%spec%n*obs%deltav
       ipar=ipar+1
       !
       ! Optical depth
       minuit%u(ipar)=par%pars(ipar)
       minuit%werr(ipar)=0.1
       if ( mod(par%flag(iline,itau),2).ne.0 .and. par%nline.ne.0 ) minuit%werr(ipar)=0.
       minuit%alim(ipar)=hfs_tau_min
       minuit%blim(ipar)=hfs_tau_max
       ipar=ipar+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=line_k) :: nline
    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=line_k) :: iline,ihfs
    logical :: dograd
    character(len=*), parameter :: rname = 'SPECTRAL>HFS>MINIMIZE'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    if (iflag.eq.minuit_rms_flag) then
       call obs%sigma(cubefit_function_spectral_hfs_profile,.false.)
       return
    endif
    !
    dograd = iflag.eq.minuit_gra_flag
    nline = max(obs%par%nline,1)
    allocate(parsarea(nline),parsvelo(nline),parsfwhm(nline),parschi2(nline),argexp(nline),&
         parstau(nline),parsgrad(nline*nparline),hfsarg(nline),hfsexp(nline))
    parsgrad = 0.
    do iline=1,nline
       parsarea(iline) = pars(iarea+nparline*(iline-1)) ! Tant * Tau [K]
       parsvelo(iline) = pars(ivelo+nparline*(iline-1)) ! Position   [km/s]
       parsfwhm(iline) = pars(ifwhm+nparline*(iline-1)) ! FWHM       [km/s]
       parstau(iline)  = pars(itau+nparline*(iline-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 iline=1,nline
             do ihfs=1,obs%hfs%n
                arg = (xvel-obs%hfs%vel(ihfs)-parsvelo(iline))/parsfwhm(iline)
                if (abs(arg).lt.4.) then
                   hfsarg(iline) = hfsarg(iline) + parstau(iline)*obs%hfs%rel(ihfs)*exp(-arg**2)
                endif
             enddo
             hfsexp(iline) = exp(-hfsarg(iline))
             chi2loc = chi2loc + parsarea(iline)*(1-hfsexp(iline))/parstau(iline)
          enddo
          chi2loc = chi2loc - obs%spec%t(ichan)
          chi2 = chi2 + chi2loc**2
          !
          ! Compute gradients
          if (dograd) then
             chi2loc = 2.*chi2loc
             do iline=1,nline ! Loop on lines
                gradarea = (1. - hfsexp(iline)) / parstau(iline)  
                gradvelo = 0.
                gradfwhm = 0.
                gradtau = 0.
                do ihfs=1,obs%hfs%n
                   arg = (xvel-obs%hfs%vel(ihfs)-parsvelo(iline))/parsfwhm(iline)
                   if (abs(arg).lt.4.) then
                      aux = obs%hfs%rel(ihfs)*exp(-arg**2)
                      gradtau = gradtau + aux        ! / Tau
                      aux = 2.*parstau(iline)*arg/parsfwhm(iline)*aux
                      gradvelo = gradvelo + aux        ! / V lsr
                      gradfwhm = gradfwhm + aux*arg    ! / Delta V
                   endif
                enddo
                aux = parsarea(iline)*hfsexp(iline)/parstau(iline)
                parsgrad(iarea+nparline*(iline-1)) = parsgrad(iarea+nparline*(iline-1)) + chi2loc*gradarea
                parsgrad(ivelo+nparline*(iline-1)) = parsgrad(ivelo+nparline*(iline-1)) + chi2loc*gradvelo*aux
                parsgrad(ifwhm+nparline*(iline-1)) = parsgrad(ifwhm+nparline*(iline-1)) + chi2loc*gradfwhm*aux
                parsgrad(itau+nparline*(iline-1))  = parsgrad(itau+nparline*(iline-1))  + &
                     chi2loc*(gradtau*aux-parsarea(iline)*(1.-hfsexp(iline))/parstau(iline)/parstau(iline) )
             enddo
          endif
       endif
    enddo
    !
    ! Normalize
    do iline=1,nline
       grad(iarea+nparline*(iline-1)) = parsgrad(iarea+nparline*(iline-1))
       grad(ivelo+nparline*(iline-1)) = parsgrad(ivelo+nparline*(iline-1))
       grad(ifwhm+nparline*(iline-1)) = parsgrad(ifwhm+nparline*(iline-1))
       grad(itau+nparline*(iline-1))  = parsgrad(itau+nparline*(iline-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=line_k) :: iline
    integer(kind=npar_k) :: ipar
    character(len=*), parameter :: rname = 'SPECTRAL>HFS>EXTRACT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ipar=0
    do iline=1,max(par%nline,1)
       par%pars(ipar+iarea) = minuit%u(ipar+iarea)
       par%pars(ipar+ivelo) = minuit%u(ipar+ivelo)
       par%pars(ipar+ifwhm) = minuit%u(ipar+ifwhm)*1.665109
       par%pars(ipar+itau)  = minuit%u(ipar+itau)
       par%errs(ipar+iarea) = minuit%werr(ipar+iarea)
       par%errs(ipar+ivelo) = minuit%werr(ipar+ivelo)
       par%errs(ipar+ifwhm) = minuit%werr(ipar+ifwhm)*1.665109
       par%errs(ipar+itau)  = minuit%werr(ipar+itau)
       ipar=ipar+nparline
    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
    end do
  end subroutine cubefit_function_spectral_hfs_residuals
  !
  subroutine cubefit_function_spectral_hfs_doprofile(iline,obs,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Compute the doprofile of a hfs fit
    !------------------------------------------------------------------------
    integer(kind=line_k), intent(in)    :: iline
    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,iline)
       spec%t(ichan) = pred
    end do
  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) :: ipar,jpar
    integer(kind=line_k) :: iline
    character(len=*), parameter :: rname = 'SPECTRAL>HFS>USER2PAR'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    par%leaders(:) = 0
    par%flag(:,:)  = 0
    par%errs(:)    = 0.
    !
    jpar = 1
    do iline=1,par%nline
       do ipar=1,nparline
          par%flag(iline,ipar) = mod(flag(jpar),2)
          par%pars(jpar)       = pars(jpar)
          jpar=jpar+1
       enddo ! ipar
    enddo ! iline
    !
    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=line_k) :: iline
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname = 'SPECTRAL>HFS>PAR2SPEC'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ichan = spec_ndaps
    do iline=1,max(par%nline,1)
       ichan = ichan+1
       spec%t(ichan) = par%flag(iline,iarea) 
       ichan = ichan+1
       spec%t(ichan) = par%pars((iline-1)*nparline+iarea)
       ichan = ichan+1
       spec%t(ichan) = par%errs((iline-1)*nparline+iarea)
       ichan = ichan+1
       spec%t(ichan) = par%flag(iline,ivelo)
       ichan = ichan+1
       spec%t(ichan) = par%pars((iline-1)*nparline+ivelo)
       ichan = ichan+1
       spec%t(ichan) = par%errs((iline-1)*nparline+ivelo)
       ichan = ichan+1
       spec%t(ichan) = par%flag(iline,ifwhm)
       ichan = ichan+1
       spec%t(ichan) = par%pars((iline-1)*nparline+ifwhm)
       ichan = ichan+1
       spec%t(ichan) = par%errs((iline-1)*nparline+ifwhm)
       ichan = ichan+1
       spec%t(ichan) = par%flag(iline,itau)
       ichan = ichan+1
       spec%t(ichan) = par%pars((iline-1)*nparline+itau)
       ichan = ichan+1
       spec%t(ichan) = par%errs((iline-1)*nparline+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=line_k) :: iline
    integer(kind=chan_k) :: ichan
    character(len=*), parameter :: rname = 'SPECTRAL>HFS>SPEC2PAR'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ichan = spec_ndaps
    do iline=1,max(par%nline,1)
       ichan = ichan+1
       par%flag(iline,iarea)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((iline-1)*nparline+iarea) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((iline-1)*nparline+iarea) = spec%t(ichan) 
       ichan = ichan+1                     
       par%flag(iline,ivelo)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((iline-1)*nparline+ivelo) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((iline-1)*nparline+ivelo) = spec%t(ichan) 
       ichan = ichan+1                     
       par%flag(iline,ifwhm)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((iline-1)*nparline+ifwhm) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((iline-1)*nparline+ifwhm) = spec%t(ichan)
       ichan = ichan+1                     
       par%flag(iline,itau)              = nint(spec%t(ichan),flag_k)
       ichan = ichan+1                     
       par%pars((iline-1)*nparline+itau) = spec%t(ichan) 
       ichan = ichan+1                     
       par%errs((iline-1)*nparline+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=line_k) :: iline
    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 iline=1,par%nline
       first = wind(2*iline-1)
       last  = wind(2*iline)
       par%flag(iline,:)  = 0
       !
       call obs%est_gauss(first,last,area,velo,fwhm,error)
       if (error) return
       if (fwhm.lt.obs%deltav) fwhm = obs%deltav
       par%pars((iline-1)*nparline+iarea) = area 
       par%pars((iline-1)*nparline+ivelo) = velo 
       par%pars((iline-1)*nparline+ifwhm) = fwhm
       par%pars((iline-1)*nparline+itau)  = 1.0
    end do
  end subroutine cubefit_function_spectral_hfs_wind2par
  !
  !----------------------------------------------------------------------
  !
  function cubefit_function_spectral_hfs_profile(obs,xvel,iline) 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=line_K),   intent(in)    :: iline       ! Which hfs is to be computed
    !
    real(kind=sign_k) :: hfs
    !
    integer(kind=line_k) :: ifirst,ilast,jline,ihfs
    real(kind=4) :: arg,expo
    real(kind=para_k) :: area,velo,fwhm,tau
    !
    if (iline.eq.0) then
       ifirst = 1
       ilast = max(obs%par%nline,1)
    else
       ifirst = iline
       ilast = iline
    endif
    !
    hfs=0.
    !
    do jline = ifirst,ilast
       area=obs%par%pars(iarea+nparline*(jline-1))              ! Tant*Tau
       velo=obs%par%pars(ivelo+nparline*(jline-1))              ! Velocity
       fwhm=obs%par%pars(ifwhm+nparline*(jline-1))/1.665109     ! Line width
       tau =obs%par%pars(itau+nparline*(jline-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(ipar,lineflag,parflag,error)
    use cubedag_allflags
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=npar_k), intent(in)    :: ipar
    type(flag_t),         intent(out)   :: lineflag
    type(flag_t),         intent(out)   :: parflag
    logical,              intent(inout) :: error
    !
    integer(kind=line_k) :: iline
    character(len=*), parameter :: rname = 'SPECTRAL>HFS>FLAGS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    iline  = ipar/nparline+1
    select case(mod(ipar,nparline))
    case(1)
       parflag = flag_brightness
    case(2)
       parflag = flag_velocity
    case(3)
       parflag = flag_fwhm
    case(0)
       parflag = flag_tau
       iline  = iline-1
    end select
    call cubefit_line2flag(iline,lineflag,error)
    if (error)  return
  end subroutine cubefit_function_spectral_hfs_flags
  !
  subroutine cubefit_function_spectral_hfs_units(ipar,unit,error)
    use cubetools_unit
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=npar_k), intent(in)    :: ipar
    character(len=*),     intent(out)   :: unit
    logical,              intent(inout) :: error
    !
    integer(kind=line_k) :: iline
    character(len=*), parameter :: rname = 'SPECTRAL>HFS>UNITS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    iline  = ipar/nparline+1
    select case(mod(ipar,nparline))
    case(1)
       unit = strg_id
    case(2)
       unit = unit_velo_name(1) ! km/s
    case(3)
       unit = unit_velo_name(1) ! km/s
    case(0)
       unit = '---' ! no unit for opacity
    end select
  end subroutine cubefit_function_spectral_hfs_units
  !
  function cubefit_function_spectral_hfs_npar(nline) result(npar)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=line_k), intent(in) :: nline
    !
    integer(kind=npar_k) :: npar
    !
    npar = nparline*nline
  end function cubefit_function_spectral_hfs_npar
end module cubefit_function_spectral_hfs
