Initial commit
This commit is contained in:
133
gen/fit_peak.f
Normal file
133
gen/fit_peak.f
Normal file
@ -0,0 +1,133 @@
|
||||
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
|
Reference in New Issue
Block a user