'功能：用雅可比法（Jacobi）计算对称矩阵的特征值和特征向量
'参数：n - Integer型变量,对称矩阵的阶数.
'dblA - Double型二维数组,体积为n x n.存放对称矩阵；返回时,对角线上存放求得的n个特征值.
'eps - Double型变量.迭代过程中的控制精度参数.
'nMaxItNum - Integer.为求得一个特征值所允许的最大迭代次数.
'返回值：Boolean型.False,失败无解；True,成功
Private Function MJacobiEigenv(n As Integer,dblA() As Double,Optional eps As Double = 0.0000001,Optional nMaxItNum As Integer = 10000) As Boolean
Dim i As Integer,j As Integer,p As Integer,q As Integer,l As Integer
Dim fm As Double,cn As Double,sn As Double,omega As Double,x As Double,y As Double,d As Double
l = 1
While (True)
fm = 0#
For i = 2 To n
For j = 1 To i - 1
d = Abs(dblA(i,j))
If i j And d > fm Then
fm = d
p = i
q = j
End If
Next j
Next i
If (fm < eps) Then
MJacobiEigenv = True
Exit Function
End If
If (l > nMaxItNum) Then
MJacobiEigenv = False
Exit Function
End If
l = l + 1
x = -dblA(p,q)
y = (dblA(q,q) - dblA(p,p)) / 2#
omega = x / Sqr(x * x + y * y)
If (y < 0#) Then omega = -omega
sn = 1# + Sqr(1# - omega * omega)
sn = omega / Sqr(2# * sn)
cn = Sqr(1# - sn * sn)
fm = dblA(p,p)
dblA(p,p) = fm * cn * cn + dblA(q,q) * sn * sn + dblA(p,q) * omega
dblA(q,q) = fm * sn * sn + dblA(q,q) * cn * cn - dblA(p,q) * omega
dblA(p,q) = 0#
dblA(q,p) = 0#
For j = 1 To n
If ((j p) And (j q)) Then
fm = dblA(p,j)
dblA(p,j) = fm * cn + dblA(q,j) * sn
dblA(q,j) = -fm * sn + dblA(q,j) * cn
End If
Next j
For i = 1 To n
If ((i p) And (i q)) Then
fm = dblA(i,p)
dblA(i,p) = fm * cn + dblA(i,q) * sn
dblA(i,q) = -fm * sn + dblA(i,q) * cn
End If
Next i
Wend
End Function
Private Sub Command1_Click()
Dim n As Integer,dblA() As Double,i As Integer,j As Integer,b As Boolean
n = Val(InputBox("请输入矩阵的阶数"))
ReDim dblA(n,n)
ReDim dblV(n,n)
For i = 1 To n
For j = 1 To n
dblA(i,j) = InputBox("请输入第" & i & "行第" & j & "列的数")
Next j
Next i
d = MJacobiEigenv(n,dblA)
If d = False Then
MsgBox "失败无解"
Else
For i = 1 To n
Print dblA(i,i)
Next i
End If
End Su
