LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cget52.f
Go to the documentation of this file.
1*> \brief \b CGET52
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 CGET52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA,
12* WORK, RWORK, RESULT )
13*
14* .. Scalar Arguments ..
15* LOGICAL LEFT
16* INTEGER LDA, LDB, LDE, N
17* ..
18* .. Array Arguments ..
19* REAL RESULT( 2 ), RWORK( * )
20* COMPLEX A( LDA, * ), ALPHA( * ), B( LDB, * ),
21* $ BETA( * ), E( LDE, * ), WORK( * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> CGET52 does an eigenvector check for the generalized eigenvalue
31*> problem.
32*>
33*> The basic test for right eigenvectors is:
34*>
35*> | b(i) A E(i) - a(i) B E(i) |
36*> RESULT(1) = max -------------------------------
37*> i n ulp max( |b(i) A|, |a(i) B| )
38*>
39*> using the 1-norm. Here, a(i)/b(i) = w is the i-th generalized
40*> eigenvalue of A - w B, or, equivalently, b(i)/a(i) = m is the i-th
41*> generalized eigenvalue of m A - B.
42*>
43*> H H _ _
44*> For left eigenvectors, A , B , a, and b are used.
45*>
46*> CGET52 also tests the normalization of E. Each eigenvector is
47*> supposed to be normalized so that the maximum "absolute value"
48*> of its elements is 1, where in this case, "absolute value"
49*> of a complex value x is |Re(x)| + |Im(x)| ; let us call this
50*> maximum "absolute value" norm of a vector v M(v).
51*> if a(i)=b(i)=0, then the eigenvector is set to be the jth coordinate
52*> vector. The normalization test is:
53*>
54*> RESULT(2) = max | M(v(i)) - 1 | / ( n ulp )
55*> eigenvectors v(i)
56*> \endverbatim
57*
58* Arguments:
59* ==========
60*
61*> \param[in] LEFT
62*> \verbatim
63*> LEFT is LOGICAL
64*> =.TRUE.: The eigenvectors in the columns of E are assumed
65*> to be *left* eigenvectors.
66*> =.FALSE.: The eigenvectors in the columns of E are assumed
67*> to be *right* eigenvectors.
68*> \endverbatim
69*>
70*> \param[in] N
71*> \verbatim
72*> N is INTEGER
73*> The size of the matrices. If it is zero, CGET52 does
74*> nothing. It must be at least zero.
75*> \endverbatim
76*>
77*> \param[in] A
78*> \verbatim
79*> A is COMPLEX array, dimension (LDA, N)
80*> The matrix A.
81*> \endverbatim
82*>
83*> \param[in] LDA
84*> \verbatim
85*> LDA is INTEGER
86*> The leading dimension of A. It must be at least 1
87*> and at least N.
88*> \endverbatim
89*>
90*> \param[in] B
91*> \verbatim
92*> B is COMPLEX array, dimension (LDB, N)
93*> The matrix B.
94*> \endverbatim
95*>
96*> \param[in] LDB
97*> \verbatim
98*> LDB is INTEGER
99*> The leading dimension of B. It must be at least 1
100*> and at least N.
101*> \endverbatim
102*>
103*> \param[in] E
104*> \verbatim
105*> E is COMPLEX array, dimension (LDE, N)
106*> The matrix of eigenvectors. It must be O( 1 ).
107*> \endverbatim
108*>
109*> \param[in] LDE
110*> \verbatim
111*> LDE is INTEGER
112*> The leading dimension of E. It must be at least 1 and at
113*> least N.
114*> \endverbatim
115*>
116*> \param[in] ALPHA
117*> \verbatim
118*> ALPHA is COMPLEX array, dimension (N)
119*> The values a(i) as described above, which, along with b(i),
120*> define the generalized eigenvalues.
121*> \endverbatim
122*>
123*> \param[in] BETA
124*> \verbatim
125*> BETA is COMPLEX array, dimension (N)
126*> The values b(i) as described above, which, along with a(i),
127*> define the generalized eigenvalues.
128*> \endverbatim
129*>
130*> \param[out] WORK
131*> \verbatim
132*> WORK is COMPLEX array, dimension (N**2)
133*> \endverbatim
134*>
135*> \param[out] RWORK
136*> \verbatim
137*> RWORK is REAL array, dimension (N)
138*> \endverbatim
139*>
140*> \param[out] RESULT
141*> \verbatim
142*> RESULT is REAL array, dimension (2)
143*> The values computed by the test described above. If A E or
144*> B E is likely to overflow, then RESULT(1:2) is set to
145*> 10 / ulp.
146*> \endverbatim
147*
148* Authors:
149* ========
150*
151*> \author Univ. of Tennessee
152*> \author Univ. of California Berkeley
153*> \author Univ. of Colorado Denver
154*> \author NAG Ltd.
155*
156*> \ingroup complex_eig
157*
158* =====================================================================
159 SUBROUTINE cget52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA,
160 $ WORK, RWORK, RESULT )
161*
162* -- LAPACK test routine --
163* -- LAPACK is a software package provided by Univ. of Tennessee, --
164* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
165*
166* .. Scalar Arguments ..
167 LOGICAL LEFT
168 INTEGER LDA, LDB, LDE, N
169* ..
170* .. Array Arguments ..
171 REAL RESULT( 2 ), RWORK( * )
172 COMPLEX A( LDA, * ), ALPHA( * ), B( LDB, * ),
173 $ beta( * ), e( lde, * ), work( * )
174* ..
175*
176* =====================================================================
177*
178* .. Parameters ..
179 REAL ZERO, ONE
180 parameter( zero = 0.0e+0, one = 1.0e+0 )
181 COMPLEX CZERO, CONE
182 parameter( czero = ( 0.0e+0, 0.0e+0 ),
183 $ cone = ( 1.0e+0, 0.0e+0 ) )
184* ..
185* .. Local Scalars ..
186 CHARACTER NORMAB, TRANS
187 INTEGER J, JVEC
188 REAL ABMAX, ALFMAX, ANORM, BETMAX, BNORM, ENORM,
189 $ enrmer, errnrm, safmax, safmin, scale, temp1,
190 $ ulp
191 COMPLEX ACOEFF, ALPHAI, BCOEFF, BETAI, X
192* ..
193* .. External Functions ..
194 REAL CLANGE, SLAMCH
195 EXTERNAL clange, slamch
196* ..
197* .. External Subroutines ..
198 EXTERNAL cgemv
199* ..
200* .. Intrinsic Functions ..
201 INTRINSIC abs, aimag, conjg, max, real
202* ..
203* .. Statement Functions ..
204 REAL ABS1
205* ..
206* .. Statement Function definitions ..
207 abs1( x ) = abs( real( x ) ) + abs( aimag( x ) )
208* ..
209* .. Executable Statements ..
210*
211 result( 1 ) = zero
212 result( 2 ) = zero
213 IF( n.LE.0 )
214 $ RETURN
215*
216 safmin = slamch( 'Safe minimum' )
217 safmax = one / safmin
218 ulp = slamch( 'Epsilon' )*slamch( 'Base' )
219*
220 IF( left ) THEN
221 trans = 'C'
222 normab = 'I'
223 ELSE
224 trans = 'N'
225 normab = 'O'
226 END IF
227*
228* Norm of A, B, and E:
229*
230 anorm = max( clange( normab, n, n, a, lda, rwork ), safmin )
231 bnorm = max( clange( normab, n, n, b, ldb, rwork ), safmin )
232 enorm = max( clange( 'O', n, n, e, lde, rwork ), ulp )
233 alfmax = safmax / max( one, bnorm )
234 betmax = safmax / max( one, anorm )
235*
236* Compute error matrix.
237* Column i = ( b(i) A - a(i) B ) E(i) / max( |a(i) B|, |b(i) A| )
238*
239 DO 10 jvec = 1, n
240 alphai = alpha( jvec )
241 betai = beta( jvec )
242 abmax = max( abs1( alphai ), abs1( betai ) )
243 IF( abs1( alphai ).GT.alfmax .OR. abs1( betai ).GT.betmax .OR.
244 $ abmax.LT.one ) THEN
245 scale = one / max( abmax, safmin )
246 alphai = scale*alphai
247 betai = scale*betai
248 END IF
249 scale = one / max( abs1( alphai )*bnorm, abs1( betai )*anorm,
250 $ safmin )
251 acoeff = scale*betai
252 bcoeff = scale*alphai
253 IF( left ) THEN
254 acoeff = conjg( acoeff )
255 bcoeff = conjg( bcoeff )
256 END IF
257 CALL cgemv( trans, n, n, acoeff, a, lda, e( 1, jvec ), 1,
258 $ czero, work( n*( jvec-1 )+1 ), 1 )
259 CALL cgemv( trans, n, n, -bcoeff, b, lda, e( 1, jvec ), 1,
260 $ cone, work( n*( jvec-1 )+1 ), 1 )
261 10 CONTINUE
262*
263 errnrm = clange( 'One', n, n, work, n, rwork ) / enorm
264*
265* Compute RESULT(1)
266*
267 result( 1 ) = errnrm / ulp
268*
269* Normalization of E:
270*
271 enrmer = zero
272 DO 30 jvec = 1, n
273 temp1 = zero
274 DO 20 j = 1, n
275 temp1 = max( temp1, abs1( e( j, jvec ) ) )
276 20 CONTINUE
277 enrmer = max( enrmer, abs( temp1-one ) )
278 30 CONTINUE
279*
280* Compute RESULT(2) : the normalization error in E.
281*
282 result( 2 ) = enrmer / ( real( n )*ulp )
283*
284 RETURN
285*
286* End of CGET52
287*
288 END
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
Definition: cgemv.f:158
subroutine cget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
CGET52
Definition: cget52.f:161