77 lines
1.3 KiB
Forth
77 lines
1.3 KiB
Forth
subroutine fit_subtract(file)
|
|
|
|
implicit none
|
|
|
|
include 'fit.inc'
|
|
|
|
character file*(*)
|
|
|
|
real x0,q0,q1,y0
|
|
integer i,j,n1,n2,n3
|
|
|
|
if (nxmin .ge. nxmax) return
|
|
n1=nxmin
|
|
n2=nxmax
|
|
npkt=npkt+1
|
|
sig(npkt)=1
|
|
n3=npkt
|
|
keepregion=.false.
|
|
call fit_link(file)
|
|
if (n3 .eq. npkt) then
|
|
npkt=n3-1
|
|
return
|
|
endif
|
|
nxmin=n1
|
|
nxmax=n2
|
|
|
|
call fit_sort(n3+1, npkt)
|
|
|
|
if (npkt+1 .eq. maxdat) npkt=npkt-1
|
|
|
|
j=n3+1
|
|
y0=1
|
|
do i=nxmin,nxmax
|
|
x0=xval(i)
|
|
if (xval(j) .lt. x0) then
|
|
xval(npkt+1)=x0
|
|
j=j+1
|
|
do while (xval(j) .lt. x0)
|
|
j=j+1
|
|
enddo
|
|
if (j .gt. npkt) then
|
|
j=npkt
|
|
x0=xval(j)
|
|
goto 20
|
|
endif
|
|
if (xval(j) .eq. x0) goto 20
|
|
j=j-1
|
|
else
|
|
xval(n3)=x0
|
|
j=j-1
|
|
do while (xval(j) .gt. x0)
|
|
j=j-1
|
|
enddo
|
|
if (j .le. n3) then
|
|
j=n3+1
|
|
x0=xval(j)
|
|
goto 20
|
|
endif
|
|
endif
|
|
20 if (xval(j) .eq. x0) then
|
|
YVAL(i)=YVAL(i)-YVAL(j)
|
|
sig(i)=sqrt(sig(i)**2+sig(j)**2)
|
|
else
|
|
q0=(x0-xval(j))/(xval(j+1)-xval(j))
|
|
q1=1-q0
|
|
YVAL(i)=YVAL(i)-YVAL(j)*q1-YVAL(j+1)*q0
|
|
sig(i)=sqrt(sig(i)**2+q1*sig(j)**2+q0*sig(j+1)**2)
|
|
endif
|
|
if (YVAL(i) .lt. y0) y0=YVAL(i)
|
|
enddo
|
|
npkt=n3-1
|
|
if (y0 .le. 0) then
|
|
print *,'The minimal y-value is ',y0
|
|
print *
|
|
endif
|
|
end
|