Initial commit

gen/fit_subtract.f

@@ -0,0 +1,76 @@
+	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