?? tred2.txt
字號:
Sub TRED2(A(), N, D(), E())
If N > 1 Then
For I = N To 2 Step -1
L = I - 1
H = 0#
SCALE1 = 0#
If L > 1 Then
For K = 1 To L
SCALE1 = SCALE1 + Abs(A(I, K))
Next K
If SCALE1 = 0# Then
E(I) = A(I, L)
Else
For K = 1 To L
A(I, K) = A(I, K) / SCALE1
H = H + A(I, K) ^ 2
Next K
F = A(I, L)
G = -Sqr(H) * Sgn(F)
E(I) = SCALE1 * G
H = H - F * G
A(I, L) = F - G
F = 0#
For J = 1 To L
A(J, I) = A(I, J) / H
G = 0#
For K = 1 To J
G = G + A(J, K) * A(I, K)
Next K
If L > J Then
For K = J + 1 To L
G = G + A(K, J) * A(I, K)
Next K
End If
E(J) = G / H
F = F + E(J) * A(I, J)
Next J
HH = F / (H + H)
For J = 1 To L
F = A(I, J)
G = E(J) - HH * F
E(J) = G
For K = 1 To J
A(J, K) = A(J, K) - F * E(K) - G * A(I, K)
Next K
Next J
End If
Else
E(I) = A(I, L)
End If
D(I) = H
Next I
End If
'Omit following line if finding only eigenvalues.
D(1) = 0#
E(1) = 0#
For I = 1 To N
'Delete lines from here ...
L = I - 1
If D(I) <> 0# Then
For J = 1 To L
G = 0#
For K = 1 To L
G = G + A(I, K) * A(K, J)
Next K
For K = 1 To L
A(K, J) = A(K, J) - G * A(K, I)
Next K
Next J
End If
'... to here when finding only eibenvalues.
D(I) = A(I, I)
'Also delete lines from here ...
A(I, I) = 1#
If L >= 1 Then
For J = 1 To L
A(I, J) = 0#
A(J, I) = 0#
Next J
End If
'... to here when finding only eigenvalues.
Next I
End Sub
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -