subroutine fitgauss (fcn,liter,ier)
  !---------------------------------------------------------------------
  ! SAS	Internal routine
  !	Setup and starts a GAUSS fit minimisation using MINUIT
  ! Arguments :
  !	FCN	Ext.	Function to be mininized	Input
  !	LITER	L	Logical of iterate fit		Input
  !	IER	I	error code 			Output
  ! (5-mar-1985)
  !---------------------------------------------------------------------
  external :: fcn                   !
  logical :: liter                  !
  integer :: ier                    !
  ! Global
  integer :: lenc
  include 'clic_fit.inc'
  include 'clic_gauss.inc'
  include 'clic_gaussdata.inc'
  ! Local
  integer :: i,k,l,k1,k2
  logical :: first
  real*8 :: dx, al, ba, du1, du2
  real :: x1, x2
  character(len=80) :: ch
  !
  ! Added error Patch for Initialisation
  ngline= nline
  maxext=ntot
  maxint=nvar
  !
  ! Initialise values
  k = max(1,ndata/4)
  x1 = 1e20
  do i=1, ndata
    if (rdatax(i).lt.x1) x1 = rdatax(i)
  enddo
  deltav = 1e20
  do i=1, ndata
    x2 = rdatax(i)-x1
    if ((x2.gt.0.01).and.(x2.lt.deltav)) deltav = x2
  enddo
  call midgauss (ier,liter)
  if (ier.ne.0) return
  call clic_intoex(x)
  up = 0.5*(sigbas**2+sigrai**2)
  nfcnmx  = 1000
  epsi  = 0.1d0 * up
  newmin  = 0
  itaur  = 0
  isw(1)  = 0
  isw(3)  = 1
  nfcn = 1
  vtest  = 0.04
  call fcn(npar,g,amin,u,1)
  !
  ! Simplex Minimization
  if (.not.liter) then
    call clic_simplx(fcn,ier)
    if (ier.ne.0) return
    k=1
    do i=1,max(nline,1)
      par(k)  =u(k+3)*u(1)*1.7724538
      par(k+1)=u(k+4)+u(2)
      par(k+2)=u(k+5)*1.665109*u(3)
      k=k+3
    enddo
  endif
  !
  ! Gradient Minimization
  first = .false.
10 first = .not.first
  call clic_intoex(x)
  call fcn(npar,g,amin,u,3)
  write(ch,1002) sigbas,sigrai
  call message(4,1,'FITGAUSS',ch(1:lenc(ch)))
  up = sigbas**2
  epsi  = 0.1d0 * up
  apsi  = epsi
  call clic_hesse(fcn)
  call clic_migrad(fcn,ier)
  if (ier.eq.3 .and. first) goto 10
  !
  if (ier.eq.1) then
    call clic_hesse(fcn)
    ier = 0
  endif
  !
  ! Print Results
  k=1
  do i=1,max(nline,1)
    par(k)  =u(k+3)*u(1)*1.7724538
    par(k+1)=u(k+4)+u(2)
    par(k+2)=u(k+5)*u(3)*1.665109
    k=k+3
  enddo
  call clic_intoex(x)
  call fcn(npar,g,amin,u,3)
  write(ch,1002) sigbas,sigrai
  call message(4,1,'MIDGAUSS',ch(1:lenc(ch)))
  up  = sigbas**2
  !
  ! Calculate External Errors
  do i=1,nu
    l  = lcorsp(i)
    if (l .eq. 0)  then
      werr(i)=0.
    else
      if (isw(2) .ge. 1)  then
        dx = dsqrt(dabs(v(l,l)*up))
        if (lcode(i) .gt. 1) then
          al = alim(i)
          ba = blim(i) - al
          du1 = al + 0.5d0 *(dsin(x(l)+dx) +1.0d0) * ba - u(i)
          du2 = al + 0.5d0 *(dsin(x(l)-dx) +1.0d0) * ba - u(i)
          if (dx .gt. 1.0d0)  du1 = ba
          dx = 0.5d0 * (dabs(du1) + dabs(du2))
        endif
        werr(i) = dx
      endif
    endif
  enddo
  !
  k=1
  do i=1,max(nline,1)
    k1=k+1
    k2=k+2
    err(k)=werr(k+3)
    if (i.eq.kt0) err(k)=werr(1)
    err(k1)=werr(k1+3)
    if (i.eq.kv0) err(k1)=werr(2)
    err(k2)=werr(k2+3)
    if (i.eq.kd0) err(k2)=werr(3)
    k=k+3
  enddo
  return
  !
