code 34150; boolean procedure ZEROIN(X, Y, FX, TOLX); real X, Y, FX, TOLX; begin integer EXT; real C, FC, B, FB, A, FA, D, FD, FDB, FDA, W, MB, TOL, M, P, Q, DW; DW:= DWARF; B:= X; FB:= FX; A:= X:= Y; FA:= FX; INTERPOLATE: C:= A; FC:= FA; EXT:= 0; EXTRAPOLATE: if ABS(FC) < ABS(FB) then begin if C ^= A then begin D:= A; FD:= FA end; A:= B; FA:= FB; B:= X:= C; FB:= FC; C:= A; FC:= FA end INTERCHANGE; TOL:= TOLX; M:= (C + B) * 0.5; MB:= M - B; if ABS(MB) > TOL then begin if EXT > 2 then W:= MB else begin TOL:= TOL * SIGN(MB); P:= (B - A) * FB; if EXT <= 1 then Q:= FA - FB else begin FDB:= (FD - FB) / (D - B); FDA:= (FD - FA) / (D - A); P:= FDA * P; Q:= FDB * FA - FDA * FB end; if P < 0 then begin P:= -P; Q:= -Q end; W:= if P < DW or P <= Q * TOL then TOL else if P < MB * Q then P / Q else MB end; D:= A; FD:= FA; A:= B; FA:= FB; X:= B:= B + W; FB:= FX; if (if FC >= 0 then FB >= 0 else FB <= 0) then goto INTERPOLATE else begin EXT:= if W = MB then 0 else EXT + 1; goto EXTRAPOLATE end end; Y:= C; ZEROIN:= if FC >= 0 then FB <= 0 else FB >= 0 end ZEROIN eop