!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!
module cubefit_spectral_fit
  use fit_minuit ! From GILDAS kernel
  use cubefit_messaging
  use cubefit_parameters
  use cubefit_spectral_obs
  use cubefit_spectral_parameters
  use cubefit_hfs
  !
  public :: fit_spectral_t,cubefit_parameters_npars_nout,cubefit_parameters_flags,cubefit_parameters_units
  private
  !
  integer(kind=code_k), parameter :: migrad_noimprov = 1
  integer(kind=code_k), parameter :: migrad_diverged = 3
  !
  integer(kind=code_k), parameter :: code_oper_minimize = 1
  integer(kind=code_k), parameter :: code_oper_iterate  = 2
  !
  type fit_spectral_t
     private
     type(fit_minuit_t)            :: minuit
     type(spectral_pars_t)         :: par
     type(spectral_obs_t)          :: obs
     type(hfs_prog_t),     pointer :: hfs
     integer(kind=chan_k), pointer :: wind(:) => null()
     logical                       :: usewind = .false.
     !
     integer(kind=code_k) :: status = code_status_unfitted
     integer(kind=code_k) :: oper   = code_oper_minimize
     !
     procedure(cubefit_spectral_init_interface),      nopass, pointer :: init     => null()
     procedure(cubefit_spectral_minimize_interface),  nopass, pointer :: mini     => null()
     procedure(cubefit_spectral_extract_interface),   nopass, pointer :: extr     => null()
     procedure(cubefit_spectral_residuals_interface), nopass, pointer :: resi     => null()
     procedure(cubefit_spectral_user2par_interface),  nopass, pointer :: user2par => null()
     procedure(cubefit_spectral_par2spec_interface),  nopass, pointer :: par2spec => null()
     procedure(cubefit_spectral_spec2par_interface),  nopass, pointer :: spec2par => null()
     procedure(cubefit_spectral_iterate_interface),   nopass, pointer :: iterate  => null()
     procedure(cubefit_spectral_wind2par_interface),  nopass, pointer :: wind2par => null()
     procedure(cubefit_spectral_profile_interface),   nopass, pointer :: prof     => null()
   contains
     procedure :: user_import => cubefit_minuit_user2par
     procedure :: spec_import => cubefit_minuit_spec2par
     procedure :: wind_import => cubefit_minuit_load_window
     procedure :: check_hfs   => cubefit_minuit_check_hfs
     procedure :: fit         => cubefit_minuit_fit
     procedure :: consistency => cubefit_minuit_consistency
     procedure :: export      => cubefit_minuit_export
     procedure :: residuals   => cubefit_minuit_residuals
     procedure :: profile     => cubefit_minuit_profile
  end type fit_spectral_t
  !
