LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
ztgexc.f
Go to the documentation of this file.
1 *> \brief \b ZTGEXC
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download ZTGEXC + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztgexc.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztgexc.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztgexc.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZTGEXC( 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*16 A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
30 * $ Z( LDZ, * )
31 * ..
32 *
33 *
34 *> \par Purpose:
35 * =============
36 *>
37 *> \verbatim
38 *>
39 *> ZTGEXC 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*16 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*16 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*16 array, dimension (LDZ,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*16 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 *> \date November 2011
167 *
168 *> \ingroup complex16GEcomputational
169 *
170 *> \par Contributors:
171 * ==================
172 *>
173 *> Bo Kagstrom and Peter Poromaa, Department of Computing Science,
174 *> Umea University, S-901 87 Umea, Sweden.
175 *
176 *> \par References:
177 * ================
178 *>
179 *> [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
180 *> Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
181 *> M.S. Moonen et al (eds), Linear Algebra for Large Scale and
182 *> Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
183 *> \n
184 *> [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
185 *> Eigenvalues of a Regular Matrix Pair (A, B) and Condition
186 *> Estimation: Theory, Algorithms and Software, Report
187 *> UMINF - 94.04, Department of Computing Science, Umea University,
188 *> S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
189 *> To appear in Numerical Algorithms, 1996.
190 *> \n
191 *> [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
192 *> for Solving the Generalized Sylvester Equation and Estimating the
193 *> Separation between Regular Matrix Pairs, Report UMINF - 93.23,
194 *> Department of Computing Science, Umea University, S-901 87 Umea,
195 *> Sweden, December 1993, Revised April 1994, Also as LAPACK working
196 *> Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
197 *> 1996.
198 *>
199 * =====================================================================
200  SUBROUTINE ztgexc( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
201  $ ldz, ifst, ilst, info )
202 *
203 * -- LAPACK computational routine (version 3.4.0) --
204 * -- LAPACK is a software package provided by Univ. of Tennessee, --
205 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
206 * November 2011
207 *
208 * .. Scalar Arguments ..
209  LOGICAL wantq, wantz
210  INTEGER ifst, ilst, info, lda, ldb, ldq, ldz, n
211 * ..
212 * .. Array Arguments ..
213  COMPLEX*16 a( lda, * ), b( ldb, * ), q( ldq, * ),
214  $ z( ldz, * )
215 * ..
216 *
217 * =====================================================================
218 *
219 * .. Local Scalars ..
220  INTEGER here
221 * ..
222 * .. External Subroutines ..
223  EXTERNAL xerbla, ztgex2
224 * ..
225 * .. Intrinsic Functions ..
226  INTRINSIC max
227 * ..
228 * .. Executable Statements ..
229 *
230 * Decode and test input arguments.
231  info = 0
232  IF( n.LT.0 ) THEN
233  info = -3
234  ELSE IF( lda.LT.max( 1, n ) ) THEN
235  info = -5
236  ELSE IF( ldb.LT.max( 1, n ) ) THEN
237  info = -7
238  ELSE IF( ldq.LT.1 .OR. wantq .AND. ( ldq.LT.max( 1, n ) ) ) THEN
239  info = -9
240  ELSE IF( ldz.LT.1 .OR. wantz .AND. ( ldz.LT.max( 1, n ) ) ) THEN
241  info = -11
242  ELSE IF( ifst.LT.1 .OR. ifst.GT.n ) THEN
243  info = -12
244  ELSE IF( ilst.LT.1 .OR. ilst.GT.n ) THEN
245  info = -13
246  END IF
247  IF( info.NE.0 ) THEN
248  CALL xerbla( 'ZTGEXC', -info )
249  return
250  END IF
251 *
252 * Quick return if possible
253 *
254  IF( n.LE.1 )
255  $ return
256  IF( ifst.EQ.ilst )
257  $ return
258 *
259  IF( ifst.LT.ilst ) THEN
260 *
261  here = ifst
262 *
263  10 continue
264 *
265 * Swap with next one below
266 *
267  CALL ztgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz,
268  $ here, info )
269  IF( info.NE.0 ) THEN
270  ilst = here
271  return
272  END IF
273  here = here + 1
274  IF( here.LT.ilst )
275  $ go to 10
276  here = here - 1
277  ELSE
278  here = ifst - 1
279 *
280  20 continue
281 *
282 * Swap with next one above
283 *
284  CALL ztgex2( wantq, wantz, n, a, lda, b, ldb, q, ldq, z, ldz,
285  $ here, info )
286  IF( info.NE.0 ) THEN
287  ilst = here
288  return
289  END IF
290  here = here - 1
291  IF( here.GE.ilst )
292  $ go to 20
293  here = here + 1
294  END IF
295  ilst = here
296  return
297 *
298 * End of ZTGEXC
299 *
300  END