1002 format ('RMS of Residuals :  Base = ',1pg9.2,   &
    '  Line = ',1pg9.2)
end subroutine fitgauss
!
subroutine itegauss (ier)
  !---------------------------------------------------------------------
  ! LAS	Support routine for command
  !	ITERATE
  !	Case of gaussian profiles
  !---------------------------------------------------------------------
  integer :: ier                    !
  ! Global
  external :: mingauss
  include 'clic_gauss.inc'
  ! Local
  integer :: kt(5),kv(5),kd(5),i,j,i1
  real*4 :: zpar(15)
  equivalence (kt(1),kt1), (kv(1),kv1), (kd(1),kd1)
  !
  i1=nline
  if (nline.eq.-1) then
    nline = ngline
  endif
  nline=max(nline,1)
  j=1
  ! Save Last Parameters
  do i=1,15
    zpar(i)=spar(i)
  enddo
  !
  ! Retrieve Last Fit
  do i=1,nline
    if (par(j+2).ne.0.0) then
      spar(j) = par(j)/par(j+2)/1.064467
    else
      ier = -1
      call message(8,3,'ITERA','Bad input parameters')
      goto 99
    endif
    if (kt(i).eq.3) spar(j)=par(j)/par(3*kt0-2)
    j=j+1
    spar(j)=par(j)
    if (kv(i).eq.3) spar(j)=par(j)-par(3*kv0-1)
    j=j+1
    spar(j)=par(j)
    if (kd(i).eq.3) spar(j)=par(j)/par(3*kd0)
    j=j+1
  enddo
  call fitgauss (mingauss,.true.,ier)
  nline=i1
  !
  ! Restore Last Parameters
99 do i=1,15
    spar(i)=zpar(i)
  enddo
end subroutine itegauss
!
subroutine midgauss (ifatal,liter)
  !---------------------------------------------------------------------
  ! ANALYSE	Internal routine
  !	Start a gaussian fit by building the PAR array and internal
  !	variable used by Minuit
  ! Arguments
  !	IFATAL	I	Number of fatal errors		Output
  !	LITER	L	Iterate a fit			Input
  !---------------------------------------------------------------------
  integer :: ifatal                 !
  logical :: liter                  !
  ! Global
  integer :: lenc
  include 'clic_fit.inc'
  include 'clic_gauss.inc'
  include 'clic_gaussdata.inc'
  ! Local
  integer :: kt(5),kv(5),kd(5),i, ninte, k, j
  equivalence (kt(1),kt1), (kv(1),kv1), (kd(1),kd1)
  real*8 :: sav, clic_pintf, sav2, vplu, vminu, asign
  character(len=80) :: ch
  !
  isyswr=6
  do i= 1, 7
    isw(i) = 0
  enddo
  sigma = 0.d0
  npfix = 0
  ninte = 0
  nu = 0
  npar = 0
  ifatal = 0
  do i= 1, maxext
    u(i) = 0.0d0
    lcode(i) = 0
    lcorsp (i) = 0
  enddo
  isw(5) = 1
  !
  ! Starting values
  !
  if (nline.eq.0) then
    nu=3
  else
    !
    ! Take initial guesses in SPAR
    nu=3*nline
    j=1
    do i=1,nline
      !
      ! 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 (kt(i).eq.3) then
        par(j) = spar(j)
      elseif (kd(i).eq.3) then
        par(j) = spar(j)*spar(j+2)*1.064467    ! Area
        par(j) = par(j)*spar(3*kd0)    !
      else
        par(j) = spar(j)*spar(j+2)*1.064467    ! Area
      endif
      par(j+1) = spar(j+1)     ! Position
      par(j+2) = spar(j+2)     ! Width
      j=j+3
    enddo
  endif
  !
  ! Type initial guesses
  nu=nu+3
  write(ch,1001) 'Guesses: ',par(1),par(2),par(3)
  call message(2,1,'MIDGAUSS',ch(1:lenc(ch)))
  k = 4
  do i=2,max(nline,1)
    write (ch,1001) '         ',par(k),par(k+1),par(k+2)
    call message(2,1,'MIDGAUSS',ch(1:lenc(ch)))
    k=k+3
  enddo
  !
  ! Set up Parameters for Major Variables
  !
  ! Velocities
  if (kv0.eq.0) then
    u(2)=0.
    werr(2)=0.
  else
    u(2)=par(3*kv0-1)
    if (kv(kv0).eq.4) then
      werr(2)=0.
    else
      werr(2)=deltav
      if (liter.and.err(3*kv0-1).ne.0) werr(2)=err(3*kv0-1)
      alim(2)=u(2)-0.15*ndata*deltav
      blim(2)=u(2)+0.15*ndata*deltav
    endif
  endif
  !
  ! Line Widths
  if (kd0.eq.0) then
    u(3)=1./1.665109           ! 1 / (2*SQRT(LN(2)))
    werr(3)=0.
  else
    u(3)=abs(par(3*kd0))/1.665109
    if (kd(kd0).eq.4) then
      werr(3)=0.
    else
      werr(3)=deltav
      if (liter.and.err(3*kd0).ne.0) werr(3)=err(3*kd0)
      alim(3)=0.25*deltav
      blim(3)=0.75*ndata*deltav
    endif
  endif
  !
  ! Areas
  if (kt0.eq.0) then
    u(1)=0.564189584           ! 1 / SQRT(PI)
    werr(1)=0.
  else
    u(1)=par(3*kt0-2)
    if (kt(kt0).eq.4) then
      werr(1)=0.
    else
      werr(1)=sigbas*deltav
      if (liter.and.err(3*kt0-2).ne.0) werr(1)=err(3*kt0-2)
      if (u(1).ne.0.) then
        alim(1)=dmin1(0.d0,10*u(1))
        blim(1)=dmax1(0.d0,10*u(1))
      else
        lcode(1)=1
      endif
    endif
  endif
  !
  ! Set up parameters for Secondary Variables
  !
  k=4
  do i=1,max(nline,1)
    ! Area
    u(k)=par(k-3)
    if (kt(i).eq.0 .or. nline.eq.0) then
      werr(k)  =  max(sigbas,sigrai)*deltav
      if (liter.and.err(k-3).ne.0) werr(k)=err(k-3)
      if (u(k).ne.0.) then
        alim(k)=dmin1(0.d0,10*u(k))
        blim(k)=dmax1(0.d0,10*u(k))
      else
        lcode(k)=1             ! No Boundaries if U(k)=0.
      endif
    else
      werr(k)=0.
      if (i.eq.kt0) then
        u(k)=0.564189584
      else
        u(k)=u(k)*0.564189584
      endif
    endif
    k=k+1
    !
    ! Velocity
    u(k)=par(k-3)
    if (kv(i).eq.0 .or. nline.eq.0) then
      werr(k)=deltav
      if (liter.and.err(k-3).ne.0) werr(k)=err(k-3)
      alim(k)=u(k)-0.15*ndata*deltav
      blim(k)=u(k)+0.15*ndata*deltav
    else
      werr(k)=0.
      if (i.eq.kv0) u(k)=0.
    endif
    k=k+1
    !
    ! Line Width
    u(k)=abs(par(k-3))
    if (kd(i).eq.0 .or. nline.eq.0) then
      werr(k)=deltav
      if (liter.and.err(k-3).ne.0) werr(k)=err(k-3)
      !		ALIM(K)=DELTAV
      alim(k)=0.25*deltav
      blim(k)=0.75*ndata*deltav
    else
      werr(k)=0.
      if (i.eq.kd0) u(k)=1.
    endif
    k=k+1
  enddo
  !
  ! Various checks
  do 200 k= 1, nu
    if (k.gt.maxext) then
      ifatal = ifatal+1
      goto 200
    endif
    if (werr(k).le.0.0d0) then
      lcode(k) = 0
      if (k.gt.3) then
        write(ch,1010)  k-3,' is fixed'
        call message(4,2,'MIDGAUSS',ch(1:lenc(ch)))
      endif
      goto 200
    endif
    ninte = ninte+1
    if (lcode(k).ne.1) then
      lcode(k) = 4
      asign = (blim(k)-u(k))*(u(k)-alim(k))
      if (asign.lt.0) then
        ifatal = ifatal+1
        write(ch,1011)  k-3,alim(k),u(k),blim(k)
        call message(4,2,'MIDGAUSS',ch(1:lenc(ch)))
      elseif (asign.eq.0) then
        if (k.gt.3) then
          write(ch,1010) k-3,' is at limit'
          call message(4,2,'MIDGAUSS',ch(1:lenc(ch)))
        endif
      endif
    endif
