LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 *> If N == 0 arguments ILST and IFST may be any value.
61 *> \endverbatim
62 *>
63 *> \param[in,out] T
64 *> \verbatim
65 *> T is COMPLEX array, dimension (LDT,N)
66 *> On entry, the upper triangular matrix T.
67 *> On exit, the reordered upper triangular matrix.
68 *> \endverbatim
69 *>
70 *> \param[in] LDT
71 *> \verbatim
72 *> LDT is INTEGER
73 *> The leading dimension of the array T. LDT >= max(1,N).
74 *> \endverbatim
75 *>
76 *> \param[in,out] Q
77 *> \verbatim
78 *> Q is COMPLEX array, dimension (LDQ,N)
79 *> On entry, if COMPQ = 'V', the matrix Q of Schur vectors.
80 *> On exit, if COMPQ = 'V', Q has been postmultiplied by the
81 *> unitary transformation matrix Z which reorders T.
82 *> If COMPQ = 'N', Q is not referenced.
83 *> \endverbatim
84 *>
85 *> \param[in] LDQ
86 *> \verbatim
87 *> LDQ is INTEGER
88 *> The leading dimension of the array Q. LDQ >= 1, and if
89 *> COMPQ = 'V', LDQ >= max(1,N).
90 *> \endverbatim
91 *>
92 *> \param[in] IFST
93 *> \verbatim
94 *> IFST is INTEGER
95 *> \endverbatim
96 *>
97 *> \param[in] ILST
98 *> \verbatim
99 *> ILST is INTEGER
100 *>
101 *> Specify the reordering of the diagonal elements of T:
102 *> The element with row index IFST is moved to row ILST by a
103 *> sequence of transpositions between adjacent elements.
104 *> 1 <= IFST <= N; 1 <= ILST <= N.
105 *> \endverbatim
106 *>
107 *> \param[out] INFO
108 *> \verbatim
109 *> INFO is INTEGER
110 *> = 0: successful exit
111 *> < 0: if INFO = -i, the i-th argument had an illegal value
112 *> \endverbatim
113 *
114 * Authors:
115 * ========
116 *
117 *> \author Univ. of Tennessee
118 *> \author Univ. of California Berkeley
119 *> \author Univ. of Colorado Denver
120 *> \author NAG Ltd.
121 *
122 *> \ingroup complexOTHERcomputational
123 *
124 * =====================================================================
125  SUBROUTINE ctrexc( COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO )
126 *
127 * -- LAPACK computational routine --
128 * -- LAPACK is a software package provided by Univ. of Tennessee, --
129 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
130 *
131 * .. Scalar Arguments ..
132  CHARACTER COMPQ
133  INTEGER IFST, ILST, INFO, LDQ, LDT, N
134 * ..
135 * .. Array Arguments ..
136  COMPLEX Q( LDQ, * ), T( LDT, * )
137 * ..
138 *
139 * =====================================================================
140 *
141 * .. Local Scalars ..
142  LOGICAL WANTQ
143  INTEGER K, M1, M2, M3
144  REAL CS
145  COMPLEX SN, T11, T22, TEMP
146 * ..
147 * .. External Functions ..
148  LOGICAL LSAME
149  EXTERNAL lsame
150 * ..
151 * .. External Subroutines ..
152  EXTERNAL clartg, crot, xerbla
153 * ..
154 * .. Intrinsic Functions ..
155  INTRINSIC conjg, max
156 * ..
157 * .. Executable Statements ..
158 *
159 * Decode and test the input parameters.
160 *
161  info = 0
162  wantq = lsame( compq, 'V' )
163  IF( .NOT.lsame( compq, 'N' ) .AND. .NOT.wantq ) THEN
164  info = -1
165  ELSE IF( n.LT.0 ) THEN
166  info = -2
167  ELSE IF( ldt.LT.max( 1, n ) ) THEN
168  info = -4
169  ELSE IF( ldq.LT.1 .OR. ( wantq .AND. ldq.LT.max( 1, n ) ) ) THEN
170  info = -6
171  ELSE IF(( ifst.LT.1 .OR. ifst.GT.n ).AND.( n.GT.0 )) THEN
172  info = -7
173  ELSE IF(( ilst.LT.1 .OR. ilst.GT.n ).AND.( n.GT.0 )) THEN
174  info = -8
175  END IF
176  IF( info.NE.0 ) THEN
177  CALL xerbla( 'CTREXC', -info )
178  RETURN
179  END IF
180 *
181 * Quick return if possible
182 *
183  IF( n.LE.1 .OR. ifst.EQ.ilst )
184  $ RETURN
185 *
186  IF( ifst.LT.ilst ) THEN
187 *
188 * Move the IFST-th diagonal element forward down the diagonal.
189 *
190  m1 = 0
191  m2 = -1
192  m3 = 1
193  ELSE
194 *
195 * Move the IFST-th diagonal element backward up the diagonal.
196 *
197  m1 = -1
198  m2 = 0
199  m3 = -1
200  END IF
201 *
202  DO 10 k = ifst + m1, ilst + m2, m3
203 *
204 * Interchange the k-th and (k+1)-th diagonal elements.
205 *
206  t11 = t( k, k )
207  t22 = t( k+1, k+1 )
208 *
209 * Determine the transformation to perform the interchange.
210 *
211  CALL clartg( t( k, k+1 ), t22-t11, cs, sn, temp )
212 *
213 * Apply transformation to the matrix T.
214 *
215  IF( k+2.LE.n )
216  $ CALL crot( n-k-1, t( k, k+2 ), ldt, t( k+1, k+2 ), ldt, cs,
217  $ sn )
218  CALL crot( k-1, t( 1, k ), 1, t( 1, k+1 ), 1, cs, conjg( sn ) )
219 *
220  t( k, k ) = t22
221  t( k+1, k+1 ) = t11
222 *
223  IF( wantq ) THEN
224 *
225 * Accumulate transformation in the matrix Q.
226 *
227  CALL crot( n, q( 1, k ), 1, q( 1, k+1 ), 1, cs,
228  $ conjg( sn ) )
229  END IF
230 *
231  10 CONTINUE
232 *
233  RETURN
234 *
235 * End of CTREXC
236 *
237  END
subroutine clartg(f, g, c, s, r)
CLARTG generates a plane rotation with real cosine and complex sine.
Definition: clartg.f90:118
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine crot(N, CX, INCX, CY, INCY, C, S)
CROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
Definition: crot.f:103
subroutine ctrexc(COMPQ, N, T, LDT, Q, LDQ, IFST, ILST, INFO)
CTREXC
Definition: ctrexc.f:126