'*****************************************************
'*    Program to demonstrate the modified false      *
'*               position subroutine                 *
'* ------------------------------------------------- *
'* Reference: BASIC Scientific Subroutines, Vol. II  *
'* By F.R. Ruckdeschel, BYTE/McGRAWW-HILL, 1981 [1]. *
'*                                                   *
'*****************************************************
defint i-n
defdbl a-h,o-z
cls
print
print " Input the initial guesses (root must be between x0, x1):"
print
input "    X0 = ",x0
input "    X1 = ",x1
print
input " Convergence factor : ",e
print
input " Maximum number of iterations: ",m

gosub 2000  'Call false position routine

print
print
print " The calculated zero is X = "; x
print
print " The associated Y value is Y = "; y
print
print " The number of steps was: "; n
print
end
'*************************************
1000 ' Function subroutine
  y = 1+5*x+10*x*x+10*x^3+5*x^4+x^5
  return
'*************************************

'***********************************************
'*     Modified false position subroutine      *
'* ------------------------------------------- *
'* This subroutine calculates the zeroes of a  *
'* function Y(x) uses Hamming's modification   *
'* to speed convergence.                       *
'* Two initial guess are required, x0 and x1,  *
'* bracketting the root, and a convergence     *
'* criterion, e. Also required is the maximum  *
'* number of iterations, m. The root is retur- *
'* ned in x, the actual number of iterations   *
'* used in n.                                  *
'***********************************************
2000 n=0
  'Make x0<x1
  if x0<x1 then goto 2100
  x=x0 : x1=x
  'Get y0 and y1
2100 x=x0 : gosub 1000 : y0=y
  x=x1 : gosub 1000 : y1=y
  'Calculate a new estimate, x
2200 x=(x0*y1-x1*y0)/(y1-y0)
  'Test for convergence
  n=n+1
  if n>=m then return
  if ABS(x1-x)<e then return
  'Get anew Y(x) value
  gosub 1000
  'Apply Hamming's modification
  if y1*y=0 then return
  if y0*y>0 then goto 2300
  x1=x : y1=y : y0=y0/2#
2300 x0=x
  x0=x : y0=y : y1=y1/2#
  goto 2200
return

'End of file regula.bas