Sub Ex_Dgehrd_Dhseqr_Dtrevc3()
Const N = 3
Dim A(N - 1, N - 1) As Double, Tau(N - 2) As Double
Dim Wr(N - 1) As Double, Wi(N - 1) As Double, Selct() 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, 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
Vr(I, J) = A(I, J)
Next
Next
Call Dorghr(N, Ilo, Ihi, Vr(), Tau(), Info)
If Info <> 0 Then
Debug.Print "Error in Dorghr: Info =", Info
Exit Sub
End If
Call Dhseqr("S", "V", N, Ilo, Ihi, A(), Wr(), Wi(), Vr(), Info)
If Info <> 0 Then
Debug.Print "Error in Dhseqr: Info =", Info
Exit Sub
End If
For I = 0 To N - 1
For J = 0 To N - 1
Vl(I, J) = Vr(I, J)
Next
Next
Call Dtrevc3("B", "B", Selct(), N, A(), Vl(), Vr(), N, M, Info)
If Info <> 0 Then
Debug.Print "Error in Dtrevc3: 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