Chapter 5 VBA Program to Implement the Bisection Function

5.13 (a) n= log(35 / .05) = 9.45 or 10 iterations log(2) (b) iteration 1 2 3 4 5 6 7 8 9 10 xr 17.5 26.25 30.625 28.4375 27.34375 26.79688 26.52344 26.66016 26.72852 26.76270 for os = 8 mg/L, T = 26.7627 oC for os = 10 mg/L, T = 15.41504 oC for os = 14mg/L, T = 1.538086 oC 5.14 Here is a VBA program to implement the Bisection function (Fig. 5.10) in a user-friendly program: Option Explicit Sub Dim Dim Dim Dim TestBisect() imax As Integer, iter As Integer x As Single, xl As Single, xu As Single es As Single, ea As Single, xr As Single root As Single Sheets("Sheet1").Select Range("b4").Select xl = ActiveCell.Value ActiveCell.Offset(1, 0).Select xu = ActiveCell.Value ActiveCell.Offset(1, 0).Select es = ActiveCell.Value ActiveCell.Offset(1, 0).Select imax = ActiveCell.Value Range("b4").Select If f(xl) root = MsgBox MsgBox MsgBox MsgBox Else MsgBox End If End Sub * f(xu) < 0 Then Bisect(xl, xu, es, imax, xr, iter, ea) "The root is: " & root "Iterations:" & iter "Estimated error: " & ea "f(xr) = " & f(xr) "No sign change between initial guesses" Function Bisect(xl, xu, es, imax, xr, iter, ea) Dim xrold As Single, test As Single iter = 0 Do xrold = xr xr = (xl + xu) / 2 iter = iter + 1 If xr < > 0 Then ea = Abs((xr - xrold) / xr) * 100 End If test = f(xl) * f(xr) If test < 0 Then xu = xr ElseIf test > 0 Then xl = xr Else ea = 0 End If If ea < es Or iter >= imax Then Exit Do Loop Bisect = xr End Function Function f(c) f = 9.8 * 68.1 / c * (1 - Exp(-(c / 68.1) * 10)) - 40 End Function For Example 5.3, the Excel worksheet used for input looks like: The program yields a root of 14.78027 after 12 iterations. The approximate error at this point is 6.63×10−3 %. These results are all displayed as message boxes. For example, the solution check is displayed as 5.15 See solutions to Probs. 5.1 through 5.6 for results. 5.16 Errata in Problem statement: Test the program by duplicating Example 5.5. Here is a VBA Sub procedure to implement the modified false position method. It is set up to evaluate Example 5.5. Option Explicit Sub Dim Dim Dim TestFP() imax As Integer, iter As Integer f As Single, FalseP As Single, x As Single, xl As Single xu As Single, es As Single, ea As Single, xr As Single xl = 0 xu = 1.3 es = 0.01 imax = 20 MsgBox "The root is: " & FalsePos(xl, xu, es, imax, xr, iter, ea) MsgBox "Iterations: " & iter MsgBox "Estimated error: " & ea End Sub Function FalsePos(xl, xu, es, imax, xr, iter, ea) Dim il As Integer, iu As Integer Dim xrold As Single, fl As Single, fu As Single, fr As Single iter = 0 fl = f(xl) fu = f(xu) Do xrold = xr xr = xu - fu * (xl - xu) / (fl - fu) fr = f(xr) iter = iter + 1 If xr < > 0 Then ea = Abs((xr - xrold) / xr) * 100 End If If fl * fr < 0 Then xu = xr fu = f(xu) iu = 0 il = il + 1 If il >= 2 Then fl = fl / 2 ElseIf fl * fr > 0 Then xl = xr fl = f(xl) il = 0 iu = iu + 1 If iu >= 2 Then fu = fu / 2 Else ea = 0# End If If ea < es Or iter >= imax Then Exit Do Loop FalsePos = xr End Function Function f(x) f = x ^ 10 - 1 End Function When the program is run for Example 5.5, it yields: root = 14.7802 iterations = 5 error = 3.9×10−5 % 5.17 Errata in Problem statement: Use the subprogram you developed in Prob. 5.16 to duplicate the computation from Example 5.6. The results are plotted as ea% et,% es,% 1000 100 10 1 0.1 0.01 0.001 0 4 8 12 Interpretation: At first, the method manifests slow convergence. However, as it approaches the root, it approaches quadratic convergence. Note also that after the first few iterations, the approximate error estimate has the nice property that εa > εt. 5.18 Here is a VBA Sub procedure to implement the false position method with minimal function evaluations set up to evaluate Example 5.6. Option Explicit Sub TestFP() Dim imax As Integer, iter As Integer, i As Integer Dim xl As Single, xu As Single, es As Single, ea As Single, xr As Single, fct As Single MsgBox "The root is: " & FPMinFctEval(xl, xu, es, imax, xr, iter, ea) MsgBox "Iterations: " & iter MsgBox "Estimated error: " & ea End Sub Function FPMinFctEval(xl, xu, es, imax, xr, iter, ea) Dim xrold, test, fl, fu, fr iter = 0 xl = 0# xu = 1.3 es = 0.01 imax = 50 fl = f(xl) fu = f(xu) xr = (xl + xu) / 2 Do xrold = xr xr = xu - fu * (xl - xu) / (fl - fu) fr = f(xr) iter = iter + 1 If (xr < > 0) Then ea = Abs((xr - xrold) / xr) * 100# End If test = fl * fr If (test < 0) Then xu = xr fu = fr ElseIf (test > 0) Then xl = xr fl = fr Else ea = 0# End If If ea < es Or iter >= imax Then Exit Do Loop FPMinFctEval = xr End Function Function f(x) f = x ^ 10 - 1 End Function The program yields a root of 0.9996887 after 39 iterations. The approximate error at this point is 9.5×10−3 %. These results are all displayed as message boxes. For example, the solution check is displayed as The number of function evaluations for this version is 2n+2. This is much smaller than the number of function evaluations in the standard false position method (5n). 5.19 Solve for the reactions: R1=265 lbs. R2= 285 lbs. Write beam equations: 0< x< 3 (1) 3< x< 6 6< x< 10 10< x< 12 Combining Equations: x − 265 x = 0 3 M = 265 − 5.55 x 3 M + (16.667 x 2 ) x −3 2 ) + 150( x − (3)) − 265 x = 0 2 3 2 (2) M = −50 x + 415 x − 150 M + 100( x − 3)( 2 M = 150( x − (3)) + 300( x − 4.5) − 265x 3 (3) M = −185x + 1650 M + 100(12 − x) = 0 ( 4) M = 100 x − 1200 Because the curve crosses the axis between 6 and 10, use (3). (3) M = −185 x + 1650 Set x L = 6; xU = 10 M ( x L ) = 540 x + xU xr = L =8 M ( xU ) = −200 2 M ( x R ) = 170 → replaces x L M ( x L ) = 170 8 + 10 xr = =9 M ( xU ) = −200 2 M ( x R ) = −15 → replaces xU M ( x L ) = 170 8+ 9 xr = = 8 .5 M ( xU ) = −15 2 M ( x R ) = 77.5 → replaces x L M ( x L ) = 77.5 8.5 + 9 xr = = 8.75 M ( xU ) = −15 2 M ( x R ) = 31.25 → replaces x L M ( x L ) = 31.25 8.75 + 9 xr = = 8.875 M ( xU ) = −15 2 M ( x R ) = 8.125 → replaces x L M ( x L ) = 8.125 8.875 + 9 xr = = 8.9375 M ( xU ) = −15 2 M ( x R ) = −3.4375 → replaces xU M ( x L ) = 8.125 8.875 + 8.9375 xr = = 8.90625 M ( xU ) = −3.4375 2 M ( x R ) = 2.34375 → replaces x L M ( x L ) = 2.34375 8.90625 + 8.9375 xr = = 8.921875 M ( xU ) = −3.4375 2 M ( x R ) = −0.546875 → replaces xU M ( x L ) = 2.34375 8.90625 + 8.921875 xr = = 8.9140625 M ( xU ) = −0.546875 2 M ( x R ) = 0.8984 Therefore, x = 8.91 feet 5.20 M = −185 x + 1650 Set x L = 6; xU = 10 M ( x L ) = 540 M ( xU ) = −200 xR = xo − M ( xU )( x L − xU ) M ( xL ) − M ( xU ) x R = 10 − − 200(6 − 10) = 8.9189 540 − (−200) M ( x R ) = −2 × 10 −7 ≅ 0 Only one iteration was necessary. Therefore, x = 8.9189 feet.