d10r13.txt

VB常用数值算法集 内含有解线性代数方程组

Private Sub Command1_Click()
    'PROGRAM D10R13
    'Driver for routine MNEWT
    NTRIAL = 5
    TOLX = 0.000001
    N = 4
    TOLF = 0.000001
    NP = 15
    Dim X(15), ALPHA(15, 15), BETA(15)
    For KK = -1 To 1 Step 2
        For K = 1 To 3
            XX = 0.2 * K * KK
            Print Tab(5); "Starting vector number"; Format$(K, "#")
            For I = 1 To 4
                X(I) = XX + 0.2 * I
                Print Tab(5); "   X("; Format$(I, "#"); ")= ";
                Print Format$(X(I), "0.#0")
            Next I
            For J = 1 To NTRIAL
                Call MNEWT(1, X(), N, TOLX, TOLF)
                Call USRFUN(X(), ALPHA(), BETA())
                Print Tab(5); "I              X(I)           F"
                For I = 1 To N
                    Print Tab(5); Format$(I, "#");
                    Print Tab(15); Format$(X(I), ".####00E+00");
                    Print Tab(29); Format$(-BETA(I), ".#####0E+00")
                Next I
            Next J
        Next K
    Next KK
End Sub
Sub USRFUN(X(), ALPHA(), BETA())
    NP = 15
    ALPHA(1, 1) = -2# * X(1)
    ALPHA(1, 2) = -2# * X(2)
    ALPHA(1, 3) = -2# * X(3)
    ALPHA(1, 4) = 1#
    ALPHA(2, 1) = 2# * X(1)
    ALPHA(2, 2) = 2# * X(2)
    ALPHA(2, 3) = 2# * X(3)
    ALPHA(2, 4) = 2# * X(4)
    ALPHA(3, 1) = 1#
    ALPHA(3, 2) = -1#
    ALPHA(3, 3) = 0#
    ALPHA(3, 4) = 0#
    ALPHA(4, 1) = 0#
    ALPHA(4, 2) = 1#
    ALPHA(4, 3) = -1#
    ALPHA(4, 4) = 0#
    BETA(1) = X(1) ^ 2 + X(2) ^ 2 + X(3) ^ 2 - X(4)
    BETA(2) = -X(1) ^ 2 - X(2) ^ 2 - X(3) ^ 2 - X(4) ^ 2 + 1#
    BETA(3) = -X(1) + X(2)
    BETA(4) = -X(2) + X(3)
End Sub