	subroutine fit_newpeak
!	----------------------

	include 'fit.inc'

	if (ififu .ne. 1) then
	  write(isyswr,*) 'Command NEWPEAK works for peak functions only'
	  return
	endif

	if (nu .lt. 7) then
	  call fit_fun(0, 0, 0.0,0.0)
	  return
	endif

	if (nu .gt. maxext-5) then
	  write(isyswr, *) 'Max.', maxpeak,' peaks allowed'
	  return
	endif

	call fit_create_peak

	call fit_cop_par(nu-9, nu-4, 5)
	u(nu-4)=u(nu-9)+(u(nu-6)+u(nu-5))*2
	if (lcode(nu-4) .eq. 0) call fit_rel(nu-4)

90	call fit_set(0,0.0,0.0,0.0,0.0)
	call fit_print(1)
	  
99	return

	end



	subroutine fit_create_peak

	include 'fit.inc'

	integer k,i

	nu=nu+5
	k=nu/5
	write(pnam(nu-4), '(a6,i2)') 'Posi. ',k
	write(pnam(nu-3), '(a6,i2)') 'MaxInt',k
	write(pnam(nu-2), '(a6,i2)') 'IntInt',k
	write(pnam(nu-1), '(a6,i2)') 'Fwhm G',k
	write(pnam(nu  ), '(a6,i2)') 'Fwhm L',k

	write(psho(nu-4), '(a1,i2)') 'P',k
	write(psho(nu-3), '(a1,i2)') 'M',k
	write(psho(nu-2), '(a1,i2)') 'I',k
	write(psho(nu-1), '(a1,i2)') 'G',k
	write(psho(nu  ), '(a1,i2)') 'L',k

	do i=nu-4,nu
	  if (k .le. 9) psho(i)(2:3)=psho(i)(3:3)
	  lcode(i)=1
	  icsw(i)=0
	  u(i)=0
	  werr(i)=0
	enddo
	lcode(nu-3)=0
	icsw(nu-3)=-1
	icto(nu-3)=nu-2
	lcode(nu)=0
	end



	subroutine fit_mov_par(from, to, size)

	include 'fit.inc'

	integer from, to, size

	integer n1,n2,i,j

	n1=1
	n2=nu
	goto 10


	entry fit_cop_par(from, to, size)

	n1=to
	n2=to+size-1

10	do j=1,nu
	  if (icto(j) .ge. to .and. icto(j) .lt. to+size .and.
	1     icsw(j) .gt. 0) then
	    icsw(j)=0
	  endif
	enddo

	i=to
	do j=from,from+size-1
	  u(i)=u(j)
	  werr(i)=werr(j)
	  lcode(i)=lcode(j)
	  icsw(i)=icsw(j)
	  icto(i)=icto(j)
	  cfac(i)=cfac(j)
	  coff(i)=coff(j)
	  werrs(i)=werrs(j)
	  alim(i)=alim(j)
	  blim(i)=blim(j)
	  i=i+1
	enddo

	do j=n1,n2
	  if (icto(j) .ge. from .and. icto(j) .lt. from+size) then
	    icto(j)=icto(j)+to-from
	  endif
	enddo
	return



	entry fit_del_par(from, size)

	do j=1,nu
	  if (icto(j) .ge. from .and. icto(j) .lt. from+size .and.
	1     icsw(j) .gt. 0) then
	    icsw(j)=0
	  endif
	enddo
	do i=from,from+size-1
	  u(i)=0
	  lcode(i)=0
	  icsw(i)=0
	enddo
	end
