1*> \brief \b CTGEXC
2*
3*  =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6*            http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download CTGEXC + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctgexc.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctgexc.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctgexc.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
22*                          LDZ, IFST, ILST, INFO )
23*
24*       .. Scalar Arguments ..
25*       LOGICAL            WANTQ, WANTZ
26*       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
27*       ..
28*       .. Array Arguments ..
29*       COMPLEX            A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
30*      $                   Z( LDZ, * )
31*       ..
32*
33*
34*> \par Purpose:
35*  =============
36*>
37*> \verbatim
38*>
39*> CTGEXC reorders the generalized Schur decomposition of a complex
40*> matrix pair (A,B), using an unitary equivalence transformation
41*> (A, B) := Q * (A, B) * Z**H, so that the diagonal block of (A, B) with
42*> row index IFST is moved to row ILST.
43*>
44*> (A, B) must be in generalized Schur canonical form, that is, A and
45*> B are both upper triangular.
46*>
47*> Optionally, the matrices Q and Z of generalized Schur vectors are
48*> updated.
49*>
50*>        Q(in) * A(in) * Z(in)**H = Q(out) * A(out) * Z(out)**H
51*>        Q(in) * B(in) * Z(in)**H = Q(out) * B(out) * Z(out)**H
52*> \endverbatim
53*
54*  Arguments:
55*  ==========
56*
57*> \param[in] WANTQ
58*> \verbatim
59*>          WANTQ is LOGICAL
60*>          .TRUE. : update the left transformation matrix Q;
61*>          .FALSE.: do not update Q.
62*> \endverbatim
63*>
64*> \param[in] WANTZ
65*> \verbatim
66*>          WANTZ is LOGICAL
67*>          .TRUE. : update the right transformation matrix Z;
68*>          .FALSE.: do not update Z.
69*> \endverbatim
70*>
71*> \param[in] N
72*> \verbatim
73*>          N is INTEGER
74*>          The order of the matrices A and B. N >= 0.
75*> \endverbatim
76*>
77*> \param[in,out] A
78*> \verbatim
79*>          A is COMPLEX array, dimension (LDA,N)
80*>          On entry, the upper triangular matrix A in the pair (A, B).
81*>          On exit, the updated matrix A.
82*> \endverbatim
83*>
84*> \param[in] LDA
85*> \verbatim
86*>          LDA is INTEGER
87*>          The leading dimension of the array A. LDA >= max(1,N).
88*> \endverbatim
89*>
90*> \param[in,out] B
91*> \verbatim
92*>          B is COMPLEX array, dimension (LDB,N)
93*>          On entry, the upper triangular matrix B in the pair (A, B).
94*>          On exit, the updated matrix B.
95*> \endverbatim
96*>
97*> \param[in] LDB
98*> \verbatim
99*>          LDB is INTEGER
100*>          The leading dimension of the array B. LDB >= max(1,N).
101*> \endverbatim
102*>
103*> \param[in,out] Q
104*> \verbatim
105*>          Q is COMPLEX array, dimension (LDQ,N)
106*>          On entry, if WANTQ = .TRUE., the unitary matrix Q.
107*>          On exit, the updated matrix Q.
108*>          If WANTQ = .FALSE., Q is not referenced.
109*> \endverbatim
110*>
111*> \param[in] LDQ
112*> \verbatim
113*>          LDQ is INTEGER
114*>          The leading dimension of the array Q. LDQ >= 1;
115*>          If WANTQ = .TRUE., LDQ >= N.
116*> \endverbatim
117*>
118*> \param[in,out] Z
119*> \verbatim
120*>          Z is COMPLEX array, dimension (LDZ,N)
121*>          On entry, if WANTZ = .TRUE., the unitary matrix Z.
122*>          On exit, the updated matrix Z.
123*>          If WANTZ = .FALSE., Z is not referenced.
124*> \endverbatim
125*>
126*> \param[in] LDZ
127*> \verbatim
128*>          LDZ is INTEGER
129*>          The leading dimension of the array Z. LDZ >= 1;
130*>          If WANTZ = .TRUE., LDZ >= N.
131*> \endverbatim
132*>
133*> \param[in] IFST
134*> \verbatim
135*>          IFST is INTEGER
136*> \endverbatim
137*>
138*> \param[in,out] ILST
139*> \verbatim
140*>          ILST is INTEGER
141*>          Specify the reordering of the diagonal blocks of (A, B).
142*>          The block with row index IFST is moved to row ILST, by a
143*>          sequence of swapping between adjacent blocks.
144*> \endverbatim
145*>
146*> \param[out] INFO
147*> \verbatim
148*>          INFO is INTEGER
149*>           =0:  Successful exit.
150*>           <0:  if INFO = -i, the i-th argument had an illegal value.
151*>           =1:  The transformed matrix pair (A, B) would be too far
152*>                from generalized Schur form; the problem is ill-
153*>                conditioned. (A, B) may have been partially reordered,
154*>                and ILST points to the first row of the current
155*>                position of the block being moved.
156*> \endverbatim
157*
158*  Authors:
159*  ========
160*
161*> \author Univ. of Tennessee
162*> \author Univ. of California Berkeley
163*> \author Univ. of Colorado Denver
164*> \author NAG Ltd.
165*
166*> \ingroup complexGEcomputational
167*
168*> \par Contributors:
169*  ==================
170*>
171*>     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
172*>     Umea University, S-901 87 Umea, Sweden.
173*
174*> \par References:
175*  ================
176*>
177*>  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
178*>      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
179*>      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
180*>      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
181*> \n
182*>  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
183*>      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
184*>      Estimation: Theory, Algorithms and Software, Report
185*>      UMINF - 94.04, Department of Computing Science, Umea University,
186*>      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
187*>      To appear in Numerical Algorithms, 1996.
188*> \n
189*>  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
190*>      for Solving the Generalized Sylvester Equation and Estimating the
191*>      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
192*>      Department of Computing Science, Umea University, S-901 87 Umea,
193*>      Sweden, December 1993, Revised April 1994, Also as LAPACK working
194*>      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
195*>      1996.
196*>
197*  =====================================================================
198      SUBROUTINE CTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
199     $                   LDZ, IFST, ILST, INFO )
200*
201*  -- LAPACK computational routine --
202*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
203*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
204*
205*     .. Scalar Arguments ..
206      LOGICAL            WANTQ, WANTZ
207      INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
208*     ..
209*     .. Array Arguments ..
210      COMPLEX            A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
211     $                   Z( LDZ, * )
212*     ..
213*
214*  =====================================================================
215*
216*     .. Local Scalars ..
217      INTEGER            HERE
218*     ..
219*     .. External Subroutines ..
220      EXTERNAL           CTGEX2, XERBLA
221*     ..
222*     .. Intrinsic Functions ..
223      INTRINSIC          MAX
224*     ..
225*     .. Executable Statements ..
226*
227*     Decode and test input arguments.
228      INFO = 0
229      IF( N.LT.0 ) THEN
230         INFO = -3
231      ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
232         INFO = -5
233      ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
234         INFO = -7
235      ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
236         INFO = -9
237      ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
238         INFO = -11
239      ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
240         INFO = -12
241      ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
242         INFO = -13
243      END IF
244      IF( INFO.NE.0 ) THEN
245         CALL XERBLA( 'CTGEXC', -INFO )
246         RETURN
247      END IF
248*
249*     Quick return if possible
250*
251      IF( N.LE.1 )
252     $   RETURN
253      IF( IFST.EQ.ILST )
254     $   RETURN
255*
256      IF( IFST.LT.ILST ) THEN
257*
258         HERE = IFST
259*
260   10    CONTINUE
261*
262*        Swap with next one below
263*
264         CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
265     $                HERE, INFO )
266         IF( INFO.NE.0 ) THEN
267            ILST = HERE
268            RETURN
269         END IF
270         HERE = HERE + 1
271         IF( HERE.LT.ILST )
272     $      GO TO 10
273         HERE = HERE - 1
274      ELSE
275         HERE = IFST - 1
276*
277   20    CONTINUE
278*
279*        Swap with next one above
280*
281         CALL CTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
282     $                HERE, INFO )
283         IF( INFO.NE.0 ) THEN
284            ILST = HERE
285            RETURN
286         END IF
287         HERE = HERE - 1
288         IF( HERE.GE.ILST )
289     $      GO TO 20
290         HERE = HERE + 1
291      END IF
292      ILST = HERE
293      RETURN
294*
295*     End of CTGEXC
296*
297      END
298