200 continue
  !
  ! End parameter cards
  ! Stop if fatal error
  if (ninte .gt. maxint)  then
    write (ch,1008)  ninte,maxint
    call message(6,4,'MIDGAUSS',ch(1:lenc(ch)))
    ifatal = ifatal + 1
  endif
  if (ninte .eq. 0) then
    call message(6,4,'MIDGAUSS','All input parameters are fixed')
    ifatal = ifatal + 1
  endif
  if (ifatal .gt. 0)  then
    ifatal = -ifatal
    return
  endif
  !
  ! O.K. Start
  ! Calculate step sizes DIRIN
  npar = 0
  do k= 1, nu
    if (lcode(k) .gt. 0)  then
      npar = npar + 1
      lcorsp(k) = npar
      sav = u(k)
      x(npar) = clic_pintf(sav,k)
      xt(npar) = x(npar)
      sav2 = sav + werr(k)
      vplu = clic_pintf(sav2,k) - x(npar)
      sav2 = sav - werr(k)
      vminu = clic_pintf(sav2,k) - x(npar)
      dirin(npar) = 0.5d0 * (dabs(vplu) +dabs(vminu))
    endif
  enddo
  return
  !
1001 format(a,1pg10.3,'    ',1pg10.3,'    ',1pg10.3)
1008 format ('Too many variable parameters.  You request ',i5/,   &
    ' This version of MINUIT is only dimensioned for ',i4)
