nimodule.bas

科学与工程数值计算算法（Visual Basic版） 附赠的光盘包含了本书中全部的源代码

Attribute VB_Name = "NLModule"
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：NIModule.bas
'  功能：  数值积分
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Option Explicit

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：NIModule.bas
'  函数名：NITrapzd
'  功能：  用变步长梯形求积法求积，本函数需要调用计算函数f(x)值的函数Func，其形式为：
'          Function Func(x As Double) As Double
'  参数：  a     - Double型变量，积分下限
'          b     - Double型变量，积分上限，要求 b>a
'          eps   - Double型变量，积分精度要求
'  返回值：Double型，积分值
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function NITrapzd(a As Double, b As Double, eps As Double) As Double
    Dim n As Integer, k As Integer
    Dim fa As Double, fb As Double, h As Double, t1 As Double, p As Double, s As Double, x As Double, t As Double
    
    ' 积分区间端点的函数值
    fa = Func(a)
    fb = Func(b)
    
    ' 迭代初值
    n = 1
    h = b - a
    t1 = h * (fa + fb) / 2#
    p = eps + 1#
    
    ' 迭代计算
    While (p >= eps)
        s = 0#
        
        For k = 0 To n - 1
            x = a + (k + 0.5) * h
            s = s + Func(x)
        Next k
        
        t = (t1 + h * s) / 2#
        p = Abs(t1 - t)
        t1 = t
        n = n + n
        h = h / 2#
    Wend
    
    ' 返回满足精度的积分值
    NITrapzd = t

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：NIModule.bas
'  函数名：NISimpson
'  功能：  用变步长辛卜生求积法求积，本函数需要调用计算函数f(x)值的函数Func，其形式为：
'          Function Func(x As Double) As Double
'  参数：  a     - Double型变量，积分下限
'          b     - Double型变量，积分上限，要求 b>a
'          eps   - Double型变量，积分精度要求
'  返回值：Double型，积分值
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function NISimpson(a As Double, b As Double, eps As Double) As Double
    Dim n As Integer, k As Integer
    Dim h As Double, t1 As Double, t2 As Double, s1 As Double, s2 As Double
    Dim ep As Double, p As Double, x As Double
    
    ' 迭代初值
    n = 1
    h = b - a
    t1 = h * (Func(a) + Func(b)) / 2#
    s1 = t1
    ep = eps + 1#
    
    ' 迭代计算
    While (ep >= eps)
        p = 0#
        
        For k = 0 To n - 1
            x = a + (k + 0.5) * h
            p = p + Func(x)
        Next k
        
        t2 = (t1 + h * p) / 2#
        s2 = (4# * t2 - t1) / 3#
        ep = Abs(s2 - s1)
        t1 = t2
        s1 = s2
        n = n + n
        h = h / 2#
    Wend
    
    ' 返回满足精度的积分值
    NISimpson = s2

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：NIModule.bas
'  函数名：NIATrapzd
'  功能：  用自适应梯形求积法求积，本函数需要调用计算函数f(x)值的函数Func，其形式为：
'          Function Func(x As Double) As Double
'  参数：  a     - Double型变量，积分下限
'          b     - Double型变量，积分上限，要求 b>a
'          eps   - Double型变量，积分精度要求
'          d     - Double型变量，对积分区间进行分割的最小步长，当子区间的宽度小于d时，即使没有满足精度要求，
'                   也不再往下进行分割
'  返回值：Double型，积分值
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function NIATrapzd(a As Double, b As Double, eps As Double, d As Double) As Double
    Dim h As Double, t As Double, f0 As Double, f1 As Double, t0 As Double
    
    h = b - a
    t = 0#
    
    f0 = Func(a)
    f1 = Func(b)
    
    t0 = h * (f0 + f1) / 2#
    
    Call ppp(a, b, h, f0, f1, t0, eps, d, t)
    
    NIATrapzd = t

End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：NIModule.bas
'  函数名：ppp
'  功能：  供函数NIATrapzd内部调用的递归过程
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Sub ppp(x0 As Double, x1 As Double, h As Double, f0 As Double, f1 As Double, t0 As Double, eps As Double, d As Double, t As Double)
    Dim x As Double, f As Double, t1 As Double, t2 As Double, p As Double, g As Double, eps1 As Double
    
    x = x0 + h / 2#
    f = Func(x)
    t1 = h * (f0 + f) / 4#
    t2 = h * (f + f1) / 4#
    p = Abs(t0 - (t1 + t2))
    
    If ((p < eps) Or (h / 2# < d)) Then
        t = t + (t1 + t2)
    Else
        g = h / 2#
        eps1 = eps / 1.4
        
        Call ppp(x0, x, g, f0, f, t1, eps1, d, t)
        
        Call ppp(x, x1, g, f, f1, t2, eps1, d, t)
    End If

End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：NIModule.bas
'  函数名：NIRomberg
'  功能：  用龙贝格求积法求积，本函数需要调用计算函数f(x)值的函数Func，其形式为：
'          Function Func(x As Double) As Double
'  参数：  a     - Double型变量，积分下限
'          b     - Double型变量，积分上限，要求 b>a
'          eps   - Double型变量，积分精度要求
'  返回值：Double型，积分值
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function NIRomberg(a As Double, b As Double, eps As Double) As Double
    Dim m As Integer, n As Integer, i As Integer, k As Integer
    Dim y(10) As Double, h As Double, ep As Double, p As Double, x As Double, s As Double, q As Double
    
    ' 初值
    h = b - a
    y(1) = h * (Func(a) + Func(b)) / 2#
    m = 1
    n = 1
    ep = eps + 1#
    
    ' 循环计算
    While ((ep >= eps) And (m <= 9))
        
        p = 0#
        
        For i = 0 To n - 1
            x = a + (i + 0.5) * h
            p = p + Func(x)
        Next i
        
        p = (y(1) + h * p) / 2#
        s = 1#
        
        For k = 1 To m
            s = 4# * s
            q = (s * p - y(k)) / (s - 1#)
            y(k) = p
            p = q
        Next k
        
        ep = Abs(q - y(m))
        m = m + 1
        y(m) = q
        n = n + n
        h = h / 2#
    Wend
    
    ' 求得满意的结果，返回
    NIRomberg = q
    
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'  模块名：NIModule.bas
'  函数名：NIPq
'  功能：  用连分式法计算一维积分，本函数需要调用计算函数f(x)值的函数Func，其形式为：
'          Function Func(x As Double) As Double
'  参数：  a     - Double型变量，积分下限
'          b     - Double型变量，积分上限，要求 b>a
'          eps   - Double型变量，积分精度要求
'  返回值：Double型，积分值
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Function NIPq(a As Double, b As Double, eps As Double) As Double
    Dim m As Integer, n As Integer, k As Integer, l As Integer, j As Integer
    Dim h(10) As Double, bb(10) As Double, hh As Double, t1 As Double, s1 As Double
    Dim ep As Double, s As Double, x As Double, t2 As Double, g As Double
    
    ' 初值
    m = 1
    n = 1
    hh = b - a
    h(1) = hh
    t1 = hh * (Func(a) + Func(b)) / 2#
    s1 = t1
    bb(1) = s1
    ep = 1# + eps
    
    ' 循环计算
    While ((ep >= eps) And (m <= 9))
        s = 0#
        For k = 0 To n - 1
            x = a + (k + 0.5) * hh
            s = s + Func(x)
        Next k
        
        t2 = (t1 + hh * s) / 2#
        m = m + 1
        h(m) = h(m - 1) / 2#