contains
  !
  subroutine cubefit_spectral_init_interface(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
  end subroutine cubefit_spectral_init_interface
  !
  subroutine cubefit_spectral_minimize_interface(npar,grad,chi2,pars,iflag,obs)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=npar_k),   intent(in)    :: npar        ! Number of parameters
    real(kind=grad_k),      intent(out)   :: grad(npar)  ! Gradients
    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
  end subroutine cubefit_spectral_minimize_interface
  !
  subroutine cubefit_spectral_extract_interface(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
  end subroutine cubefit_spectral_extract_interface
  !
  subroutine cubefit_spectral_residuals_interface(obs,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! 
    !------------------------------------------------------------------------
    type(spectral_obs_t), intent(inout) :: obs          
    type(spectrum_t),     intent(inout) :: spec         
    logical,              intent(inout) :: error
  end subroutine cubefit_spectral_residuals_interface
  !
  subroutine cubefit_spectral_profile_interface(ifunc,obs,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! 
    !------------------------------------------------------------------------
    integer(kind=func_k), intent(in)    :: ifunc
    type(spectral_obs_t), intent(inout) :: obs  
    type(spectrum_t),     intent(inout) :: spec         
    logical,              intent(inout) :: error
  end subroutine cubefit_spectral_profile_interface
  !
  subroutine cubefit_spectral_user2par_interface(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
  end subroutine cubefit_spectral_user2par_interface
  !
  subroutine cubefit_spectral_par2spec_interface(par,spec,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectral_pars_t), intent(in)    :: par
    type(spectrum_t),      intent(inout) :: spec
    logical,               intent(inout) :: error
  end subroutine cubefit_spectral_par2spec_interface
  !
  subroutine cubefit_spectral_spec2par_interface(spec,par,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectrum_t),      intent(in)    :: spec
    type(spectral_pars_t), intent(inout) :: par
    logical,               intent(inout) :: error
  end subroutine cubefit_spectral_spec2par_interface
  !
  subroutine cubefit_spectral_iterate_interface(par,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    type(spectral_pars_t), intent(inout) :: par
    logical,               intent(inout) :: error
  end subroutine cubefit_spectral_iterate_interface
  !
  subroutine cubefit_spectral_wind2par_interface(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
  end subroutine cubefit_spectral_wind2par_interface
  !
  !--------------------------------------------------------------------------------
  !
  subroutine cubefit_minuit_set_method(fit,method,error)
    use cubefit_function_spectral_absorption
    use cubefit_function_spectral_gaussian
    use cubefit_function_spectral_hfs
    use cubefit_function_spectral_shell
    !------------------------------------------------------------------------
    ! Set the method to be used on the fit
    !------------------------------------------------------------------------
    class(fit_spectral_t), intent(inout) :: fit
    integer(kind=code_k),  intent(in)    :: method
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname="MINUIT>SET>METHOD"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    select case(method)
    case(code_method_gaussian)
       fit%init     => cubefit_function_spectral_gaussian_init      ! Equivalent to CLASS's midgauss.f90 
       fit%mini     => cubefit_function_spectral_gaussian_minimize  ! Equivalent to CLASS's mingauss.f90
       fit%extr     => cubefit_function_spectral_gaussian_extract   ! Part of fitgauss in minimize.f90
       fit%resi     => cubefit_function_spectral_gaussian_residuals ! New functionality
       fit%user2par => cubefit_function_spectral_gaussian_user2par  ! Similar to CLASS's guegauss in lines.f90
       fit%par2spec => cubefit_function_spectral_gaussian_par2spec  ! New functionality
       fit%spec2par => cubefit_function_spectral_gaussian_spec2par  ! New functionality
       fit%iterate  => cubefit_function_spectral_gaussian_iterate   ! Similar to CLASS's itegauss in iterate.f90
       fit%wind2par => cubefit_function_spectral_gaussian_wind2par  ! Similar to CLASS's guegauss in lines.f90
       fit%prof     => cubefit_function_spectral_gaussian_doprofile ! New functionality
    case(code_method_absorption)
       fit%init     => cubefit_function_spectral_absorption_init      ! Equivalent to CLASS's midabs.f90 
       fit%mini     => cubefit_function_spectral_absorption_minimize  ! Equivalent to CLASS's minabs.f90
       fit%extr     => cubefit_function_spectral_absorption_extract   ! Part of fitabs in minimize.f90
       fit%resi     => cubefit_function_spectral_absorption_residuals ! New functionality
       fit%user2par => cubefit_function_spectral_absorption_user2par  ! Similar to CLASS's gueabs in lines.f90
       fit%par2spec => cubefit_function_spectral_absorption_par2spec  ! New functionality
       fit%spec2par => cubefit_function_spectral_absorption_spec2par  ! New functionality
       fit%iterate  => cubefit_function_spectral_absorption_iterate   ! Similar to CLASS's iteabs in iterate.f90
       fit%wind2par => cubefit_function_spectral_absorption_wind2par  ! Similar to CLASS's gueabs in lines.f90
       fit%prof     => cubefit_function_spectral_absorption_doprofile ! New functionality
    case(code_method_shell)
       fit%init     => cubefit_function_spectral_shell_init      ! Equivalent to CLASS's midshell.f90 
       fit%mini     => cubefit_function_spectral_shell_minimize  ! Equivalent to CLASS's minshell.f90
       fit%extr     => cubefit_function_spectral_shell_extract   ! Part of fitabs in minimize.f90
       fit%resi     => cubefit_function_spectral_shell_residuals ! New functionality
       fit%user2par => cubefit_function_spectral_shell_user2par  ! Similar to CLASS's gueshell in lines.f90
       fit%par2spec => cubefit_function_spectral_shell_par2spec  ! New functionality
       fit%spec2par => cubefit_function_spectral_shell_spec2par  ! New functionality
       fit%iterate  => cubefit_function_spectral_shell_iterate   ! Similar to CLASS's iteshell in iterate.f90
       fit%wind2par => cubefit_function_spectral_shell_wind2par  ! Similar to CLASS's gueshell in lines.f90
       fit%prof     => cubefit_function_spectral_shell_doprofile ! New functionality
    case(code_method_hfs)
       fit%init     => cubefit_function_spectral_hfs_init      ! Equivalent to CLASS's midnh3.f90 
       fit%mini     => cubefit_function_spectral_hfs_minimize  ! Equivalent to CLASS's minnh3.f90
       fit%extr     => cubefit_function_spectral_hfs_extract   ! Part of fitnh3 in minimize.f90
       fit%resi     => cubefit_function_spectral_hfs_residuals ! New functionality
       fit%user2par => cubefit_function_spectral_hfs_user2par  ! Similar to CLASS's guenh3 in lines.f90
       fit%par2spec => cubefit_function_spectral_hfs_par2spec  ! New functionality
       fit%spec2par => cubefit_function_spectral_hfs_spec2par  ! New functionality
       fit%iterate  => cubefit_function_spectral_hfs_iterate   ! Similar to CLASS's itenh3 in iterate.f90
       fit%wind2par => cubefit_function_spectral_hfs_wind2par  ! Similar to CLASS's guenh3 in lines.f90
       fit%prof     => cubefit_function_spectral_hfs_doprofile ! New functionality
    case default
       call cubefit_message(seve%e,rname,"Unrecognized method")
       error = .true.
       return
    end select
  end subroutine cubefit_minuit_set_method
  !
  subroutine cubefit_minuit_user2par(fit,hfs,npar,method,nfunc,flag,pars,error)
    !----------------------------------------------------------------------
    ! Initialize parameters according to user inputs
    !----------------------------------------------------------------------
    class(fit_spectral_t),    intent(inout) :: fit
    type(hfs_prog_t), target, intent(in)    :: hfs
    integer(kind=npar_k),     intent(in)    :: npar
    integer(kind=code_k),     intent(in)    :: method
    integer(kind=func_k),     intent(in)    :: nfunc
    integer(kind=flag_k),     intent(in)    :: flag(:)
    real(kind=para_k),        intent(in)    :: pars(:)
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname="MINUIT>USER2PAR"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call cubefit_minuit_set_method(fit,method,error)
    if (error) return
    !
    call fit%check_hfs(method,hfs,error)
    if (error) return
    call fit%par%init(npar,method,nfunc,error)
    if (error) return
    if (nfunc.gt.0) then
       call fit%user2par(flag,pars,fit%par,error)
       if (error) return
    endif
    fit%oper = code_oper_minimize
  end subroutine cubefit_minuit_user2par
  !
  subroutine cubefit_minuit_spec2par(fit,hfs,spec,error)
    use cubemain_spectrum_real
    !----------------------------------------------------------------------
    ! Initialize parameters according to user inputs
    !----------------------------------------------------------------------
    class(fit_spectral_t),    intent(inout) :: fit
    type(hfs_prog_t), target, intent(in)    :: hfs
    type(spectrum_t),         intent(in)    :: spec         
    logical,                  intent(inout) :: error
    !
    integer(kind=func_k) :: nfunc
    integer(kind=npar_k) :: npar
    integer(kind=chan_k) :: nout
    integer(kind=code_k) :: method
    character(len=*), parameter :: rname="MINUIT>SPEC2PAR"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    method  =  nint(spec%t(icol_method),npar_k)
    nfunc   =  nint(spec%t(icol_nfunc),func_k)
    !
    call fit%check_hfs(method,hfs,error)
    if (error) return
    !
    call cubefit_parameters_npars_nout(method,nfunc,npar,nout,error)
    if (error) return
    !
    call cubefit_minuit_set_method(fit,method,error)
    if (error) return
    !
    call fit%par%init(npar,method,nfunc,error)
    if (error) return
    call fit%spec2par(spec,fit%par,error)
    if (error) return
    !
    fit%oper = code_oper_iterate
  end subroutine cubefit_minuit_spec2par
  !
  subroutine cubefit_minuit_load_window(fit,hfs,method,wind,error)
    !----------------------------------------------------------------------
    ! Load a window onto the fit and allocate parameters
    !----------------------------------------------------------------------
    class(fit_spectral_t),        intent(inout) :: fit
    type(hfs_prog_t),     target, intent(in)    :: hfs
    integer(kind=code_k),         intent(in)    :: method
    integer(kind=chan_k), target, intent(in)    :: wind(:)        
    logical,                      intent(inout) :: error
    !
    integer(kind=func_k) :: nfunc
    integer(kind=npar_k) :: npar
    integer(kind=chan_k) :: nout
    character(len=*), parameter :: rname="MINUIT>LOAD>WINDOW"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call fit%check_hfs(method,hfs,error)
    if (error) return
    !
    ! VVV Should there be a test for window size?
    nfunc = size(wind)/2
    fit%wind => wind
    fit%usewind = .true.
    call cubefit_parameters_npars_nout(method,nfunc,npar,nout,error)
    if (error) return
    call cubefit_minuit_set_method(fit,method,error)
    if (error) return
    call fit%par%init(npar,method,nfunc,error)
    if (error) return
    !
    fit%oper = code_oper_minimize
  end subroutine cubefit_minuit_load_window
  !
  subroutine cubefit_minuit_check_hfs(fit,method,hfs,error)
    !----------------------------------------------------------------------
    ! Check if fit needs a HFS structure and if it is loaded
    !----------------------------------------------------------------------
    class(fit_spectral_t),    intent(inout) :: fit
    integer(kind=code_k),     intent(in)    :: method
    type(hfs_prog_t), target, intent(in)    :: hfs
    logical,                  intent(inout) :: error
    !
    character(len=*), parameter :: rname="MINUIT>CHECK>HFS"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    fit%hfs => hfs
    select case(method)
    case(code_method_hfs,code_method_absorption)
       if (.not.fit%hfs%loaded) then
          call cubefit_message(seve%e,rname,"No hyperfine structure loaded")
          error = .true.
          return
       endif
!!$    case(inh31,inh32,inh33)
!!$       call cubefit_hfs_nh3(method,fit%hfs,error)
!!$       if (error) return
    end select
  end subroutine cubefit_minuit_check_hfs
  !
  subroutine cubefit_minuit_fit(fit,spec,wind,error)
    use gkernel_interfaces
    use cubemain_windowing
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Executes the minuit fit
    !------------------------------------------------------------------------
    class(fit_spectral_t), intent(inout) :: fit          ! Fit spectral object
    type(spectrum_t),      intent(inout) :: spec         ! Observation
    type(window_array_t),  intent(in)    :: wind         ! Window
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: ier
    character(len=*), parameter :: rname="MINUIT>FIT"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !    
    ! Initialize fit%obs
    call fit%obs%init(fit%hfs,fit%par,spec,wind,error)
    if (error) return
    !
    ! Initialize first guesses based on a window
    if (fit%usewind) then
       call fit%wind2par(fit%obs,fit%wind,fit%par,error)
       if (error) return
    endif
    !
    ! Minuit initialization:
    fit%minuit%owner = gpack_get_id('cube',.true.,error)
    if (error) return
    fit%minuit%maxext=ntot
    fit%minuit%maxint=nvar
    fit%minuit%verbose=.false.
    fit%minuit%isw(1:7) = 0
    fit%minuit%sigma  = 0.d0
    fit%minuit%npfix  = 0
    fit%minuit%nu     = 0
    fit%minuit%npar   = 0
    fit%minuit%u(1:fit%minuit%maxext)      = 0.0d0
    fit%minuit%lcode(1:fit%minuit%maxext)  = 0
    fit%minuit%lcorsp(1:fit%minuit%maxext) = 0
    fit%minuit%isw(5) = 1
    fit%minuit%g(:) = 0.d0
    ! Minuit keeps a pointer to the observation
    fit%minuit%data = locwrd(fit%obs)
    !
    ! Method dependant initialization
    if (fit%oper.eq.code_oper_iterate) then
       call fit%iterate(fit%par,error)
       if (error) return
    endif
    call fit%init(fit%par,fit%obs,fit%minuit,error)
    if (error) return
    !
    call fit%consistency(error)
    if (error) return
    call intoex(fit%minuit,fit%minuit%x)
    fit%minuit%up = 0.5*(fit%obs%sigbase**2+fit%obs%sigline**2)
    fit%minuit%nfcnmx  = 1000
    fit%minuit%epsi  = 0.1d0 * fit%minuit%up
    fit%minuit%newmin  = 0
    fit%minuit%itaur  = 0
    fit%minuit%isw(1)  = 0
    fit%minuit%isw(3)  = 1
    fit%minuit%nfcn = 1
    fit%minuit%vtest  = 0.04
    call fit%mini(fit%minuit%npar,fit%minuit%g,fit%minuit%amin,fit%minuit%u,code_minuit_value,fit%obs)
    !
    !------------------------------------------------------------------------
    !
    ! Do Simplex Minimisation:
    call simplx(fit%minuit,fit%mini,ier)
    if (ier.ne.0) then
       call cubefit_message(fitseve%others,rname,'Simplex Fit diverged')
       fit%status = code_status_diverged
       return
    endif
    call fit%extr(fit%minuit,fit%obs,fit%par,error)
    if (error) return
    !
    ! Gradient Minimization
    call intoex(fit%minuit,fit%minuit%x)
    call fit%mini(fit%minuit%npar,fit%minuit%g,fit%minuit%amin,fit%minuit%u,code_minuit_rms,fit%obs) 
    !
    fit%minuit%up = fit%obs%sigbase**2
    fit%minuit%epsi  = 0.1d0 * fit%minuit%up
    fit%minuit%apsi  = fit%minuit%epsi
    call hesse(fit%minuit,fit%mini)
    call migrad(fit%minuit,fit%mini,ier)
    if (ier.eq.migrad_noimprov) then
       call hesse(fit%minuit,fit%mini)
       ier = 0
    elseif (ier.eq.migrad_diverged) then
       call cubefit_message(fitseve%others,rname,'Solution not converged')
       ier = 0
       fit%status = code_status_diverged
    endif
    fit%status = code_status_converged
    !    
  end subroutine cubefit_minuit_fit
  !
  subroutine cubefit_minuit_consistency(fit,error)
    use gkernel_interfaces
    !------------------------------------------------------------------------
    ! Checks minuit consistency and set steps
    !------------------------------------------------------------------------
    class(fit_spectral_t), intent(inout) :: fit          ! Fit spectral object
    logical,               intent(inout) :: error
    !
    real(kind=8) :: sav,sav2
    real(kind=coor_k) :: vplu,vminu
    character(len=mess_l) :: mess
    integer(kind=4) :: ninte,ipara,ifatal
    character(len=*), parameter :: rname="MINUIT>CONSISTENCY"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ifatal = 0
    ninte  = 0
    do ipara= 1, fit%minuit%nu
       if (ipara.gt.fit%minuit%maxext) then
          ifatal = ifatal+1
       else if (fit%minuit%werr(ipara).le.0.d0) then
          ! Fixed parameter
          fit%minuit%lcode(ipara) = 0
          write(mess,'(a,i3,a)') "Parameter",ipara," is fixed"
          call cubefit_message(fitseve%others,rname,mess)
       else
          ! Variable parameter
          ninte = ninte + 1
          ! Parameter with limits
          if (fit%minuit%lcode(ipara).ne.1) then
             fit%minuit%lcode(ipara) = 4
             sav = (fit%minuit%blim(ipara)-fit%minuit%u(ipara))*(fit%minuit%u(ipara)-fit%minuit%alim(ipara))
             if (sav.lt.0d0) then
                ifatal = ifatal + 1
                write(mess,'(a,i0,3(a,f0.3))') 'Parameter #',ipara,' (',fit%minuit%u(ipara),&
                     ') outside limits ',fit%minuit%alim(ipara),' to ',fit%minuit%blim(ipara)
                call cubefit_message(seve%e,rname,mess)
             else if (sav.eq.0d0) then
                write(mess,'(a,i3,a)') "Parameter",ipara," is at limit"
                call cubefit_message(fitseve%others,rname,mess)
             endif
          endif
       endif
    enddo
    !
    ! End parameter cards
    ! Stop if fatal error
    if (ninte.gt.fit%minuit%maxint)  then
       write(mess,1008) ninte,fit%minuit%maxint
       call cubefit_message(seve%e,rname,mess)
       ifatal = ifatal + 1
    endif
    if (ninte .eq. 0) then
       call cubefit_message(seve%e,rname,'All input parameters are fixed')
       ifatal = ifatal + 1
    endif
    if (ifatal.gt.0)  then
       write(mess,'(I0,A)')  ifatal,' errors on input parameters, abort.'
       call cubefit_message(seve%e,rname,mess)
       error = .true.
       return
    endif
    !
    ! O.K. Start
    ! Calculate step sizes DIRIN
    fit%minuit%npar = 0
    do ipara= 1, fit%minuit%nu
       if (fit%minuit%lcode(ipara) .gt. 0)  then
          fit%minuit%npar         = fit%minuit%npar + 1
          fit%minuit%lcorsp(ipara) = fit%minuit%npar
          sav = fit%minuit%u(ipara)
          fit%minuit%x(fit%minuit%npar)  = pintf(fit%minuit,sav,ipara)
          fit%minuit%xt(fit%minuit%npar) = fit%minuit%x(fit%minuit%npar)
          sav2 = sav + fit%minuit%werr(ipara)
          vplu = pintf(fit%minuit,sav2,ipara) - fit%minuit%x(fit%minuit%npar)
          sav2 = sav - fit%minuit%werr(ipara)
          vminu = pintf(fit%minuit,sav2,ipara) - fit%minuit%x(fit%minuit%npar)
          fit%minuit%dirin(fit%minuit%npar) = 0.5d0 * (dabs(vplu) +dabs(vminu))
       endif
    enddo
    return
    !
1008 format (' Too many variable parameters.  You request ',i5/,   &
          &    ' This version of MINUIT is only dimensioned for ',i4)
  end subroutine cubefit_minuit_consistency
  !
  subroutine cubefit_minuit_export(fit,spec,error)
    use cubetools_nan
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Export the minuit fit results onto a spectrum type
    !------------------------------------------------------------------------
    class(fit_spectral_t), intent(inout) :: fit          ! Fit spectral object
    type(spectrum_t),      intent(inout) :: spec         ! exported output
    logical,               intent(inout) :: error
    !
    integer(kind=4) :: il
    integer(kind=npar_k) :: ipara
    real(kind=para_k) :: dx,al,ba,du1,du2
    character(len=mess_l) :: mess
    character(len=*), parameter :: rname="MINUIT>EXPORT"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    spec%t(icol_status) = fit%status
    spec%t(icol_method) = fit%par%method
    spec%t(icol_nfunc)  = max(fit%par%nfunc,1)
    !
    write (mess,'(a,i0)') "Number of calls: ",fit%minuit%nfcn
    call cubefit_message(fitseve%others,rname,mess)
    write (mess,'(a,l)') "Fit converged: ",fit%status.eq.code_status_converged
    call cubefit_message(fitseve%others,rname,mess)
    !
    select case(fit%status)
    case(code_status_converged)
       call fit%extr(fit%minuit,fit%obs,fit%par,error)
       if (error) return
       !
       call fit%mini(fit%minuit%npar,fit%minuit%g,fit%minuit%amin,fit%minuit%u,code_minuit_rms,fit%obs)
       write(mess,1002) fit%obs%sigbase,fit%obs%sigline
       call cubefit_message(fitseve%others,rname,mess)
       fit%minuit%up  = fit%obs%sigbase**2
       do ipara=1,fit%minuit%nu
          il  = fit%minuit%lcorsp(ipara)
          if (il .eq. 0)  then
             fit%minuit%werr(ipara)=0.
          else
             if (fit%minuit%isw(2) .ge. 1)  then
                dx = sqrt(abs(fit%minuit%v(il,il)*fit%minuit%up))
                if (fit%minuit%lcode(ipara) .gt. 1) then
                   al = fit%minuit%alim(ipara)
                   ba = fit%minuit%blim(ipara) - al
                   du1 = al + 0.5d0 *(sin(fit%minuit%x(il)+dx) +1.0d0) * ba - fit%minuit%u(ipara)
                   du2 = al + 0.5d0 *(sin(fit%minuit%x(il)-dx) +1.0d0) * ba - fit%minuit%u(ipara)
                   if (dx .gt. 1.0d0)  du1 = ba
                   dx = 0.5d0 * (abs(du1) + abs(du2))
                endif
                fit%minuit%werr(ipara) = dx
             endif
          endif
       enddo
       !
       call fit%extr(fit%minuit,fit%obs,fit%par,error)
       if (error) return
       !
       spec%t(icol_rmsbase) = fit%obs%sigbase
       spec%t(icol_rmsline) = fit%obs%sigline
       !
       call fit%par2spec(fit%par,spec,error)
       if (error) return
       !
       do ipara=1,fit%par%n
          write(mess,'(a,i0,a,2(1pg14.7))') "Parameter #",ipara," = ",fit%par%pars(ipara),fit%par%errs(ipara)
          call cubefit_message(fitseve%others,rname,mess)
       enddo
    case(code_status_diverged)
       ! Diverged output is NaN
       spec%t(icol_nfunc:spec%n) = gr4nan
    case default
       write(mess,'(a,i0)') "Unknown fit status: ",fit%status
       call cubefit_message(seve%e,rname,mess)
       error = .true.
       return
    end select
1002 format (' RMS of Residuals :  Base = ',1pg9.2,'  Line = ',1pg9.2)
  end subroutine cubefit_minuit_export
  !
  subroutine cubefit_minuit_residuals(fit,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Compute the residuals of a fit
    !------------------------------------------------------------------------
    class(fit_spectral_t), intent(inout) :: fit          ! Fit spectral object
    type(spectrum_t),      intent(inout) :: spec         ! Residual output
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname="MINUIT>RESIDUALS"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    if (spec%n.ne.fit%obs%spec%n) then
       call cubefit_message(seve%e,rname,'Output residuals and input observation have different sizes')
       error = .true.
       return
    endif
    if (fit%status.eq.code_status_converged) then
       call fit%resi(fit%obs,spec,error)
       if (error) return
    else ! If fit diverged residuals are the input spectrum
       spec%t(:) = fit%obs%spec%t(:)
    endif
  end subroutine cubefit_minuit_residuals
  !
  subroutine cubefit_minuit_profile(fit,ifunc,spec,error)
    use cubemain_spectrum_real
    use cubemain_windowing
    !------------------------------------------------------------------------
    ! Compute the profile of a fit
    !------------------------------------------------------------------------
    class(fit_spectral_t), intent(inout) :: fit          ! Fit spectral object
    integer(kind=func_k),  intent(in)    :: ifunc        ! Component to compute profile
    type(spectrum_t),      intent(inout) :: spec         ! Residual output
    logical,               intent(inout) :: error
    !
    character(len=*), parameter :: rname="MINUIT>PROFILE"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    call fit%obs%point(fit%hfs,fit%par,spec,error)
    if (error) return
    call fit%prof(ifunc,fit%obs,spec,error)
    if (error) return
  end subroutine cubefit_minuit_profile
  !
  !----------------------------------------------------------------------
  !
  subroutine cubefit_parameters_npars_nout(method,nfunc,npar,nout,error)
    use cubefit_function_spectral_absorption
    use cubefit_function_spectral_gaussian
    use cubefit_function_spectral_hfs
    use cubefit_function_spectral_shell
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: method
    integer(kind=func_k), intent(in)    :: nfunc
    integer(kind=npar_k), intent(out)   :: npar
    integer(kind=chan_k), intent(out)   :: nout
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='PARAMETERS>NPARS>NOUT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    if (nfunc.lt.0) then
       call cubefit_message(seve%e,rname,"Number of lines must be positive")
       error = .true.
       return
    endif
    if (nfunc.gt.10) then
       call cubefit_message(seve%e,rname,"Only up to 10 lines are supported")
       error = .true.
       return
    endif
    select case(method)
    case(code_method_gaussian)
       npar = cubefit_function_spectral_gaussian_npar(max(nfunc,1))
    case(code_method_hfs)
       npar = cubefit_function_spectral_hfs_npar(max(nfunc,1))
    case(code_method_absorption)
       npar = cubefit_function_spectral_absorption_npar(max(nfunc,1))
    case(code_method_shell)
       npar = cubefit_function_spectral_shell_npar(max(nfunc,1))
    case default
       call cubefit_message(seve%e,rname,"Unrecognized method")
       error = .true.
       return
    end select
    nout = 3*npar+ndaps
  end subroutine cubefit_parameters_npars_nout
  !
  subroutine cubefit_parameters_flags(method,ipara,methflag,funcflag,paraflag,error)
    use cubedag_allflags
    use cubefit_function_spectral_absorption
    use cubefit_function_spectral_gaussian
    use cubefit_function_spectral_hfs
    use cubefit_function_spectral_shell
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: method
    integer(kind=npar_k), intent(in)    :: ipara
    type(flag_t),         intent(out)   :: methflag
    type(flag_t),         intent(out)   :: funcflag
    type(flag_t),         intent(out)   :: paraflag
    logical,              intent(inout) :: error
    !
    type(flag_t) :: methflags(nmeth)
    character(len=*), parameter :: rname='PARAMETERS>FLAGS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ! *** JP: The following is error-prone because it may be unsynchronized with the
    ! *** JP: definitions in the cubefit_parameters module.
    ! Declare after flags were registered at init time:
    methflags(:) = [flag_gaussian,   &
                   flag_absorption,  &
                   flag_hfs,         &
                   flag_shell]
    !
    methflag = methflags(method)
    select case(method)
    case(code_method_gaussian)
       call cubefit_function_spectral_gaussian_flags(ipara,funcflag,paraflag,error)
       if (error) return    
    case(code_method_hfs)
       call cubefit_function_spectral_hfs_flags(ipara,funcflag,paraflag,error)
       if (error) return                                                         
    case(code_method_absorption)
       call cubefit_function_spectral_absorption_flags(ipara,funcflag,paraflag,error)
       if (error) return                                                         
    case(code_method_shell)
       call cubefit_function_spectral_shell_flags(ipara,funcflag,paraflag,error)
       if (error) return
    case default
       call cubefit_message(seve%e,rname,"Unrecognized method")
       error = .true.
       return
    end select
  end subroutine cubefit_parameters_flags
  !
  subroutine cubefit_parameters_units(method,ipara,unit,error)
    use cubefit_function_spectral_absorption
    use cubefit_function_spectral_gaussian
    use cubefit_function_spectral_hfs
    use cubefit_function_spectral_shell
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=code_k), intent(in)    :: method
    integer(kind=npar_k), intent(in)    :: ipara
    character(len=*),     intent(out)   :: unit
    logical,              intent(inout) :: error
    !
    character(len=*), parameter :: rname='PARAMETERS>UNITS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    select case(method)
    case(code_method_gaussian)
       call cubefit_function_spectral_gaussian_units(ipara,unit,error)
       if (error) return    
    case(code_method_hfs)
       call cubefit_function_spectral_hfs_units(ipara,unit,error)
       if (error) return                                                         
    case(code_method_absorption)
       call cubefit_function_spectral_absorption_units(ipara,unit,error)
       if (error) return                                                         
    case(code_method_shell)
       call cubefit_function_spectral_shell_units(ipara,unit,error)
       if (error) return
    case default
       call cubefit_message(seve%e,rname,"Unrecognized method")
       error = .true.
       return
    end select
  end subroutine cubefit_parameters_units
end module cubefit_spectral_fit
!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
