LAPACK  3.6.0
LAPACK: Linear Algebra PACKage
cdrvev.f
Go to the documentation of this file.
1 *> \brief \b CDRVEV
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 CDRVEV( 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 * REAL THRESH
20 * ..
21 * .. Array Arguments ..
22 * LOGICAL DOTYPE( * )
23 * INTEGER ISEED( 4 ), IWORK( * ), NN( * )
24 * REAL RESULT( 7 ), RWORK( * )
25 * COMPLEX 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 *> CDRVEV checks the nonsymmetric eigenvalue problem driver CGEEV.
37 *>
38 *> When CDRVEV 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 *> CDRVEV 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, CDRVEV
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 CDRVEV to continue the same random number
210 *> sequence.
211 *> \endverbatim
212 *>
213 *> \param[in] THRESH
214 *> \verbatim
215 *> THRESH is REAL
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 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 array, dimension (LDA, max(NN))
248 *> Another copy of the test matrix A, modified by CGEEV.
249 *> \endverbatim
250 *>
251 *> \param[out] W
252 *> \verbatim
253 *> W is COMPLEX 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 array, dimension (max(NN))
261 *> Like W, this array contains the eigenvalues of A,
262 *> but those computed when CGEEV 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 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 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 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 REAL 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 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 REAL 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 CLATMR, CLATMS, CLATME or CGEEV 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 complex_eig
387 *
388 * =====================================================================
389  SUBROUTINE cdrvev( 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  REAL THRESH
403 * ..
404 * .. Array Arguments ..
405  LOGICAL DOTYPE( * )
406  INTEGER ISEED( 4 ), IWORK( * ), NN( * )
407  REAL RESULT( 7 ), RWORK( * )
408  COMPLEX A( lda, * ), H( lda, * ), LRE( ldlre, * ),
409  $ vl( ldvl, * ), vr( ldvr, * ), w( * ), w1( * ),
410  $ work( * )
411 * ..
412 *
413 * =====================================================================
414 *
415 * .. Parameters ..
416  COMPLEX CZERO
417  parameter( czero = ( 0.0e+0, 0.0e+0 ) )
418  COMPLEX CONE
419  parameter( cone = ( 1.0e+0, 0.0e+0 ) )
420  REAL ZERO, ONE
421  parameter( zero = 0.0e+0, one = 1.0e+0 )
422  REAL TWO
423  parameter( two = 2.0e+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,
432  $ nnwork, ntest, ntestf, ntestt
433  REAL 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  REAL RES( 2 )
441  COMPLEX DUM( 1 )
442 * ..
443 * .. External Functions ..
444  REAL SCNRM2, SLAMCH
445  EXTERNAL scnrm2, slamch
446 * ..
447 * .. External Subroutines ..
448  EXTERNAL cgeev, cget22, clacpy, clatme, clatmr, clatms,
450 * ..
451 * .. Intrinsic Functions ..
452  INTRINSIC abs, aimag, cmplx, max, min, REAL, 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 ) = 'Complex 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( 'CDRVEV', -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 = slamch( 'Safe minimum' )
520  ovfl = one / unfl
521  CALL slabad( unfl, ovfl )
522  ulp = slamch( '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 claset( '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 ) = cmplx( 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 ) = cmplx( 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 clatms( 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 clatms( 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 clatme( n, 'D', iseed, work, imode, cond, cone,
647  $ 'T', 'T', 'T', rwork, 4, conds, n, n,
648  $ anorm, a, lda, work( 2*n+1 ), iinfo )
649 *
650  ELSE IF( itype.EQ.7 ) THEN
651 *
652 * Diagonal, random eigenvalues
653 *
654  CALL clatmr( 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 clatmr( 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 clatmr( 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 claset( 'Full', 2, n, czero, czero, a, lda )
678  CALL claset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
679  $ lda )
680  CALL claset( 'Full', n-3, 2, czero, czero,
681  $ a( 3, n-1 ), lda )
682  CALL claset( '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 clatmr( 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 clacpy( 'F', n, n, a, lda, h, lda )
728  CALL cgeev( '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 )'CGEEV1', iinfo, n, jtype,
733  $ ioldsd
734  info = abs( iinfo )
735  GO TO 220
736  END IF
737 *
738 * Do Test (1)
739 *
740  CALL cget22( '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 cget22( '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 = scnrm2( 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( aimag( vr( jj, j ) ).EQ.zero .AND.
763  $ abs( REAL( VR( JJ, J ) ) ).GT.vrmx )
764  $ vrmx = abs( REAL( 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 = scnrm2( 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( aimag( vl( jj, j ) ).EQ.zero .AND.
783  $ abs( REAL( VL( JJ, J ) ) ).GT.vrmx )
784  $ vrmx = abs( REAL( 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 clacpy( 'F', n, n, a, lda, h, lda )
793  CALL cgeev( '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 )'CGEEV2', 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 clacpy( 'F', n, n, a, lda, h, lda )
813  CALL cgeev( '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 )'CGEEV3', 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 clacpy( 'F', n, n, a, lda, h, lda )
842  CALL cgeev( '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 )'CGEEV4', 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 slasum( path, nounit, nerrs, ntestt )
909 *
910  9999 FORMAT( / 1x, a3, ' -- Complex Eigenvalue-Eigenvector ',
911  $ 'Decomposition Driver', /
912  $ ' Matrix types (see CDRVEV 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( ' CDRVEV: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
947  $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
948 *
949  RETURN
950 *
951 * End of CDRVEV
952 *
953  END
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
Definition: claset.f:108
subroutine clatme(N, DIST, ISEED, D, MODE, COND, DMAX, RSIGN, UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, A, LDA, WORK, INFO)
CLATME
Definition: clatme.f:303
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:76
subroutine cdrvev(NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, W, W1, VL, LDVL, VR, LDVR, LRE, LDLRE, RESULT, WORK, NWORK, RWORK, IWORK, INFO)
CDRVEV
Definition: cdrvev.f:393
subroutine cget22(TRANSA, TRANSE, TRANSW, N, A, LDA, E, LDE, W, WORK, RWORK, RESULT)
CGET22
Definition: cget22.f:145
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:105
subroutine clatmr(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, PACK, A, LDA, IWORK, INFO)
CLATMR
Definition: clatmr.f:492
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:42
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:334
subroutine cgeev(JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, LDVR, WORK, LWORK, RWORK, INFO)
CGEEV computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
Definition: cgeev.f:179