00001 SUBROUTINE ZTGEXC( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, 00002 $ LDZ, IFST, ILST, INFO ) 00003 * 00004 * -- LAPACK routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 LOGICAL WANTQ, WANTZ 00011 INTEGER IFST, ILST, INFO, LDA, LDB, LDQ, LDZ, N 00012 * .. 00013 * .. Array Arguments .. 00014 COMPLEX*16 A( LDA, * ), B( LDB, * ), Q( LDQ, * ), 00015 $ Z( LDZ, * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * ZTGEXC reorders the generalized Schur decomposition of a complex 00022 * matrix pair (A,B), using an unitary equivalence transformation 00023 * (A, B) := Q * (A, B) * Z', so that the diagonal block of (A, B) with 00024 * row index IFST is moved to row ILST. 00025 * 00026 * (A, B) must be in generalized Schur canonical form, that is, A and 00027 * B are both upper triangular. 00028 * 00029 * Optionally, the matrices Q and Z of generalized Schur vectors are 00030 * updated. 00031 * 00032 * Q(in) * A(in) * Z(in)' = Q(out) * A(out) * Z(out)' 00033 * Q(in) * B(in) * Z(in)' = Q(out) * B(out) * Z(out)' 00034 * 00035 * Arguments 00036 * ========= 00037 * 00038 * WANTQ (input) LOGICAL 00039 * .TRUE. : update the left transformation matrix Q; 00040 * .FALSE.: do not update Q. 00041 * 00042 * WANTZ (input) LOGICAL 00043 * .TRUE. : update the right transformation matrix Z; 00044 * .FALSE.: do not update Z. 00045 * 00046 * N (input) INTEGER 00047 * The order of the matrices A and B. N >= 0. 00048 * 00049 * A (input/output) COMPLEX*16 array, dimension (LDA,N) 00050 * On entry, the upper triangular matrix A in the pair (A, B). 00051 * On exit, the updated matrix A. 00052 * 00053 * LDA (input) INTEGER 00054 * The leading dimension of the array A. LDA >= max(1,N). 00055 * 00056 * B (input/output) COMPLEX*16 array, dimension (LDB,N) 00057 * On entry, the upper triangular matrix B in the pair (A, B). 00058 * On exit, the updated matrix B. 00059 * 00060 * LDB (input) INTEGER 00061 * The leading dimension of the array B. LDB >= max(1,N). 00062 * 00063 * Q (input/output) COMPLEX*16 array, dimension (LDZ,N) 00064 * On entry, if WANTQ = .TRUE., the unitary matrix Q. 00065 * On exit, the updated matrix Q. 00066 * If WANTQ = .FALSE., Q is not referenced. 00067 * 00068 * LDQ (input) INTEGER 00069 * The leading dimension of the array Q. LDQ >= 1; 00070 * If WANTQ = .TRUE., LDQ >= N. 00071 * 00072 * Z (input/output) COMPLEX*16 array, dimension (LDZ,N) 00073 * On entry, if WANTZ = .TRUE., the unitary matrix Z. 00074 * On exit, the updated matrix Z. 00075 * If WANTZ = .FALSE., Z is not referenced. 00076 * 00077 * LDZ (input) INTEGER 00078 * The leading dimension of the array Z. LDZ >= 1; 00079 * If WANTZ = .TRUE., LDZ >= N. 00080 * 00081 * IFST (input) INTEGER 00082 * ILST (input/output) INTEGER 00083 * Specify the reordering of the diagonal blocks of (A, B). 00084 * The block with row index IFST is moved to row ILST, by a 00085 * sequence of swapping between adjacent blocks. 00086 * 00087 * INFO (output) INTEGER 00088 * =0: Successful exit. 00089 * <0: if INFO = -i, the i-th argument had an illegal value. 00090 * =1: The transformed matrix pair (A, B) would be too far 00091 * from generalized Schur form; the problem is ill- 00092 * conditioned. (A, B) may have been partially reordered, 00093 * and ILST points to the first row of the current 00094 * position of the block being moved. 00095 * 00096 * 00097 * Further Details 00098 * =============== 00099 * 00100 * Based on contributions by 00101 * Bo Kagstrom and Peter Poromaa, Department of Computing Science, 00102 * Umea University, S-901 87 Umea, Sweden. 00103 * 00104 * [1] B. Kagstrom; A Direct Method for Reordering Eigenvalues in the 00105 * Generalized Real Schur Form of a Regular Matrix Pair (A, B), in 00106 * M.S. Moonen et al (eds), Linear Algebra for Large Scale and 00107 * Real-Time Applications, Kluwer Academic Publ. 1993, pp 195-218. 00108 * 00109 * [2] B. Kagstrom and P. Poromaa; Computing Eigenspaces with Specified 00110 * Eigenvalues of a Regular Matrix Pair (A, B) and Condition 00111 * Estimation: Theory, Algorithms and Software, Report 00112 * UMINF - 94.04, Department of Computing Science, Umea University, 00113 * S-901 87 Umea, Sweden, 1994. Also as LAPACK Working Note 87. 00114 * To appear in Numerical Algorithms, 1996. 00115 * 00116 * [3] B. Kagstrom and P. Poromaa, LAPACK-Style Algorithms and Software 00117 * for Solving the Generalized Sylvester Equation and Estimating the 00118 * Separation between Regular Matrix Pairs, Report UMINF - 93.23, 00119 * Department of Computing Science, Umea University, S-901 87 Umea, 00120 * Sweden, December 1993, Revised April 1994, Also as LAPACK working 00121 * Note 75. To appear in ACM Trans. on Math. Software, Vol 22, No 1, 00122 * 1996. 00123 * 00124 * ===================================================================== 00125 * 00126 * .. Local Scalars .. 00127 INTEGER HERE 00128 * .. 00129 * .. External Subroutines .. 00130 EXTERNAL XERBLA, ZTGEX2 00131 * .. 00132 * .. Intrinsic Functions .. 00133 INTRINSIC MAX 00134 * .. 00135 * .. Executable Statements .. 00136 * 00137 * Decode and test input arguments. 00138 INFO = 0 00139 IF( N.LT.0 ) THEN 00140 INFO = -3 00141 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00142 INFO = -5 00143 ELSE IF( LDB.LT.MAX( 1, N ) ) THEN 00144 INFO = -7 00145 ELSE IF( LDQ.LT.1 .OR. WANTQ .AND. ( LDQ.LT.MAX( 1, N ) ) ) THEN 00146 INFO = -9 00147 ELSE IF( LDZ.LT.1 .OR. WANTZ .AND. ( LDZ.LT.MAX( 1, N ) ) ) THEN 00148 INFO = -11 00149 ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN 00150 INFO = -12 00151 ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN 00152 INFO = -13 00153 END IF 00154 IF( INFO.NE.0 ) THEN 00155 CALL XERBLA( 'ZTGEXC', -INFO ) 00156 RETURN 00157 END IF 00158 * 00159 * Quick return if possible 00160 * 00161 IF( N.LE.1 ) 00162 $ RETURN 00163 IF( IFST.EQ.ILST ) 00164 $ RETURN 00165 * 00166 IF( IFST.LT.ILST ) THEN 00167 * 00168 HERE = IFST 00169 * 00170 10 CONTINUE 00171 * 00172 * Swap with next one below 00173 * 00174 CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, 00175 $ HERE, INFO ) 00176 IF( INFO.NE.0 ) THEN 00177 ILST = HERE 00178 RETURN 00179 END IF 00180 HERE = HERE + 1 00181 IF( HERE.LT.ILST ) 00182 $ GO TO 10 00183 HERE = HERE - 1 00184 ELSE 00185 HERE = IFST - 1 00186 * 00187 20 CONTINUE 00188 * 00189 * Swap with next one above 00190 * 00191 CALL ZTGEX2( WANTQ, WANTZ, N, A, LDA, B, LDB, Q, LDQ, Z, LDZ, 00192 $ HERE, INFO ) 00193 IF( INFO.NE.0 ) THEN 00194 ILST = HERE 00195 RETURN 00196 END IF 00197 HERE = HERE - 1 00198 IF( HERE.GE.ILST ) 00199 $ GO TO 20 00200 HERE = HERE + 1 00201 END IF 00202 ILST = HERE 00203 RETURN 00204 * 00205 * End of ZTGEXC 00206 * 00207 END
1.7.2