OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zget52.f
Go to the documentation of this file.
1*> \brief \b ZGET52
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 ZGET52( 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* DOUBLE PRECISION RESULT( 2 ), RWORK( * )
20* COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
21* $ BETA( * ), E( LDE, * ), WORK( * )
22* ..
23*
24*
25*> \par Purpose:
26* =============
27*>
28*> \verbatim
29*>
30*> ZGET52 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*> ZGET52 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*>
57*> \endverbatim
58*
59* Arguments:
60* ==========
61*
62*> \param[in] LEFT
63*> \verbatim
64*> LEFT is LOGICAL
65*> =.TRUE.: The eigenvectors in the columns of E are assumed
66*> to be *left* eigenvectors.
67*> =.FALSE.: The eigenvectors in the columns of E are assumed
68*> to be *right* eigenvectors.
69*> \endverbatim
70*>
71*> \param[in] N
72*> \verbatim
73*> N is INTEGER
74*> The size of the matrices. If it is zero, ZGET52 does
75*> nothing. It must be at least zero.
76*> \endverbatim
77*>
78*> \param[in] A
79*> \verbatim
80*> A is COMPLEX*16 array, dimension (LDA, N)
81*> The matrix A.
82*> \endverbatim
83*>
84*> \param[in] LDA
85*> \verbatim
86*> LDA is INTEGER
87*> The leading dimension of A. It must be at least 1
88*> and at least N.
89*> \endverbatim
90*>
91*> \param[in] B
92*> \verbatim
93*> B is COMPLEX*16 array, dimension (LDB, N)
94*> The matrix B.
95*> \endverbatim
96*>
97*> \param[in] LDB
98*> \verbatim
99*> LDB is INTEGER
100*> The leading dimension of B. It must be at least 1
101*> and at least N.
102*> \endverbatim
103*>
104*> \param[in] E
105*> \verbatim
106*> E is COMPLEX*16 array, dimension (LDE, N)
107*> The matrix of eigenvectors. It must be O( 1 ).
108*> \endverbatim
109*>
110*> \param[in] LDE
111*> \verbatim
112*> LDE is INTEGER
113*> The leading dimension of E. It must be at least 1 and at
114*> least N.
115*> \endverbatim
116*>
117*> \param[in] ALPHA
118*> \verbatim
119*> ALPHA is COMPLEX*16 array, dimension (N)
120*> The values a(i) as described above, which, along with b(i),
121*> define the generalized eigenvalues.
122*> \endverbatim
123*>
124*> \param[in] BETA
125*> \verbatim
126*> BETA is COMPLEX*16 array, dimension (N)
127*> The values b(i) as described above, which, along with a(i),
128*> define the generalized eigenvalues.
129*> \endverbatim
130*>
131*> \param[out] WORK
132*> \verbatim
133*> WORK is COMPLEX*16 array, dimension (N**2)
134*> \endverbatim
135*>
136*> \param[out] RWORK
137*> \verbatim
138*> RWORK is DOUBLE PRECISION array, dimension (N)
139*> \endverbatim
140*>
141*> \param[out] RESULT
142*> \verbatim
143*> RESULT is DOUBLE PRECISION array, dimension (2)
144*> The values computed by the test described above. If A E or
145*> B E is likely to overflow, then RESULT(1:2) is set to
146*> 10 / ulp.
147*> \endverbatim
148*
149* Authors:
150* ========
151*
152*> \author Univ. of Tennessee
153*> \author Univ. of California Berkeley
154*> \author Univ. of Colorado Denver
155*> \author NAG Ltd.
156*
157*> \ingroup complex16_eig
158*
159* =====================================================================
160 SUBROUTINE zget52( LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA,
161 $ WORK, RWORK, RESULT )
162*
163* -- LAPACK test routine --
164* -- LAPACK is a software package provided by Univ. of Tennessee, --
165* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
166*
167* .. Scalar Arguments ..
168 LOGICAL LEFT
169 INTEGER LDA, LDB, LDE, N
170* ..
171* .. Array Arguments ..
172 DOUBLE PRECISION RESULT( 2 ), RWORK( * )
173 COMPLEX*16 A( LDA, * ), ALPHA( * ), B( LDB, * ),
174 $ beta( * ), e( lde, * ), work( * )
175* ..
176*
177* =====================================================================
178*
179* .. Parameters ..
180 DOUBLE PRECISION ZERO, ONE
181 parameter( zero = 0.0d+0, one = 1.0d+0 )
182 COMPLEX*16 CZERO, CONE
183 parameter( czero = ( 0.0d+0, 0.0d+0 ),
184 $ cone = ( 1.0d+0, 0.0d+0 ) )
185* ..
186* .. Local Scalars ..
187 CHARACTER NORMAB, TRANS
188 INTEGER J, JVEC
189 DOUBLE PRECISION ABMAX, ALFMAX, ANORM, BETMAX, BNORM, ENORM,
190 $ enrmer, errnrm, safmax, safmin, scale, temp1,
191 $ ulp
192 COMPLEX*16 ACOEFF, ALPHAI, BCOEFF, BETAI, X
193* ..
194* .. External Functions ..
195 DOUBLE PRECISION DLAMCH, ZLANGE
196 EXTERNAL dlamch, zlange
197* ..
198* .. External Subroutines ..
199 EXTERNAL zgemv
200* ..
201* .. Intrinsic Functions ..
202 INTRINSIC abs, dble, dconjg, dimag, max
203* ..
204* .. Statement Functions ..
205 DOUBLE PRECISION ABS1
206* ..
207* .. Statement Function definitions ..
208 abs1( x ) = abs( dble( x ) ) + abs( dimag( x ) )
209* ..
210* .. Executable Statements ..
211*
212 result( 1 ) = zero
213 result( 2 ) = zero
214 IF( n.LE.0 )
215 $ RETURN
216*
217 safmin = dlamch( 'Safe minimum' )
218 safmax = one / safmin
219 ulp = dlamch( 'Epsilon' )*dlamch( 'Base' )
220*
221 IF( left ) THEN
222 trans = 'C'
223 normab = 'I'
224 ELSE
225 trans = 'n'
226 NORMAB = 'o'
227 END IF
228*
229* Norm of A, B, and E:
230*
231 ANORM = MAX( ZLANGE( NORMAB, N, N, A, LDA, RWORK ), SAFMIN )
232 BNORM = MAX( ZLANGE( NORMAB, N, N, B, LDB, RWORK ), SAFMIN )
233 ENORM = MAX( ZLANGE( 'o', N, N, E, LDE, RWORK ), ULP )
234 ALFMAX = SAFMAX / MAX( ONE, BNORM )
235 BETMAX = SAFMAX / MAX( ONE, ANORM )
236*
237* Compute error matrix.
238* Column i = ( b(i) A - a(i) B ) E(i) / max( |a(i) B|, |b(i) A| )
239*
240 DO 10 JVEC = 1, N
241 ALPHAI = ALPHA( JVEC )
242 BETAI = BETA( JVEC )
243 ABMAX = MAX( ABS1( ALPHAI ), ABS1( BETAI ) )
244.GT..OR..GT..OR. IF( ABS1( ALPHAI )ALFMAX ABS1( BETAI )BETMAX
245.LT. $ ABMAXONE ) THEN
246 SCALE = ONE / MAX( ABMAX, SAFMIN )
247 ALPHAI = SCALE*ALPHAI
248 BETAI = SCALE*BETAI
249 END IF
250 SCALE = ONE / MAX( ABS1( ALPHAI )*BNORM, ABS1( BETAI )*ANORM,
251 $ SAFMIN )
252 ACOEFF = SCALE*BETAI
253 BCOEFF = SCALE*ALPHAI
254 IF( LEFT ) THEN
255 ACOEFF = DCONJG( ACOEFF )
256 BCOEFF = DCONJG( BCOEFF )
257 END IF
258 CALL ZGEMV( TRANS, N, N, ACOEFF, A, LDA, E( 1, JVEC ), 1,
259 $ CZERO, WORK( N*( JVEC-1 )+1 ), 1 )
260 CALL ZGEMV( TRANS, N, N, -BCOEFF, B, LDA, E( 1, JVEC ), 1,
261 $ CONE, WORK( N*( JVEC-1 )+1 ), 1 )
262 10 CONTINUE
263*
264 ERRNRM = ZLANGE( 'one', N, N, WORK, N, RWORK ) / ENORM
265*
266* Compute RESULT(1)
267*
268 RESULT( 1 ) = ERRNRM / ULP
269*
270* Normalization of E:
271*
272 ENRMER = ZERO
273 DO 30 JVEC = 1, N
274 TEMP1 = ZERO
275 DO 20 J = 1, N
276 TEMP1 = MAX( TEMP1, ABS1( E( J, JVEC ) ) )
277 20 CONTINUE
278 ENRMER = MAX( ENRMER, ABS( TEMP1-ONE ) )
279 30 CONTINUE
280*
281* Compute RESULT(2) : the normalization error in E.
282*
283 RESULT( 2 ) = ENRMER / ( DBLE( N )*ULP )
284*
285 RETURN
286*
287* End of ZGET52
288*
289 END
subroutine zgemv(trans, m, n, alpha, a, lda, x, incx, beta, y, incy)
ZGEMV
Definition zgemv.f:158
subroutine zget52(left, n, a, lda, b, ldb, e, lde, alpha, beta, work, rwork, result)
ZGET52
Definition zget52.f:162
#define max(a, b)
Definition macros.h:21