1010 format ('Parameter ',i2,' ',a)
1011 format ('Parameter ',i2,' outside limits ', 3(1pg11.3))
end subroutine midgauss
!
subroutine mingauss (npar,g,f,x,iflag)
  !---------------------------------------------------------------------
  ! LAS	Internal routine
  !	Function to be minimized in the gaussian fit.
  !	By using 3 hidden parameters, the method allows dependent
  !	and independent gaussians to be fitted. The computation is
  !	highly optimised, but take care of R*4 and R*8 values !...
  !	Basic parameters are Area, Position and Width.
  ! Arguments :
  !	NPAR	I	Number of parameters		Input
  !	G	R*8(1)	Array of derivatives		Output
  !	F	R*8	Function value			Output
  !	X	R*8(1)	Parameter values		Input
  !	IFLAG	I	Code operation			Input
  ! (5-mar-1985)
  !---------------------------------------------------------------------
  integer :: npar                   !
  real*8 :: g(*)                    !
  real*8 :: f                       !
  real*8 :: x(*)                    !
  integer :: iflag                  !
  ! Global
  real :: progauss
  include 'clic_gauss.inc'
  include 'clic_gaussdata.inc'
  ! Local
  logical :: dograd
  real :: tt,vv,dd,gt,gv,gd,ff
  real :: t1,v1,d1,t2,v2,d2,t3,v3,d3,t4,v4,d4,t5,v5,d5
  real :: g1,g2,g3,g4,g5,g6,g7,g8,g9,g10,g11,g12,g13,g14,g15
  real :: xvel,arg1,arg2,arg3,arg4,arg5,f1,f2,f3,f4,f5,arg
  real :: seuil,ta,ybas,yrai,kbas,krai
  integer :: i
  !
  ! Final computations
  if (iflag.eq.3) goto 20
  dograd = iflag.eq.2
  !
  f=0.
  tt=x(1)
  vv=x(2)
  dd=x(3)
  gt=0.
  gv=0.
  gd=0.
  t1=x(4)*tt
  v1=x(5)+vv
  d1=x(6)*dd
  goto (1,2,3,4,5) nline
  goto 1
5 t5=x(16)*tt
  v5=x(17)+vv
  d5=x(18)*dd
  g13=0.
  g14=0.
  g15=0.
  !
4 t4=x(13)*tt
  v4=x(14)+vv
  d4=x(15)*dd
  g10=0.
  g11=0.
  g12=0.
  !
3 t3=x(10)*tt
  v3=x(11)+vv
  d3=x(12)*dd
  g7=0.
  g8=0.
  g9=0.
  !
2 t2=x(7)*tt
  v2=x(8)+vv
  d2=x(9)*dd
  g4=0.
  g5=0.
  g6=0.
  !
1 g1=0.
  g2=0.
  g3=0.
  !
  !	g1 derivee / aire
  !	g2 derivee / vlsr
  !	g3 derivee / delt
  !
  ! Compute gaussians
  do 600 i=1,ndata
    if (wfit(i).eq.0.0) goto 600
    xvel = rdatax(i)
    ! First
    arg1 = (xvel - v1) / d1
    if (abs(arg1).gt.4.) then
      f1 = 0.
      ff = 0.
    else
      f1 = exp(-arg1**2)
      ff = f1 * t1 / d1
    endif
    if (nline.le.1) goto 610
    ! Second
    arg2 = (xvel - v2) / d2
    if (abs(arg2).gt.4.) then
      f2=0.
    else
      f2 = exp(-arg2**2)
      ff = ff + f2 * t2 / d2
    endif
    if (nline.le.2) goto 610
    ! Third
    arg3 = (xvel - v3) / d3
    if (abs(arg3).gt.4.) then
      f3=0.
    else
      f3 = exp(-arg3**2)
      ff = ff + f3 * t3 / d3
    endif
    if (nline.le.3) goto 610
    ! Fourth
    arg4 = (xvel - v4) / d4
    if (abs(arg4).gt.4.) then
      f4=0.
    else
      f4 = exp(-arg4**2)
      ff = ff + f4 * t4 / d4
    endif
    if (nline.le.4) goto 610
    ! Fifth
    arg5 = (xvel - v5) / d5
    if (abs(arg5).gt.4.) then
      f5=0.
    else
      f5 = exp(-arg5**2)
      ff = ff + f5 * t5 / d5
    endif
    !
