module cubefit_function_spectral_gaussian
  use fit_minuit
  !
  use cubefit_messaging
  use cubefit_spectral_parameters
  use cubefit_spectral_obs
  !
  integer(kind=npar_k),parameter :: npara = 3
  integer(kind=npar_k),parameter :: iarea   = 1
  integer(kind=npar_k),parameter :: ivelo   = 2
  integer(kind=npar_k),parameter :: ifwhm   = 3
  !
  public cubefit_function_spectral_gaussian_init, cubefit_function_spectral_gaussian_minimize
  public cubefit_function_spectral_gaussian_extract, cubefit_function_spectral_gaussian_residuals
  public cubefit_function_spectral_gaussian_npar, cubefit_function_spectral_gaussian_user2par
  public cubefit_function_spectral_gaussian_par2spec, cubefit_function_spectral_gaussian_spec2par
  public cubefit_function_spectral_gaussian_iterate,cubefit_function_spectral_gaussian_wind2par
  public cubefit_function_spectral_gaussian_flags, cubefit_function_spectral_gaussian_doprofile
  public cubefit_function_spectral_gaussian_units
  private
  !
contains
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>INIT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')    
    !     
    ! Starting values
    if (par%nfunc.eq.0) then
       ! Automatic guess
       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)
       if (par%pars(ifwhm).lt.obs%deltav) par%pars(ifwhm) = obs%deltav
       par%pars(iarea)=area
       minuit%nu=npara
    else
       ! Manipulate initial guesses from user
       minuit%nu=3*par%nfunc
       ipara=0
       do ifunc=1,par%nfunc
          !
          ! That is quite tricky, since the area is the product of the original
          ! intensity by the width. But for dependant gaussian, it is more subtle
          if (par%flag(ifunc,iarea).eq.3) then
             continue
          elseif (par%flag(ifunc,ifwhm).eq.3) then
             par%pars(ipara+iarea) = par%pars(ipara+iarea)*par%pars(ipara+ifwhm)*1.064467
             par%pars(ipara+iarea) = par%pars(ipara+iarea)*par%pars(3*par%leaders(ifwhm))    !
          else
             ! Area=amp*fwhm*sqrt(2pi/8log2)
             par%pars(ipara+iarea) = par%pars(ipara+iarea)*par%pars(ipara+ifwhm)*1.064467 
          endif
          ipara=ipara+3
       enddo ! ifunc
    endif
    minuit%nu=minuit%nu+3
    !
    ! User feedback on par%parsameters used, useful for debug only...
    call cubefit_message(fitseve%others,rname,'Input Parameters:  Area Position Fwhm')
    ipara = 0
    do ifunc=1,max(par%nfunc,1)
       write (mess,1002) par%pars(ipara+iarea),par%pars(ipara+ivelo),par%pars(ipara+ifwhm)
       call cubefit_message(fitseve%others,rname,mess)
       ipara=ipara+npara
    enddo ! ifunc
    !
    ! Set up parameters for major variables
    !
    ! Velocities
    if (par%leaders(ivelo).eq.0) then 
       minuit%u(2)=0.
       minuit%werr(2)=0.
    else
       minuit%u(2)=par%pars(3*par%leaders(ivelo)-1)
       if (par%flag(par%leaders(ivelo),ivelo).eq.4) then
          minuit%werr(2)=0.
       else
          minuit%werr(2)=obs%deltav
          minuit%alim(2)=minuit%u(2)-0.15*obs%spec%n*obs%deltav
          minuit%blim(2)=minuit%u(2)+0.15*obs%spec%n*obs%deltav
       endif
    endif
    !
    ! Line widths
    if (par%leaders(ifwhm).eq.0) then 
       minuit%u(3)=1./1.665109           ! 1 / (2*SQRT(LN(2)))
       minuit%werr(3)=0.
    else
       minuit%u(3)=abs(par%pars(3*par%leaders(ifwhm)))/1.665109
       if (par%flag(par%leaders(ifwhm),ifwhm).eq.4) then
          minuit%werr(3)=0.
       else
          minuit%werr(3)=obs%deltav
          minuit%alim(3)=0.25*obs%deltav
          minuit%blim(3)=0.75*obs%spec%n*obs%deltav
       endif
    endif
    !
    ! Areas
    if (par%leaders(iarea).eq.0) then 
       minuit%u(1)=0.564189584           ! 1 / SQRT(PI)
       minuit%werr(1)=0.
    else
       minuit%u(1)=par%pars(3*par%leaders(iarea)-2)
       if (par%flag(par%leaders(iarea),iarea).eq.4) then
          minuit%werr(1)=0.
       else
          minuit%werr(1)=obs%sigbase*obs%deltav
          if (minuit%u(1).ne.0.) then
             minuit%alim(1)=dmin1(0.d0,10*minuit%u(1))
             minuit%blim(1)=dmax1(0.d0,10*minuit%u(1))
          else
             minuit%lcode(1)=1
          endif
       endif
    endif
    !
    ! Set up parameters for secondary variables
    ipara=4
    do ifunc=1,max(par%nfunc,1)
       ! Area
       minuit%u(ipara)=par%pars(ipara-npara)
       if (par%flag(ifunc,iarea).eq.0 .or. par%nfunc.eq.0) then
          minuit%werr(ipara)  =  max(obs%sigbase,obs%sigline)*obs%deltav
          if (par%errs(ipara-npara).ne.0) minuit%werr(ipara)=par%errs(ipara-npara)
          if (minuit%u(ipara).ne.0.) then
             minuit%alim(ipara)=dmin1(0.d0,10*minuit%u(ipara))
             minuit%blim(ipara)=dmax1(0.d0,10*minuit%u(ipara))
          else
             minuit%lcode(ipara)=1             ! No Boundaries if minuit%u(ipara)=0.
          endif
       else
          minuit%werr(ipara)=0.
          if (ifunc.eq.par%leaders(iarea)) then
             minuit%u(ipara)=0.564189584
          else
             minuit%u(ipara)=minuit%u(ipara)*0.564189584
          endif
       endif
       ipara=ipara+1
       !
       ! Velocity
       minuit%u(ipara)=par%pars(ipara-npara)
       if (par%flag(ifunc,ivelo).eq.0 .or. par%nfunc.eq.0) then
          minuit%werr(ipara)=obs%deltav
          if (par%errs(ipara-npara).ne.0) minuit%werr(ipara)=par%errs(ipara-npara)
          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
       else
          minuit%werr(ipara)=0.
          if (ifunc.eq.par%leaders(ivelo)) minuit%u(ipara)=0.
       endif
       ipara=ipara+1
       !
       ! Line width
       minuit%u(ipara)=abs(par%pars(ipara-npara))
       if (par%flag(ifunc,ifwhm).eq.0 .or. par%nfunc.eq.0) then
          minuit%werr(ipara)=obs%deltav
          if (par%errs(ipara-npara).ne.0) minuit%werr(ipara)=par%errs(ipara-npara)
          minuit%alim(ipara)=obs%deltav
          minuit%blim(ipara)=0.75*obs%spec%n*obs%deltav
       else
          minuit%werr(ipara)=0.
          if (ifunc.eq.par%leaders(ifwhm)) minuit%u(ipara)=1.
       endif
       ipara=ipara+1
    enddo
    !
