Sub Ex_Dgehrd_Dhseqr_Dhsein()
Const N = 3
Dim A(N - 1, N - 1) As Double, Tau(N - 2) As Double
Dim H(N - 1, N - 1) As Double, Z() As Double
Dim Wr(N - 1) As Double, Wi(N - 1) As Double, Selct(N - 1) As Boolean
Dim Vl(N - 1, N - 1) As Double, Vr(N - 1, N - 1) As Double, M As Long
Dim Ilo As Long, Ihi As Long, Ifaill(N - 1) As Long, Ifailr(N - 1) As Long
Dim I As Long, J As Long, Info As Long
A(0, 0) = 0.2: A(0, 1) = -0.11: A(0, 2) = -0.93
A(1, 0) = -0.32: A(1, 1) = 0.81: A(1, 2) = 0.37
A(2, 0) = -0.8: A(2, 1) = -0.92: A(2, 2) = -0.29
Ilo = 1: Ihi = N
Call Dgehrd(N, Ilo, Ihi, A(), Tau(), Info)
If Info <> 0 Then
Debug.Print "Error in Dgehrd: Info =", Info
Exit Sub
End If
For I = 0 To N - 1
For J = 0 To N - 1
H(I, J) = A(I, J)
Next
Next
Call Dhseqr("E", "N", N, Ilo, Ihi, H(), Wr(), Wi(), Z(), Info)
If Info <> 0 Then
Debug.Print "Error in Dhseqr: Info =", Info
Exit Sub
End If
For I = 0 To N - 1
Selct(I) = True
Next
Call Dhsein("B", "Q", "N", Selct(), N, A(), Wr(), Wi(), Vl(), Vr(), N, M, Ifaill(), Ifailr(), Info)
If Info <> 0 Then
Debug.Print "Error in Dhsein: Info =", Info
Exit Sub
End If
Call Dormhr("L", "N", N, N, Ilo, Ihi, A(), Tau(), Vr(), Info)
If Info <> 0 Then
Debug.Print "Error in Dormhr: Info =", Info
Exit Sub
End If
Call Dormhr("L", "N", N, N, Ilo, Ihi, A(), Tau(), Vl(), Info)
If Info <> 0 Then
Debug.Print "Error in Dormhr: Info =", Info
Exit Sub
End If
Debug.Print "Eigenvalues (r) =", Wr(0), Wr(1), Wr(2)
Debug.Print "Eigenvalues (i) =", Wi(0), Wi(1), Wi(2)
Debug.Print "Eigenvectors (L) ="
Debug.Print Vl(0, 0), Vl(0, 1), Vl(0, 2)
Debug.Print Vl(1, 0), Vl(1, 1), Vl(1, 2)
Debug.Print Vl(2, 0), Vl(2, 1), Vl(2, 2)
Debug.Print "Eigenvectors (R) ="
Debug.Print Vr(0, 0), Vr(0, 1), Vr(0, 2)
Debug.Print Vr(1, 0), Vr(1, 1), Vr(1, 2)
Debug.Print Vr(2, 0), Vr(2, 1), Vr(2, 2)
Debug.Print "M =", M
End Sub
1.9.6