Sub Ex_Dgees_r()
Const N = 3
Dim A(N - 1, N - 1) As Double, Wr(N - 1) As Double, Wi(N - 1) As Double
Dim Sdim As Long, Vs(N - 1, N - 1) As Double
Dim IRev As Long, Selct(N - 1) 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
IRev = 0
Do
Call
Dgees_r("V", "S", N, A(), Sdim, Wr(), Wi(), Vs(), Info, IRev, Selct())
If IRev = 1 Then Call Selct_r(Wr(), Wi(), Selct())
Loop While IRev <> 0
Debug.Print "Eigenvalues (r) =", Wr(0), Wr(1), Wr(2)
Debug.Print "Eigenvalues (i) =", Wi(0), Wi(1), Wi(2)
Debug.Print "Schur form T ="
Debug.Print A(0, 0), A(0, 1), A(0, 2)
Debug.Print A(1, 0), A(1, 1), A(1, 2)
Debug.Print A(2, 0), A(2, 1), A(2, 2)
Debug.Print "Schur vectors ="
Debug.Print Vs(0, 0), Vs(0, 1), Vs(0, 2)
Debug.Print Vs(1, 0), Vs(1, 1), Vs(1, 2)
Debug.Print Vs(2, 0), Vs(2, 1), Vs(2, 2)
Debug.Print "Sdim =", Sdim, "Info =", Info
End Sub
Sub Selct_r(Wr() As Double, Wi() As Double, Selct() As Long)
Const N = 3
Dim I As Long
For I = 0 To N - 1
Selct(I) = 0
If Wi(I) <> 0 Then Selct(I) = 1
Next
End Sub
Sub Dgees_r(Jobvs As String, Sort As String, N As Long, A() As Double, Sdim As Long, Wr() As Double, Wi() As Double, Vs() As Double, Info As Long, IRev As Long, Selct() As Long)
(Simple driver) Schur factorization of a general matrix (Reverse communication version)