1002 format((3(1pg10.3)))
  end subroutine cubefit_function_spectral_gaussian_init
  !
  subroutine cubefit_function_spectral_gaussian_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,nfunc
    real(kind=coor_k) :: xvel
    real(kind=sign_k), allocatable :: parsarea(:),parsvelo(:),parsfwhm(:)
    real(kind=8),      allocatable :: argexp(:)
    real(kind=chi2_k), allocatable :: parschi2(:)
    real(kind=grad_k), allocatable :: parsgrad(:)
    real(kind=8) :: arg
    real(kind=chi2_k) :: chi2loc
    real(kind=para_K) :: area,velo,fwhm
    real(kind=grad_k) :: gradarea,gradvelo,gradfwhm
    integer(kind=func_k) :: ifunc
    logical :: dograd
    character(len=*), parameter :: rname='SPECTRAL>GAUSSIAN>MINIMIZE'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    if (iflag.eq.code_minuit_rms) then
       call obs%sigma(cubefit_function_spectral_gaussian_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),&
         parsgrad(nfunc*npara))
    !
    ! Compute gaussians
    chi2 = 0.
    parsgrad = 0.
    gradarea = 0.
    gradvelo = 0.
    gradfwhm = 0.
    parsarea = 0.
    parsvelo = 0.
    parsfwhm = 0.
    area = pars(iarea)
    velo = pars(ivelo)
    fwhm = pars(ifwhm)       
    do ifunc=1,nfunc
       parsarea(ifunc) = pars(npara*ifunc+iarea) * area
       parsvelo(ifunc) = pars(npara*ifunc+ivelo) + velo
       parsfwhm(ifunc) = pars(npara*ifunc+ifwhm) * fwhm
    enddo
    !
    do ichan=obs%ifirst,obs%ilast
       if (obs%wfit(ichan).gt.0) then 
          xvel = obs%spec%v(ichan)
          parschi2 = 0.
          argexp   = 0.
          argexp(1:nfunc) = (xvel - parsvelo(1:nfunc)) / parsfwhm(1:nfunc)
          where(argexp(1:nfunc).le.4.)
             parschi2(1:nfunc) = exp(-argexp(1:nfunc)**2)
          end where
          chi2loc = sum(parschi2(1:nfunc)*parsarea(1:nfunc)/parsfwhm(1:nfunc))
          !
          ! Compute chi^2 (No ponderation, WFIT is ignored)
          chi2loc =  (chi2loc - obs%spec%t(ichan))
          chi2 = chi2 + chi2loc**2
          !
          ! Compute Gradients
          if (dograd) then
             chi2loc = 2. * chi2loc
             do ifunc=1,nfunc
                if (parschi2(ifunc).ne.0.) then
                   arg                                 = parschi2(ifunc) * chi2loc / parsfwhm(ifunc)
                   parsgrad(iarea+npara*(ifunc-1))  = parsgrad(iarea+npara*(ifunc-1)) + arg
                   gradarea                            = gradarea + arg*parsarea(ifunc)
                   !
                   arg                                 = parsarea(ifunc)*arg/parsfwhm(ifunc)
                   parsgrad(ifwhm+npara*(ifunc-1))  = parsgrad(ifwhm+npara*(ifunc-1)) - arg
                   gradfwhm                            = gradfwhm - arg*parsfwhm(ifunc)
                   !
                   arg                                 = arg*argexp(ifunc)*2.
                   parsgrad(ivelo+npara*(ifunc-1))  = parsgrad(ivelo+npara*(ifunc-1)) + arg
                   parsgrad(ifwhm+npara*(ifunc-1))  = parsgrad(ifwhm+npara*(ifunc-1)) + arg*argexp(ifunc)
                   gradvelo                            = gradvelo + arg
                   gradfwhm                            = gradfwhm + arg*argexp(ifunc)*parsfwhm(ifunc)
                endif
             enddo
          endif
       endif
    enddo
    !
    ! Setup values and return
    grad(iarea)=gradarea/area
    grad(ivelo)=gradvelo
    grad(ifwhm)=gradfwhm/fwhm
    !
    do ifunc=1,nfunc
       grad(npara*(ifunc-1)+iarea) = parsgrad(iarea+npara*(ifunc-1)) *area
       grad(npara*(ifunc-1)+ivelo) = parsgrad(ivelo+npara*(ifunc-1))
       grad(npara*(ifunc-1)+ifwhm) = parsgrad(ifwhm+npara*(ifunc-1)) *fwhm
    enddo
  end subroutine cubefit_function_spectral_gaussian_minimize
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>EXTRACT'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    ! Update parameters to compute RMS
    ipara=0
    do ifunc=1,max(par%nfunc,1)
       par%pars(ipara+iarea)=minuit%u(ipara+3+iarea)*minuit%u(1)*1.7724538
       par%pars(ipara+ivelo)=minuit%u(ipara+3+ivelo)+minuit%u(2)
       par%pars(ipara+ifwhm)=minuit%u(ipara+3+ifwhm)*minuit%u(3)*1.665109
       par%errs(ipara+iarea)=minuit%werr(ipara+iarea+3)
       if (ifunc.eq.par%leaders(iarea)) par%errs(ipara+iarea)=minuit%werr(1)
       par%errs(ipara+ivelo)=minuit%werr(ipara+ivelo+3)
       if (ifunc.eq.par%leaders(ivelo)) par%errs(ipara+ivelo)=minuit%werr(2)
       par%errs(ipara+ifwhm)=minuit%werr(ipara+ifwhm+3)
       if (ifunc.eq.par%leaders(ifwhm)) par%errs(ipara+ifwhm)=minuit%werr(3)
       ipara=ipara+npara
    enddo
  end subroutine cubefit_function_spectral_gaussian_extract
  !
  subroutine cubefit_function_spectral_gaussian_residuals(obs,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Compute the residuals of a gaussian 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>GAUSSIAN>RESIDUALS"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    do ichan=1, spec%n
       xvel = obs%spec%v(ichan)
       pred = cubefit_function_spectral_gaussian_profile(obs,xvel,0)
       spec%t(ichan) = obs%spec%t(ichan) - pred
    enddo
  end subroutine cubefit_function_spectral_gaussian_residuals
  !
  subroutine cubefit_function_spectral_gaussian_doprofile(ifunc,obs,spec,error)
    use cubemain_spectrum_real
    !------------------------------------------------------------------------
    ! Compute the profile of a gaussian 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>GAUSSIAN>DOPROFILE"
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    do ichan=1, spec%n
       xvel = obs%spec%v(ichan)
       pred = cubefit_function_spectral_gaussian_profile(obs,xvel,ifunc)
       spec%t(ichan) = pred
    enddo
  end subroutine cubefit_function_spectral_gaussian_doprofile
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>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) = flag(jpara)
          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    
    if (par%leaders(iarea).ne.0 .and. par%leaders(ifwhm).ne.0 .and. &
         par%leaders(iarea).ne.par%leaders(ifwhm)) then
       call cubefit_message(seve%e,rname,'Parameters flags are inconsistent')
       error = .true.
       return
    endif
  end subroutine cubefit_function_spectral_gaussian_user2par
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>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)
    enddo
  end subroutine cubefit_function_spectral_gaussian_par2spec
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>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) 
    enddo
  end subroutine cubefit_function_spectral_gaussian_spec2par
  !
  subroutine cubefit_function_spectral_gaussian_iterate(par,error)
    !----------------------------------------------------------------------
    !
    !----------------------------------------------------------------------
    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>GAUSSIAN>ITERATE'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ipara = 0
    do ifunc=1,par%nfunc
       par%pars(ipara+iarea) = par%pars(ipara+iarea)/par%pars(ipara+ifwhm)/1.064467
       if (par%flag(ifunc,ipara+iarea).eq.3) &
            par%pars(ipara+iarea)=par%pars(ipara+iarea)/par%pars(npara*(par%leaders(iarea)-1)+iarea)
       if (par%flag(ifunc,ipara+ivelo).eq.3) &
            par%pars(ipara+ivelo)=par%pars(ipara+ivelo)/par%pars(npara*(par%leaders(ivelo)-1)+ivelo)
       if (par%flag(ifunc,ipara+ifwhm).eq.3) &
            par%pars(ipara+ifwhm)=par%pars(ipara+ifwhm)/par%pars(npara*(par%leaders(ifwhm)-1)+ifwhm)    
       ipara = ipara+npara
    enddo
  end subroutine cubefit_function_spectral_gaussian_iterate
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>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
    enddo
  end subroutine cubefit_function_spectral_gaussian_wind2par
  !
  !----------------------------------------------------------------------
  !
  function cubefit_function_spectral_gaussian_profile(obs,xvel,ifunc) result(gauss)
    !----------------------------------------------------------------------
    ! Compute the value of a gaussian or a sum of gaussians 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 gaussian is to be computed
    !
    real(kind=sign_k) :: gauss
    !
    integer(kind=func_k) :: ifirst,ilast,jfunc
    integer(kind=npar_k) :: ipara 
    real(kind=4) :: arg
    !
    gauss=0.
    arg=0.
    ! dobase = .false.
    !
    if (ifunc.eq.0) then
       ifirst = 1
       ilast = max(obs%par%nfunc,1)
    else
       ifirst = ifunc
       ilast = ifunc
    endif
    !
    do jfunc = ifirst,ilast
       ipara = npara*(jfunc-1)
       arg = abs((xvel-obs%par%pars(ipara+ivelo)) / obs%par%pars(ipara+ifwhm)*1.665109)
       if (arg.lt.4.) then
          gauss = gauss + exp(-arg**2)*obs%par%pars(ipara+iarea)/obs%par%pars(ipara+ifwhm)/1.064467
       endif
    enddo
  end function cubefit_function_spectral_gaussian_profile
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>FLAGS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ifunc  = ipara/npara+1
    select case(mod(ipara,npara))
    case(1)
       paraflag = flag_area
    case(2)
       paraflag = flag_velocity
    case(0)
       paraflag = flag_fwhm
       ifunc  = ifunc-1
    end select
    call cubefit_func2flag(ifunc,funcflag,error)
    if (error) return
  end subroutine cubefit_function_spectral_gaussian_flags
  !
  subroutine cubefit_function_spectral_gaussian_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>GAUSSIAN>UNITS'
    !
    call cubefit_message(fitseve%trace,rname,'Welcome')
    !
    ifunc  = ipara/npara+1
    select case(mod(ipara,npara))
    case(1)
       unit = strg_add//unit_velo%prog_name()
    case(2)
       unit = unit_velo%prog_name()
    case(0)
       unit = unit_velo%prog_name()
    end select
  end subroutine cubefit_function_spectral_gaussian_units
  !
  function cubefit_function_spectral_gaussian_npar(nfunc) result(npar)
    !------------------------------------------------------------------------
    !
    !------------------------------------------------------------------------
    integer(kind=func_k), intent(in) :: nfunc
    !
    integer(kind=npar_k) :: npar
    !
    npar = npara*nfunc
  end function cubefit_function_spectral_gaussian_npar
end module cubefit_function_spectral_gaussian
