d1r3.frm

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

VERSION 5.00
Begin VB.Form Form1 
   Caption         =   "Form1"
   ClientHeight    =   3780
   ClientLeft      =   60
   ClientTop       =   345
   ClientWidth     =   4680
   LinkTopic       =   "Form1"
   ScaleHeight     =   3780
   ScaleWidth      =   4680
   StartUpPosition =   3  'Windows Default
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3000
      TabIndex        =   0
      Top             =   3120
      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 D1R3
    'Driver program for routine TRIDAG
    N = 3
    Dim A(3), B(3), C(3), R(3), U(3), A1(3, 3), X(3)
    '输入已知的方程组的系数矩阵
    A1(1, 1) = 1: A1(1, 2) = 2: A1(1, 3) = 0
    A1(2, 1) = 2: A1(2, 2) = 2: A1(2, 3) = 3
    A1(3, 1) = 0: A1(3, 2) = 3: A1(3, 3) = 3
    '输入已知的方程组的右端向量
    R(1) = 1
    R(2) = 2
    R(3) = 3
    Print
    Print Tab(5); "已知的方程组的右端向量"
    Print Tab(14); Format$(R(1), "##.##")
    Print Tab(14); Format$(R(2), "##.##")
    Print Tab(14); Format$(R(3), "##.##")
    For I = 2 To N
        A(I) = A1(I, I - 1)
    Next I
    For I = 1 To N - 1
        C(I) = A1(I + 1, I)
    Next I
    For I = 1 To N
        B(I) = A1(I, I)
    Next I
    Call TRIDAG(A(), B(), C(), R(), U(), N)
    Print
    Print Tab(5); "计算出的方程组的解"
    Print Tab(14); Format$(U(1), "##.####")
    Print Tab(14); Format$(U(2), "##.####")
    Print Tab(14); Format$(U(3), "##.####")
    '将计算出的解乘以系数矩阵，以验证计算结果正确
    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), "##.##")
End Sub
Sub TRIDAG(A(), B(), C(), R(), U(), N)
    NMAX = 100
    Dim GAM(100)
    If B(1) = 0# Then Exit Sub
    BET = B(1)
    U(1) = R(1) / BET
    For J = 2 To N
        GAM(J) = C(J - 1) / BET
        BET = B(J) - A(J) * GAM(J)
        If BET = 0# Then Exit Sub
        U(J) = (R(J) - A(J) * U(J - 1)) / BET
    Next J
    For J = N - 1 To 1 Step -1
        U(J) = U(J) - GAM(J + 1) * U(J + 1)
    Next J
End Sub