LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
zdrvev.f
Go to the documentation of this file.
1 *> \brief \b ZDRVEV
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 ZDRVEV( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
12 * NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR,
13 * LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK,
14 * INFO )
15 *
16 * .. Scalar Arguments ..
17 * INTEGER INFO, LDA, LDLRE, LDVL, LDVR, NOUNIT, NSIZES,
18 * $ NTYPES, NWORK
19 * DOUBLE PRECISION THRESH
20 * ..
21 * .. Array Arguments ..
22 * LOGICAL DOTYPE( * )
23 * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
24 * DOUBLE PRECISION RESULT( 7 ), RWORK( * )
25 * COMPLEX*16 A( LDA, * ), H( LDA, * ), LRE( LDLRE, * ),
26 * $ VL( LDVL, * ), VR( LDVR, * ), W( * ), W1( * ),
27 * $ WORK( * )
28 * ..
29 *
30 *
31 *> \par Purpose:
32 * =============
33 *>
34 *> \verbatim
35 *>
36 *> ZDRVEV checks the nonsymmetric eigenvalue problem driver ZGEEV.
37 *>
38 *> When ZDRVEV is called, a number of matrix "sizes" ("n's") and a
39 *> number of matrix "types" are specified. For each size ("n")
40 *> and each type of matrix, one matrix will be generated and used
41 *> to test the nonsymmetric eigenroutines. For each matrix, 7
42 *> tests will be performed:
43 *>
44 *> (1) | A * VR - VR * W | / ( n |A| ulp )
45 *>
46 *> Here VR is the matrix of unit right eigenvectors.
47 *> W is a diagonal matrix with diagonal entries W(j).
48 *>
49 *> (2) | A**H * VL - VL * W**H | / ( n |A| ulp )
50 *>
51 *> Here VL is the matrix of unit left eigenvectors, A**H is the
52 *> conjugate-transpose of A, and W is as above.
53 *>
54 *> (3) | |VR(i)| - 1 | / ulp and whether largest component real
55 *>
56 *> VR(i) denotes the i-th column of VR.
57 *>
58 *> (4) | |VL(i)| - 1 | / ulp and whether largest component real
59 *>
60 *> VL(i) denotes the i-th column of VL.
61 *>
62 *> (5) W(full) = W(partial)
63 *>
64 *> W(full) denotes the eigenvalues computed when both VR and VL
65 *> are also computed, and W(partial) denotes the eigenvalues
66 *> computed when only W, only W and VR, or only W and VL are
67 *> computed.
68 *>
69 *> (6) VR(full) = VR(partial)
70 *>
71 *> VR(full) denotes the right eigenvectors computed when both VR
72 *> and VL are computed, and VR(partial) denotes the result
73 *> when only VR is computed.
74 *>
75 *> (7) VL(full) = VL(partial)
76 *>
77 *> VL(full) denotes the left eigenvectors computed when both VR
78 *> and VL are also computed, and VL(partial) denotes the result
79 *> when only VL is computed.
80 *>
81 *> The "sizes" are specified by an array NN(1:NSIZES); the value of
82 *> each element NN(j) specifies one size.
83 *> The "types" are specified by a logical array DOTYPE( 1:NTYPES );
84 *> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated.
85 *> Currently, the list of possible types is:
86 *>
87 *> (1) The zero matrix.
88 *> (2) The identity matrix.
89 *> (3) A (transposed) Jordan block, with 1's on the diagonal.
90 *>
91 *> (4) A diagonal matrix with evenly spaced entries
92 *> 1, ..., ULP and random complex angles.
93 *> (ULP = (first number larger than 1) - 1 )
94 *> (5) A diagonal matrix with geometrically spaced entries
95 *> 1, ..., ULP and random complex angles.
96 *> (6) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP
97 *> and random complex angles.
98 *>
99 *> (7) Same as (4), but multiplied by a constant near
100 *> the overflow threshold
101 *> (8) Same as (4), but multiplied by a constant near
102 *> the underflow threshold
103 *>
104 *> (9) A matrix of the form U' T U, where U is unitary and
105 *> T has evenly spaced entries 1, ..., ULP with random complex
106 *> angles on the diagonal and random O(1) entries in the upper
107 *> triangle.
108 *>
109 *> (10) A matrix of the form U' T U, where U is unitary and
110 *> T has geometrically spaced entries 1, ..., ULP with random
111 *> complex angles on the diagonal and random O(1) entries in
112 *> the upper triangle.
113 *>
114 *> (11) A matrix of the form U' T U, where U is unitary and
115 *> T has "clustered" entries 1, ULP,..., ULP with random
116 *> complex angles on the diagonal and random O(1) entries in
117 *> the upper triangle.
118 *>
119 *> (12) A matrix of the form U' T U, where U is unitary and
120 *> T has complex eigenvalues randomly chosen from
121 *> ULP < |z| < 1 and random O(1) entries in the upper
122 *> triangle.
123 *>
124 *> (13) A matrix of the form X' T X, where X has condition
125 *> SQRT( ULP ) and T has evenly spaced entries 1, ..., ULP
126 *> with random complex angles on the diagonal and random O(1)
127 *> entries in the upper triangle.
128 *>
129 *> (14) A matrix of the form X' T X, where X has condition
130 *> SQRT( ULP ) and T has geometrically spaced entries
131 *> 1, ..., ULP with random complex angles on the diagonal
132 *> and random O(1) entries in the upper triangle.
133 *>
134 *> (15) A matrix of the form X' T X, where X has condition
135 *> SQRT( ULP ) and T has "clustered" entries 1, ULP,..., ULP
136 *> with random complex angles on the diagonal and random O(1)
137 *> entries in the upper triangle.
138 *>
139 *> (16) A matrix of the form X' T X, where X has condition
140 *> SQRT( ULP ) and T has complex eigenvalues randomly chosen
141 *> from ULP < |z| < 1 and random O(1) entries in the upper
142 *> triangle.
143 *>
144 *> (17) Same as (16), but multiplied by a constant
145 *> near the overflow threshold
146 *> (18) Same as (16), but multiplied by a constant
147 *> near the underflow threshold
148 *>
149 *> (19) Nonsymmetric matrix with random entries chosen from |z| < 1
150 *> If N is at least 4, all entries in first two rows and last
151 *> row, and first column and last two columns are zero.
152 *> (20) Same as (19), but multiplied by a constant
153 *> near the overflow threshold
154 *> (21) Same as (19), but multiplied by a constant
155 *> near the underflow threshold
156 *> \endverbatim
157 *
158 * Arguments:
159 * ==========
160 *
161 *> \param[in] NSIZES
162 *> \verbatim
163 *> NSIZES is INTEGER
164 *> The number of sizes of matrices to use. If it is zero,
165 *> ZDRVEV does nothing. It must be at least zero.
166 *> \endverbatim
167 *>
168 *> \param[in] NN
169 *> \verbatim
170 *> NN is INTEGER array, dimension (NSIZES)
171 *> An array containing the sizes to be used for the matrices.
172 *> Zero values will be skipped. The values must be at least
173 *> zero.
174 *> \endverbatim
175 *>
176 *> \param[in] NTYPES
177 *> \verbatim
178 *> NTYPES is INTEGER
179 *> The number of elements in DOTYPE. If it is zero, ZDRVEV
180 *> does nothing. It must be at least zero. If it is MAXTYP+1
181 *> and NSIZES is 1, then an additional type, MAXTYP+1 is
182 *> defined, which is to use whatever matrix is in A. This
183 *> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and
184 *> DOTYPE(MAXTYP+1) is .TRUE. .
185 *> \endverbatim
186 *>
187 *> \param[in] DOTYPE
188 *> \verbatim
189 *> DOTYPE is LOGICAL array, dimension (NTYPES)
190 *> If DOTYPE(j) is .TRUE., then for each size in NN a
191 *> matrix of that size and of type j will be generated.
192 *> If NTYPES is smaller than the maximum number of types
193 *> defined (PARAMETER MAXTYP), then types NTYPES+1 through
194 *> MAXTYP will not be generated. If NTYPES is larger
195 *> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES)
196 *> will be ignored.
197 *> \endverbatim
198 *>
199 *> \param[in,out] ISEED
200 *> \verbatim
201 *> ISEED is INTEGER array, dimension (4)
202 *> On entry ISEED specifies the seed of the random number
203 *> generator. The array elements should be between 0 and 4095;
204 *> if not they will be reduced mod 4096. Also, ISEED(4) must
205 *> be odd. The random number generator uses a linear
206 *> congruential sequence limited to small integers, and so
207 *> should produce machine independent random numbers. The
208 *> values of ISEED are changed on exit, and can be used in the
209 *> next call to ZDRVEV to continue the same random number
210 *> sequence.
211 *> \endverbatim
212 *>
213 *> \param[in] THRESH
214 *> \verbatim
215 *> THRESH is DOUBLE PRECISION
216 *> A test will count as "failed" if the "error", computed as
217 *> described above, exceeds THRESH. Note that the error
218 *> is scaled to be O(1), so THRESH should be a reasonably
219 *> small multiple of 1, e.g., 10 or 100. In particular,
220 *> it should not depend on the precision (single vs. double)
221 *> or the size of the matrix. It must be at least zero.
222 *> \endverbatim
223 *>
224 *> \param[in] NOUNIT
225 *> \verbatim
226 *> NOUNIT is INTEGER
227 *> The FORTRAN unit number for printing out error messages
228 *> (e.g., if a routine returns INFO not equal to 0.)
229 *> \endverbatim
230 *>
231 *> \param[out] A
232 *> \verbatim
233 *> A is COMPLEX*16 array, dimension (LDA, max(NN))
234 *> Used to hold the matrix whose eigenvalues are to be
235 *> computed. On exit, A contains the last matrix actually used.
236 *> \endverbatim
237 *>
238 *> \param[in] LDA
239 *> \verbatim
240 *> LDA is INTEGER
241 *> The leading dimension of A, and H. LDA must be at
242 *> least 1 and at least max(NN).
243 *> \endverbatim
244 *>
245 *> \param[out] H
246 *> \verbatim
247 *> H is COMPLEX*16 array, dimension (LDA, max(NN))
248 *> Another copy of the test matrix A, modified by ZGEEV.
249 *> \endverbatim
250 *>
251 *> \param[out] W
252 *> \verbatim
253 *> W is COMPLEX*16 array, dimension (max(NN))
254 *> The eigenvalues of A. On exit, W are the eigenvalues of
255 *> the matrix in A.
256 *> \endverbatim
257 *>
258 *> \param[out] W1
259 *> \verbatim
260 *> W1 is COMPLEX*16 array, dimension (max(NN))
261 *> Like W, this array contains the eigenvalues of A,
262 *> but those computed when ZGEEV only computes a partial
263 *> eigendecomposition, i.e. not the eigenvalues and left
264 *> and right eigenvectors.
265 *> \endverbatim
266 *>
267 *> \param[out] VL
268 *> \verbatim
269 *> VL is COMPLEX*16 array, dimension (LDVL, max(NN))
270 *> VL holds the computed left eigenvectors.
271 *> \endverbatim
272 *>
273 *> \param[in] LDVL
274 *> \verbatim
275 *> LDVL is INTEGER
276 *> Leading dimension of VL. Must be at least max(1,max(NN)).
277 *> \endverbatim
278 *>
279 *> \param[out] VR
280 *> \verbatim
281 *> VR is COMPLEX*16 array, dimension (LDVR, max(NN))
282 *> VR holds the computed right eigenvectors.
283 *> \endverbatim
284 *>
285 *> \param[in] LDVR
286 *> \verbatim
287 *> LDVR is INTEGER
288 *> Leading dimension of VR. Must be at least max(1,max(NN)).
289 *> \endverbatim
290 *>
291 *> \param[out] LRE
292 *> \verbatim
293 *> LRE is COMPLEX*16 array, dimension (LDLRE, max(NN))
294 *> LRE holds the computed right or left eigenvectors.
295 *> \endverbatim
296 *>
297 *> \param[in] LDLRE
298 *> \verbatim
299 *> LDLRE is INTEGER
300 *> Leading dimension of LRE. Must be at least max(1,max(NN)).
301 *> \endverbatim
302 *>
303 *> \param[out] RESULT
304 *> \verbatim
305 *> RESULT is DOUBLE PRECISION array, dimension (7)
306 *> The values computed by the seven tests described above.
307 *> The values are currently limited to 1/ulp, to avoid
308 *> overflow.
309 *> \endverbatim
310 *>
311 *> \param[out] WORK
312 *> \verbatim
313 *> WORK is COMPLEX*16 array, dimension (NWORK)
314 *> \endverbatim
315 *>
316 *> \param[in] NWORK
317 *> \verbatim
318 *> NWORK is INTEGER
319 *> The number of entries in WORK. This must be at least
320 *> 5*NN(j)+2*NN(j)**2 for all j.
321 *> \endverbatim
322 *>
323 *> \param[out] RWORK
324 *> \verbatim
325 *> RWORK is DOUBLE PRECISION array, dimension (2*max(NN))
326 *> \endverbatim
327 *>
328 *> \param[out] IWORK
329 *> \verbatim
330 *> IWORK is INTEGER array, dimension (max(NN))
331 *> \endverbatim
332 *>
333 *> \param[out] INFO
334 *> \verbatim
335 *> INFO is INTEGER
336 *> If 0, then everything ran OK.
337 *> -1: NSIZES < 0
338 *> -2: Some NN(j) < 0
339 *> -3: NTYPES < 0
340 *> -6: THRESH < 0
341 *> -9: LDA < 1 or LDA < NMAX, where NMAX is max( NN(j) ).
342 *> -14: LDVL < 1 or LDVL < NMAX, where NMAX is max( NN(j) ).
343 *> -16: LDVR < 1 or LDVR < NMAX, where NMAX is max( NN(j) ).
344 *> -18: LDLRE < 1 or LDLRE < NMAX, where NMAX is max( NN(j) ).
345 *> -21: NWORK too small.
346 *> If ZLATMR, CLATMS, CLATME or ZGEEV returns an error code,
347 *> the absolute value of it is returned.
348 *>
349 *>-----------------------------------------------------------------------
350 *>
351 *> Some Local Variables and Parameters:
352 *> ---- ----- --------- --- ----------
353 *>
354 *> ZERO, ONE Real 0 and 1.
355 *> MAXTYP The number of types defined.
356 *> NMAX Largest value in NN.
357 *> NERRS The number of tests which have exceeded THRESH
358 *> COND, CONDS,
359 *> IMODE Values to be passed to the matrix generators.
360 *> ANORM Norm of A; passed to matrix generators.
361 *>
362 *> OVFL, UNFL Overflow and underflow thresholds.
363 *> ULP, ULPINV Finest relative precision and its inverse.
364 *> RTULP, RTULPI Square roots of the previous 4 values.
365 *>
366 *> The following four arrays decode JTYPE:
367 *> KTYPE(j) The general type (1-10) for type "j".
368 *> KMODE(j) The MODE value to be passed to the matrix
369 *> generator for type "j".
370 *> KMAGN(j) The order of magnitude ( O(1),
371 *> O(overflow^(1/2) ), O(underflow^(1/2) )
372 *> KCONDS(j) Selectw whether CONDS is to be 1 or
373 *> 1/sqrt(ulp). (0 means irrelevant.)
374 *> \endverbatim
375 *
376 * Authors:
377 * ========
378 *
379 *> \author Univ. of Tennessee
380 *> \author Univ. of California Berkeley
381 *> \author Univ. of Colorado Denver
382 *> \author NAG Ltd.
383 *
384 *> \date November 2011
385 *
386 *> \ingroup complex16_eig
387 *
388 * =====================================================================
389  SUBROUTINE zdrvev( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
390  $ nounit, a, lda, h, w, w1, vl, ldvl, vr, ldvr,
391  $ lre, ldlre, result, work, nwork, rwork, iwork,
392  $ info )
393 *
394 * -- LAPACK test routine (version 3.4.0) --
395 * -- LAPACK is a software package provided by Univ. of Tennessee, --
396 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
397 * November 2011
398 *
399 * .. Scalar Arguments ..
400  INTEGER info, lda, ldlre, ldvl, ldvr, nounit, nsizes,
401  $ ntypes, nwork
402  DOUBLE PRECISION thresh
403 * ..
404 * .. Array Arguments ..
405  LOGICAL dotype( * )
406  INTEGER iseed( 4 ), iwork( * ), nn( * )
407  DOUBLE PRECISION result( 7 ), rwork( * )
408  COMPLEX*16 a( lda, * ), h( lda, * ), lre( ldlre, * ),
409  $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
410  $ work( * )
411 * ..
412 *
413 * =====================================================================
414 *
415 * .. Parameters ..
416  COMPLEX*16 czero
417  parameter( czero = ( 0.0d+0, 0.0d+0 ) )
418  COMPLEX*16 cone
419  parameter( cone = ( 1.0d+0, 0.0d+0 ) )
420  DOUBLE PRECISION zero, one
421  parameter( zero = 0.0d+0, one = 1.0d+0 )
422  DOUBLE PRECISION two
423  parameter( two = 2.0d+0 )
424  INTEGER maxtyp
425  parameter( maxtyp = 21 )
426 * ..
427 * .. Local Scalars ..
428  LOGICAL badnn
429  CHARACTER*3 path
430  INTEGER iinfo, imode, itype, iwk, j, jcol, jj, jsize,
431  $ jtype, mtypes, n, nerrs, nfail, nmax, nnwork,
432  $ ntest, ntestf, ntestt
433  DOUBLE PRECISION anorm, cond, conds, ovfl, rtulp, rtulpi, tnrm,
434  $ ulp, ulpinv, unfl, vmx, vrmx, vtst
435 * ..
436 * .. Local Arrays ..
437  INTEGER idumma( 1 ), ioldsd( 4 ), kconds( maxtyp ),
438  $ kmagn( maxtyp ), kmode( maxtyp ),
439  $ ktype( maxtyp )
440  DOUBLE PRECISION res( 2 )
441  COMPLEX*16 dum( 1 )
442 * ..
443 * .. External Functions ..
444  DOUBLE PRECISION dlamch, dznrm2
445  EXTERNAL dlamch, dznrm2
446 * ..
447 * .. External Subroutines ..
448  EXTERNAL dlabad, dlasum, xerbla, zgeev, zget22, zlacpy,
450 * ..
451 * .. Intrinsic Functions ..
452  INTRINSIC abs, dble, dcmplx, dimag, max, min, sqrt
453 * ..
454 * .. Data statements ..
455  DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
456  DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
457  $ 3, 1, 2, 3 /
458  DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
459  $ 1, 5, 5, 5, 4, 3, 1 /
460  DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
461 * ..
462 * .. Executable Statements ..
463 *
464  path( 1: 1 ) = 'Zomplex precision'
465  path( 2: 3 ) = 'EV'
466 *
467 * Check for errors
468 *
469  ntestt = 0
470  ntestf = 0
471  info = 0
472 *
473 * Important constants
474 *
475  badnn = .false.
476  nmax = 0
477  DO 10 j = 1, nsizes
478  nmax = max( nmax, nn( j ) )
479  IF( nn( j ).LT.0 )
480  $ badnn = .true.
481  10 CONTINUE
482 *
483 * Check for errors
484 *
485  IF( nsizes.LT.0 ) THEN
486  info = -1
487  ELSE IF( badnn ) THEN
488  info = -2
489  ELSE IF( ntypes.LT.0 ) THEN
490  info = -3
491  ELSE IF( thresh.LT.zero ) THEN
492  info = -6
493  ELSE IF( nounit.LE.0 ) THEN
494  info = -7
495  ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
496  info = -9
497  ELSE IF( ldvl.LT.1 .OR. ldvl.LT.nmax ) THEN
498  info = -14
499  ELSE IF( ldvr.LT.1 .OR. ldvr.LT.nmax ) THEN
500  info = -16
501  ELSE IF( ldlre.LT.1 .OR. ldlre.LT.nmax ) THEN
502  info = -28
503  ELSE IF( 5*nmax+2*nmax**2.GT.nwork ) THEN
504  info = -21
505  END IF
506 *
507  IF( info.NE.0 ) THEN
508  CALL xerbla( 'ZDRVEV', -info )
509  RETURN
510  END IF
511 *
512 * Quick return if nothing to do
513 *
514  IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
515  $ RETURN
516 *
517 * More Important constants
518 *
519  unfl = dlamch( 'Safe minimum' )
520  ovfl = one / unfl
521  CALL dlabad( unfl, ovfl )
522  ulp = dlamch( 'Precision' )
523  ulpinv = one / ulp
524  rtulp = sqrt( ulp )
525  rtulpi = one / rtulp
526 *
527 * Loop over sizes, types
528 *
529  nerrs = 0
530 *
531  DO 270 jsize = 1, nsizes
532  n = nn( jsize )
533  IF( nsizes.NE.1 ) THEN
534  mtypes = min( maxtyp, ntypes )
535  ELSE
536  mtypes = min( maxtyp+1, ntypes )
537  END IF
538 *
539  DO 260 jtype = 1, mtypes
540  IF( .NOT.dotype( jtype ) )
541  $ go to 260
542 *
543 * Save ISEED in case of an error.
544 *
545  DO 20 j = 1, 4
546  ioldsd( j ) = iseed( j )
547  20 CONTINUE
548 *
549 * Compute "A"
550 *
551 * Control parameters:
552 *
553 * KMAGN KCONDS KMODE KTYPE
554 * =1 O(1) 1 clustered 1 zero
555 * =2 large large clustered 2 identity
556 * =3 small exponential Jordan
557 * =4 arithmetic diagonal, (w/ eigenvalues)
558 * =5 random log symmetric, w/ eigenvalues
559 * =6 random general, w/ eigenvalues
560 * =7 random diagonal
561 * =8 random symmetric
562 * =9 random general
563 * =10 random triangular
564 *
565  IF( mtypes.GT.maxtyp )
566  $ go to 90
567 *
568  itype = ktype( jtype )
569  imode = kmode( jtype )
570 *
571 * Compute norm
572 *
573  go to( 30, 40, 50 )kmagn( jtype )
574 *
575  30 CONTINUE
576  anorm = one
577  go to 60
578 *
579  40 CONTINUE
580  anorm = ovfl*ulp
581  go to 60
582 *
583  50 CONTINUE
584  anorm = unfl*ulpinv
585  go to 60
586 *
587  60 CONTINUE
588 *
589  CALL zlaset( 'Full', lda, n, czero, czero, a, lda )
590  iinfo = 0
591  cond = ulpinv
592 *
593 * Special Matrices -- Identity & Jordan block
594 *
595 * Zero
596 *
597  IF( itype.EQ.1 ) THEN
598  iinfo = 0
599 *
600  ELSE IF( itype.EQ.2 ) THEN
601 *
602 * Identity
603 *
604  DO 70 jcol = 1, n
605  a( jcol, jcol ) = dcmplx( anorm )
606  70 CONTINUE
607 *
608  ELSE IF( itype.EQ.3 ) THEN
609 *
610 * Jordan Block
611 *
612  DO 80 jcol = 1, n
613  a( jcol, jcol ) = dcmplx( anorm )
614  IF( jcol.GT.1 )
615  $ a( jcol, jcol-1 ) = cone
616  80 CONTINUE
617 *
618  ELSE IF( itype.EQ.4 ) THEN
619 *
620 * Diagonal Matrix, [Eigen]values Specified
621 *
622  CALL zlatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
623  $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
624  $ iinfo )
625 *
626  ELSE IF( itype.EQ.5 ) THEN
627 *
628 * Hermitian, eigenvalues specified
629 *
630  CALL zlatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
631  $ anorm, n, n, 'N', a, lda, work( n+1 ),
632  $ iinfo )
633 *
634  ELSE IF( itype.EQ.6 ) THEN
635 *
636 * General, eigenvalues specified
637 *
638  IF( kconds( jtype ).EQ.1 ) THEN
639  conds = one
640  ELSE IF( kconds( jtype ).EQ.2 ) THEN
641  conds = rtulpi
642  ELSE
643  conds = zero
644  END IF
645 *
646  CALL zlatme( n, 'D', iseed, work, imode, cond, cone,
647  $ 'T', 'T', 'T', rwork, 4, conds, n, n, anorm,
648  $ a, lda, work( 2*n+1 ), iinfo )
649 *
650  ELSE IF( itype.EQ.7 ) THEN
651 *
652 * Diagonal, random eigenvalues
653 *
654  CALL zlatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
655  $ 'T', 'N', work( n+1 ), 1, one,
656  $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
657  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
658 *
659  ELSE IF( itype.EQ.8 ) THEN
660 *
661 * Symmetric, random eigenvalues
662 *
663  CALL zlatmr( n, n, 'D', iseed, 'H', work, 6, one, cone,
664  $ 'T', 'N', work( n+1 ), 1, one,
665  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
666  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
667 *
668  ELSE IF( itype.EQ.9 ) THEN
669 *
670 * General, random eigenvalues
671 *
672  CALL zlatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
673  $ 'T', 'N', work( n+1 ), 1, one,
674  $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
675  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
676  IF( n.GE.4 ) THEN
677  CALL zlaset( 'Full', 2, n, czero, czero, a, lda )
678  CALL zlaset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
679  $ lda )
680  CALL zlaset( 'Full', n-3, 2, czero, czero,
681  $ a( 3, n-1 ), lda )
682  CALL zlaset( 'Full', 1, n, czero, czero, a( n, 1 ),
683  $ lda )
684  END IF
685 *
686  ELSE IF( itype.EQ.10 ) THEN
687 *
688 * Triangular, random eigenvalues
689 *
690  CALL zlatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
691  $ 'T', 'N', work( n+1 ), 1, one,
692  $ work( 2*n+1 ), 1, one, 'N', idumma, n, 0,
693  $ zero, anorm, 'NO', a, lda, iwork, iinfo )
694 *
695  ELSE
696 *
697  iinfo = 1
698  END IF
699 *
700  IF( iinfo.NE.0 ) THEN
701  WRITE( nounit, fmt = 9993 )'Generator', iinfo, n, jtype,
702  $ ioldsd
703  info = abs( iinfo )
704  RETURN
705  END IF
706 *
707  90 CONTINUE
708 *
709 * Test for minimal and generous workspace
710 *
711  DO 250 iwk = 1, 2
712  IF( iwk.EQ.1 ) THEN
713  nnwork = 2*n
714  ELSE
715  nnwork = 5*n + 2*n**2
716  END IF
717  nnwork = max( nnwork, 1 )
718 *
719 * Initialize RESULT
720 *
721  DO 100 j = 1, 7
722  result( j ) = -one
723  100 CONTINUE
724 *
725 * Compute eigenvalues and eigenvectors, and test them
726 *
727  CALL zlacpy( 'F', n, n, a, lda, h, lda )
728  CALL zgeev( 'V', 'V', n, h, lda, w, vl, ldvl, vr, ldvr,
729  $ work, nnwork, rwork, iinfo )
730  IF( iinfo.NE.0 ) THEN
731  result( 1 ) = ulpinv
732  WRITE( nounit, fmt = 9993 )'ZGEEV1', iinfo, n, jtype,
733  $ ioldsd
734  info = abs( iinfo )
735  go to 220
736  END IF
737 *
738 * Do Test (1)
739 *
740  CALL zget22( 'N', 'N', 'N', n, a, lda, vr, ldvr, w, work,
741  $ rwork, res )
742  result( 1 ) = res( 1 )
743 *
744 * Do Test (2)
745 *
746  CALL zget22( 'C', 'N', 'C', n, a, lda, vl, ldvl, w, work,
747  $ rwork, res )
748  result( 2 ) = res( 1 )
749 *
750 * Do Test (3)
751 *
752  DO 120 j = 1, n
753  tnrm = dznrm2( n, vr( 1, j ), 1 )
754  result( 3 ) = max( result( 3 ),
755  $ min( ulpinv, abs( tnrm-one ) / ulp ) )
756  vmx = zero
757  vrmx = zero
758  DO 110 jj = 1, n
759  vtst = abs( vr( jj, j ) )
760  IF( vtst.GT.vmx )
761  $ vmx = vtst
762  IF( dimag( vr( jj, j ) ).EQ.zero .AND.
763  $ abs( dble( vr( jj, j ) ) ).GT.vrmx )
764  $ vrmx = abs( dble( vr( jj, j ) ) )
765  110 CONTINUE
766  IF( vrmx / vmx.LT.one-two*ulp )
767  $ result( 3 ) = ulpinv
768  120 CONTINUE
769 *
770 * Do Test (4)
771 *
772  DO 140 j = 1, n
773  tnrm = dznrm2( n, vl( 1, j ), 1 )
774  result( 4 ) = max( result( 4 ),
775  $ min( ulpinv, abs( tnrm-one ) / ulp ) )
776  vmx = zero
777  vrmx = zero
778  DO 130 jj = 1, n
779  vtst = abs( vl( jj, j ) )
780  IF( vtst.GT.vmx )
781  $ vmx = vtst
782  IF( dimag( vl( jj, j ) ).EQ.zero .AND.
783  $ abs( dble( vl( jj, j ) ) ).GT.vrmx )
784  $ vrmx = abs( dble( vl( jj, j ) ) )
785  130 CONTINUE
786  IF( vrmx / vmx.LT.one-two*ulp )
787  $ result( 4 ) = ulpinv
788  140 CONTINUE
789 *
790 * Compute eigenvalues only, and test them
791 *
792  CALL zlacpy( 'F', n, n, a, lda, h, lda )
793  CALL zgeev( 'N', 'N', n, h, lda, w1, dum, 1, dum, 1,
794  $ work, nnwork, rwork, iinfo )
795  IF( iinfo.NE.0 ) THEN
796  result( 1 ) = ulpinv
797  WRITE( nounit, fmt = 9993 )'ZGEEV2', iinfo, n, jtype,
798  $ ioldsd
799  info = abs( iinfo )
800  go to 220
801  END IF
802 *
803 * Do Test (5)
804 *
805  DO 150 j = 1, n
806  IF( w( j ).NE.w1( j ) )
807  $ result( 5 ) = ulpinv
808  150 CONTINUE
809 *
810 * Compute eigenvalues and right eigenvectors, and test them
811 *
812  CALL zlacpy( 'F', n, n, a, lda, h, lda )
813  CALL zgeev( 'N', 'V', n, h, lda, w1, dum, 1, lre, ldlre,
814  $ work, nnwork, rwork, iinfo )
815  IF( iinfo.NE.0 ) THEN
816  result( 1 ) = ulpinv
817  WRITE( nounit, fmt = 9993 )'ZGEEV3', iinfo, n, jtype,
818  $ ioldsd
819  info = abs( iinfo )
820  go to 220
821  END IF
822 *
823 * Do Test (5) again
824 *
825  DO 160 j = 1, n
826  IF( w( j ).NE.w1( j ) )
827  $ result( 5 ) = ulpinv
828  160 CONTINUE
829 *
830 * Do Test (6)
831 *
832  DO 180 j = 1, n
833  DO 170 jj = 1, n
834  IF( vr( j, jj ).NE.lre( j, jj ) )
835  $ result( 6 ) = ulpinv
836  170 CONTINUE
837  180 CONTINUE
838 *
839 * Compute eigenvalues and left eigenvectors, and test them
840 *
841  CALL zlacpy( 'F', n, n, a, lda, h, lda )
842  CALL zgeev( 'V', 'N', n, h, lda, w1, lre, ldlre, dum, 1,
843  $ work, nnwork, rwork, iinfo )
844  IF( iinfo.NE.0 ) THEN
845  result( 1 ) = ulpinv
846  WRITE( nounit, fmt = 9993 )'ZGEEV4', iinfo, n, jtype,
847  $ ioldsd
848  info = abs( iinfo )
849  go to 220
850  END IF
851 *
852 * Do Test (5) again
853 *
854  DO 190 j = 1, n
855  IF( w( j ).NE.w1( j ) )
856  $ result( 5 ) = ulpinv
857  190 CONTINUE
858 *
859 * Do Test (7)
860 *
861  DO 210 j = 1, n
862  DO 200 jj = 1, n
863  IF( vl( j, jj ).NE.lre( j, jj ) )
864  $ result( 7 ) = ulpinv
865  200 CONTINUE
866  210 CONTINUE
867 *
868 * End of Loop -- Check for RESULT(j) > THRESH
869 *
870  220 CONTINUE
871 *
872  ntest = 0
873  nfail = 0
874  DO 230 j = 1, 7
875  IF( result( j ).GE.zero )
876  $ ntest = ntest + 1
877  IF( result( j ).GE.thresh )
878  $ nfail = nfail + 1
879  230 CONTINUE
880 *
881  IF( nfail.GT.0 )
882  $ ntestf = ntestf + 1
883  IF( ntestf.EQ.1 ) THEN
884  WRITE( nounit, fmt = 9999 )path
885  WRITE( nounit, fmt = 9998 )
886  WRITE( nounit, fmt = 9997 )
887  WRITE( nounit, fmt = 9996 )
888  WRITE( nounit, fmt = 9995 )thresh
889  ntestf = 2
890  END IF
891 *
892  DO 240 j = 1, 7
893  IF( result( j ).GE.thresh ) THEN
894  WRITE( nounit, fmt = 9994 )n, iwk, ioldsd, jtype,
895  $ j, result( j )
896  END IF
897  240 CONTINUE
898 *
899  nerrs = nerrs + nfail
900  ntestt = ntestt + ntest
901 *
902  250 CONTINUE
903  260 CONTINUE
904  270 CONTINUE
905 *
906 * Summary
907 *
908  CALL dlasum( path, nounit, nerrs, ntestt )
909 *
910  9999 FORMAT( / 1x, a3, ' -- Complex Eigenvalue-Eigenvector ',
911  $ 'Decomposition Driver', /
912  $ ' Matrix types (see ZDRVEV for details): ' )
913 *
914  9998 FORMAT( / ' Special Matrices:', / ' 1=Zero matrix. ',
915  $ ' ', ' 5=Diagonal: geometr. spaced entries.',
916  $ / ' 2=Identity matrix. ', ' 6=Diagona',
917  $ 'l: clustered entries.', / ' 3=Transposed Jordan block. ',
918  $ ' ', ' 7=Diagonal: large, evenly spaced.', / ' ',
919  $ '4=Diagonal: evenly spaced entries. ', ' 8=Diagonal: s',
920  $ 'mall, evenly spaced.' )
921  9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / ' 9=Well-cond., ev',
922  $ 'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',
923  $ 'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',
924  $ ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',
925  $ 'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',
926  $ 'lex ', a6, / ' 12=Well-cond., random complex ', a6, ' ',
927  $ ' 17=Ill-cond., large rand. complx ', a4, / ' 13=Ill-condi',
928  $ 'tioned, evenly spaced. ', ' 18=Ill-cond., small rand.',
929  $ ' complx ', a4 )
930  9996 FORMAT( ' 19=Matrix with random O(1) entries. ', ' 21=Matrix ',
931  $ 'with small random entries.', / ' 20=Matrix with large ran',
932  $ 'dom entries. ', / )
933  9995 FORMAT( ' Tests performed with test threshold =', f8.2,
934  $ / / ' 1 = | A VR - VR W | / ( n |A| ulp ) ',
935  $ / ' 2 = | conj-trans(A) VL - VL conj-trans(W) | /',
936  $ ' ( n |A| ulp ) ', / ' 3 = | |VR(i)| - 1 | / ulp ',
937  $ / ' 4 = | |VL(i)| - 1 | / ulp ',
938  $ / ' 5 = 0 if W same no matter if VR or VL computed,',
939  $ ' 1/ulp otherwise', /
940  $ ' 6 = 0 if VR same no matter if VL computed,',
941  $ ' 1/ulp otherwise', /
942  $ ' 7 = 0 if VL same no matter if VR computed,',
943  $ ' 1/ulp otherwise', / )
944  9994 FORMAT( ' N=', i5, ', IWK=', i2, ', seed=', 4( i4, ',' ),
945  $ ' type ', i2, ', test(', i2, ')=', g10.3 )
946  9993 FORMAT( ' ZDRVEV: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
947  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
948 *
949  RETURN
950 *
951 * End of ZDRVEV
952 *
953  END