LAPACK  3.7.1
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 *> \date June 2016
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.7.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 * June 2016
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
alasvm
subroutine alasvm(TYPE, NOUT, NFAIL, NRUN, NERRS)
ALASVM
Definition: alasvm.f:75
zlatm6
subroutine zlatm6(TYPE, N, A, LDA, B, X, LDX, Y, LDY, ALPHA, BETA, WX, WY, S, DIF)
ZLATM6
Definition: zlatm6.f:176
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:299
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:105
zget52
subroutine zget52(LEFT, N, A, LDA, B, LDB, E, LDE, ALPHA, BETA, WORK, RWORK, RESULT)
ZGET52
Definition: zget52.f:164
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
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:376