LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
ztrexc.f
Go to the documentation of this file.
1*> \brief \b ZTREXC
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> \htmlonly
9*> Download ZTREXC + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/ztrexc.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/ztrexc.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/ztrexc.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE ZTREXC( 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*16 Q( LDQ, * ), T( LDT, * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> ZTREXC 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*> postmultiplying 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*16 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*16 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 trexc
123*
124* =====================================================================
125 SUBROUTINE ztrexc( 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*16 Q( LDQ, * ), T( LDT, * )
137* ..
138*
139* =====================================================================
140*
141* .. Local Scalars ..
142 LOGICAL WANTQ
143 INTEGER K, M1, M2, M3
144 DOUBLE PRECISION CS
145 COMPLEX*16 SN, T11, T22, TEMP
146* ..
147* .. External Functions ..
148 LOGICAL LSAME
149 EXTERNAL lsame
150* ..
151* .. External Subroutines ..
152 EXTERNAL xerbla, zlartg, zrot
153* ..
154* .. Intrinsic Functions ..
155 INTRINSIC dconjg, 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( 'ZTREXC', -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 zlartg( 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 zrot( n-k-1, t( k, k+2 ), ldt, t( k+1, k+2 ), ldt, cs,
217 $ sn )
218 CALL zrot( k-1, t( 1, k ), 1, t( 1, k+1 ), 1, cs,
219 $ dconjg( 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 zrot( n, q( 1, k ), 1, q( 1, k+1 ), 1, cs,
229 $ dconjg( sn ) )
230 END IF
231*
232 10 CONTINUE
233*
234 RETURN
235*
236* End of ZTREXC
237*
238 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
subroutine zlartg(f, g, c, s, r)
ZLARTG generates a plane rotation with real cosine and complex sine.
Definition zlartg.f90:116
subroutine zrot(n, cx, incx, cy, incy, c, s)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
Definition zrot.f:103
subroutine ztrexc(compq, n, t, ldt, q, ldq, ifst, ilst, info)
ZTREXC
Definition ztrexc.f:126