LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
zdrgvx.f
Go to the documentation of this file.
1*> \brief \b ZDRGVX
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 ZDRGVX( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
12* ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE,
13* S, DTRU, DIF, DIFTRU, WORK, LWORK, RWORK,
14* IWORK, LIWORK, RESULT, BWORK, INFO )
15*
16* .. Scalar Arguments ..
17* INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
18* $ NSIZE
19* DOUBLE PRECISION THRESH
20* ..
21* .. Array Arguments ..
22* LOGICAL BWORK( * )
23* INTEGER IWORK( * )
24* DOUBLE PRECISION DIF( * ), DIFTRU( * ), DTRU( * ), LSCALE( * ),
25* $ RESULT( 4 ), RSCALE( * ), RWORK( * ), S( * )
26* COMPLEX*16 A( LDA, * ), AI( LDA, * ), ALPHA( * ),
27* $ B( LDA, * ), BETA( * ), BI( LDA, * ),
28* $ VL( LDA, * ), VR( LDA, * ), WORK( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> ZDRGVX checks the nonsymmetric generalized eigenvalue problem
38*> expert driver ZGGEVX.
39*>
40*> ZGGEVX computes the generalized eigenvalues, (optionally) the left
41*> and/or right eigenvectors, (optionally) computes a balancing
42*> transformation to improve the conditioning, and (optionally)
43*> reciprocal condition numbers for the eigenvalues and eigenvectors.
44*>
45*> When ZDRGVX is called with NSIZE > 0, two types of test matrix pairs
46*> are generated by the subroutine DLATM6 and test the driver ZGGEVX.
47*> The test matrices have the known exact condition numbers for
48*> eigenvalues. For the condition numbers of the eigenvectors
49*> corresponding the first and last eigenvalues are also know
50*> ``exactly'' (see ZLATM6).
51*> For each matrix pair, the following tests will be performed and
52*> compared with the threshold THRESH.
53*>
54*> (1) max over all left eigenvalue/-vector pairs (beta/alpha,l) of
55*>
56*> | l**H * (beta A - alpha B) | / ( ulp max( |beta A|, |alpha B| ) )
57*>
58*> where l**H is the conjugate transpose of l.
59*>
60*> (2) max over all right eigenvalue/-vector pairs (beta/alpha,r) of
61*>
62*> | (beta A - alpha B) r | / ( ulp max( |beta A|, |alpha B| ) )
63*>
64*> (3) The condition number S(i) of eigenvalues computed by ZGGEVX
65*> differs less than a factor THRESH from the exact S(i) (see
66*> ZLATM6).
67*>
68*> (4) DIF(i) computed by ZTGSNA differs less than a factor 10*THRESH
69*> from the exact value (for the 1st and 5th vectors only).
70*>
71*> Test Matrices
72*> =============
73*>
74*> Two kinds of test matrix pairs
75*> (A, B) = inverse(YH) * (Da, Db) * inverse(X)
76*> are used in the tests:
77*>
78*> 1: Da = 1+a 0 0 0 0 Db = 1 0 0 0 0
79*> 0 2+a 0 0 0 0 1 0 0 0
80*> 0 0 3+a 0 0 0 0 1 0 0
81*> 0 0 0 4+a 0 0 0 0 1 0
82*> 0 0 0 0 5+a , 0 0 0 0 1 , and
83*>
84*> 2: Da = 1 -1 0 0 0 Db = 1 0 0 0 0
85*> 1 1 0 0 0 0 1 0 0 0
86*> 0 0 1 0 0 0 0 1 0 0
87*> 0 0 0 1+a 1+b 0 0 0 1 0
88*> 0 0 0 -1-b 1+a , 0 0 0 0 1 .
89*>
90*> In both cases the same inverse(YH) and inverse(X) are used to compute
91*> (A, B), giving the exact eigenvectors to (A,B) as (YH, X):
92*>
93*> YH: = 1 0 -y y -y X = 1 0 -x -x x
94*> 0 1 -y y -y 0 1 x -x -x
95*> 0 0 1 0 0 0 0 1 0 0
96*> 0 0 0 1 0 0 0 0 1 0
97*> 0 0 0 0 1, 0 0 0 0 1 , where
98*>
99*> a, b, x and y will have all values independently of each other from
100*> { sqrt(sqrt(ULP)), 0.1, 1, 10, 1/sqrt(sqrt(ULP)) }.
101*> \endverbatim
102*
103* Arguments:
104* ==========
105*
106*> \param[in] NSIZE
107*> \verbatim
108*> NSIZE is INTEGER
109*> The number of sizes of matrices to use. NSIZE must be at
110*> least zero. If it is zero, no randomly generated matrices
111*> are tested, but any test matrices read from NIN will be
112*> tested. If it is not zero, then N = 5.
113*> \endverbatim
114*>
115*> \param[in] THRESH
116*> \verbatim
117*> THRESH is DOUBLE PRECISION
118*> A test will count as "failed" if the "error", computed as
119*> described above, exceeds THRESH. Note that the error
120*> is scaled to be O(1), so THRESH should be a reasonably
121*> small multiple of 1, e.g., 10 or 100. In particular,
122*> it should not depend on the precision (single vs. double)
123*> or the size of the matrix. It must be at least zero.
124*> \endverbatim
125*>
126*> \param[in] NIN
127*> \verbatim
128*> NIN is INTEGER
129*> The FORTRAN unit number for reading in the data file of
130*> problems to solve.
131*> \endverbatim
132*>
133*> \param[in] NOUT
134*> \verbatim
135*> NOUT is INTEGER
136*> The FORTRAN unit number for printing out error messages
137*> (e.g., if a routine returns IINFO not equal to 0.)
138*> \endverbatim
139*>
140*> \param[out] A
141*> \verbatim
142*> A is COMPLEX*16 array, dimension (LDA, NSIZE)
143*> Used to hold the matrix whose eigenvalues are to be
144*> computed. On exit, A contains the last matrix actually used.
145*> \endverbatim
146*>
147*> \param[in] LDA
148*> \verbatim
149*> LDA is INTEGER
150*> The leading dimension of A, B, AI, BI, Ao, and Bo.
151*> It must be at least 1 and at least NSIZE.
152*> \endverbatim
153*>
154*> \param[out] B
155*> \verbatim
156*> B is COMPLEX*16 array, dimension (LDA, NSIZE)
157*> Used to hold the matrix whose eigenvalues are to be
158*> computed. On exit, B contains the last matrix actually used.
159*> \endverbatim
160*>
161*> \param[out] AI
162*> \verbatim
163*> AI is COMPLEX*16 array, dimension (LDA, NSIZE)
164*> Copy of A, modified by ZGGEVX.
165*> \endverbatim
166*>
167*> \param[out] BI
168*> \verbatim
169*> BI is COMPLEX*16 array, dimension (LDA, NSIZE)
170*> Copy of B, modified by ZGGEVX.
171*> \endverbatim
172*>
173*> \param[out] ALPHA
174*> \verbatim
175*> ALPHA is COMPLEX*16 array, dimension (NSIZE)
176*> \endverbatim
177*>
178*> \param[out] BETA
179*> \verbatim
180*> BETA is COMPLEX*16 array, dimension (NSIZE)
181*>
182*> On exit, ALPHA/BETA are the eigenvalues.
183*> \endverbatim
184*>
185*> \param[out] VL
186*> \verbatim
187*> VL is COMPLEX*16 array, dimension (LDA, NSIZE)
188*> VL holds the left eigenvectors computed by ZGGEVX.
189*> \endverbatim
190*>
191*> \param[out] VR
192*> \verbatim
193*> VR is COMPLEX*16 array, dimension (LDA, NSIZE)
194*> VR holds the right eigenvectors computed by ZGGEVX.
195*> \endverbatim
196*>
197*> \param[out] ILO
198*> \verbatim
199*> ILO is INTEGER
200*> \endverbatim
201*>
202*> \param[out] IHI
203*> \verbatim
204*> IHI is INTEGER
205*> \endverbatim
206*>
207*> \param[out] LSCALE
208*> \verbatim
209*> LSCALE is DOUBLE PRECISION array, dimension (N)
210*> \endverbatim
211*>
212*> \param[out] RSCALE
213*> \verbatim
214*> RSCALE is DOUBLE PRECISION array, dimension (N)
215*> \endverbatim
216*>
217*> \param[out] S
218*> \verbatim
219*> S is DOUBLE PRECISION array, dimension (N)
220*> \endverbatim
221*>
222*> \param[out] DTRU
223*> \verbatim
224*> DTRU is DOUBLE PRECISION array, dimension (N)
225*> \endverbatim
226*>
227*> \param[out] DIF
228*> \verbatim
229*> DIF is DOUBLE PRECISION array, dimension (N)
230*> \endverbatim
231*>
232*> \param[out] DIFTRU
233*> \verbatim
234*> DIFTRU is DOUBLE PRECISION array, dimension (N)
235*> \endverbatim
236*>
237*> \param[out] WORK
238*> \verbatim
239*> WORK is COMPLEX*16 array, dimension (LWORK)
240*> \endverbatim
241*>
242*> \param[in] LWORK
243*> \verbatim
244*> LWORK is INTEGER
245*> Leading dimension of WORK. LWORK >= 2*N*N + 2*N
246*> \endverbatim
247*>
248*> \param[out] RWORK
249*> \verbatim
250*> RWORK is DOUBLE PRECISION array, dimension (6*N)
251*> \endverbatim
252*>
253*> \param[out] IWORK
254*> \verbatim
255*> IWORK is INTEGER array, dimension (LIWORK)
256*> \endverbatim
257*>
258*> \param[in] LIWORK
259*> \verbatim
260*> LIWORK is INTEGER
261*> Leading dimension of IWORK. LIWORK >= N+2.
262*> \endverbatim
263*>
264*> \param[out] RESULT
265*> \verbatim
266*> RESULT is DOUBLE PRECISION array, dimension (4)
267*> \endverbatim
268*>
269*> \param[out] BWORK
270*> \verbatim
271*> BWORK is LOGICAL array, dimension (N)
272*> \endverbatim
273*>
274*> \param[out] INFO
275*> \verbatim
276*> INFO is INTEGER
277*> = 0: successful exit
278*> < 0: if INFO = -i, the i-th argument had an illegal value.
279*> > 0: A routine returned an error code.
280*> \endverbatim
281*
282* Authors:
283* ========
284*
285*> \author Univ. of Tennessee
286*> \author Univ. of California Berkeley
287*> \author Univ. of Colorado Denver
288*> \author NAG Ltd.
289*
290*> \ingroup complex16_eig
291*
292* =====================================================================
293 SUBROUTINE zdrgvx( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
294 $ ALPHA, BETA, VL, VR, ILO, IHI, LSCALE, RSCALE,
295 $ S, DTRU, DIF, DIFTRU, WORK, LWORK, RWORK,
296 $ IWORK, LIWORK, RESULT, BWORK, INFO )
297*
298* -- LAPACK test routine --
299* -- LAPACK is a software package provided by Univ. of Tennessee, --
300* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
301*
302* .. Scalar Arguments ..
303 INTEGER IHI, ILO, INFO, LDA, LIWORK, LWORK, NIN, NOUT,
304 $ NSIZE
305 DOUBLE PRECISION THRESH
306* ..
307* .. Array Arguments ..
308 LOGICAL BWORK( * )
309 INTEGER IWORK( * )
310 DOUBLE PRECISION DIF( * ), DIFTRU( * ), DTRU( * ), LSCALE( * ),
311 $ result( 4 ), rscale( * ), rwork( * ), s( * )
312 COMPLEX*16 A( LDA, * ), AI( LDA, * ), ALPHA( * ),
313 $ b( lda, * ), beta( * ), bi( lda, * ),
314 $ vl( lda, * ), vr( lda, * ), work( * )
315* ..
316*
317* =====================================================================
318*
319* .. Parameters ..
320 DOUBLE PRECISION ZERO, ONE, TEN, TNTH, HALF
321 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0, ten = 1.0d+1,
322 $ tnth = 1.0d-1, half = 0.5d+0 )
323* ..
324* .. Local Scalars ..
325 INTEGER I, IPTYPE, IWA, IWB, IWX, IWY, J, LINFO,
326 $ MAXWRK, MINWRK, N, NERRS, NMAX, NPTKNT, NTESTT
327 DOUBLE PRECISION ABNORM, ANORM, BNORM, RATIO1, RATIO2, THRSH2,
328 $ ulp, ulpinv
329* ..
330* .. Local Arrays ..
331 COMPLEX*16 WEIGHT( 5 )
332* ..
333* .. External Functions ..
334 INTEGER ILAENV
335 DOUBLE PRECISION DLAMCH, ZLANGE
336 EXTERNAL ILAENV, DLAMCH, ZLANGE
337* ..
338* .. External Subroutines ..
339 EXTERNAL alasvm, xerbla, zget52, zggevx, zlacpy, zlatm6
340* ..
341* .. Intrinsic Functions ..
342 INTRINSIC abs, dcmplx, max, sqrt
343* ..
344* .. Executable Statements ..
345*
346* Check for errors
347*
348 info = 0
349*
350 nmax = 5
351*
352 IF( nsize.LT.0 ) THEN
353 info = -1
354 ELSE IF( thresh.LT.zero ) THEN
355 info = -2
356 ELSE IF( nin.LE.0 ) THEN
357 info = -3
358 ELSE IF( nout.LE.0 ) THEN
359 info = -4
360 ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
361 info = -6
362 ELSE IF( liwork.LT.nmax+2 ) THEN
363 info = -26
364 END IF
365*
366* Compute workspace
367* (Note: Comments in the code beginning "Workspace:" describe the
368* minimal amount of workspace needed at that point in the code,
369* as well as the preferred amount for good performance.
370* NB refers to the optimal block size for the immediately
371* following subroutine, as returned by ILAENV.)
372*
373 minwrk = 1
374 IF( info.EQ.0 .AND. lwork.GE.1 ) THEN
375 minwrk = 2*nmax*( nmax+1 )
376 maxwrk = nmax*( 1+ilaenv( 1, 'ZGEQRF', ' ', nmax, 1, nmax,
377 $ 0 ) )
378 maxwrk = max( maxwrk, 2*nmax*( nmax+1 ) )
379 work( 1 ) = maxwrk
380 END IF
381*
382 IF( lwork.LT.minwrk )
383 $ info = -23
384*
385 IF( info.NE.0 ) THEN
386 CALL xerbla( 'ZDRGVX', -info )
387 RETURN
388 END IF
389*
390 n = 5
391 ulp = dlamch( 'P' )
392 ulpinv = one / ulp
393 thrsh2 = ten*thresh
394 nerrs = 0
395 nptknt = 0
396 ntestt = 0
397*
398 IF( nsize.EQ.0 )
399 $ GO TO 90
400*
401* Parameters used for generating test matrices.
402*
403 weight( 1 ) = dcmplx( tnth, zero )
404 weight( 2 ) = dcmplx( half, zero )
405 weight( 3 ) = one
406 weight( 4 ) = one / weight( 2 )
407 weight( 5 ) = one / weight( 1 )
408*
409 DO 80 iptype = 1, 2
410 DO 70 iwa = 1, 5
411 DO 60 iwb = 1, 5
412 DO 50 iwx = 1, 5
413 DO 40 iwy = 1, 5
414*
415* generated a pair of test matrix
416*
417 CALL zlatm6( iptype, 5, a, lda, b, vr, lda, vl,
418 $ lda, weight( iwa ), weight( iwb ),
419 $ weight( iwx ), weight( iwy ), dtru,
420 $ diftru )
421*
422* Compute eigenvalues/eigenvectors of (A, B).
423* Compute eigenvalue/eigenvector condition numbers
424* using computed eigenvectors.
425*
426 CALL zlacpy( 'F', n, n, a, lda, ai, lda )
427 CALL zlacpy( 'F', n, n, b, lda, bi, lda )
428*
429 CALL zggevx( 'N', 'V', 'V', 'B', n, ai, lda, bi,
430 $ lda, alpha, beta, vl, lda, vr, lda,
431 $ ilo, ihi, lscale, rscale, anorm,
432 $ bnorm, s, dif, work, lwork, rwork,
433 $ iwork, bwork, linfo )
434 IF( linfo.NE.0 ) THEN
435 WRITE( nout, fmt = 9999 )'ZGGEVX', linfo, n,
436 $ iptype, iwa, iwb, iwx, iwy
437 GO TO 30
438 END IF
439*
440* Compute the norm(A, B)
441*
442 CALL zlacpy( 'Full', n, n, ai, lda, work, n )
443 CALL zlacpy( 'Full', n, n, bi, lda, work( n*n+1 ),
444 $ n )
445 abnorm = zlange( 'Fro', n, 2*n, work, n, rwork )
446*
447* Tests (1) and (2)
448*
449 result( 1 ) = zero
450 CALL zget52( .true., n, a, lda, b, lda, vl, lda,
451 $ alpha, beta, work, rwork,
452 $ result( 1 ) )
453 IF( result( 2 ).GT.thresh ) THEN
454 WRITE( nout, fmt = 9998 )'Left', 'ZGGEVX',
455 $ result( 2 ), n, iptype, iwa, iwb, iwx, iwy
456 END IF
457*
458 result( 2 ) = zero
459 CALL zget52( .false., n, a, lda, b, lda, vr, lda,
460 $ alpha, beta, work, rwork,
461 $ result( 2 ) )
462 IF( result( 3 ).GT.thresh ) THEN
463 WRITE( nout, fmt = 9998 )'Right', 'ZGGEVX',
464 $ result( 3 ), n, iptype, iwa, iwb, iwx, iwy
465 END IF
466*
467* Test (3)
468*
469 result( 3 ) = zero
470 DO 10 i = 1, n
471 IF( s( i ).EQ.zero ) THEN
472 IF( dtru( i ).GT.abnorm*ulp )
473 $ result( 3 ) = ulpinv
474 ELSE IF( dtru( i ).EQ.zero ) THEN
475 IF( s( i ).GT.abnorm*ulp )
476 $ result( 3 ) = ulpinv
477 ELSE
478 rwork( i ) = max( abs( dtru( i ) / s( i ) ),
479 $ abs( s( i ) / dtru( i ) ) )
480 result( 3 ) = max( result( 3 ), rwork( i ) )
481 END IF
482 10 CONTINUE
483*
484* Test (4)
485*
486 result( 4 ) = zero
487 IF( dif( 1 ).EQ.zero ) THEN
488 IF( diftru( 1 ).GT.abnorm*ulp )
489 $ result( 4 ) = ulpinv
490 ELSE IF( diftru( 1 ).EQ.zero ) THEN
491 IF( dif( 1 ).GT.abnorm*ulp )
492 $ result( 4 ) = ulpinv
493 ELSE IF( dif( 5 ).EQ.zero ) THEN
494 IF( diftru( 5 ).GT.abnorm*ulp )
495 $ result( 4 ) = ulpinv
496 ELSE IF( diftru( 5 ).EQ.zero ) THEN
497 IF( dif( 5 ).GT.abnorm*ulp )
498 $ result( 4 ) = ulpinv
499 ELSE
500 ratio1 = max( abs( diftru( 1 ) / dif( 1 ) ),
501 $ abs( dif( 1 ) / diftru( 1 ) ) )
502 ratio2 = max( abs( diftru( 5 ) / dif( 5 ) ),
503 $ abs( dif( 5 ) / diftru( 5 ) ) )
504 result( 4 ) = max( ratio1, ratio2 )
505 END IF
506*
507 ntestt = ntestt + 4
508*
509* Print out tests which fail.
510*
511 DO 20 j = 1, 4
512 IF( ( result( j ).GE.thrsh2 .AND. j.GE.4 ) .OR.
513 $ ( result( j ).GE.thresh .AND. j.LE.3 ) )
514 $ THEN
515*
516* If this is the first test to fail,
517* print a header to the data file.
518*
519 IF( nerrs.EQ.0 ) THEN
520 WRITE( nout, fmt = 9997 )'ZXV'
521*
522* Print out messages for built-in examples
523*
524* Matrix types
525*
526 WRITE( nout, fmt = 9995 )
527 WRITE( nout, fmt = 9994 )
528 WRITE( nout, fmt = 9993 )
529*
530* Tests performed
531*
532 WRITE( nout, fmt = 9992 )'''',
533 $ 'transpose', ''''
534*
535 END IF
536 nerrs = nerrs + 1
537 IF( result( j ).LT.10000.0d0 ) THEN
538 WRITE( nout, fmt = 9991 )iptype, iwa,
539 $ iwb, iwx, iwy, j, result( j )
540 ELSE
541 WRITE( nout, fmt = 9990 )iptype, iwa,
542 $ iwb, iwx, iwy, j, result( j )
543 END IF
544 END IF
545 20 CONTINUE
546*
547 30 CONTINUE
548*
549 40 CONTINUE
550 50 CONTINUE
551 60 CONTINUE
552 70 CONTINUE
553 80 CONTINUE
554*
555 GO TO 150
556*
557 90 CONTINUE
558*
559* Read in data from file to check accuracy of condition estimation
560* Read input data until N=0
561*
562 READ( nin, fmt = *, END = 150 )n
563 IF( n.EQ.0 )
564 $ GO TO 150
565 DO 100 i = 1, n
566 READ( nin, fmt = * )( a( i, j ), j = 1, n )
567 100 CONTINUE
568 DO 110 i = 1, n
569 READ( nin, fmt = * )( b( i, j ), j = 1, n )
570 110 CONTINUE
571 READ( nin, fmt = * )( dtru( i ), i = 1, n )
572 READ( nin, fmt = * )( diftru( i ), i = 1, n )
573*
574 nptknt = nptknt + 1
575*
576* Compute eigenvalues/eigenvectors of (A, B).
577* Compute eigenvalue/eigenvector condition numbers
578* using computed eigenvectors.
579*
580 CALL zlacpy( 'F', n, n, a, lda, ai, lda )
581 CALL zlacpy( 'F', n, n, b, lda, bi, lda )
582*
583 CALL zggevx( 'N', 'V', 'V', 'B', n, ai, lda, bi, lda, alpha, beta,
584 $ vl, lda, vr, lda, ilo, ihi, lscale, rscale, anorm,
585 $ bnorm, s, dif, work, lwork, rwork, iwork, bwork,
586 $ linfo )
587*
588 IF( linfo.NE.0 ) THEN
589 WRITE( nout, fmt = 9987 )'ZGGEVX', linfo, n, nptknt
590 GO TO 140
591 END IF
592*
593* Compute the norm(A, B)
594*
595 CALL zlacpy( 'Full', n, n, ai, lda, work, n )
596 CALL zlacpy( 'Full', n, n, bi, lda, work( n*n+1 ), n )
597 abnorm = zlange( 'Fro', n, 2*n, work, n, rwork )
598*
599* Tests (1) and (2)
600*
601 result( 1 ) = zero
602 CALL zget52( .true., n, a, lda, b, lda, vl, lda, alpha, beta,
603 $ work, rwork, result( 1 ) )
604 IF( result( 2 ).GT.thresh ) THEN
605 WRITE( nout, fmt = 9986 )'Left', 'ZGGEVX', result( 2 ), n,
606 $ nptknt
607 END IF
608*
609 result( 2 ) = zero
610 CALL zget52( .false., n, a, lda, b, lda, vr, lda, alpha, beta,
611 $ work, rwork, result( 2 ) )
612 IF( result( 3 ).GT.thresh ) THEN
613 WRITE( nout, fmt = 9986 )'Right', 'ZGGEVX', result( 3 ), n,
614 $ nptknt
615 END IF
616*
617* Test (3)
618*
619 result( 3 ) = zero
620 DO 120 i = 1, n
621 IF( s( i ).EQ.zero ) THEN
622 IF( dtru( i ).GT.abnorm*ulp )
623 $ result( 3 ) = ulpinv
624 ELSE IF( dtru( i ).EQ.zero ) THEN
625 IF( s( i ).GT.abnorm*ulp )
626 $ result( 3 ) = ulpinv
627 ELSE
628 rwork( i ) = max( abs( dtru( i ) / s( i ) ),
629 $ abs( s( i ) / dtru( i ) ) )
630 result( 3 ) = max( result( 3 ), rwork( i ) )
631 END IF
632 120 CONTINUE
633*
634* Test (4)
635*
636 result( 4 ) = zero
637 IF( dif( 1 ).EQ.zero ) THEN
638 IF( diftru( 1 ).GT.abnorm*ulp )
639 $ result( 4 ) = ulpinv
640 ELSE IF( diftru( 1 ).EQ.zero ) THEN
641 IF( dif( 1 ).GT.abnorm*ulp )
642 $ result( 4 ) = ulpinv
643 ELSE IF( dif( 5 ).EQ.zero ) THEN
644 IF( diftru( 5 ).GT.abnorm*ulp )
645 $ result( 4 ) = ulpinv
646 ELSE IF( diftru( 5 ).EQ.zero ) THEN
647 IF( dif( 5 ).GT.abnorm*ulp )
648 $ result( 4 ) = ulpinv
649 ELSE
650 ratio1 = max( abs( diftru( 1 ) / dif( 1 ) ),
651 $ abs( dif( 1 ) / diftru( 1 ) ) )
652 ratio2 = max( abs( diftru( 5 ) / dif( 5 ) ),
653 $ abs( dif( 5 ) / diftru( 5 ) ) )
654 result( 4 ) = max( ratio1, ratio2 )
655 END IF
656*
657 ntestt = ntestt + 4
658*
659* Print out tests which fail.
660*
661 DO 130 j = 1, 4
662 IF( result( j ).GE.thrsh2 ) THEN
663*
664* If this is the first test to fail,
665* print a header to the data file.
666*
667 IF( nerrs.EQ.0 ) THEN
668 WRITE( nout, fmt = 9997 )'ZXV'
669*
670* Print out messages for built-in examples
671*
672* Matrix types
673*
674 WRITE( nout, fmt = 9996 )
675*
676* Tests performed
677*
678 WRITE( nout, fmt = 9992 )'''', 'transpose', ''''
679*
680 END IF
681 nerrs = nerrs + 1
682 IF( result( j ).LT.10000.0d0 ) THEN
683 WRITE( nout, fmt = 9989 )nptknt, n, j, result( j )
684 ELSE
685 WRITE( nout, fmt = 9988 )nptknt, n, j, result( j )
686 END IF
687 END IF
688 130 CONTINUE
689*
690 140 CONTINUE
691*
692 GO TO 90
693 150 CONTINUE
694*
695* Summary
696*
697 CALL alasvm( 'ZXV', nout, nerrs, ntestt, 0 )
698*
699 work( 1 ) = maxwrk
700*
701 RETURN
702*
703 9999 FORMAT( ' ZDRGVX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
704 $ i6, ', JTYPE=', i6, ')' )
705*
706 9998 FORMAT( ' ZDRGVX: ', a, ' Eigenvectors from ', a, ' incorrectly ',
707 $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
708 $ 'N=', i6, ', JTYPE=', i6, ', IWA=', i5, ', IWB=', i5,
709 $ ', IWX=', i5, ', IWY=', i5 )
710*
711 9997 FORMAT( / 1x, a3, ' -- Complex Expert Eigenvalue/vector',
712 $ ' problem driver' )
713*
714 9996 FORMAT( 'Input Example' )
715*
716 9995 FORMAT( ' Matrix types: ', / )
717*
718 9994 FORMAT( ' TYPE 1: Da is diagonal, Db is identity, ',
719 $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
720 $ / ' YH and X are left and right eigenvectors. ', / )
721*
722 9993 FORMAT( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
723 $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
724 $ / ' YH and X are left and right eigenvectors. ', / )
725*
726 9992 FORMAT( / ' Tests performed: ', / 4x,
727 $ ' a is alpha, b is beta, l is a left eigenvector, ', / 4x,
728 $ ' r is a right eigenvector and ', a, ' means ', a, '.',
729 $ / ' 1 = max | ( b A - a B )', a, ' l | / const.',
730 $ / ' 2 = max | ( b A - a B ) r | / const.',
731 $ / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
732 $ ' over all eigenvalues', /
733 $ ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
734 $ ' over the 1st and 5th eigenvectors', / )
735*
736 9991 FORMAT( ' Type=', i2, ',', ' IWA=', i2, ', IWB=', i2, ', IWX=',
737 $ i2, ', IWY=', i2, ', result ', i2, ' is', 0p, f8.2 )
738*
739 9990 FORMAT( ' Type=', i2, ',', ' IWA=', i2, ', IWB=', i2, ', IWX=',
740 $ i2, ', IWY=', i2, ', result ', i2, ' is', 1p, d10.3 )
741*
742 9989 FORMAT( ' Input example #', i2, ', matrix order=', i4, ',',
743 $ ' result ', i2, ' is', 0p, f8.2 )
744*
745 9988 FORMAT( ' Input example #', i2, ', matrix order=', i4, ',',
746 $ ' result ', i2, ' is', 1p, d10.3 )
747*
748 9987 FORMAT( ' ZDRGVX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
749 $ i6, ', Input example #', i2, ')' )
750*
751 9986 FORMAT( ' ZDRGVX: ', a, ' Eigenvectors from ', a, ' incorrectly ',
752 $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
753 $ 'N=', i6, ', Input Example #', i2, ')' )
754*
755* End of ZDRGVX
756*
757 END
alasvm
subroutine alasvm(type, nout, nfail, nrun, nerrs)
ALASVM
Definition alasvm.f:73
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
zggevx
subroutine zggevx(balanc, jobvl, jobvr, sense, n, a, lda, b, ldb, alpha, beta, vl, ldvl, vr, ldvr, ilo, ihi, lscale, rscale, abnrm, bbnrm, rconde, rcondv, work, lwork, rwork, iwork, bwork, info)
ZGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices
Definition zggevx.f:374
zlacpy
subroutine zlacpy(uplo, m, n, a, lda, b, ldb)
ZLACPY copies all or part of one two-dimensional array to another.
Definition zlacpy.f:103
zlange
double precision function zlange(norm, m, n, a, lda, work)
ZLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition zlange.f:115
zdrgvx
subroutine zdrgvx(nsize, thresh, nin, nout, a, lda, b, ai, bi, alpha, beta, vl, vr, ilo, ihi, lscale, rscale, s, dtru, dif, diftru, work, lwork, rwork, iwork, liwork, result, bwork, info)
ZDRGVX
Definition zdrgvx.f:297
zget52
subroutine zget52(left, n, a, lda, b, ldb, e, lde, alpha, beta, work, rwork, result)
ZGET52
Definition zget52.f:162
zlatm6
subroutine zlatm6(type, n, a, lda, b, x, ldx, y, ldy, alpha, beta, wx, wy, s, dif)
ZLATM6
Definition zlatm6.f:174