mhbergeigenvmainmodule.bas

科学与工程数值计算算法（Visual Basic版）一书的源代码。对科学研究者自己开发领域内计算程序极具参考价值。

Attribute VB_Name = "MainModule"
Sub Main()
    Dim mtxA(5, 5) As Double
    Dim mtxB(5, 5) As Double
    Dim mtxC(5, 5) As Double
    Dim dblUR(5) As Double
    Dim dblUI(5) As Double
    Dim i As Integer, j As Integer
    Dim s As String

    ' 原矩阵
    mtxA(1, 1) = 1:  mtxA(1, 2) = 6: mtxA(1, 3) = -3:  mtxA(1, 4) = -1: mtxA(1, 5) = 7
    mtxA(2, 1) = 8:  mtxA(2, 2) = -15: mtxA(2, 3) = 18:  mtxA(2, 4) = 5: mtxA(2, 5) = 4
    mtxA(3, 1) = -2:  mtxA(3, 2) = 11: mtxA(3, 3) = 9:  mtxA(3, 4) = 15: mtxA(3, 5) = 20
    mtxA(4, 1) = -13:  mtxA(4, 2) = 2: mtxA(4, 3) = 21:  mtxA(4, 4) = 30: mtxA(4, 5) = -6
    mtxA(5, 1) = 17:  mtxA(5, 2) = 22: mtxA(5, 3) = -5:  mtxA(5, 4) = 3: mtxA(5, 5) = 6

    ' 备份原矩阵
    For i = 1 To 5
        For j = 1 To 5
            mtxB(i, j) = mtxA(i, j)
        Next j
    Next i

    '求解H矩阵
    Call MHberg(5, mtxA)

    ' 备份H矩阵
    For i = 1 To 5
        For j = 1 To 5
            mtxC(i, j) = mtxA(i, j)
        Next j
    Next i

    ' 求解特征值
    If MHbergEigenv(5, mtxA, dblUR, dblUI, 0.000001, 60) Then

        ' 生成特征值显示字符串
        For i = 1 To 5
            s = s + Format(dblUR(i), "######0.0000000") + " + " + Format(dblUI(i), "######0.0000000") + "j" & Chr$(13)
        Next i

        MsgBox "求解成功！" & Chr$(13) & Chr$(13) & _
                "原矩阵A" & Chr$(13) & Chr$(13) & _
                MatrixToString(5, 5, mtxB, "######0.0000000") & Chr$(13) & _
                "H矩阵" & Chr$(13) & Chr$(13) & _
                MatrixToString(5, 5, mtxC, "######0.0000000") & Chr$(13) & _
                "特征值为" & Chr$(13) & Chr$(13) & s
    Else
         MsgBox "求解失败！"
    End If

End Sub