610 continue
    !
    ! Compute Chi-2 with ponderation
    ff =  wfit(i) * (ff - rdatay(i))
    f = f + ff**2
    !
    ! Compute Gradients
    if (.not.dograd) goto 620
    ff = 2.*ff
    ! First
    if (f1.ne.0.) then
      arg = f1*ff/d1
      g1  = g1 + arg
      gt  = gt + arg*t1
      arg = t1/d1*arg
      g3  = g3 - arg
      gd  = gd - arg*d1
      arg = arg*arg1*2.
      g2  = g2 + arg
      gv  = gv + arg
      g3  = g3 + arg*arg1
      gd  = gd + arg*arg1*d1
    endif
    if (nline.le.1) goto 620
    ! Second
    if (f2.ne.0.) then
      arg = f2*ff/d2
      g4  = g4 + arg
      gt  = gt + arg*t2
      arg = arg*t2/d2
      g6  = g6 - arg
      gd  = gd - arg*d2
      arg = arg*arg2*2.
      g5  = g5 + arg
      gv  = gv + arg
      g6  = g6 + arg*arg2
      gd  = gd + arg*arg2*d2
    endif
    if (nline.le.2) goto 620
    ! Third
    if (f3.ne.0.) then
      arg = f3*ff/d3
      g7  = g7 + arg
      gt  = gt + arg*t3
      arg = arg*t3/d3
      g9  = g9 - arg
      gd  = gd - arg*d3
      arg = arg*arg3*2.
      g8  = g8 + arg
      gv  = gv + arg
      g9  = g9 + arg*arg3
      gd  = gd + arg*arg3*d3
    endif
    if (nline.le.3) goto 620
    ! Fourth
    if (f4.ne.0.) then
      arg = f4*ff/d4
      g10 = g10 + arg
      gt  = gt + arg*t4
      arg = arg*t4/d4
      g12 = g12 - arg
      gd  = gd - arg*d4
      arg = arg*arg4*2.
      g11 = g11 + arg
      gv  = gv + arg
      g12 = g12 + arg*arg4
      gd  = gd + arg*arg4*d4
    endif
    if (nline.le.4) goto 620
    ! Fifth
    if (f5.ne.0.) then
      arg = f5*ff/d5
      g13 = g13 + arg
      gt  = gt  + arg*t5
      arg = arg*t5/d5
      g15 = g15 - arg
      gd  = gd - arg*d5
      arg = arg*arg5*2.
      g14 = g14 + arg
      gv  = gv  + arg
      g15 = g15 + arg*arg5
      gd  = gd  + arg*arg5*d5
    endif
620 continue
  !
600 continue
  !
  ! Setup values and return
  f = f
  g(1)=gt/tt
  g(2)=gv
  g(3)=gd/dd
  !
  g(4)=g1*tt
  g(5)=g2
  g(6)=g3*dd
  goto (701,702,703,704,705) nline
701 return
705 g(16)=g13*tt
  g(17)=g14
  g(18)=g15*dd
704 g(13)=g10*tt
  g(14)=g11
  g(15)=g12*dd
703 g(10)=g7*tt
  g(11)=g8
  g(12)=g9*dd
702 g(7)=g4*tt
  g(8)=g5
  g(9)=g6*dd
  return
  !
  ! Compute Sigma after Minimisation
20 kbas=0.
  ybas=0.
  krai=0.
  yrai=0.
  seuil= sigbas/3.
  !
  do i=1,ndata
    if (wfit(i).ne.0.0) then
      ta = progauss (rdatax(i),0)
      if (abs(ta).lt.seuil) then
        kbas=kbas+wfit(i)
        ybas=ybas+wfit(i)*rdatay(i)**2
      else
        krai=krai+wfit(i)
        yrai=yrai+wfit(i)*(ta-rdatay(i))**2
      endif
    endif
  enddo
  if (kbas.gt.2.0) then
    sigbas = sqrt(ybas/kbas)
  else
    sigbas=0.d0
  endif
  if (krai.ne.0.0) then
    sigrai=sqrt(yrai/krai)
  else
    sigrai=sigbas
  endif
  if (sigbas.eq.0.0) sigbas = sigrai
  return
