LAPACK  3.10.0
LAPACK: Linear Algebra PACKage
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 tranpose 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
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:73
zget52
subroutine zget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
ZGET52
Definition: zget52.f:162
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
zlatm6
subroutine zlatm6(TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA, BETA, WX, WY, S, DIF)
ZLATM6
Definition: zlatm6.f:174
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
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