LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
clatm6.f
Go to the documentation of this file.
1*> \brief \b CLATM6
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8* Definition:
9* ===========
10*
11* SUBROUTINE CLATM6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
12* BETA, WX, WY, S, DIF )
13*
14* .. Scalar Arguments ..
15* INTEGER LDA, LDX, LDY, N, TYPE
16* COMPLEX ALPHA, BETA, WX, WY
17* ..
18* .. Array Arguments ..
19* REAL DIF( * ), S( * )
20* COMPLEX A( LDA, * ), B( LDA, * ), X( LDX, * ),
21* $ Y( LDY, * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CLATM6 generates test matrices for the generalized eigenvalue
31*> problem, their corresponding right and left eigenvector matrices,
32*> and also reciprocal condition numbers for all eigenvalues and
33*> the reciprocal condition numbers of eigenvectors corresponding to
34*> the 1th and 5th eigenvalues.
35*>
36*> Test Matrices
37*> =============
38*>
39*> Two kinds of test matrix pairs
40*> (A, B) = inverse(YH) * (Da, Db) * inverse(X)
41*> are used in the tests:
42*>
43*> Type 1:
44*> Da = 1+a 0 0 0 0 Db = 1 0 0 0 0
45*> 0 2+a 0 0 0 0 1 0 0 0
46*> 0 0 3+a 0 0 0 0 1 0 0
47*> 0 0 0 4+a 0 0 0 0 1 0
48*> 0 0 0 0 5+a , 0 0 0 0 1
49*> and Type 2:
50*> Da = 1+i 0 0 0 0 Db = 1 0 0 0 0
51*> 0 1-i 0 0 0 0 1 0 0 0
52*> 0 0 1 0 0 0 0 1 0 0
53*> 0 0 0 (1+a)+(1+b)i 0 0 0 0 1 0
54*> 0 0 0 0 (1+a)-(1+b)i, 0 0 0 0 1 .
55*>
56*> In both cases the same inverse(YH) and inverse(X) are used to compute
57*> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
58*>
59*> YH: = 1 0 -y y -y X = 1 0 -x -x x
60*> 0 1 -y y -y 0 1 x -x -x
61*> 0 0 1 0 0 0 0 1 0 0
62*> 0 0 0 1 0 0 0 0 1 0
63*> 0 0 0 0 1, 0 0 0 0 1 , where
64*>
65*> a, b, x and y will have all values independently of each other.
66*> \endverbatim
67*
68* Arguments:
69* ==========
70*
71*> \param[in] TYPE
72*> \verbatim
73*> TYPE is INTEGER
74*> Specifies the problem type (see further details).
75*> \endverbatim
76*>
77*> \param[in] N
78*> \verbatim
79*> N is INTEGER
80*> Size of the matrices A and B.
81*> \endverbatim
82*>
83*> \param[out] A
84*> \verbatim
85*> A is COMPLEX array, dimension (LDA, N).
86*> On exit A N-by-N is initialized according to TYPE.
87*> \endverbatim
88*>
89*> \param[in] LDA
90*> \verbatim
91*> LDA is INTEGER
92*> The leading dimension of A and of B.
93*> \endverbatim
94*>
95*> \param[out] B
96*> \verbatim
97*> B is COMPLEX array, dimension (LDA, N).
98*> On exit B N-by-N is initialized according to TYPE.
99*> \endverbatim
100*>
101*> \param[out] X
102*> \verbatim
103*> X is COMPLEX array, dimension (LDX, N).
104*> On exit X is the N-by-N matrix of right eigenvectors.
105*> \endverbatim
106*>
107*> \param[in] LDX
108*> \verbatim
109*> LDX is INTEGER
110*> The leading dimension of X.
111*> \endverbatim
112*>
113*> \param[out] Y
114*> \verbatim
115*> Y is COMPLEX array, dimension (LDY, N).
116*> On exit Y is the N-by-N matrix of left eigenvectors.
117*> \endverbatim
118*>
119*> \param[in] LDY
120*> \verbatim
121*> LDY is INTEGER
122*> The leading dimension of Y.
123*> \endverbatim
124*>
125*> \param[in] ALPHA
126*> \verbatim
127*> ALPHA is COMPLEX
128*> \endverbatim
129*>
130*> \param[in] BETA
131*> \verbatim
132*> BETA is COMPLEX
133*>
134*> Weighting constants for matrix A.
135*> \endverbatim
136*>
137*> \param[in] WX
138*> \verbatim
139*> WX is COMPLEX
140*> Constant for right eigenvector matrix.
141*> \endverbatim
142*>
143*> \param[in] WY
144*> \verbatim
145*> WY is COMPLEX
146*> Constant for left eigenvector matrix.
147*> \endverbatim
148*>
149*> \param[out] S
150*> \verbatim
151*> S is REAL array, dimension (N)
152*> S(i) is the reciprocal condition number for eigenvalue i.
153*> \endverbatim
154*>
155*> \param[out] DIF
156*> \verbatim
157*> DIF is REAL array, dimension (N)
158*> DIF(i) is the reciprocal condition number for eigenvector i.
159*> \endverbatim
160*
161* Authors:
162* ========
163*
164*> \author Univ. of Tennessee
165*> \author Univ. of California Berkeley
166*> \author Univ. of Colorado Denver
167*> \author NAG Ltd.
168*
169*> \ingroup complex_matgen
170*
171* =====================================================================
172 SUBROUTINE clatm6( TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA,
173 $ BETA, WX, WY, S, DIF )
174*
175* -- LAPACK computational routine --
176* -- LAPACK is a software package provided by Univ. of Tennessee, --
177* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
178*
179* .. Scalar Arguments ..
180 INTEGER LDA, LDX, LDY, N, TYPE
181 COMPLEX ALPHA, BETA, WX, WY
182* ..
183* .. Array Arguments ..
184 REAL DIF( * ), S( * )
185 COMPLEX A( LDA, * ), B( LDA, * ), X( LDX, * ),
186 $ y( ldy, * )
187* ..
188*
189* =====================================================================
190*
191* .. Parameters ..
192 REAL RONE, TWO, THREE
193 parameter( rone = 1.0e+0, two = 2.0e+0, three = 3.0e+0 )
194 COMPLEX ZERO, ONE
195 parameter( zero = ( 0.0e+0, 0.0e+0 ),
196 $ one = ( 1.0e+0, 0.0e+0 ) )
197* ..
198* .. Local Scalars ..
199 INTEGER I, INFO, J
200* ..
201* .. Local Arrays ..
202 REAL RWORK( 50 )
203 COMPLEX WORK( 26 ), Z( 8, 8 )
204* ..
205* .. Intrinsic Functions ..
206 INTRINSIC cabs, cmplx, conjg, real, sqrt
207* ..
208* .. External Subroutines ..
209 EXTERNAL cgesvd, clacpy, clakf2
210* ..
211* .. Executable Statements ..
212*
213* Generate test problem ...
214* (Da, Db) ...
215*
216 DO 20 i = 1, n
217 DO 10 j = 1, n
218*
219 IF( i.EQ.j ) THEN
220 a( i, i ) = cmplx( i ) + alpha
221 b( i, i ) = one
222 ELSE
223 a( i, j ) = zero
224 b( i, j ) = zero
225 END IF
226*
227 10 CONTINUE
228 20 CONTINUE
229 IF( type.EQ.2 ) THEN
230 a( 1, 1 ) = cmplx( rone, rone )
231 a( 2, 2 ) = conjg( a( 1, 1 ) )
232 a( 3, 3 ) = one
233 a( 4, 4 ) = cmplx( real( one+alpha ), real( one+beta ) )
234 a( 5, 5 ) = conjg( a( 4, 4 ) )
235 END IF
236*
237* Form X and Y
238*
239 CALL clacpy( 'F', n, n, b, lda, y, ldy )
240 y( 3, 1 ) = -conjg( wy )
241 y( 4, 1 ) = conjg( wy )
242 y( 5, 1 ) = -conjg( wy )
243 y( 3, 2 ) = -conjg( wy )
244 y( 4, 2 ) = conjg( wy )
245 y( 5, 2 ) = -conjg( wy )
246*
247 CALL clacpy( 'F', n, n, b, lda, x, ldx )
248 x( 1, 3 ) = -wx
249 x( 1, 4 ) = -wx
250 x( 1, 5 ) = wx
251 x( 2, 3 ) = wx
252 x( 2, 4 ) = -wx
253 x( 2, 5 ) = -wx
254*
255* Form (A, B)
256*
257 b( 1, 3 ) = wx + wy
258 b( 2, 3 ) = -wx + wy
259 b( 1, 4 ) = wx - wy
260 b( 2, 4 ) = wx - wy
261 b( 1, 5 ) = -wx + wy
262 b( 2, 5 ) = wx + wy
263 a( 1, 3 ) = wx*a( 1, 1 ) + wy*a( 3, 3 )
264 a( 2, 3 ) = -wx*a( 2, 2 ) + wy*a( 3, 3 )
265 a( 1, 4 ) = wx*a( 1, 1 ) - wy*a( 4, 4 )
266 a( 2, 4 ) = wx*a( 2, 2 ) - wy*a( 4, 4 )
267 a( 1, 5 ) = -wx*a( 1, 1 ) + wy*a( 5, 5 )
268 a( 2, 5 ) = wx*a( 2, 2 ) + wy*a( 5, 5 )
269*
270* Compute condition numbers
271*
272 s( 1 ) = rone / sqrt( ( rone+three*cabs( wy )*cabs( wy ) ) /
273 $ ( rone+cabs( a( 1, 1 ) )*cabs( a( 1, 1 ) ) ) )
274 s( 2 ) = rone / sqrt( ( rone+three*cabs( wy )*cabs( wy ) ) /
275 $ ( rone+cabs( a( 2, 2 ) )*cabs( a( 2, 2 ) ) ) )
276 s( 3 ) = rone / sqrt( ( rone+two*cabs( wx )*cabs( wx ) ) /
277 $ ( rone+cabs( a( 3, 3 ) )*cabs( a( 3, 3 ) ) ) )
278 s( 4 ) = rone / sqrt( ( rone+two*cabs( wx )*cabs( wx ) ) /
279 $ ( rone+cabs( a( 4, 4 ) )*cabs( a( 4, 4 ) ) ) )
280 s( 5 ) = rone / sqrt( ( rone+two*cabs( wx )*cabs( wx ) ) /
281 $ ( rone+cabs( a( 5, 5 ) )*cabs( a( 5, 5 ) ) ) )
282*
283 CALL clakf2( 1, 4, a, lda, a( 2, 2 ), b, b( 2, 2 ), z, 8 )
284 CALL cgesvd( 'N', 'N', 8, 8, z, 8, rwork, work, 1, work( 2 ), 1,
285 $ work( 3 ), 24, rwork( 9 ), info )
286 dif( 1 ) = rwork( 8 )
287*
288 CALL clakf2( 4, 1, a, lda, a( 5, 5 ), b, b( 5, 5 ), z, 8 )
289 CALL cgesvd( 'N', 'N', 8, 8, z, 8, rwork, work, 1, work( 2 ), 1,
290 $ work( 3 ), 24, rwork( 9 ), info )
291 dif( 5 ) = rwork( 8 )
292*
293 RETURN
294*
295* End of CLATM6
296*
297 END
subroutine clakf2(m, n, a, lda, b, d, e, z, ldz)
CLAKF2
Definition clakf2.f:105
subroutine clatm6(type, n, a, lda, b, x, ldx, y, ldy, alpha, beta, wx, wy, s, dif)
CLATM6
Definition clatm6.f:174
subroutine cgesvd(jobu, jobvt, m, n, a, lda, s, u, ldu, vt, ldvt, work, lwork, rwork, info)
CGESVD computes the singular value decomposition (SVD) for GE matrices
Definition cgesvd.f:214
subroutine clacpy(uplo, m, n, a, lda, b, ldb)
CLACPY copies all or part of one two-dimensional array to another.
Definition clacpy.f:103