001:       SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z,
002:      $                   LDZ, IFST, ILST, INFO )
003: *
004: *  -- LAPACK routine (version 3.2) --
005: *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
006: *     November 2006
007: *
008: *     .. Scalar Arguments ..
009:       LOGICAL            WANTQ, WANTZ
010:       INTEGER            IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N
011: *     ..
012: *     .. Array Arguments ..
013:       COMPLEX*16         A( LDA, * ), B( LDB, * ), Q( LDQ, * ),
014:      $                   Z( LDZ, * )
015: *     ..
016: *
017: *  Purpose
018: *  =======
019: *
020: *  ZTGEXC reorders the generalized Schur decomposition of a complex
021: *  matrix pair (A,B), using an unitary equivalence transformation
022: *  (A, B) := Q * (A, B) * Z', so that the diagonal block of (A, B) with
023: *  row index IFST is moved to row ILST.
024: *
025: *  (A, B) must be in generalized Schur canonical form, that is, A and
026: *  B are both upper triangular.
027: *
028: *  Optionally, the matrices Q and Z of generalized Schur vectors are
029: *  updated.
030: *
031: *         Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)'
032: *         Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)'
033: *
034: *  Arguments
035: *  =========
036: *
037: *  WANTQ   (input) LOGICAL
038: *          .TRUE. : update the left transformation matrix Q;
039: *          .FALSE.: do not update Q.
040: *
041: *  WANTZ   (input) LOGICAL
042: *          .TRUE. : update the right transformation matrix Z;
043: *          .FALSE.: do not update Z.
044: *
045: *  N       (input) INTEGER
046: *          The order of the matrices A and B. N >= 0.
047: *
048: *  A       (input/output) COMPLEX*16 array, dimension (LDA,N)
049: *          On entry, the upper triangular matrix A in the pair (A, B).
050: *          On exit, the updated matrix A.
051: *
052: *  LDA     (input)  INTEGER
053: *          The leading dimension of the array A. LDA >= max(1,N).
054: *
055: *  B       (input/output) COMPLEX*16 array, dimension (LDB,N)
056: *          On entry, the upper triangular matrix B in the pair (A, B).
057: *          On exit, the updated matrix B.
058: *
059: *  LDB     (input)  INTEGER
060: *          The leading dimension of the array B. LDB >= max(1,N).
061: *
062: *  Q       (input/output) COMPLEX*16 array, dimension (LDZ,N)
063: *          On entry, if WANTQ = .TRUE., the unitary matrix Q.
064: *          On exit, the updated matrix Q.
065: *          If WANTQ = .FALSE., Q is not referenced.
066: *
067: *  LDQ     (input) INTEGER
068: *          The leading dimension of the array Q. LDQ >= 1;
069: *          If WANTQ = .TRUE., LDQ >= N.
070: *
071: *  Z       (input/output) COMPLEX*16 array, dimension (LDZ,N)
072: *          On entry, if WANTZ = .TRUE., the unitary matrix Z.
073: *          On exit, the updated matrix Z.
074: *          If WANTZ = .FALSE., Z is not referenced.
075: *
076: *  LDZ     (input) INTEGER
077: *          The leading dimension of the array Z. LDZ >= 1;
078: *          If WANTZ = .TRUE., LDZ >= N.
079: *
080: *  IFST    (input) INTEGER
081: *  ILST    (input/output) INTEGER
082: *          Specify the reordering of the diagonal blocks of (A, B).
083: *          The block with row index IFST is moved to row ILST, by a
084: *          sequence of swapping between adjacent blocks.
085: *
086: *  INFO    (output) INTEGER
087: *           =0:  Successful exit.
088: *           <0:  if INFO = -i, the i-th argument had an illegal value.
089: *           =1:  The transformed matrix pair (A, B) would be too far
090: *                from generalized Schur form; the problem is ill-
091: *                conditioned. (A, B) may have been partially reordered,
092: *                and ILST points to the first row of the current
093: *                position of the block being moved.
094: *
095: *
096: *  Further Details
097: *  ===============
098: *
099: *  Based on contributions by
100: *     Bo Kagstrom and Peter Poromaa, Department of Computing Science,
101: *     Umea University, S-901 87 Umea, Sweden.
102: *
103: *  [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the
104: *      Generalized Real Schur Form of a Regular Matrix Pair (A, B), in
105: *      M.S. Moonen et al (eds), Linear Algebra for Large Scale and
106: *      Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218.
107: *
108: *  [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified
109: *      Eigenvalues of a Regular Matrix Pair (A, B) and Condition
110: *      Estimation: Theory, Algorithms and Software, Report
111: *      UMINF - 94.04, Department of Computing Science, Umea University,
112: *      S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87.
113: *      To appear in Numerical Algorithms, 1996.
114: *
115: *  [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software
116: *      for Solving the Generalized Sylvester Equation and Estimating the
117: *      Separation between Regular Matrix Pairs, Report UMINF - 93.23,
118: *      Department of Computing Science, Umea University, S-901 87 Umea,
119: *      Sweden, December 1993, Revised April 1994, Also as LAPACK working
120: *      Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1,
121: *      1996.
122: *
123: *  =====================================================================
124: *
125: *     .. Local Scalars ..
126:       INTEGER            HERE
127: *     ..
128: *     .. External Subroutines ..
129:       EXTERNAL           XERBLA, ZTGEX2
130: *     ..
131: *     .. Intrinsic Functions ..
132:       INTRINSIC          MAX
133: *     ..
134: *     .. Executable Statements ..
135: *
136: *     Decode and test input arguments.
137:       INFO = 0
138:       IF( N.LT.0 ) THEN
139:          INFO = -3
140:       ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
141:          INFO = -5
142:       ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
143:          INFO = -7
144:       ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN
145:          INFO = -9
146:       ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN
147:          INFO = -11
148:       ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN
149:          INFO = -12
150:       ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN
151:          INFO = -13
152:       END IF
153:       IF( INFO.NE.0 ) THEN
154:          CALL XERBLA( 'ZTGEXC', -INFO )
155:          RETURN
156:       END IF
157: *
158: *     Quick return if possible
159: *
160:       IF( N.LE.1 )
161:      $   RETURN
162:       IF( IFST.EQ.ILST )
163:      $   RETURN
164: *
165:       IF( IFST.LT.ILST ) THEN
166: *
167:          HERE = IFST
168: *
169:    10    CONTINUE
170: *
171: *        Swap with next one below
172: *
173:          CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
174:      $                HERE, INFO )
175:          IF( INFO.NE.0 ) THEN
176:             ILST = HERE
177:             RETURN
178:          END IF
179:          HERE = HERE + 1
180:          IF( HERE.LT.ILST )
181:      $      GO TO 10
182:          HERE = HERE - 1
183:       ELSE
184:          HERE = IFST - 1
185: *
186:    20    CONTINUE
187: *
188: *        Swap with next one above
189: *
190:          CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ,
191:      $                HERE, INFO )
192:          IF( INFO.NE.0 ) THEN
193:             ILST = HERE
194:             RETURN
195:          END IF
196:          HERE = HERE - 1
197:          IF( HERE.GE.ILST )
198:      $      GO TO 20
199:          HERE = HERE + 1
200:       END IF
201:       ILST = HERE
202:       RETURN
203: *
204: *     End of ZTGEXC
205: *
206:       END
207: