龙贝格求积算法
Function romberg(a As Double, b As Double, epsilon As Double) As Double
Dim n As Integer
Dim k As Integer
n = 1
Dim h As Double
Dim x As Double
Dim temp As Double
h = b - a
Dim t1 As Double
Dim t2 As Double
Dim s1 As Double
Dim s2 As Double
Dim c1 As Double
Dim c2 As Double
Dim r1 As Double
Dim r2 As Double
t1 = h / 2 * (f(a) + f(b))
While (1)
temp = 0
For k = 0 To n - 1
x = a + k * h + h / 2
temp = temp + f(x)
Next k
t2 = (t1 + temp * h) / 2
If (Abs(t2 - t1) < epsilon) Then
romberg = t2
Exit Function
End If
s2 = t2 + (t2 - t1) / 3
If (n = 1) Then
t1 = t2
s1 = s2
h = h / 2
n = n * 2
End If
c2 = s2 + (s2 - s1) / 15
If (n = 2) Then
c1 = c2
t1 = t2
s1 = s2
h = h / 2
n = n * 2
End If
r2 = c2 + (c2 - c1) / 63
If (n = 4) Then
r1 = r2
c1 = c2
s1 = s2
t1 = t2
h = h / 2
n = n * 2
End If
If (Abs(r2 - r1) < epsilon) Then
romberg = r2
Exit Function
End If
r1 = r2
c1 = c2
s1 = s2
t1 = t2
h = h / 2
n = n * 2
Wend
End Function
Function f(x As Double) As Double
f = Exp(-x * x)
End Function
Sub main()
Dim epsilon As Double
epsilon = 0.000001
Dim ans_ As Double
ans_ = romberg(0, 2, epsilon)
Print ans_
End Sub
Private Sub Command1_Click()
main
End Sub
Private Sub Form_Load()
End Sub