1 SUBROUTINE ZTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
2 *
3 * -- LAPACK routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
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
2 *
3 * -- LAPACK routine (version 3.2) --
4 * -- LAPACK is a software package provided by Univ. of Tennessee, --
5 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6 * November 2006
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