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