LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
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 threshhold 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 *> \date November 2011
291 *
292 *> \ingroup complex16_eig
293 *
294 * =====================================================================
295  SUBROUTINE zdrgvx( NSIZE, THRESH, NIN, NOUT, A, LDA, B, AI, BI,
296  $ alpha, beta, vl, vr, ilo, ihi, lscale, rscale,
297  $ s, dtru, dif, diftru, work, lwork, rwork,
298  $ iwork, liwork, result, bwork, info )
299 *
300 * -- LAPACK test routine (version 3.4.0) --
301 * -- LAPACK is a software package provided by Univ. of Tennessee, --
302 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
303 * November 2011
304 *
305 * .. Scalar Arguments ..
306  INTEGER ihi, ilo, info, lda, liwork, lwork, nin, nout,
307  $ nsize
308  DOUBLE PRECISION thresh
309 * ..
310 * .. Array Arguments ..
311  LOGICAL bwork( * )
312  INTEGER iwork( * )
313  DOUBLE PRECISION dif( * ), diftru( * ), dtru( * ), lscale( * ),
314  $ result( 4 ), rscale( * ), rwork( * ), s( * )
315  COMPLEX*16 a( lda, * ), ai( lda, * ), alpha( * ),
316  $ b( lda, * ), beta( * ), bi( lda, * ),
317  $ vl( lda, * ), vr( lda, * ), work( * )
318 * ..
319 *
320 * =====================================================================
321 *
322 * .. Parameters ..
323  DOUBLE PRECISION zero, one, ten, tnth, half
324  parameter( zero = 0.0d+0, one = 1.0d+0, ten = 1.0d+1,
325  $ tnth = 1.0d-1, half = 0.5d+0 )
326 * ..
327 * .. Local Scalars ..
328  INTEGER i, iptype, iwa, iwb, iwx, iwy, j, linfo,
329  $ maxwrk, minwrk, n, nerrs, nmax, nptknt, ntestt
330  DOUBLE PRECISION abnorm, anorm, bnorm, ratio1, ratio2, thrsh2,
331  $ ulp, ulpinv
332 * ..
333 * .. Local Arrays ..
334  COMPLEX*16 weight( 5 )
335 * ..
336 * .. External Functions ..
337  INTEGER ilaenv
338  DOUBLE PRECISION dlamch, zlange
339  EXTERNAL ilaenv, dlamch, zlange
340 * ..
341 * .. External Subroutines ..
342  EXTERNAL alasvm, xerbla, zget52, zggevx, zlacpy, zlatm6
343 * ..
344 * .. Intrinsic Functions ..
345  INTRINSIC abs, dcmplx, max, sqrt
346 * ..
347 * .. Executable Statements ..
348 *
349 * Check for errors
350 *
351  info = 0
352 *
353  nmax = 5
354 *
355  IF( nsize.LT.0 ) THEN
356  info = -1
357  ELSE IF( thresh.LT.zero ) THEN
358  info = -2
359  ELSE IF( nin.LE.0 ) THEN
360  info = -3
361  ELSE IF( nout.LE.0 ) THEN
362  info = -4
363  ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
364  info = -6
365  ELSE IF( liwork.LT.nmax+2 ) THEN
366  info = -26
367  END IF
368 *
369 * Compute workspace
370 * (Note: Comments in the code beginning "Workspace:" describe the
371 * minimal amount of workspace needed at that point in the code,
372 * as well as the preferred amount for good performance.
373 * NB refers to the optimal block size for the immediately
374 * following subroutine, as returned by ILAENV.)
375 *
376  minwrk = 1
377  IF( info.EQ.0 .AND. lwork.GE.1 ) THEN
378  minwrk = 2*nmax*( nmax+1 )
379  maxwrk = nmax*( 1+ilaenv( 1, 'ZGEQRF', ' ', nmax, 1, nmax,
380  $ 0 ) )
381  maxwrk = max( maxwrk, 2*nmax*( nmax+1 ) )
382  work( 1 ) = maxwrk
383  END IF
384 *
385  IF( lwork.LT.minwrk )
386  $ info = -23
387 *
388  IF( info.NE.0 ) THEN
389  CALL xerbla( 'ZDRGVX', -info )
390  return
391  END IF
392 *
393  n = 5
394  ulp = dlamch( 'P' )
395  ulpinv = one / ulp
396  thrsh2 = ten*thresh
397  nerrs = 0
398  nptknt = 0
399  ntestt = 0
400 *
401  IF( nsize.EQ.0 )
402  $ go to 90
403 *
404 * Parameters used for generating test matrices.
405 *
406  weight( 1 ) = dcmplx( tnth, zero )
407  weight( 2 ) = dcmplx( half, zero )
408  weight( 3 ) = one
409  weight( 4 ) = one / weight( 2 )
410  weight( 5 ) = one / weight( 1 )
411 *
412  DO 80 iptype = 1, 2
413  DO 70 iwa = 1, 5
414  DO 60 iwb = 1, 5
415  DO 50 iwx = 1, 5
416  DO 40 iwy = 1, 5
417 *
418 * generated a pair of test matrix
419 *
420  CALL zlatm6( iptype, 5, a, lda, b, vr, lda, vl,
421  $ lda, weight( iwa ), weight( iwb ),
422  $ weight( iwx ), weight( iwy ), dtru,
423  $ diftru )
424 *
425 * Compute eigenvalues/eigenvectors of (A, B).
426 * Compute eigenvalue/eigenvector condition numbers
427 * using computed eigenvectors.
428 *
429  CALL zlacpy( 'F', n, n, a, lda, ai, lda )
430  CALL zlacpy( 'F', n, n, b, lda, bi, lda )
431 *
432  CALL zggevx( 'N', 'V', 'V', 'B', n, ai, lda, bi,
433  $ lda, alpha, beta, vl, lda, vr, lda,
434  $ ilo, ihi, lscale, rscale, anorm,
435  $ bnorm, s, dif, work, lwork, rwork,
436  $ iwork, bwork, linfo )
437  IF( linfo.NE.0 ) THEN
438  WRITE( nout, fmt = 9999 )'ZGGEVX', linfo, n,
439  $ iptype, iwa, iwb, iwx, iwy
440  go to 30
441  END IF
442 *
443 * Compute the norm(A, B)
444 *
445  CALL zlacpy( 'Full', n, n, ai, lda, work, n )
446  CALL zlacpy( 'Full', n, n, bi, lda, work( n*n+1 ),
447  $ n )
448  abnorm = zlange( 'Fro', n, 2*n, work, n, rwork )
449 *
450 * Tests (1) and (2)
451 *
452  result( 1 ) = zero
453  CALL zget52( .true., n, a, lda, b, lda, vl, lda,
454  $ alpha, beta, work, rwork,
455  $ result( 1 ) )
456  IF( result( 2 ).GT.thresh ) THEN
457  WRITE( nout, fmt = 9998 )'Left', 'ZGGEVX',
458  $ result( 2 ), n, iptype, iwa, iwb, iwx, iwy
459  END IF
460 *
461  result( 2 ) = zero
462  CALL zget52( .false., n, a, lda, b, lda, vr, lda,
463  $ alpha, beta, work, rwork,
464  $ result( 2 ) )
465  IF( result( 3 ).GT.thresh ) THEN
466  WRITE( nout, fmt = 9998 )'Right', 'ZGGEVX',
467  $ result( 3 ), n, iptype, iwa, iwb, iwx, iwy
468  END IF
469 *
470 * Test (3)
471 *
472  result( 3 ) = zero
473  DO 10 i = 1, n
474  IF( s( i ).EQ.zero ) THEN
475  IF( dtru( i ).GT.abnorm*ulp )
476  $ result( 3 ) = ulpinv
477  ELSE IF( dtru( i ).EQ.zero ) THEN
478  IF( s( i ).GT.abnorm*ulp )
479  $ result( 3 ) = ulpinv
480  ELSE
481  rwork( i ) = max( abs( dtru( i ) / s( i ) ),
482  $ abs( s( i ) / dtru( i ) ) )
483  result( 3 ) = max( result( 3 ), rwork( i ) )
484  END IF
485  10 continue
486 *
487 * Test (4)
488 *
489  result( 4 ) = zero
490  IF( dif( 1 ).EQ.zero ) THEN
491  IF( diftru( 1 ).GT.abnorm*ulp )
492  $ result( 4 ) = ulpinv
493  ELSE IF( diftru( 1 ).EQ.zero ) THEN
494  IF( dif( 1 ).GT.abnorm*ulp )
495  $ result( 4 ) = ulpinv
496  ELSE IF( dif( 5 ).EQ.zero ) THEN
497  IF( diftru( 5 ).GT.abnorm*ulp )
498  $ result( 4 ) = ulpinv
499  ELSE IF( diftru( 5 ).EQ.zero ) THEN
500  IF( dif( 5 ).GT.abnorm*ulp )
501  $ result( 4 ) = ulpinv
502  ELSE
503  ratio1 = max( abs( diftru( 1 ) / dif( 1 ) ),
504  $ abs( dif( 1 ) / diftru( 1 ) ) )
505  ratio2 = max( abs( diftru( 5 ) / dif( 5 ) ),
506  $ abs( dif( 5 ) / diftru( 5 ) ) )
507  result( 4 ) = max( ratio1, ratio2 )
508  END IF
509 *
510  ntestt = ntestt + 4
511 *
512 * Print out tests which fail.
513 *
514  DO 20 j = 1, 4
515  IF( ( result( j ).GE.thrsh2 .AND. j.GE.4 ) .OR.
516  $ ( result( j ).GE.thresh .AND. j.LE.3 ) )
517  $ THEN
518 *
519 * If this is the first test to fail,
520 * print a header to the data file.
521 *
522  IF( nerrs.EQ.0 ) THEN
523  WRITE( nout, fmt = 9997 )'ZXV'
524 *
525 * Print out messages for built-in examples
526 *
527 * Matrix types
528 *
529  WRITE( nout, fmt = 9995 )
530  WRITE( nout, fmt = 9994 )
531  WRITE( nout, fmt = 9993 )
532 *
533 * Tests performed
534 *
535  WRITE( nout, fmt = 9992 )'''',
536  $ 'transpose', ''''
537 *
538  END IF
539  nerrs = nerrs + 1
540  IF( result( j ).LT.10000.0d0 ) THEN
541  WRITE( nout, fmt = 9991 )iptype, iwa,
542  $ iwb, iwx, iwy, j, result( j )
543  ELSE
544  WRITE( nout, fmt = 9990 )iptype, iwa,
545  $ iwb, iwx, iwy, j, result( j )
546  END IF
547  END IF
548  20 continue
549 *
550  30 continue
551 *
552  40 continue
553  50 continue
554  60 continue
555  70 continue
556  80 continue
557 *
558  go to 150
559 *
560  90 continue
561 *
562 * Read in data from file to check accuracy of condition estimation
563 * Read input data until N=0
564 *
565  READ( nin, fmt = *, END = 150 )n
566  IF( n.EQ.0 )
567  $ go to 150
568  DO 100 i = 1, n
569  READ( nin, fmt = * )( a( i, j ), j = 1, n )
570  100 continue
571  DO 110 i = 1, n
572  READ( nin, fmt = * )( b( i, j ), j = 1, n )
573  110 continue
574  READ( nin, fmt = * )( dtru( i ), i = 1, n )
575  READ( nin, fmt = * )( diftru( i ), i = 1, n )
576 *
577  nptknt = nptknt + 1
578 *
579 * Compute eigenvalues/eigenvectors of (A, B).
580 * Compute eigenvalue/eigenvector condition numbers
581 * using computed eigenvectors.
582 *
583  CALL zlacpy( 'F', n, n, a, lda, ai, lda )
584  CALL zlacpy( 'F', n, n, b, lda, bi, lda )
585 *
586  CALL zggevx( 'N', 'V', 'V', 'B', n, ai, lda, bi, lda, alpha, beta,
587  $ vl, lda, vr, lda, ilo, ihi, lscale, rscale, anorm,
588  $ bnorm, s, dif, work, lwork, rwork, iwork, bwork,
589  $ linfo )
590 *
591  IF( linfo.NE.0 ) THEN
592  WRITE( nout, fmt = 9987 )'ZGGEVX', linfo, n, nptknt
593  go to 140
594  END IF
595 *
596 * Compute the norm(A, B)
597 *
598  CALL zlacpy( 'Full', n, n, ai, lda, work, n )
599  CALL zlacpy( 'Full', n, n, bi, lda, work( n*n+1 ), n )
600  abnorm = zlange( 'Fro', n, 2*n, work, n, rwork )
601 *
602 * Tests (1) and (2)
603 *
604  result( 1 ) = zero
605  CALL zget52( .true., n, a, lda, b, lda, vl, lda, alpha, beta,
606  $ work, rwork, result( 1 ) )
607  IF( result( 2 ).GT.thresh ) THEN
608  WRITE( nout, fmt = 9986 )'Left', 'ZGGEVX', result( 2 ), n,
609  $ nptknt
610  END IF
611 *
612  result( 2 ) = zero
613  CALL zget52( .false., n, a, lda, b, lda, vr, lda, alpha, beta,
614  $ work, rwork, result( 2 ) )
615  IF( result( 3 ).GT.thresh ) THEN
616  WRITE( nout, fmt = 9986 )'Right', 'ZGGEVX', result( 3 ), n,
617  $ nptknt
618  END IF
619 *
620 * Test (3)
621 *
622  result( 3 ) = zero
623  DO 120 i = 1, n
624  IF( s( i ).EQ.zero ) THEN
625  IF( dtru( i ).GT.abnorm*ulp )
626  $ result( 3 ) = ulpinv
627  ELSE IF( dtru( i ).EQ.zero ) THEN
628  IF( s( i ).GT.abnorm*ulp )
629  $ result( 3 ) = ulpinv
630  ELSE
631  rwork( i ) = max( abs( dtru( i ) / s( i ) ),
632  $ abs( s( i ) / dtru( i ) ) )
633  result( 3 ) = max( result( 3 ), rwork( i ) )
634  END IF
635  120 continue
636 *
637 * Test (4)
638 *
639  result( 4 ) = zero
640  IF( dif( 1 ).EQ.zero ) THEN
641  IF( diftru( 1 ).GT.abnorm*ulp )
642  $ result( 4 ) = ulpinv
643  ELSE IF( diftru( 1 ).EQ.zero ) THEN
644  IF( dif( 1 ).GT.abnorm*ulp )
645  $ result( 4 ) = ulpinv
646  ELSE IF( dif( 5 ).EQ.zero ) THEN
647  IF( diftru( 5 ).GT.abnorm*ulp )
648  $ result( 4 ) = ulpinv
649  ELSE IF( diftru( 5 ).EQ.zero ) THEN
650  IF( dif( 5 ).GT.abnorm*ulp )
651  $ result( 4 ) = ulpinv
652  ELSE
653  ratio1 = max( abs( diftru( 1 ) / dif( 1 ) ),
654  $ abs( dif( 1 ) / diftru( 1 ) ) )
655  ratio2 = max( abs( diftru( 5 ) / dif( 5 ) ),
656  $ abs( dif( 5 ) / diftru( 5 ) ) )
657  result( 4 ) = max( ratio1, ratio2 )
658  END IF
659 *
660  ntestt = ntestt + 4
661 *
662 * Print out tests which fail.
663 *
664  DO 130 j = 1, 4
665  IF( result( j ).GE.thrsh2 ) THEN
666 *
667 * If this is the first test to fail,
668 * print a header to the data file.
669 *
670  IF( nerrs.EQ.0 ) THEN
671  WRITE( nout, fmt = 9997 )'ZXV'
672 *
673 * Print out messages for built-in examples
674 *
675 * Matrix types
676 *
677  WRITE( nout, fmt = 9996 )
678 *
679 * Tests performed
680 *
681  WRITE( nout, fmt = 9992 )'''', 'transpose', ''''
682 *
683  END IF
684  nerrs = nerrs + 1
685  IF( result( j ).LT.10000.0d0 ) THEN
686  WRITE( nout, fmt = 9989 )nptknt, n, j, result( j )
687  ELSE
688  WRITE( nout, fmt = 9988 )nptknt, n, j, result( j )
689  END IF
690  END IF
691  130 continue
692 *
693  140 continue
694 *
695  go to 90
696  150 continue
697 *
698 * Summary
699 *
700  CALL alasvm( 'ZXV', nout, nerrs, ntestt, 0 )
701 *
702  work( 1 ) = maxwrk
703 *
704  return
705 *
706  9999 format( ' ZDRGVX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
707  $ i6, ', JTYPE=', i6, ')' )
708 *
709  9998 format( ' ZDRGVX: ', a, ' Eigenvectors from ', a, ' incorrectly ',
710  $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
711  $ 'N=', i6, ', JTYPE=', i6, ', IWA=', i5, ', IWB=', i5,
712  $ ', IWX=', i5, ', IWY=', i5 )
713 *
714  9997 format( / 1x, a3, ' -- Complex Expert Eigenvalue/vector',
715  $ ' problem driver' )
716 *
717  9996 format( 'Input Example' )
718 *
719  9995 format( ' Matrix types: ', / )
720 *
721  9994 format( ' TYPE 1: Da is diagonal, Db is identity, ',
722  $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
723  $ / ' YH and X are left and right eigenvectors. ', / )
724 *
725  9993 format( ' TYPE 2: Da is quasi-diagonal, Db is identity, ',
726  $ / ' A = Y^(-H) Da X^(-1), B = Y^(-H) Db X^(-1) ',
727  $ / ' YH and X are left and right eigenvectors. ', / )
728 *
729  9992 format( / ' Tests performed: ', / 4x,
730  $ ' a is alpha, b is beta, l is a left eigenvector, ', / 4x,
731  $ ' r is a right eigenvector and ', a, ' means ', a, '.',
732  $ / ' 1 = max | ( b A - a B )', a, ' l | / const.',
733  $ / ' 2 = max | ( b A - a B ) r | / const.',
734  $ / ' 3 = max ( Sest/Stru, Stru/Sest ) ',
735  $ ' over all eigenvalues', /
736  $ ' 4 = max( DIFest/DIFtru, DIFtru/DIFest ) ',
737  $ ' over the 1st and 5th eigenvectors', / )
738 *
739  9991 format( ' Type=', i2, ',', ' IWA=', i2, ', IWB=', i2, ', IWX=',
740  $ i2, ', IWY=', i2, ', result ', i2, ' is', 0p, f8.2 )
741 *
742  9990 format( ' Type=', i2, ',', ' IWA=', i2, ', IWB=', i2, ', IWX=',
743  $ i2, ', IWY=', i2, ', result ', i2, ' is', 1p, d10.3 )
744 *
745  9989 format( ' Input example #', i2, ', matrix order=', i4, ',',
746  $ ' result ', i2, ' is', 0p, f8.2 )
747 *
748  9988 format( ' Input example #', i2, ', matrix order=', i4, ',',
749  $ ' result ', i2, ' is', 1p, d10.3 )
750 *
751  9987 format( ' ZDRGVX: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
752  $ i6, ', Input example #', i2, ')' )
753 *
754  9986 format( ' ZDRGVX: ', a, ' Eigenvectors from ', a, ' incorrectly ',
755  $ 'normalized.', / ' Bits of error=', 0p, g10.3, ',', 9x,
756  $ 'N=', i6, ', Input Example #', i2, ')' )
757 *
758 * End of ZDRGVX
759 *
760  END