LAPACK 3.11.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
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*> \ingroup complex_eig
373*
374* =====================================================================
375 SUBROUTINE cdrves( NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH,
376 $ NOUNIT, A, LDA, H, HT, W, WT, VS, LDVS, RESULT,
377 $ WORK, NWORK, RWORK, IWORK, BWORK, INFO )
378*
379* -- LAPACK test routine --
380* -- LAPACK is a software package provided by Univ. of Tennessee, --
381* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
382*
383* .. Scalar Arguments ..
384 INTEGER INFO, LDA, LDVS, NOUNIT, NSIZES, NTYPES, NWORK
385 REAL THRESH
386* ..
387* .. Array Arguments ..
388 LOGICAL BWORK( * ), DOTYPE( * )
389 INTEGER ISEED( 4 ), IWORK( * ), NN( * )
390 REAL RESULT( 13 ), RWORK( * )
391 COMPLEX A( LDA, * ), H( LDA, * ), HT( LDA, * ),
392 $ vs( ldvs, * ), w( * ), work( * ), wt( * )
393* ..
394*
395* =====================================================================
396*
397* .. Parameters ..
398 COMPLEX CZERO
399 PARAMETER ( CZERO = ( 0.0e+0, 0.0e+0 ) )
400 COMPLEX CONE
401 parameter( cone = ( 1.0e+0, 0.0e+0 ) )
402 REAL ZERO, ONE
403 parameter( zero = 0.0e+0, one = 1.0e+0 )
404 INTEGER MAXTYP
405 parameter( maxtyp = 21 )
406* ..
407* .. Local Scalars ..
408 LOGICAL BADNN
409 CHARACTER SORT
410 CHARACTER*3 PATH
411 INTEGER I, IINFO, IMODE, ISORT, ITYPE, IWK, J, JCOL,
412 $ jsize, jtype, knteig, lwork, mtypes, n,
413 $ nerrs, nfail, nmax, nnwork, ntest, ntestf,
414 $ ntestt, rsub, sdim
415 REAL ANORM, COND, CONDS, OVFL, RTULP, RTULPI, ULP,
416 $ ULPINV, UNFL
417* ..
418* .. Local Arrays ..
419 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KCONDS( MAXTYP ),
420 $ KMAGN( MAXTYP ), KMODE( MAXTYP ),
421 $ ktype( maxtyp )
422 REAL RES( 2 )
423* ..
424* .. Arrays in Common ..
425 LOGICAL SELVAL( 20 )
426 REAL SELWI( 20 ), SELWR( 20 )
427* ..
428* .. Scalars in Common ..
429 INTEGER SELDIM, SELOPT
430* ..
431* .. Common blocks ..
432 COMMON / sslct / selopt, seldim, selval, selwr, selwi
433* ..
434* .. External Functions ..
435 LOGICAL CSLECT
436 REAL SLAMCH
437 EXTERNAL cslect, slamch
438* ..
439* .. External Subroutines ..
440 EXTERNAL cgees, chst01, clacpy, clatme, clatmr, clatms,
442* ..
443* .. Intrinsic Functions ..
444 INTRINSIC abs, cmplx, max, min, sqrt
445* ..
446* .. Data statements ..
447 DATA ktype / 1, 2, 3, 5*4, 4*6, 6*6, 3*9 /
448 DATA kmagn / 3*1, 1, 1, 1, 2, 3, 4*1, 1, 1, 1, 1, 2,
449 $ 3, 1, 2, 3 /
450 DATA kmode / 3*0, 4, 3, 1, 4, 4, 4, 3, 1, 5, 4, 3,
451 $ 1, 5, 5, 5, 4, 3, 1 /
452 DATA kconds / 3*0, 5*0, 4*1, 6*2, 3*0 /
453* ..
454* .. Executable Statements ..
455*
456 path( 1: 1 ) = 'Complex precision'
457 path( 2: 3 ) = 'ES'
458*
459* Check for errors
460*
461 ntestt = 0
462 ntestf = 0
463 info = 0
464 selopt = 0
465*
466* Important constants
467*
468 badnn = .false.
469 nmax = 0
470 DO 10 j = 1, nsizes
471 nmax = max( nmax, nn( j ) )
472 IF( nn( j ).LT.0 )
473 $ badnn = .true.
474 10 CONTINUE
475*
476* Check for errors
477*
478 IF( nsizes.LT.0 ) THEN
479 info = -1
480 ELSE IF( badnn ) THEN
481 info = -2
482 ELSE IF( ntypes.LT.0 ) THEN
483 info = -3
484 ELSE IF( thresh.LT.zero ) THEN
485 info = -6
486 ELSE IF( nounit.LE.0 ) THEN
487 info = -7
488 ELSE IF( lda.LT.1 .OR. lda.LT.nmax ) THEN
489 info = -9
490 ELSE IF( ldvs.LT.1 .OR. ldvs.LT.nmax ) THEN
491 info = -15
492 ELSE IF( 5*nmax+2*nmax**2.GT.nwork ) THEN
493 info = -18
494 END IF
495*
496 IF( info.NE.0 ) THEN
497 CALL xerbla( 'CDRVES', -info )
498 RETURN
499 END IF
500*
501* Quick return if nothing to do
502*
503 IF( nsizes.EQ.0 .OR. ntypes.EQ.0 )
504 $ RETURN
505*
506* More Important constants
507*
508 unfl = slamch( 'Safe minimum' )
509 ovfl = one / unfl
510 CALL slabad( unfl, ovfl )
511 ulp = slamch( 'Precision' )
512 ulpinv = one / ulp
513 rtulp = sqrt( ulp )
514 rtulpi = one / rtulp
515*
516* Loop over sizes, types
517*
518 nerrs = 0
519*
520 DO 240 jsize = 1, nsizes
521 n = nn( jsize )
522 IF( nsizes.NE.1 ) THEN
523 mtypes = min( maxtyp, ntypes )
524 ELSE
525 mtypes = min( maxtyp+1, ntypes )
526 END IF
527*
528 DO 230 jtype = 1, mtypes
529 IF( .NOT.dotype( jtype ) )
530 $ GO TO 230
531*
532* Save ISEED in case of an error.
533*
534 DO 20 j = 1, 4
535 ioldsd( j ) = iseed( j )
536 20 CONTINUE
537*
538* Compute "A"
539*
540* Control parameters:
541*
542* KMAGN KCONDS KMODE KTYPE
543* =1 O(1) 1 clustered 1 zero
544* =2 large large clustered 2 identity
545* =3 small exponential Jordan
546* =4 arithmetic diagonal, (w/ eigenvalues)
547* =5 random log symmetric, w/ eigenvalues
548* =6 random general, w/ eigenvalues
549* =7 random diagonal
550* =8 random symmetric
551* =9 random general
552* =10 random triangular
553*
554 IF( mtypes.GT.maxtyp )
555 $ GO TO 90
556*
557 itype = ktype( jtype )
558 imode = kmode( jtype )
559*
560* Compute norm
561*
562 GO TO ( 30, 40, 50 )kmagn( jtype )
563*
564 30 CONTINUE
565 anorm = one
566 GO TO 60
567*
568 40 CONTINUE
569 anorm = ovfl*ulp
570 GO TO 60
571*
572 50 CONTINUE
573 anorm = unfl*ulpinv
574 GO TO 60
575*
576 60 CONTINUE
577*
578 CALL claset( 'Full', lda, n, czero, czero, a, lda )
579 iinfo = 0
580 cond = ulpinv
581*
582* Special Matrices -- Identity & Jordan block
583*
584 IF( itype.EQ.1 ) THEN
585*
586* Zero
587*
588 iinfo = 0
589*
590 ELSE IF( itype.EQ.2 ) THEN
591*
592* Identity
593*
594 DO 70 jcol = 1, n
595 a( jcol, jcol ) = cmplx( anorm )
596 70 CONTINUE
597*
598 ELSE IF( itype.EQ.3 ) THEN
599*
600* Jordan Block
601*
602 DO 80 jcol = 1, n
603 a( jcol, jcol ) = cmplx( anorm )
604 IF( jcol.GT.1 )
605 $ a( jcol, jcol-1 ) = cone
606 80 CONTINUE
607*
608 ELSE IF( itype.EQ.4 ) THEN
609*
610* Diagonal Matrix, [Eigen]values Specified
611*
612 CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
613 $ anorm, 0, 0, 'N', a, lda, work( n+1 ),
614 $ iinfo )
615*
616 ELSE IF( itype.EQ.5 ) THEN
617*
618* Symmetric, eigenvalues specified
619*
620 CALL clatms( n, n, 'S', iseed, 'H', rwork, imode, cond,
621 $ anorm, n, n, 'N', a, lda, work( n+1 ),
622 $ iinfo )
623*
624 ELSE IF( itype.EQ.6 ) THEN
625*
626* General, eigenvalues specified
627*
628 IF( kconds( jtype ).EQ.1 ) THEN
629 conds = one
630 ELSE IF( kconds( jtype ).EQ.2 ) THEN
631 conds = rtulpi
632 ELSE
633 conds = zero
634 END IF
635*
636 CALL clatme( n, 'D', iseed, work, imode, cond, cone,
637 $ 'T', 'T', 'T', rwork, 4, conds, n, n, anorm,
638 $ a, lda, work( 2*n+1 ), iinfo )
639*
640 ELSE IF( itype.EQ.7 ) THEN
641*
642* Diagonal, random eigenvalues
643*
644 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
645 $ 'T', 'N', work( n+1 ), 1, one,
646 $ work( 2*n+1 ), 1, one, 'N', idumma, 0, 0,
647 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
648*
649 ELSE IF( itype.EQ.8 ) THEN
650*
651* Symmetric, random eigenvalues
652*
653 CALL clatmr( n, n, 'D', iseed, 'H', work, 6, one, cone,
654 $ 'T', 'N', work( n+1 ), 1, one,
655 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
656 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
657*
658 ELSE IF( itype.EQ.9 ) THEN
659*
660* General, random eigenvalues
661*
662 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
663 $ 'T', 'N', work( n+1 ), 1, one,
664 $ work( 2*n+1 ), 1, one, 'N', idumma, n, n,
665 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
666 IF( n.GE.4 ) THEN
667 CALL claset( 'Full', 2, n, czero, czero, a, lda )
668 CALL claset( 'Full', n-3, 1, czero, czero, a( 3, 1 ),
669 $ lda )
670 CALL claset( 'Full', n-3, 2, czero, czero,
671 $ a( 3, n-1 ), lda )
672 CALL claset( 'Full', 1, n, czero, czero, a( n, 1 ),
673 $ lda )
674 END IF
675*
676 ELSE IF( itype.EQ.10 ) THEN
677*
678* Triangular, random eigenvalues
679*
680 CALL clatmr( n, n, 'D', iseed, 'N', work, 6, one, cone,
681 $ 'T', 'N', work( n+1 ), 1, one,
682 $ work( 2*n+1 ), 1, one, 'N', idumma, n, 0,
683 $ zero, anorm, 'NO', a, lda, iwork, iinfo )
684*
685 ELSE
686*
687 iinfo = 1
688 END IF
689*
690 IF( iinfo.NE.0 ) THEN
691 WRITE( nounit, fmt = 9992 )'Generator', iinfo, n, jtype,
692 $ ioldsd
693 info = abs( iinfo )
694 RETURN
695 END IF
696*
697 90 CONTINUE
698*
699* Test for minimal and generous workspace
700*
701 DO 220 iwk = 1, 2
702 IF( iwk.EQ.1 ) THEN
703 nnwork = 3*n
704 ELSE
705 nnwork = 5*n + 2*n**2
706 END IF
707 nnwork = max( nnwork, 1 )
708*
709* Initialize RESULT
710*
711 DO 100 j = 1, 13
712 result( j ) = -one
713 100 CONTINUE
714*
715* Test with and without sorting of eigenvalues
716*
717 DO 180 isort = 0, 1
718 IF( isort.EQ.0 ) THEN
719 sort = 'N'
720 rsub = 0
721 ELSE
722 sort = 'S'
723 rsub = 6
724 END IF
725*
726* Compute Schur form and Schur vectors, and test them
727*
728 CALL clacpy( 'F', n, n, a, lda, h, lda )
729 CALL cgees( 'V', sort, cslect, n, h, lda, sdim, w, vs,
730 $ ldvs, work, nnwork, rwork, bwork, iinfo )
731 IF( iinfo.NE.0 ) THEN
732 result( 1+rsub ) = ulpinv
733 WRITE( nounit, fmt = 9992 )'CGEES1', iinfo, n,
734 $ jtype, ioldsd
735 info = abs( iinfo )
736 GO TO 190
737 END IF
738*
739* Do Test (1) or Test (7)
740*
741 result( 1+rsub ) = zero
742 DO 120 j = 1, n - 1
743 DO 110 i = j + 1, n
744 IF( h( i, j ).NE.zero )
745 $ result( 1+rsub ) = ulpinv
746 110 CONTINUE
747 120 CONTINUE
748*
749* Do Tests (2) and (3) or Tests (8) and (9)
750*
751 lwork = max( 1, 2*n*n )
752 CALL chst01( n, 1, n, a, lda, h, lda, vs, ldvs, work,
753 $ lwork, rwork, res )
754 result( 2+rsub ) = res( 1 )
755 result( 3+rsub ) = res( 2 )
756*
757* Do Test (4) or Test (10)
758*
759 result( 4+rsub ) = zero
760 DO 130 i = 1, n
761 IF( h( i, i ).NE.w( i ) )
762 $ result( 4+rsub ) = ulpinv
763 130 CONTINUE
764*
765* Do Test (5) or Test (11)
766*
767 CALL clacpy( 'F', n, n, a, lda, ht, lda )
768 CALL cgees( 'N', sort, cslect, n, ht, lda, sdim, wt,
769 $ vs, ldvs, work, nnwork, rwork, bwork,
770 $ iinfo )
771 IF( iinfo.NE.0 ) THEN
772 result( 5+rsub ) = ulpinv
773 WRITE( nounit, fmt = 9992 )'CGEES2', iinfo, n,
774 $ jtype, ioldsd
775 info = abs( iinfo )
776 GO TO 190
777 END IF
778*
779 result( 5+rsub ) = zero
780 DO 150 j = 1, n
781 DO 140 i = 1, n
782 IF( h( i, j ).NE.ht( i, j ) )
783 $ result( 5+rsub ) = ulpinv
784 140 CONTINUE
785 150 CONTINUE
786*
787* Do Test (6) or Test (12)
788*
789 result( 6+rsub ) = zero
790 DO 160 i = 1, n
791 IF( w( i ).NE.wt( i ) )
792 $ result( 6+rsub ) = ulpinv
793 160 CONTINUE
794*
795* Do Test (13)
796*
797 IF( isort.EQ.1 ) THEN
798 result( 13 ) = zero
799 knteig = 0
800 DO 170 i = 1, n
801 IF( cslect( w( i ) ) )
802 $ knteig = knteig + 1
803 IF( i.LT.n ) THEN
804 IF( cslect( w( i+1 ) ) .AND.
805 $ ( .NOT.cslect( w( i ) ) ) )result( 13 )
806 $ = ulpinv
807 END IF
808 170 CONTINUE
809 IF( sdim.NE.knteig )
810 $ result( 13 ) = ulpinv
811 END IF
812*
813 180 CONTINUE
814*
815* End of Loop -- Check for RESULT(j) > THRESH
816*
817 190 CONTINUE
818*
819 ntest = 0
820 nfail = 0
821 DO 200 j = 1, 13
822 IF( result( j ).GE.zero )
823 $ ntest = ntest + 1
824 IF( result( j ).GE.thresh )
825 $ nfail = nfail + 1
826 200 CONTINUE
827*
828 IF( nfail.GT.0 )
829 $ ntestf = ntestf + 1
830 IF( ntestf.EQ.1 ) THEN
831 WRITE( nounit, fmt = 9999 )path
832 WRITE( nounit, fmt = 9998 )
833 WRITE( nounit, fmt = 9997 )
834 WRITE( nounit, fmt = 9996 )
835 WRITE( nounit, fmt = 9995 )thresh
836 WRITE( nounit, fmt = 9994 )
837 ntestf = 2
838 END IF
839*
840 DO 210 j = 1, 13
841 IF( result( j ).GE.thresh ) THEN
842 WRITE( nounit, fmt = 9993 )n, iwk, ioldsd, jtype,
843 $ j, result( j )
844 END IF
845 210 CONTINUE
846*
847 nerrs = nerrs + nfail
848 ntestt = ntestt + ntest
849*
850 220 CONTINUE
851 230 CONTINUE
852 240 CONTINUE
853*
854* Summary
855*
856 CALL slasum( path, nounit, nerrs, ntestt )
857*
858 9999 FORMAT( / 1x, a3, ' -- Complex Schur Form Decomposition Driver',
859 $ / ' Matrix types (see CDRVES for details): ' )
860*
861 9998 FORMAT( / ' Special Matrices:', / ' 1=Zero matrix. ',
862 $ ' ', ' 5=Diagonal: geometr. spaced entries.',
863 $ / ' 2=Identity matrix. ', ' 6=Diagona',
864 $ 'l: clustered entries.', / ' 3=Transposed Jordan block. ',
865 $ ' ', ' 7=Diagonal: large, evenly spaced.', / ' ',
866 $ '4=Diagonal: evenly spaced entries. ', ' 8=Diagonal: s',
867 $ 'mall, evenly spaced.' )
868 9997 FORMAT( ' Dense, Non-Symmetric Matrices:', / ' 9=Well-cond., ev',
869 $ 'enly spaced eigenvals.', ' 14=Ill-cond., geomet. spaced e',
870 $ 'igenals.', / ' 10=Well-cond., geom. spaced eigenvals. ',
871 $ ' 15=Ill-conditioned, clustered e.vals.', / ' 11=Well-cond',
872 $ 'itioned, clustered e.vals. ', ' 16=Ill-cond., random comp',
873 $ 'lex ', a6, / ' 12=Well-cond., random complex ', a6, ' ',
874 $ ' 17=Ill-cond., large rand. complx ', a4, / ' 13=Ill-condi',
875 $ 'tioned, evenly spaced. ', ' 18=Ill-cond., small rand.',
876 $ ' complx ', a4 )
877 9996 FORMAT( ' 19=Matrix with random O(1) entries. ', ' 21=Matrix ',
878 $ 'with small random entries.', / ' 20=Matrix with large ran',
879 $ 'dom entries. ', / )
880 9995 FORMAT( ' Tests performed with test threshold =', f8.2,
881 $ / ' ( A denotes A on input and T denotes A on output)',
882 $ / / ' 1 = 0 if T in Schur form (no sort), ',
883 $ ' 1/ulp otherwise', /
884 $ ' 2 = | A - VS T transpose(VS) | / ( n |A| ulp ) (no sort)',
885 $ / ' 3 = | I - VS transpose(VS) | / ( n ulp ) (no sort) ',
886 $ / ' 4 = 0 if W are eigenvalues of T (no sort),',
887 $ ' 1/ulp otherwise', /
888 $ ' 5 = 0 if T same no matter if VS computed (no sort),',
889 $ ' 1/ulp otherwise', /
890 $ ' 6 = 0 if W same no matter if VS computed (no sort)',
891 $ ', 1/ulp otherwise' )
892 9994 FORMAT( ' 7 = 0 if T in Schur form (sort), ', ' 1/ulp otherwise',
893 $ / ' 8 = | A - VS T transpose(VS) | / ( n |A| ulp ) (sort)',
894 $ / ' 9 = | I - VS transpose(VS) | / ( n ulp ) (sort) ',
895 $ / ' 10 = 0 if W are eigenvalues of T (sort),',
896 $ ' 1/ulp otherwise', /
897 $ ' 11 = 0 if T same no matter if VS computed (sort),',
898 $ ' 1/ulp otherwise', /
899 $ ' 12 = 0 if W same no matter if VS computed (sort),',
900 $ ' 1/ulp otherwise', /
901 $ ' 13 = 0 if sorting successful, 1/ulp otherwise', / )
902 9993 FORMAT( ' N=', i5, ', IWK=', i2, ', seed=', 4( i4, ',' ),
903 $ ' type ', i2, ', test(', i2, ')=', g10.3 )
904 9992 FORMAT( ' CDRVES: ', a, ' returned INFO=', i6, '.', / 9x, 'N=',
905 $ i6, ', JTYPE=', i6, ', ISEED=(', 3( i5, ',' ), i5, ')' )
906*
907 RETURN
908*
909* End of CDRVES
910*
911 END
subroutine slabad(SMALL, LARGE)
SLABAD
Definition: slabad.f:74
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine chst01(N, ILO, IHI, A, LDA, H, LDH, Q, LDQ, WORK, LWORK, RWORK, RESULT)
CHST01
Definition: chst01.f:140
subroutine cdrves(NSIZES, NN, NTYPES, DOTYPE, ISEED, THRESH, NOUNIT, A, LDA, H, HT, W, WT, VS, LDVS, RESULT, WORK, NWORK, RWORK, IWORK, BWORK, INFO)
CDRVES
Definition: cdrves.f:378
subroutine clatms(M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, KL, KU, PACK, A, LDA, WORK, INFO)
CLATMS
Definition: clatms.f:332
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:301
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:490
subroutine cgees(JOBVS, SORT, SELECT, N, A, LDA, SDIM, W, VS, LDVS, WORK, LWORK, RWORK, BWORK, INFO)
CGEES computes the eigenvalues, the Schur form, and, optionally, the matrix of Schur vectors for GE m...
Definition: cgees.f:197
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:106
subroutine clacpy(UPLO, M, N, A, LDA, B, LDB)
CLACPY copies all or part of one two-dimensional array to another.
Definition: clacpy.f:103
subroutine slasum(TYPE, IOUNIT, IE, NRUN)
SLASUM
Definition: slasum.f:41