|
2329
|
1 SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO ) |
|
|
2 * |
|
3333
|
3 * -- LAPACK routine (version 3.0) -- |
|
2329
|
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
|
|
5 * Courant Institute, Argonne National Lab, and Rice University |
|
|
6 * March 31, 1993 |
|
|
7 * |
|
|
8 * .. Scalar Arguments .. |
|
|
9 CHARACTER COMPQ |
|
|
10 INTEGER IFST, ILST, INFO, LDQ, LDT, N |
|
|
11 * .. |
|
|
12 * .. Array Arguments .. |
|
|
13 COMPLEX*16 Q( LDQ, * ), T( LDT, * ) |
|
|
14 * .. |
|
|
15 * |
|
|
16 * Purpose |
|
|
17 * ======= |
|
|
18 * |
|
|
19 * ZTREXC reorders the Schur factorization of a complex matrix |
|
|
20 * A = Q*T*Q**H, so that the diagonal element of T with row index IFST |
|
|
21 * is moved to row ILST. |
|
|
22 * |
|
|
23 * The Schur form T is reordered by a unitary similarity transformation |
|
|
24 * Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by |
|
|
25 * postmultplying it with Z. |
|
|
26 * |
|
|
27 * Arguments |
|
|
28 * ========= |
|
|
29 * |
|
|
30 * COMPQ (input) CHARACTER*1 |
|
|
31 * = 'V': update the matrix Q of Schur vectors; |
|
|
32 * = 'N': do not update Q. |
|
|
33 * |
|
|
34 * N (input) INTEGER |
|
|
35 * The order of the matrix T. N >= 0. |
|
|
36 * |
|
|
37 * T (input/output) COMPLEX*16 array, dimension (LDT,N) |
|
|
38 * On entry, the upper triangular matrix T. |
|
|
39 * On exit, the reordered upper triangular matrix. |
|
|
40 * |
|
|
41 * LDT (input) INTEGER |
|
|
42 * The leading dimension of the array T. LDT >= max(1,N). |
|
|
43 * |
|
|
44 * Q (input/output) COMPLEX*16 array, dimension (LDQ,N) |
|
|
45 * On entry, if COMPQ = 'V', the matrix Q of Schur vectors. |
|
|
46 * On exit, if COMPQ = 'V', Q has been postmultiplied by the |
|
|
47 * unitary transformation matrix Z which reorders T. |
|
|
48 * If COMPQ = 'N', Q is not referenced. |
|
|
49 * |
|
|
50 * LDQ (input) INTEGER |
|
|
51 * The leading dimension of the array Q. LDQ >= max(1,N). |
|
|
52 * |
|
|
53 * IFST (input) INTEGER |
|
|
54 * ILST (input) INTEGER |
|
|
55 * Specify the reordering of the diagonal elements of T: |
|
|
56 * The element with row index IFST is moved to row ILST by a |
|
|
57 * sequence of transpositions between adjacent elements. |
|
|
58 * 1 <= IFST <= N; 1 <= ILST <= N. |
|
|
59 * |
|
|
60 * INFO (output) INTEGER |
|
|
61 * = 0: successful exit |
|
|
62 * < 0: if INFO = -i, the i-th argument had an illegal value |
|
|
63 * |
|
|
64 * ===================================================================== |
|
|
65 * |
|
|
66 * .. Local Scalars .. |
|
|
67 LOGICAL WANTQ |
|
|
68 INTEGER K, M1, M2, M3 |
|
|
69 DOUBLE PRECISION CS |
|
|
70 COMPLEX*16 SN, T11, T22, TEMP |
|
|
71 * .. |
|
|
72 * .. External Functions .. |
|
|
73 LOGICAL LSAME |
|
|
74 EXTERNAL LSAME |
|
|
75 * .. |
|
|
76 * .. External Subroutines .. |
|
|
77 EXTERNAL XERBLA, ZLARTG, ZROT |
|
|
78 * .. |
|
|
79 * .. Intrinsic Functions .. |
|
|
80 INTRINSIC DCONJG, MAX |
|
|
81 * .. |
|
|
82 * .. Executable Statements .. |
|
|
83 * |
|
|
84 * Decode and test the input parameters. |
|
|
85 * |
|
|
86 INFO = 0 |
|
|
87 WANTQ = LSAME( COMPQ, 'V' ) |
|
|
88 IF( .NOT.LSAME( COMPQ, 'N' ) .AND. .NOT.WANTQ ) THEN |
|
|
89 INFO = -1 |
|
|
90 ELSE IF( N.LT.0 ) THEN |
|
|
91 INFO = -2 |
|
|
92 ELSE IF( LDT.LT.MAX( 1, N ) ) THEN |
|
|
93 INFO = -4 |
|
|
94 ELSE IF( LDQ.LT.1 .OR. ( WANTQ .AND. LDQ.LT.MAX( 1, N ) ) ) THEN |
|
|
95 INFO = -6 |
|
|
96 ELSE IF( IFST.LT.1 .OR. IFST.GT.N ) THEN |
|
|
97 INFO = -7 |
|
|
98 ELSE IF( ILST.LT.1 .OR. ILST.GT.N ) THEN |
|
|
99 INFO = -8 |
|
|
100 END IF |
|
|
101 IF( INFO.NE.0 ) THEN |
|
|
102 CALL XERBLA( 'ZTREXC', -INFO ) |
|
|
103 RETURN |
|
|
104 END IF |
|
|
105 * |
|
|
106 * Quick return if possible |
|
|
107 * |
|
|
108 IF( N.EQ.1 .OR. IFST.EQ.ILST ) |
|
|
109 $ RETURN |
|
|
110 * |
|
|
111 IF( IFST.LT.ILST ) THEN |
|
|
112 * |
|
|
113 * Move the IFST-th diagonal element forward down the diagonal. |
|
|
114 * |
|
|
115 M1 = 0 |
|
|
116 M2 = -1 |
|
|
117 M3 = 1 |
|
|
118 ELSE |
|
|
119 * |
|
|
120 * Move the IFST-th diagonal element backward up the diagonal. |
|
|
121 * |
|
|
122 M1 = -1 |
|
|
123 M2 = 0 |
|
|
124 M3 = -1 |
|
|
125 END IF |
|
|
126 * |
|
|
127 DO 10 K = IFST + M1, ILST + M2, M3 |
|
|
128 * |
|
|
129 * Interchange the k-th and (k+1)-th diagonal elements. |
|
|
130 * |
|
|
131 T11 = T( K, K ) |
|
|
132 T22 = T( K+1, K+1 ) |
|
|
133 * |
|
|
134 * Determine the transformation to perform the interchange. |
|
|
135 * |
|
|
136 CALL ZLARTG( T( K, K+1 ), T22-T11, CS, SN, TEMP ) |
|
|
137 * |
|
|
138 * Apply transformation to the matrix T. |
|
|
139 * |
|
|
140 IF( K+2.LE.N ) |
|
|
141 $ CALL ZROT( N-K-1, T( K, K+2 ), LDT, T( K+1, K+2 ), LDT, CS, |
|
|
142 $ SN ) |
|
|
143 CALL ZROT( K-1, T( 1, K ), 1, T( 1, K+1 ), 1, CS, |
|
|
144 $ DCONJG( SN ) ) |
|
|
145 * |
|
|
146 T( K, K ) = T22 |
|
|
147 T( K+1, K+1 ) = T11 |
|
|
148 * |
|
|
149 IF( WANTQ ) THEN |
|
|
150 * |
|
|
151 * Accumulate transformation in the matrix Q. |
|
|
152 * |
|
|
153 CALL ZROT( N, Q( 1, K ), 1, Q( 1, K+1 ), 1, CS, |
|
|
154 $ DCONJG( SN ) ) |
|
|
155 END IF |
|
|
156 * |
|
|
157 10 CONTINUE |
|
|
158 * |
|
|
159 RETURN |
|
|
160 * |
|
|
161 * End of ZTREXC |
|
|
162 * |
|
|
163 END |
