Sub Ex_Dggesx_r()
Const N = 3
Dim A(N - 1, N - 1) As Double, B(N - 1, N - 1) As Double
Dim Alphar(N - 1) As Double, Alphai(N - 1) As Double, Beta(N - 1) As Double
Dim Sdim As Long, Vsl(N - 1, N - 1) As Double, Vsr(N - 1, N - 1) As Double
Dim RConde(1) As Double, RCondv(1) As Double, Info As Long
Dim IRev As Long, Selct(N - 1) 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
B(0, 0) = -0.58: B(0, 1) = -0.79: B(0, 2) = 0.82
B(1, 0) = 0.77: B(1, 1) = 0.71: B(1, 2) = -0.55
B(2, 0) = -1.36: B(2, 1) = -1.22: B(2, 2) = 1.66
IRev = 0
Do
Call Dggesx_r("V", "V", "S", "B", N, A(), B(), Sdim, Alphar(), Alphai(), Beta(), Vsl(), Vsr(), RConde(), RCondv(), Info, IRev, Selct())
If IRev = 1 Then Call Selctg_r(Alphar(), Alphai(), Beta(), Selct())
Loop While IRev <> 0
Debug.Print "Eigenvalues ="
Debug.Print " (r)", Alphar(0) / Beta(0), Alphar(1) / Beta(1), Alphar(2) / Beta(2)
Debug.Print " (i)", Alphai(0) / Beta(0), Alphai(1) / Beta(1), Alphai(2) / Beta(2)
Debug.Print "Schur form S ="
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 form T ="
Debug.Print B(0, 0), B(0, 1), B(0, 2)
Debug.Print B(1, 0), B(1, 1), B(1, 2)
Debug.Print B(2, 0), B(2, 1), B(2, 2)
Debug.Print "Left Schur vectors ="
Debug.Print Vsl(0, 0), Vsl(0, 1), Vsl(0, 2)
Debug.Print Vsl(1, 0), Vsl(1, 1), Vsl(1, 2)
Debug.Print Vsl(2, 0), Vsl(2, 1), Vsl(2, 2)
Debug.Print "Right Schur vectors ="
Debug.Print Vsr(0, 0), Vsr(0, 1), Vsr(0, 2)
Debug.Print Vsr(1, 0), Vsr(1, 1), Vsr(1, 2)
Debug.Print Vsr(2, 0), Vsr(2, 1), Vsr(2, 2)
Debug.Print "Rconde =", RConde(0), RConde(1)
Debug.Print "Rcondv =", RCondv(0), RCondv(1)
Debug.Print "Sdim =", Sdim, "Info =", Info
End Sub
Sub Selctg_r(Alphar() As Double, Alphai() As Double, Beta() As Double, Selct() As Long)
Const N = 3
Dim I As Long
For I = 0 To N - 1
Selct(I) = 0
If Alphai(I) <> 0 Then Selct(I) = 1
Next
End Sub