d1r4.frm

矩阵特征值的求解过程之二

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   6195
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   6195
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3000
      TabIndex        =   0
      Top             =   5400
      Width           =   1335
   End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub Command1_Click()
    'program D1R4
    'Driver program for routine PENDAG
    N = 7
    Dim A(7), B(7), C(7), D(7), E(7), R(7), U(7), A1(7, 7), X(7)
    '输入已知的方程组的系数矩阵
    For I = 1 To N
        For J = 1 To N
        A1(I, J) = 0
        Next J
    Next I
    A1(1, 1) = 4: A1(1, 2) = 1: A1(1, 3) = 1
    A1(2, 1) = 1: A1(2, 2) = 5: A1(2, 3) = 2: A1(2, 4) = 2
    A1(3, 1) = 1: A1(3, 2) = 2: A1(3, 3) = 6: A1(3, 4) = 3: A1(3, 5) = 3
    A1(4, 2) = 2: A1(4, 3) = 3: A1(4, 4) = 7: A1(4, 5) = 4: A1(4, 6) = 4
    A1(5, 3) = 3: A1(5, 4) = 4: A1(5, 5) = 8: A1(5, 6) = 5: A1(5, 7) = 5
    A1(6, 4) = 4: A1(6, 5) = 5: A1(6, 6) = 9: A1(6, 7) = 6
    A1(7, 5) = 5: A1(7, 6) = 6: A1(7, 7) = 10
    '输入已知的方程组的右端向量
    R(1) = 1
    R(2) = 2
    R(3) = 3
    R(4) = 4
    R(5) = 5
    R(6) = 6
    R(7) = 7
    Print
    Print Tab(5); "已知的方程组的右端向量"
    Print Tab(14); Format$(R(1), "#.##")
    Print Tab(14); Format$(R(2), "#.##")
    Print Tab(14); Format$(R(3), "#.##")
    Print Tab(14); Format$(R(4), "#.##")
    Print Tab(14); Format$(R(5), "#.##")
    Print Tab(14); Format$(R(6), "#.##")
    Print Tab(14); Format$(R(7), "#.##")
    For I = 3 To N
        A(I) = A1(I, I - 2)
    Next I
    For I = 2 To N
        B(I) = A1(I, I - 1)
    Next I
    For I = 1 To N - 1
        D(I) = A1(I, I + 1)
    Next I
    For I = 1 To N - 2
        E(I) = A1(I, I + 2)
    Next I
    For I = 1 To N
        C(I) = A1(I, I)
    Next I
    Call PENDAG(A(), B(), C(), D(), E(), R(), U(), N)
    Print
    Print Tab(5); "计算出的方程组的解"
    Print Tab(10); Format$(U(1), "#.####E+00")
    Print Tab(10); Format$(U(2), "#.####E+00")
    Print Tab(10); Format$(U(3), "#.####E+00")
    Print Tab(10); Format$(U(4), "#.####E+00")
    Print Tab(10); Format$(U(5), "#.####E+00")
    Print Tab(10); Format$(U(6), "#.####E+00")
    Print Tab(10); Format$(U(7), "#.####E+00")
    '将计算出的解乘以系数矩阵，以验证计算结果正确
    For L = 1 To N
        X(L) = 0#
        For J = 1 To N
            X(L) = X(L) + A1(L, J) * U(J)
        Next J
    Next L
    Print
    Print Tab(5); "计算出的解乘以系数矩阵的结果"
    Print Tab(14); Format$(X(1), "##.##")
    Print Tab(14); Format$(X(2), "##.##")
    Print Tab(14); Format$(X(3), "##.##")
    Print Tab(14); Format$(X(4), "##.##")
    Print Tab(14); Format$(X(5), "##.##")
    Print Tab(14); Format$(X(6), "##.##")
    Print Tab(14); Format$(X(7), "##.##")
End Sub
Sub PENDAG(A(), B(), C(), D(), E(), R(), U(), N)
    Dim W(100), BETA(100), ALPHA(100), CG(100), H(100)
    W(1) = C(1)
    BETA(1) = 0#
    BETA(2) = D(1) / W(1)
    ALPHA(1) = 0#
    ALPHA(2) = E(1) / W(1)
    ALPHA(N) = 0#
    ALPHA(N + 1) = 0#
    For K = 2 To N
        CG(K) = B(K) - A(K) * BETA(K - 1)
        W(K) = C(K) - A(K) * ALPHA(K - 1) - CG(K) * BETA(K)
        If W(K) = 0# Then Print "    W(K)=0.0 in PENDAG"
        BETA(K + 1) = (D(K) - CG(K) * ALPHA(K)) / W(K)
        ALPHA(K + 1) = E(K) / W(K)
    Next K
        H(1) = 0#
        H(2) = R(1) / W(1)
    For K = 2 To N
        H(K + 1) = (R(K) - A(K) * H(K - 1) - CG(K) * H(K)) / W(K)
    Next K
        U(N) = H(N + 1)
        U(N - 1) = H(N) - BETA(N) * U(N)
    For K = N - 2 To 1 Step -1
        U(K) = H(K + 1) - BETA(K + 1) * U(K + 1) - ALPHA(K + 1) * U(K + 2)
    Next K
End Sub