d3r10.txt

常用的数值算法的VB程序

Dim XMAX, X, Y, Z
Private Sub Command1_Click()
    'PROGRAM D3R10
    'Driver for routine QUAD3D
    PI = 3.1415926
    NVAL = 10
    Print
    Print "Integral of r^2 over a spherical volume"
    Print
    Print Tab(5); "Radius       QUAD3D       Actual"
    For I = 1 To NVAL
        XMAX = 0.1 * I
        XMIN = -XMAX
        Call QUAD3D(XMIN, XMAX, S)
        Print Tab(5); Format$(XMAX, "#.#0");
        Print Tab(18); Format$(S, "#.###0");
        Print Tab(31); Format$(4# * PI * (XMAX ^ 5) / 5#, "#.###0")
    Next I
End Sub
Function FUNC(X, Y, Z)
    FUNC = X ^ 2 + Y ^ 2 + Z ^ 2
End Function
Function Z1(X, Y)
    Z1 = -Sqr(Abs(XMAX ^ 2 - X ^ 2 - Y ^ 2))
End Function
Function Z2(X, Y)
    Z2 = Sqr(Abs(XMAX ^ 2 - X ^ 2 - Y ^ 2))
End Function
Function Y1(X)
    Y1 = -Sqr(Abs(XMAX ^ 2 - X ^ 2))
End Function
Function Y2(X)
    Y2 = Sqr(Abs(XMAX ^ 2 - X ^ 2))
End Function
Sub QGAUSX(DUM, A, B, SS)
    Dim X1(5), W(5)
    X1(1) = 0.1488743389: X1(2) = 0.4333953941: X1(3) = 0.6794095682
    X1(4) = 0.8650633666: X1(5) = 0.9739065285
    W(1) = 0.2955242247: W(2) = 0.2692667193: W(3) = 0.2190863625
    W(4) = 0.1494513491: W(5) = 0.0666713443
    XM = 0.5 * (B + A)
    XR = 0.5 * (B - A)
    SS = 0#
    For J = 1 To 5
        DX = XR * X1(J)
        SS = SS + W(J) * (H(XM + DX) + H(XM - DX))
    Next J
    SS = XR * SS
    Erase W(), X1()
End Sub
Sub QGAUSY(DUM, A, B, SS)
    Dim X1(5), W(5)
    X1(1) = 0.1488743389: X1(2) = 0.4333953941: X1(3) = 0.6794095682
    X1(4) = 0.8650633666: X1(5) = 0.9739065285
    W(1) = 0.2955242247: W(2) = 0.2692667193: W(3) = 0.2190863625
    W(4) = 0.1494513491: W(5) = 0.0666713443
    XM = 0.5 * (B + A)
    XR = 0.5 * (B - A)
    SS = 0#
    For J = 1 To 5
        DX = XR * X1(J)
        SS = SS + W(J) * (G(XM + DX) + G(XM - DX))
    Next J
    SS = XR * SS
    Erase W(), X1()
End Sub
Sub QGAUSZ(DUM, A, B, SS)
    Dim X1(5), W(5)
    X1(1) = 0.1488743389: X1(2) = 0.4333953941: X1(3) = 0.6794095682
    X1(4) = 0.8650633666: X1(5) = 0.9739065285
    W(1) = 0.2955242247: W(2) = 0.2692667193: W(3) = 0.2190863625
    W(4) = 0.1494513491: W(5) = 0.0666713443
    XM = 0.5 * (B + A)
    XR = 0.5 * (B - A)
    SS = 0#
    For J = 1 To 5
        DX = XR * X1(J)
        SS = SS + W(J) * (F(XM + DX) + F(XM - DX))
    Next J
    SS = XR * SS
    Erase W(), X1()
End Sub