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
  !
1000 format ('  ',i1,2x,1pg10.3,' (',0pf7.2,') ',   &
    2(1x,0pf8.3,' (',0pf7.2,') '),2x,1pg10.3)
1001 format (/,'		FIT Results   ',//,   &
    ' Line      Area               Position   WIDTH           INTENSITY')
1002 format ('RMS of Residuals :  Base = ',1pg9.2,   &
    '  Line = ',1pg9.2)
1003 format (/,'         Bad or Doubtful FIT',//,   &
    ' Line      Area               Position   WIDTH           INTENSITY')
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)
1009 format ('All input parameters are fixed')
1010 format ('Parameter ',i2,' ',a)
1011 format ('Parameter ',i2,' outside limits ', 3(1pg11.3))
1013 format (i3,' errors on input parameters. ABORT.')
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
