d10r12.txt

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

Private Sub Command1_Click()
    'PROGRAM D10R12
    'Driver for routine QROOT
    N = 7
    EPS = 0.000001
    NTRY = 10
    TINY = 0.00001
    Dim P(7), B(10), C(10)
    P(1) = 10#
    P(2) = -18#
    P(3) = 25#
    P(4) = -24#
    P(5) = 16#
    P(6) = -6#
    P(7) = 1#
    Print
    Print Tab(5); "P(x)=x^6-6x^5+16x^4-24x^3+25x^2-18x+10"
    Print
    Print Tab(5); "Quadratic factors x^2+Bx+C"
    Print
    Print Tab(3); "Factor          B             C"
    Print
    NROOT = 0
    For I = 1 To NTRY
        C(I) = 0.5 * I
        B(I) = -0.5 * I
        Call QROOT(P(), N, B(I), C(I), EPS)
        If NROOT = 0 Then
            Print Tab(5); Format$(NROOT, "0");
            Print Tab(15); Format$(B(I), "#.#####0");
            Print Tab(29); Format$(C(I), "#.#####0")
            NROOT = 1
        Else
            NFLAG = 0
            For J = 1 To NROOT
                AAA = Abs(B(I) - B(J))
                BBB = Abs(C(I) - C(J))
                If AAA < TINY And BBB < TINY Then NFLAG = 1
            Next J
            If NFLAG = 0 Then
                Print Tab(5); Format$(NROOT, "#");
                Print Tab(15); Format$(B(I), "#.#####0");
                Print Tab(29); Format$(C(I), "#.#####0")
                NROOT = NROOT + 1
            End If
        End If
    Next I
End Sub