Tema23 - 23.10 Option Explicit Sub RhombTest() Dim maxit As...

Info iconThis preview shows pages 1–8. Sign up to view the full content.

View Full Document Right Arrow Icon
Background image of page 1

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
Background image of page 2
Background image of page 3

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
Background image of page 4
Background image of page 5

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
23.10 Option Explicit Sub RhombTest() Dim maxit As Integer Dim a As Single, b As Single, es As Single Dim x As Single x = 0.5 maxit = 3 es = 0.001 MsgBox RhomDiff(x, maxit, es) End Sub Function RhomDiff(x, maxit, es) Dim n As Integer, j As Integer, k As Integer, iter As Integer Dim i(10, 10) As Single, ea As Single, del As Single, a As Single, b As Single n = 1 i(1, 1) = DyDx(x, n) iter = 0 Do iter = iter + 1 n = 2 ^ iter i(iter + 1, 1) = DyDx(x, n) For k = 2 To iter + 1 j = 2 + iter - k i(j, k) = (4 ^ (k - 1) * i(j + 1, k - 1) - i(j, k - 1)) / (4 ^ (k - 1) - 1) Next k ea = Abs((i(1, iter + 1) - i(1, iter)) / i(1, iter + 1)) * 100 If (iter >= maxit Or ea <= es) Then Exit Do Loop RhomDiff = i(1, iter + 1) End Function Function DyDx(x, n) Dim a As Single, b As Single a = x - x / n b = x + x / n DyDx = (f(b) - f(a)) / (b - a) End Function Function f(x) f = -0.1 * x ^ 4 - 0.15 * x ^ 3 - 0.5 * x ^ 2 - 0.25 * x + 1.2 End Function 23.11 The following program implements Eq. 23.9. Option Explicit Sub TestDerivUnequal() Dim n As Integer, i As Integer Dim x(100) As Single, y(100) As Single, dy(100) As Single Range("a5").Select n = ActiveCell.Row Selection.End(xlDown).Select n = ActiveCell.Row - n Range("a5").Select For i = 0 To n x(i) = ActiveCell.Value ActiveCell.Offset(0, 1).Select y(i) = ActiveCell.Value
Background image of page 6
ActiveCell.Offset(1, -1).Select Next i For i = 0 To n dy(i) = DerivUnequal(x(), y(), n, x(i)) Next i Range("c5").Select For i = 0 To n ActiveCell.Value = dy(i) ActiveCell.Offset(1, 0).Select Next i End Sub Function DerivUnequal(x, y, n, xx) Dim ii As Integer If xx < x(0) Or xx > x(n) Then DerivUnequal = "out of range" Else If xx < x(1) Then DerivUnequal = DyDx(xx, x(0), x(1), x(2), y(0), y(1), y(2)) ElseIf xx > x(n - 1) Then DerivUnequal = DyDx(xx, x(n - 2), x(n - 1), x(n), y(n - 2), y(n - 1), y(n)) Else For ii = 1 To n - 2 If xx >= x(ii) And xx <= x(ii + 1) Then If xx - x(ii - 1) < x(ii) - xx Then 'If the unknown is closer to the lower end of the range, 'x(ii) will be chosen as the middle point DerivUnequal = DyDx(xx, x(ii - 1), x(ii), x(ii + 1), y(ii - 1),
Background image of page 7

Info iconThis preview has intentionally blurred sections. Sign up to view the full version.

View Full DocumentRight Arrow Icon
Image of page 8
This is the end of the preview. Sign up to access the rest of the document.

Page1 / 18

Tema23 - 23.10 Option Explicit Sub RhombTest() Dim maxit As...

This preview shows document pages 1 - 8. Sign up to view the full document.

View Full Document Right Arrow Icon
Ask a homework question - tutors are online