end subroutine mingauss
!
function progauss (a,m)
  !---------------------------------------------------------------------
  ! ANALYSE	(Internal routine)
  !	M = 0
  ! 	Computes the composite profile from sum of all gaussians.
  !	M # 0
  !	Computes the profile from gaussian number M
  !
  ! S. Guilloteau 19-Dec-1984
  !---------------------------------------------------------------------
  real*4 :: progauss                !
  real*4 :: a                       !
  integer :: m                      !
  ! Global
  include 'clic_gauss.inc'
  ! Local
  real*4 :: arg
  !
  progauss=0.
  arg=0.
  goto (1,2,3,4,5) m
  !
1 if (par(1).ne.0 .and. par(3).ne.0.) then
    arg = abs((a - par(2)) / par(3)*1.665109)
    if (arg.lt.4.) then
      progauss = exp(-arg**2)*par(1)/par(3)/1.064467
    endif
  endif
  if (ngline.le.1 .or. m.eq.1) return
  !
2 if (par(4).ne.0 .and. par(6).ne.0.) then
    arg = abs((a - par(5)) / par(6)*1.665109)
    if (arg.lt.4.) then
      progauss = progauss + exp(-arg**2)*par(4)/par(6)/1.064467
    endif
  endif
  if (ngline.le.2 .or. m.eq.2) return
  !
3 if (par(7).ne.0 .and. par(9).ne.0.) then
    arg = abs((a - par(8)) / par(9)*1.665109)
    if (arg.lt.4.) then
      progauss = progauss + exp(-arg**2)*par(7)/par(9)/1.064467
    endif
  endif
  if (ngline.le.3 .or. m.eq.3) return
  !
4 if (par(10).ne.0. .and. par(12).ne.0.) then
    arg = abs((a - par(11)) / par(12)*1.665109)
    if (arg.lt.4.) then
      progauss = progauss + exp(-arg**2)*par(10)/par(12)/1.064467
    endif
  endif
  if (ngline.le.4 .or. m.eq.4) return
  !
5 if (par(13).ne.0. .and. par(15).ne.0.) then
    arg = abs((a - par(14)) / par(15)*1.665109)
    if (arg.lt.4.) then
      progauss = progauss + exp(-arg**2)*par(13)/par(15)/1.064467
    endif
  endif
end function progauss
!
subroutine inigauss
  !---------------------------------------------------------------------
  ! CLIC 	Internal routine
  !	Start a gaussian fit by building the PAR array
  !---------------------------------------------------------------------
  ! Global
  external :: progauss
  real :: progauss
  include 'clic_gauss.inc'
  include 'clic_gaussdata.inc'
  ! Local
  real :: ybas
  real :: sym, ym, swy, swxy, swx2y
  integer :: i, kbas
  !
  ! Starting values : Automatic guess
  ! works also if several points coincide in x (focus scans).
  sym = 0
  ym = 0
  swxy = 0
  swx2y = 0
  swy = 0
  do i=1, ndata
    swy = swy + wfit(i)*rdatay(i)
    swxy = swxy + wfit(i)*rdatax(i)*rdatay(i)
    swx2y = swx2y + wfit(i)*rdatax(i)**2*rdatay(i)
  enddo
  if (swy.ne.0) then
    swxy = swxy / swy
    swx2y = sqrt(8*log(2.) * abs(swx2y / swy - swxy**2))
  endif
  do i=1, ndata
    if (abs(rdatax(i)-swxy).le.swx2y) then
      ym = ym+rdatay(i)*wfit(i)
      sym = sym+wfit(i)
    endif
  enddo
  if (sym.ne.0) then
    ym = ym/sym
  endif
  swy = 2 * ym * swx2y
  par(1) = swy
  par(2) = swxy
  par(3) = swx2y
  !
  ! Compute sigmas
  kbas=0
  ybas=0.
  do i=1,ndata
    if (wfit(i).ne.0.0) then
      ybas = ybas + (rdatay(i)-progauss(rdatax(i),0))**2
      kbas = kbas+1
    endif
  enddo
  if (kbas.gt.0) then
    sigbas=sqrt(ybas/kbas)
  else
    sigbas = 0
  endif
  sigrai=sigbas
end subroutine inigauss
