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, 441 $ CLASET, SLABAD, SLASUM, XERBLA 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 912