1*> \brief \b ZCHKBB 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 ZCHKBB( NSIZES, MVAL, NVAL, NWDTHS, KK, NTYPES, DOTYPE, 12* NRHS, ISEED, THRESH, NOUNIT, A, LDA, AB, LDAB, 13* BD, BE, Q, LDQ, P, LDP, C, LDC, CC, WORK, 14* LWORK, RWORK, RESULT, INFO ) 15* 16* .. Scalar Arguments .. 17* INTEGER INFO, LDA, LDAB, LDC, LDP, LDQ, LWORK, NOUNIT, 18* $ NRHS, NSIZES, NTYPES, NWDTHS 19* DOUBLE PRECISION THRESH 20* .. 21* .. Array Arguments .. 22* LOGICAL DOTYPE( * ) 23* INTEGER ISEED( 4 ), KK( * ), MVAL( * ), NVAL( * ) 24* DOUBLE PRECISION BD( * ), BE( * ), RESULT( * ), RWORK( * ) 25* COMPLEX*16 A( LDA, * ), AB( LDAB, * ), C( LDC, * ), 26* $ CC( LDC, * ), P( LDP, * ), Q( LDQ, * ), 27* $ WORK( * ) 28* .. 29* 30* 31*> \par Purpose: 32* ============= 33*> 34*> \verbatim 35*> 36*> ZCHKBB tests the reduction of a general complex rectangular band 37*> matrix to real bidiagonal form. 38*> 39*> ZGBBRD factors a general band matrix A as Q B P* , where * means 40*> conjugate transpose, B is upper bidiagonal, and Q and P are unitary; 41*> ZGBBRD can also overwrite a given matrix C with Q* C . 42*> 43*> For each pair of matrix dimensions (M,N) and each selected matrix 44*> type, an M by N matrix A and an M by NRHS matrix C are generated. 45*> The problem dimensions are as follows 46*> A: M x N 47*> Q: M x M 48*> P: N x N 49*> B: min(M,N) x min(M,N) 50*> C: M x NRHS 51*> 52*> For each generated matrix, 4 tests are performed: 53*> 54*> (1) | A - Q B PT | / ( |A| max(M,N) ulp ), PT = P' 55*> 56*> (2) | I - Q' Q | / ( M ulp ) 57*> 58*> (3) | I - PT PT' | / ( N ulp ) 59*> 60*> (4) | Y - Q' C | / ( |Y| max(M,NRHS) ulp ), where Y = Q' C. 61*> 62*> The "types" are specified by a logical array DOTYPE( 1:NTYPES ); 63*> if DOTYPE(j) is .TRUE., then matrix type "j" will be generated. 64*> Currently, the list of possible types is: 65*> 66*> The possible matrix types are 67*> 68*> (1) The zero matrix. 69*> (2) The identity matrix. 70*> 71*> (3) A diagonal matrix with evenly spaced entries 72*> 1, ..., ULP and random signs. 73*> (ULP = (first number larger than 1) - 1 ) 74*> (4) A diagonal matrix with geometrically spaced entries 75*> 1, ..., ULP and random signs. 76*> (5) A diagonal matrix with "clustered" entries 1, ULP, ..., ULP 77*> and random signs. 78*> 79*> (6) Same as (3), but multiplied by SQRT( overflow threshold ) 80*> (7) Same as (3), but multiplied by SQRT( underflow threshold ) 81*> 82*> (8) A matrix of the form U D V, where U and V are orthogonal and 83*> D has evenly spaced entries 1, ..., ULP with random signs 84*> on the diagonal. 85*> 86*> (9) A matrix of the form U D V, where U and V are orthogonal and 87*> D has geometrically spaced entries 1, ..., ULP with random 88*> signs on the diagonal. 89*> 90*> (10) A matrix of the form U D V, where U and V are orthogonal and 91*> D has "clustered" entries 1, ULP,..., ULP with random 92*> signs on the diagonal. 93*> 94*> (11) Same as (8), but multiplied by SQRT( overflow threshold ) 95*> (12) Same as (8), but multiplied by SQRT( underflow threshold ) 96*> 97*> (13) Rectangular matrix with random entries chosen from (-1,1). 98*> (14) Same as (13), but multiplied by SQRT( overflow threshold ) 99*> (15) Same as (13), but multiplied by SQRT( underflow threshold ) 100*> \endverbatim 101* 102* Arguments: 103* ========== 104* 105*> \param[in] NSIZES 106*> \verbatim 107*> NSIZES is INTEGER 108*> The number of values of M and N contained in the vectors 109*> MVAL and NVAL. The matrix sizes are used in pairs (M,N). 110*> If NSIZES is zero, ZCHKBB does nothing. NSIZES must be at 111*> least zero. 112*> \endverbatim 113*> 114*> \param[in] MVAL 115*> \verbatim 116*> MVAL is INTEGER array, dimension (NSIZES) 117*> The values of the matrix row dimension M. 118*> \endverbatim 119*> 120*> \param[in] NVAL 121*> \verbatim 122*> NVAL is INTEGER array, dimension (NSIZES) 123*> The values of the matrix column dimension N. 124*> \endverbatim 125*> 126*> \param[in] NWDTHS 127*> \verbatim 128*> NWDTHS is INTEGER 129*> The number of bandwidths to use. If it is zero, 130*> ZCHKBB does nothing. It must be at least zero. 131*> \endverbatim 132*> 133*> \param[in] KK 134*> \verbatim 135*> KK is INTEGER array, dimension (NWDTHS) 136*> An array containing the bandwidths to be used for the band 137*> matrices. The values must be at least zero. 138*> \endverbatim 139*> 140*> \param[in] NTYPES 141*> \verbatim 142*> NTYPES is INTEGER 143*> The number of elements in DOTYPE. If it is zero, ZCHKBB 144*> does nothing. It must be at least zero. If it is MAXTYP+1 145*> and NSIZES is 1, then an additional type, MAXTYP+1 is 146*> defined, which is to use whatever matrix is in A. This 147*> is only useful if DOTYPE(1:MAXTYP) is .FALSE. and 148*> DOTYPE(MAXTYP+1) is .TRUE. . 149*> \endverbatim 150*> 151*> \param[in] DOTYPE 152*> \verbatim 153*> DOTYPE is LOGICAL array, dimension (NTYPES) 154*> If DOTYPE(j) is .TRUE., then for each size in NN a 155*> matrix of that size and of type j will be generated. 156*> If NTYPES is smaller than the maximum number of types 157*> defined (PARAMETER MAXTYP), then types NTYPES+1 through 158*> MAXTYP will not be generated. If NTYPES is larger 159*> than MAXTYP, DOTYPE(MAXTYP+1) through DOTYPE(NTYPES) 160*> will be ignored. 161*> \endverbatim 162*> 163*> \param[in] NRHS 164*> \verbatim 165*> NRHS is INTEGER 166*> The number of columns in the "right-hand side" matrix C. 167*> If NRHS = 0, then the operations on the right-hand side will 168*> not be tested. NRHS must be at least 0. 169*> \endverbatim 170*> 171*> \param[in,out] ISEED 172*> \verbatim 173*> ISEED is INTEGER array, dimension (4) 174*> On entry ISEED specifies the seed of the random number 175*> generator. The array elements should be between 0 and 4095; 176*> if not they will be reduced mod 4096. Also, ISEED(4) must 177*> be odd. The random number generator uses a linear 178*> congruential sequence limited to small integers, and so 179*> should produce machine independent random numbers. The 180*> values of ISEED are changed on exit, and can be used in the 181*> next call to ZCHKBB to continue the same random number 182*> sequence. 183*> \endverbatim 184*> 185*> \param[in] THRESH 186*> \verbatim 187*> THRESH is DOUBLE PRECISION 188*> A test will count as "failed" if the "error", computed as 189*> described above, exceeds THRESH. Note that the error 190*> is scaled to be O(1), so THRESH should be a reasonably 191*> small multiple of 1, e.g., 10 or 100. In particular, 192*> it should not depend on the precision (single vs. double) 193*> or the size of the matrix. It must be at least zero. 194*> \endverbatim 195*> 196*> \param[in] NOUNIT 197*> \verbatim 198*> NOUNIT is INTEGER 199*> The FORTRAN unit number for printing out error messages 200*> (e.g., if a routine returns IINFO not equal to 0.) 201*> \endverbatim 202*> 203*> \param[in,out] A 204*> \verbatim 205*> A is DOUBLE PRECISION array, dimension 206*> (LDA, max(NN)) 207*> Used to hold the matrix A. 208*> \endverbatim 209*> 210*> \param[in] LDA 211*> \verbatim 212*> LDA is INTEGER 213*> The leading dimension of A. It must be at least 1 214*> and at least max( NN ). 215*> \endverbatim 216*> 217*> \param[out] AB 218*> \verbatim 219*> AB is DOUBLE PRECISION array, dimension (LDAB, max(NN)) 220*> Used to hold A in band storage format. 221*> \endverbatim 222*> 223*> \param[in] LDAB 224*> \verbatim 225*> LDAB is INTEGER 226*> The leading dimension of AB. It must be at least 2 (not 1!) 227*> and at least max( KK )+1. 228*> \endverbatim 229*> 230*> \param[out] BD 231*> \verbatim 232*> BD is DOUBLE PRECISION array, dimension (max(NN)) 233*> Used to hold the diagonal of the bidiagonal matrix computed 234*> by ZGBBRD. 235*> \endverbatim 236*> 237*> \param[out] BE 238*> \verbatim 239*> BE is DOUBLE PRECISION array, dimension (max(NN)) 240*> Used to hold the off-diagonal of the bidiagonal matrix 241*> computed by ZGBBRD. 242*> \endverbatim 243*> 244*> \param[out] Q 245*> \verbatim 246*> Q is COMPLEX*16 array, dimension (LDQ, max(NN)) 247*> Used to hold the unitary matrix Q computed by ZGBBRD. 248*> \endverbatim 249*> 250*> \param[in] LDQ 251*> \verbatim 252*> LDQ is INTEGER 253*> The leading dimension of Q. It must be at least 1 254*> and at least max( NN ). 255*> \endverbatim 256*> 257*> \param[out] P 258*> \verbatim 259*> P is COMPLEX*16 array, dimension (LDP, max(NN)) 260*> Used to hold the unitary matrix P computed by ZGBBRD. 261*> \endverbatim 262*> 263*> \param[in] LDP 264*> \verbatim 265*> LDP is INTEGER 266*> The leading dimension of P. It must be at least 1 267*> and at least max( NN ). 268*> \endverbatim 269*> 270*> \param[out] C 271*> \verbatim 272*> C is COMPLEX*16 array, dimension (LDC, max(NN)) 273*> Used to hold the matrix C updated by ZGBBRD. 274*> \endverbatim 275*> 276*> \param[in] LDC 277*> \verbatim 278*> LDC is INTEGER 279*> The leading dimension of U. It must be at least 1 280*> and at least max( NN ). 281*> \endverbatim 282*> 283*> \param[out] CC 284*> \verbatim 285*> CC is COMPLEX*16 array, dimension (LDC, max(NN)) 286*> Used to hold a copy of the matrix C. 287*> \endverbatim 288*> 289*> \param[out] WORK 290*> \verbatim 291*> WORK is COMPLEX*16 array, dimension (LWORK) 292*> \endverbatim 293*> 294*> \param[in] LWORK 295*> \verbatim 296*> LWORK is INTEGER 297*> The number of entries in WORK. This must be at least 298*> max( LDA+1, max(NN)+1 )*max(NN). 299*> \endverbatim 300*> 301*> \param[out] RWORK 302*> \verbatim 303*> RWORK is DOUBLE PRECISION array, dimension (max(NN)) 304*> \endverbatim 305*> 306*> \param[out] RESULT 307*> \verbatim 308*> RESULT is DOUBLE PRECISION array, dimension (4) 309*> The values computed by the tests described above. 310*> The values are currently limited to 1/ulp, to avoid 311*> overflow. 312*> \endverbatim 313*> 314*> \param[out] INFO 315*> \verbatim 316*> INFO is INTEGER 317*> If 0, then everything ran OK. 318*> 319*>----------------------------------------------------------------------- 320*> 321*> Some Local Variables and Parameters: 322*> ---- ----- --------- --- ---------- 323*> ZERO, ONE Real 0 and 1. 324*> MAXTYP The number of types defined. 325*> NTEST The number of tests performed, or which can 326*> be performed so far, for the current matrix. 327*> NTESTT The total number of tests performed so far. 328*> NMAX Largest value in NN. 329*> NMATS The number of matrices generated so far. 330*> NERRS The number of tests which have exceeded THRESH 331*> so far. 332*> COND, IMODE Values to be passed to the matrix generators. 333*> ANORM Norm of A; passed to matrix generators. 334*> 335*> OVFL, UNFL Overflow and underflow thresholds. 336*> ULP, ULPINV Finest relative precision and its inverse. 337*> RTOVFL, RTUNFL Square roots of the previous 2 values. 338*> The following four arrays decode JTYPE: 339*> KTYPE(j) The general type (1-10) for type "j". 340*> KMODE(j) The MODE value to be passed to the matrix 341*> generator for type "j". 342*> KMAGN(j) The order of magnitude ( O(1), 343*> O(overflow^(1/2) ), O(underflow^(1/2) ) 344*> \endverbatim 345* 346* Authors: 347* ======== 348* 349*> \author Univ. of Tennessee 350*> \author Univ. of California Berkeley 351*> \author Univ. of Colorado Denver 352*> \author NAG Ltd. 353* 354*> \date November 2011 355* 356*> \ingroup complex16_eig 357* 358* ===================================================================== 359 SUBROUTINE ZCHKBB( NSIZES, MVAL, NVAL, NWDTHS, KK, NTYPES, DOTYPE, 360 $ NRHS, ISEED, THRESH, NOUNIT, A, LDA, AB, LDAB, 361 $ BD, BE, Q, LDQ, P, LDP, C, LDC, CC, WORK, 362 $ LWORK, RWORK, RESULT, INFO ) 363* 364* -- LAPACK test routine (input) -- 365* -- LAPACK is a software package provided by Univ. of Tennessee, -- 366* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 367* November 2011 368* 369* .. Scalar Arguments .. 370 INTEGER INFO, LDA, LDAB, LDC, LDP, LDQ, LWORK, NOUNIT, 371 $ NRHS, NSIZES, NTYPES, NWDTHS 372 DOUBLE PRECISION THRESH 373* .. 374* .. Array Arguments .. 375 LOGICAL DOTYPE( * ) 376 INTEGER ISEED( 4 ), KK( * ), MVAL( * ), NVAL( * ) 377 DOUBLE PRECISION BD( * ), BE( * ), RESULT( * ), RWORK( * ) 378 COMPLEX*16 A( LDA, * ), AB( LDAB, * ), C( LDC, * ), 379 $ CC( LDC, * ), P( LDP, * ), Q( LDQ, * ), 380 $ WORK( * ) 381* .. 382* 383* ===================================================================== 384* 385* .. Parameters .. 386 COMPLEX*16 CZERO, CONE 387 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ), 388 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 389 DOUBLE PRECISION ZERO, ONE 390 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 ) 391 INTEGER MAXTYP 392 PARAMETER ( MAXTYP = 15 ) 393* .. 394* .. Local Scalars .. 395 LOGICAL BADMM, BADNN, BADNNB 396 INTEGER I, IINFO, IMODE, ITYPE, J, JCOL, JR, JSIZE, 397 $ JTYPE, JWIDTH, K, KL, KMAX, KU, M, MMAX, MNMAX, 398 $ MNMIN, MTYPES, N, NERRS, NMATS, NMAX, NTEST, 399 $ NTESTT 400 DOUBLE PRECISION AMNINV, ANORM, COND, OVFL, RTOVFL, RTUNFL, ULP, 401 $ ULPINV, UNFL 402* .. 403* .. Local Arrays .. 404 INTEGER IDUMMA( 1 ), IOLDSD( 4 ), KMAGN( MAXTYP ), 405 $ KMODE( MAXTYP ), KTYPE( MAXTYP ) 406* .. 407* .. External Functions .. 408 DOUBLE PRECISION DLAMCH 409 EXTERNAL DLAMCH 410* .. 411* .. External Subroutines .. 412 EXTERNAL DLAHD2, DLASUM, XERBLA, ZBDT01, ZBDT02, ZGBBRD, 413 $ ZLACPY, ZLASET, ZLATMR, ZLATMS, ZUNT01 414* .. 415* .. Intrinsic Functions .. 416 INTRINSIC ABS, DBLE, MAX, MIN, SQRT 417* .. 418* .. Data statements .. 419 DATA KTYPE / 1, 2, 5*4, 5*6, 3*9 / 420 DATA KMAGN / 2*1, 3*1, 2, 3, 3*1, 2, 3, 1, 2, 3 / 421 DATA KMODE / 2*0, 4, 3, 1, 4, 4, 4, 3, 1, 4, 4, 0, 422 $ 0, 0 / 423* .. 424* .. Executable Statements .. 425* 426* Check for errors 427* 428 NTESTT = 0 429 INFO = 0 430* 431* Important constants 432* 433 BADMM = .FALSE. 434 BADNN = .FALSE. 435 MMAX = 1 436 NMAX = 1 437 MNMAX = 1 438 DO 10 J = 1, NSIZES 439 MMAX = MAX( MMAX, MVAL( J ) ) 440 IF( MVAL( J ).LT.0 ) 441 $ BADMM = .TRUE. 442 NMAX = MAX( NMAX, NVAL( J ) ) 443 IF( NVAL( J ).LT.0 ) 444 $ BADNN = .TRUE. 445 MNMAX = MAX( MNMAX, MIN( MVAL( J ), NVAL( J ) ) ) 446 10 CONTINUE 447* 448 BADNNB = .FALSE. 449 KMAX = 0 450 DO 20 J = 1, NWDTHS 451 KMAX = MAX( KMAX, KK( J ) ) 452 IF( KK( J ).LT.0 ) 453 $ BADNNB = .TRUE. 454 20 CONTINUE 455* 456* Check for errors 457* 458 IF( NSIZES.LT.0 ) THEN 459 INFO = -1 460 ELSE IF( BADMM ) THEN 461 INFO = -2 462 ELSE IF( BADNN ) THEN 463 INFO = -3 464 ELSE IF( NWDTHS.LT.0 ) THEN 465 INFO = -4 466 ELSE IF( BADNNB ) THEN 467 INFO = -5 468 ELSE IF( NTYPES.LT.0 ) THEN 469 INFO = -6 470 ELSE IF( NRHS.LT.0 ) THEN 471 INFO = -8 472 ELSE IF( LDA.LT.NMAX ) THEN 473 INFO = -13 474 ELSE IF( LDAB.LT.2*KMAX+1 ) THEN 475 INFO = -15 476 ELSE IF( LDQ.LT.NMAX ) THEN 477 INFO = -19 478 ELSE IF( LDP.LT.NMAX ) THEN 479 INFO = -21 480 ELSE IF( LDC.LT.NMAX ) THEN 481 INFO = -23 482 ELSE IF( ( MAX( LDA, NMAX )+1 )*NMAX.GT.LWORK ) THEN 483 INFO = -26 484 END IF 485* 486 IF( INFO.NE.0 ) THEN 487 CALL XERBLA( 'ZCHKBB', -INFO ) 488 RETURN 489 END IF 490* 491* Quick return if possible 492* 493 IF( NSIZES.EQ.0 .OR. NTYPES.EQ.0 .OR. NWDTHS.EQ.0 ) 494 $ RETURN 495* 496* More Important constants 497* 498 UNFL = DLAMCH( 'Safe minimum' ) 499 OVFL = ONE / UNFL 500 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 501 ULPINV = ONE / ULP 502 RTUNFL = SQRT( UNFL ) 503 RTOVFL = SQRT( OVFL ) 504* 505* Loop over sizes, widths, types 506* 507 NERRS = 0 508 NMATS = 0 509* 510 DO 160 JSIZE = 1, NSIZES 511 M = MVAL( JSIZE ) 512 N = NVAL( JSIZE ) 513 MNMIN = MIN( M, N ) 514 AMNINV = ONE / DBLE( MAX( 1, M, N ) ) 515* 516 DO 150 JWIDTH = 1, NWDTHS 517 K = KK( JWIDTH ) 518 IF( K.GE.M .AND. K.GE.N ) 519 $ GO TO 150 520 KL = MAX( 0, MIN( M-1, K ) ) 521 KU = MAX( 0, MIN( N-1, K ) ) 522* 523 IF( NSIZES.NE.1 ) THEN 524 MTYPES = MIN( MAXTYP, NTYPES ) 525 ELSE 526 MTYPES = MIN( MAXTYP+1, NTYPES ) 527 END IF 528* 529 DO 140 JTYPE = 1, MTYPES 530 IF( .NOT.DOTYPE( JTYPE ) ) 531 $ GO TO 140 532 NMATS = NMATS + 1 533 NTEST = 0 534* 535 DO 30 J = 1, 4 536 IOLDSD( J ) = ISEED( J ) 537 30 CONTINUE 538* 539* Compute "A". 540* 541* Control parameters: 542* 543* KMAGN KMODE KTYPE 544* =1 O(1) clustered 1 zero 545* =2 large clustered 2 identity 546* =3 small exponential (none) 547* =4 arithmetic diagonal, (w/ singular values) 548* =5 random log (none) 549* =6 random nonhermitian, w/ singular values 550* =7 (none) 551* =8 (none) 552* =9 random nonhermitian 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 ( 40, 50, 60 )KMAGN( JTYPE ) 563* 564 40 CONTINUE 565 ANORM = ONE 566 GO TO 70 567* 568 50 CONTINUE 569 ANORM = ( RTOVFL*ULP )*AMNINV 570 GO TO 70 571* 572 60 CONTINUE 573 ANORM = RTUNFL*MAX( M, N )*ULPINV 574 GO TO 70 575* 576 70 CONTINUE 577* 578 CALL ZLASET( 'Full', LDA, N, CZERO, CZERO, A, LDA ) 579 CALL ZLASET( 'Full', LDAB, N, CZERO, CZERO, AB, LDAB ) 580 IINFO = 0 581 COND = ULPINV 582* 583* Special Matrices -- Identity & Jordan block 584* 585* Zero 586* 587 IF( ITYPE.EQ.1 ) THEN 588 IINFO = 0 589* 590 ELSE IF( ITYPE.EQ.2 ) THEN 591* 592* Identity 593* 594 DO 80 JCOL = 1, N 595 A( JCOL, JCOL ) = ANORM 596 80 CONTINUE 597* 598 ELSE IF( ITYPE.EQ.4 ) THEN 599* 600* Diagonal Matrix, singular values specified 601* 602 CALL ZLATMS( M, N, 'S', ISEED, 'N', RWORK, IMODE, 603 $ COND, ANORM, 0, 0, 'N', A, LDA, WORK, 604 $ IINFO ) 605* 606 ELSE IF( ITYPE.EQ.6 ) THEN 607* 608* Nonhermitian, singular values specified 609* 610 CALL ZLATMS( M, N, 'S', ISEED, 'N', RWORK, IMODE, 611 $ COND, ANORM, KL, KU, 'N', A, LDA, WORK, 612 $ IINFO ) 613* 614 ELSE IF( ITYPE.EQ.9 ) THEN 615* 616* Nonhermitian, random entries 617* 618 CALL ZLATMR( M, N, 'S', ISEED, 'N', WORK, 6, ONE, 619 $ CONE, 'T', 'N', WORK( N+1 ), 1, ONE, 620 $ WORK( 2*N+1 ), 1, ONE, 'N', IDUMMA, KL, 621 $ KU, ZERO, ANORM, 'N', A, LDA, IDUMMA, 622 $ IINFO ) 623* 624 ELSE 625* 626 IINFO = 1 627 END IF 628* 629* Generate Right-Hand Side 630* 631 CALL ZLATMR( M, NRHS, 'S', ISEED, 'N', WORK, 6, ONE, 632 $ CONE, 'T', 'N', WORK( M+1 ), 1, ONE, 633 $ WORK( 2*M+1 ), 1, ONE, 'N', IDUMMA, M, NRHS, 634 $ ZERO, ONE, 'NO', C, LDC, IDUMMA, IINFO ) 635* 636 IF( IINFO.NE.0 ) THEN 637 WRITE( NOUNIT, FMT = 9999 )'Generator', IINFO, N, 638 $ JTYPE, IOLDSD 639 INFO = ABS( IINFO ) 640 RETURN 641 END IF 642* 643 90 CONTINUE 644* 645* Copy A to band storage. 646* 647 DO 110 J = 1, N 648 DO 100 I = MAX( 1, J-KU ), MIN( M, J+KL ) 649 AB( KU+1+I-J, J ) = A( I, J ) 650 100 CONTINUE 651 110 CONTINUE 652* 653* Copy C 654* 655 CALL ZLACPY( 'Full', M, NRHS, C, LDC, CC, LDC ) 656* 657* Call ZGBBRD to compute B, Q and P, and to update C. 658* 659 CALL ZGBBRD( 'B', M, N, NRHS, KL, KU, AB, LDAB, BD, BE, 660 $ Q, LDQ, P, LDP, CC, LDC, WORK, RWORK, 661 $ IINFO ) 662* 663 IF( IINFO.NE.0 ) THEN 664 WRITE( NOUNIT, FMT = 9999 )'ZGBBRD', IINFO, N, JTYPE, 665 $ IOLDSD 666 INFO = ABS( IINFO ) 667 IF( IINFO.LT.0 ) THEN 668 RETURN 669 ELSE 670 RESULT( 1 ) = ULPINV 671 GO TO 120 672 END IF 673 END IF 674* 675* Test 1: Check the decomposition A := Q * B * P' 676* 2: Check the orthogonality of Q 677* 3: Check the orthogonality of P 678* 4: Check the computation of Q' * C 679* 680 CALL ZBDT01( M, N, -1, A, LDA, Q, LDQ, BD, BE, P, LDP, 681 $ WORK, RWORK, RESULT( 1 ) ) 682 CALL ZUNT01( 'Columns', M, M, Q, LDQ, WORK, LWORK, RWORK, 683 $ RESULT( 2 ) ) 684 CALL ZUNT01( 'Rows', N, N, P, LDP, WORK, LWORK, RWORK, 685 $ RESULT( 3 ) ) 686 CALL ZBDT02( M, NRHS, C, LDC, CC, LDC, Q, LDQ, WORK, 687 $ RWORK, RESULT( 4 ) ) 688* 689* End of Loop -- Check for RESULT(j) > THRESH 690* 691 NTEST = 4 692 120 CONTINUE 693 NTESTT = NTESTT + NTEST 694* 695* Print out tests which fail. 696* 697 DO 130 JR = 1, NTEST 698 IF( RESULT( JR ).GE.THRESH ) THEN 699 IF( NERRS.EQ.0 ) 700 $ CALL DLAHD2( NOUNIT, 'ZBB' ) 701 NERRS = NERRS + 1 702 WRITE( NOUNIT, FMT = 9998 )M, N, K, IOLDSD, JTYPE, 703 $ JR, RESULT( JR ) 704 END IF 705 130 CONTINUE 706* 707 140 CONTINUE 708 150 CONTINUE 709 160 CONTINUE 710* 711* Summary 712* 713 CALL DLASUM( 'ZBB', NOUNIT, NERRS, NTESTT ) 714 RETURN 715* 716 9999 FORMAT( ' ZCHKBB: ', A, ' returned INFO=', I5, '.', / 9X, 'M=', 717 $ I5, ' N=', I5, ' K=', I5, ', JTYPE=', I5, ', ISEED=(', 718 $ 3( I5, ',' ), I5, ')' ) 719 9998 FORMAT( ' M =', I4, ' N=', I4, ', K=', I3, ', seed=', 720 $ 4( I4, ',' ), ' type ', I2, ', test(', I2, ')=', G10.3 ) 721* 722* End of ZCHKBB 723* 724 END 725