LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
ctrexc.f
Go to the documentation of this file.
1 *> \brief \b CTREXC
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download CTREXC + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ctrexc.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ctrexc.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ctrexc.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CTREXC( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
22 *
23 * .. Scalar Arguments ..
24 * CHARACTER COMPQ
25 * INTEGER IFST, ILST, INFO, LDQ, LDT, N
26 * ..
27 * .. Array Arguments ..
28 * COMPLEX Q( LDQ, * ), T( LDT, * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> CTREXC reorders the Schur factorization of a complex matrix
38 *> A = Q*T*Q**H, so that the diagonal element of T with row index IFST
39 *> is moved to row ILST.
40 *>
41 *> The Schur form T is reordered by a unitary similarity transformation
42 *> Z**H*T*Z, and optionally the matrix Q of Schur vectors is updated by
43 *> postmultplying it with Z.
44 *> \endverbatim
45 *
46 * Arguments:
47 * ==========
48 *
49 *> \param[in] COMPQ
50 *> \verbatim
51 *> COMPQ is CHARACTER*1
52 *> = 'V': update the matrix Q of Schur vectors;
53 *> = 'N': do not update Q.
54 *> \endverbatim
55 *>
56 *> \param[in] N
57 *> \verbatim
58 *> N is INTEGER
59 *> The order of the matrix T. N >= 0.
60 *> \endverbatim
61 *>
62 *> \param[in,out] T
63 *> \verbatim
64 *> T is COMPLEX array, dimension (LDT,N)
65 *> On entry, the upper triangular matrix T.
66 *> On exit, the reordered upper triangular matrix.
67 *> \endverbatim
68 *>
69 *> \param[in] LDT
70 *> \verbatim
71 *> LDT is INTEGER
72 *> The leading dimension of the array T. LDT >= max(1,N).
73 *> \endverbatim
74 *>
75 *> \param[in,out] Q
76 *> \verbatim
77 *> Q is COMPLEX array, dimension (LDQ,N)
78 *> On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
79 *> On exit, if COMPQ = 'V', Q has been postmultiplied by the
80 *> unitary transformation matrix Z which reorders T.
81 *> If COMPQ = 'N', Q is not referenced.
82 *> \endverbatim
83 *>
84 *> \param[in] LDQ
85 *> \verbatim
86 *> LDQ is INTEGER
87 *> The leading dimension of the array Q. LDQ >= max(1,N).
88 *> \endverbatim
89 *>
90 *> \param[in] IFST
91 *> \verbatim
92 *> IFST is INTEGER
93 *> \endverbatim
94 *>
95 *> \param[in] ILST
96 *> \verbatim
97 *> ILST is INTEGER
98 *>
99 *> Specify the reordering of the diagonal elements of T:
100 *> The element with row index IFST is moved to row ILST by a
101 *> sequence of transpositions between adjacent elements.
102 *> 1 <= IFST <= N; 1 <= ILST <= N.
103 *> \endverbatim
104 *>
105 *> \param[out] INFO
106 *> \verbatim
107 *> INFO is INTEGER
108 *> = 0: successful exit
109 *> < 0: if INFO = -i, the i-th argument had an illegal value
110 *> \endverbatim
111 *
112 * Authors:
113 * ========
114 *
115 *> \author Univ. of Tennessee
116 *> \author Univ. of California Berkeley
117 *> \author Univ. of Colorado Denver
118 *> \author NAG Ltd.
119 *
120 *> \date November 2011
121 *
122 *> \ingroup complexOTHERcomputational
123 *
124 * =====================================================================
125  SUBROUTINE ctrexc( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
126 *
127 * -- LAPACK computational routine (version 3.4.0) --
128 * -- LAPACK is a software package provided by Univ. of Tennessee, --
129 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
130 * November 2011
131 *
132 * .. Scalar Arguments ..
133  CHARACTER compq
134  INTEGER ifst, ilst, info, ldq, ldt, n
135 * ..
136 * .. Array Arguments ..
137  COMPLEX q( ldq, * ), t( ldt, * )
138 * ..
139 *
140 * =====================================================================
141 *
142 * .. Local Scalars ..
143  LOGICAL wantq
144  INTEGER k, m1, m2, m3
145  REAL cs
146  COMPLEX sn, t11, t22, temp
147 * ..
148 * .. External Functions ..
149  LOGICAL lsame
150  EXTERNAL lsame
151 * ..
152 * .. External Subroutines ..
153  EXTERNAL clartg, crot, xerbla
154 * ..
155 * .. Intrinsic Functions ..
156  INTRINSIC conjg, max
157 * ..
158 * .. Executable Statements ..
159 *
160 * Decode and test the input parameters.
161 *
162  info = 0
163  wantq = lsame( compq, 'V' )
164  IF( .NOT.lsame( compq, 'N' ) .AND. .NOT.wantq ) THEN
165  info = -1
166  ELSE IF( n.LT.0 ) THEN
167  info = -2
168  ELSE IF( ldt.LT.max( 1, n ) ) THEN
169  info = -4
170  ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.max( 1, n ) ) ) THEN
171  info = -6
172  ELSE IF( ifst.LT.1 .OR. ifst.GT.n ) THEN
173  info = -7
174  ELSE IF( ilst.LT.1 .OR. ilst.GT.n ) THEN
175  info = -8
176  END IF
177  IF( info.NE.0 ) THEN
178  CALL xerbla( 'CTREXC', -info )
179  return
180  END IF
181 *
182 * Quick return if possible
183 *
184  IF( n.EQ.1 .OR. ifst.EQ.ilst )
185  $ return
186 *
187  IF( ifst.LT.ilst ) THEN
188 *
189 * Move the IFST-th diagonal element forward down the diagonal.
190 *
191  m1 = 0
192  m2 = -1
193  m3 = 1
194  ELSE
195 *
196 * Move the IFST-th diagonal element backward up the diagonal.
197 *
198  m1 = -1
199  m2 = 0
200  m3 = -1
201  END IF
202 *
203  DO 10 k = ifst + m1, ilst + m2, m3
204 *
205 * Interchange the k-th and (k+1)-th diagonal elements.
206 *
207  t11 = t( k, k )
208  t22 = t( k+1, k+1 )
209 *
210 * Determine the transformation to perform the interchange.
211 *
212  CALL clartg( t( k, k+1 ), t22-t11, cs, sn, temp )
213 *
214 * Apply transformation to the matrix T.
215 *
216  IF( k+2.LE.n )
217  $ CALL crot( n-k-1, t( k, k+2 ), ldt, t( k+1, k+2 ), ldt, cs,
218  $ sn )
219  CALL crot( k-1, t( 1, k ), 1, t( 1, k+1 ), 1, cs, conjg( sn ) )
220 *
221  t( k, k ) = t22
222  t( k+1, k+1 ) = t11
223 *
224  IF( wantq ) THEN
225 *
226 * Accumulate transformation in the matrix Q.
227 *
228  CALL crot( n, q( 1, k ), 1, q( 1, k+1 ), 1, cs,
229  $ conjg( sn ) )
230  END IF
231 *
232  10 continue
233 *
234  return
235 *
236 * End of CTREXC
237 *
238  END