134 lines
2.1 KiB
Fortran
134 lines
2.1 KiB
Fortran
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
|