1*> \brief \b ZLATTB 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 ZLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, 12* LDAB, B, WORK, RWORK, INFO ) 13* 14* .. Scalar Arguments .. 15* CHARACTER DIAG, TRANS, UPLO 16* INTEGER IMAT, INFO, KD, LDAB, N 17* .. 18* .. Array Arguments .. 19* INTEGER ISEED( 4 ) 20* DOUBLE PRECISION RWORK( * ) 21* COMPLEX*16 AB( LDAB, * ), B( * ), WORK( * ) 22* .. 23* 24* 25*> \par Purpose: 26* ============= 27*> 28*> \verbatim 29*> 30*> ZLATTB generates a triangular test matrix in 2-dimensional storage. 31*> IMAT and UPLO uniquely specify the properties of the test matrix, 32*> which is returned in the array A. 33*> \endverbatim 34* 35* Arguments: 36* ========== 37* 38*> \param[in] IMAT 39*> \verbatim 40*> IMAT is INTEGER 41*> An integer key describing which matrix to generate for this 42*> path. 43*> \endverbatim 44*> 45*> \param[in] UPLO 46*> \verbatim 47*> UPLO is CHARACTER*1 48*> Specifies whether the matrix A will be upper or lower 49*> triangular. 50*> = 'U': Upper triangular 51*> = 'L': Lower triangular 52*> \endverbatim 53*> 54*> \param[in] TRANS 55*> \verbatim 56*> TRANS is CHARACTER*1 57*> Specifies whether the matrix or its transpose will be used. 58*> = 'N': No transpose 59*> = 'T': Transpose 60*> = 'C': Conjugate transpose (= transpose) 61*> \endverbatim 62*> 63*> \param[out] DIAG 64*> \verbatim 65*> DIAG is CHARACTER*1 66*> Specifies whether or not the matrix A is unit triangular. 67*> = 'N': Non-unit triangular 68*> = 'U': Unit triangular 69*> \endverbatim 70*> 71*> \param[in,out] ISEED 72*> \verbatim 73*> ISEED is INTEGER array, dimension (4) 74*> The seed vector for the random number generator (used in 75*> ZLATMS). Modified on exit. 76*> \endverbatim 77*> 78*> \param[in] N 79*> \verbatim 80*> N is INTEGER 81*> The order of the matrix to be generated. 82*> \endverbatim 83*> 84*> \param[in] KD 85*> \verbatim 86*> KD is INTEGER 87*> The number of superdiagonals or subdiagonals of the banded 88*> triangular matrix A. KD >= 0. 89*> \endverbatim 90*> 91*> \param[out] AB 92*> \verbatim 93*> AB is COMPLEX*16 array, dimension (LDAB,N) 94*> The upper or lower triangular banded matrix A, stored in the 95*> first KD+1 rows of AB. Let j be a column of A, 1<=j<=n. 96*> If UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j. 97*> If UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd). 98*> \endverbatim 99*> 100*> \param[in] LDAB 101*> \verbatim 102*> LDAB is INTEGER 103*> The leading dimension of the array AB. LDAB >= KD+1. 104*> \endverbatim 105*> 106*> \param[out] B 107*> \verbatim 108*> B is COMPLEX*16 array, dimension (N) 109*> \endverbatim 110*> 111*> \param[out] WORK 112*> \verbatim 113*> WORK is COMPLEX*16 array, dimension (2*N) 114*> \endverbatim 115*> 116*> \param[out] RWORK 117*> \verbatim 118*> RWORK is DOUBLE PRECISION array, dimension (N) 119*> \endverbatim 120*> 121*> \param[out] INFO 122*> \verbatim 123*> INFO is INTEGER 124*> = 0: successful exit 125*> < 0: if INFO = -i, the i-th argument had an illegal value 126*> \endverbatim 127* 128* Authors: 129* ======== 130* 131*> \author Univ. of Tennessee 132*> \author Univ. of California Berkeley 133*> \author Univ. of Colorado Denver 134*> \author NAG Ltd. 135* 136*> \date November 2011 137* 138*> \ingroup complex16_lin 139* 140* ===================================================================== 141 SUBROUTINE ZLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB, 142 $ LDAB, B, WORK, RWORK, INFO ) 143* 144* -- LAPACK test routine (version 3.4.0) -- 145* -- LAPACK is a software package provided by Univ. of Tennessee, -- 146* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 147* November 2011 148* 149* .. Scalar Arguments .. 150 CHARACTER DIAG, TRANS, UPLO 151 INTEGER IMAT, INFO, KD, LDAB, N 152* .. 153* .. Array Arguments .. 154 INTEGER ISEED( 4 ) 155 DOUBLE PRECISION RWORK( * ) 156 COMPLEX*16 AB( LDAB, * ), B( * ), WORK( * ) 157* .. 158* 159* ===================================================================== 160* 161* .. Parameters .. 162 DOUBLE PRECISION ONE, TWO, ZERO 163 PARAMETER ( ONE = 1.0D+0, TWO = 2.0D+0, ZERO = 0.0D+0 ) 164* .. 165* .. Local Scalars .. 166 LOGICAL UPPER 167 CHARACTER DIST, PACKIT, TYPE 168 CHARACTER*3 PATH 169 INTEGER I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE 170 DOUBLE PRECISION ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP, 171 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP, 172 $ UNFL 173 COMPLEX*16 PLUS1, PLUS2, STAR1 174* .. 175* .. External Functions .. 176 LOGICAL LSAME 177 INTEGER IZAMAX 178 DOUBLE PRECISION DLAMCH, DLARND 179 COMPLEX*16 ZLARND 180 EXTERNAL LSAME, IZAMAX, DLAMCH, DLARND, ZLARND 181* .. 182* .. External Subroutines .. 183 EXTERNAL DLABAD, DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4, 184 $ ZLATMS, ZSWAP 185* .. 186* .. Intrinsic Functions .. 187 INTRINSIC ABS, DBLE, DCMPLX, MAX, MIN, SQRT 188* .. 189* .. Executable Statements .. 190* 191 PATH( 1: 1 ) = 'Zomplex precision' 192 PATH( 2: 3 ) = 'TB' 193 UNFL = DLAMCH( 'Safe minimum' ) 194 ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' ) 195 SMLNUM = UNFL 196 BIGNUM = ( ONE-ULP ) / SMLNUM 197 CALL DLABAD( SMLNUM, BIGNUM ) 198 IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN 199 DIAG = 'U' 200 ELSE 201 DIAG = 'N' 202 END IF 203 INFO = 0 204* 205* Quick return if N.LE.0. 206* 207 IF( N.LE.0 ) 208 $ RETURN 209* 210* Call ZLATB4 to set parameters for CLATMS. 211* 212 UPPER = LSAME( UPLO, 'U' ) 213 IF( UPPER ) THEN 214 CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 215 $ CNDNUM, DIST ) 216 KU = KD 217 IOFF = 1 + MAX( 0, KD-N+1 ) 218 KL = 0 219 PACKIT = 'Q' 220 ELSE 221 CALL ZLATB4( PATH, -IMAT, N, N, TYPE, KL, KU, ANORM, MODE, 222 $ CNDNUM, DIST ) 223 KL = KD 224 IOFF = 1 225 KU = 0 226 PACKIT = 'B' 227 END IF 228* 229* IMAT <= 5: Non-unit triangular matrix 230* 231 IF( IMAT.LE.5 ) THEN 232 CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM, 233 $ ANORM, KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK, 234 $ INFO ) 235* 236* IMAT > 5: Unit triangular matrix 237* The diagonal is deliberately set to something other than 1. 238* 239* IMAT = 6: Matrix is the identity 240* 241 ELSE IF( IMAT.EQ.6 ) THEN 242 IF( UPPER ) THEN 243 DO 20 J = 1, N 244 DO 10 I = MAX( 1, KD+2-J ), KD 245 AB( I, J ) = ZERO 246 10 CONTINUE 247 AB( KD+1, J ) = J 248 20 CONTINUE 249 ELSE 250 DO 40 J = 1, N 251 AB( 1, J ) = J 252 DO 30 I = 2, MIN( KD+1, N-J+1 ) 253 AB( I, J ) = ZERO 254 30 CONTINUE 255 40 CONTINUE 256 END IF 257* 258* IMAT > 6: Non-trivial unit triangular matrix 259* 260* A unit triangular matrix T with condition CNDNUM is formed. 261* In this version, T only has bandwidth 2, the rest of it is zero. 262* 263 ELSE IF( IMAT.LE.9 ) THEN 264 TNORM = SQRT( CNDNUM ) 265* 266* Initialize AB to zero. 267* 268 IF( UPPER ) THEN 269 DO 60 J = 1, N 270 DO 50 I = MAX( 1, KD+2-J ), KD 271 AB( I, J ) = ZERO 272 50 CONTINUE 273 AB( KD+1, J ) = DBLE( J ) 274 60 CONTINUE 275 ELSE 276 DO 80 J = 1, N 277 DO 70 I = 2, MIN( KD+1, N-J+1 ) 278 AB( I, J ) = ZERO 279 70 CONTINUE 280 AB( 1, J ) = DBLE( J ) 281 80 CONTINUE 282 END IF 283* 284* Special case: T is tridiagonal. Set every other offdiagonal 285* so that the matrix has norm TNORM+1. 286* 287 IF( KD.EQ.1 ) THEN 288 IF( UPPER ) THEN 289 AB( 1, 2 ) = TNORM*ZLARND( 5, ISEED ) 290 LENJ = ( N-3 ) / 2 291 CALL ZLARNV( 2, ISEED, LENJ, WORK ) 292 DO 90 J = 1, LENJ 293 AB( 1, 2*( J+1 ) ) = TNORM*WORK( J ) 294 90 CONTINUE 295 ELSE 296 AB( 2, 1 ) = TNORM*ZLARND( 5, ISEED ) 297 LENJ = ( N-3 ) / 2 298 CALL ZLARNV( 2, ISEED, LENJ, WORK ) 299 DO 100 J = 1, LENJ 300 AB( 2, 2*J+1 ) = TNORM*WORK( J ) 301 100 CONTINUE 302 END IF 303 ELSE IF( KD.GT.1 ) THEN 304* 305* Form a unit triangular matrix T with condition CNDNUM. T is 306* given by 307* | 1 + * | 308* | 1 + | 309* T = | 1 + * | 310* | 1 + | 311* | 1 + * | 312* | 1 + | 313* | . . . | 314* Each element marked with a '*' is formed by taking the product 315* of the adjacent elements marked with '+'. The '*'s can be 316* chosen freely, and the '+'s are chosen so that the inverse of 317* T will have elements of the same magnitude as T. 318* 319* The two offdiagonals of T are stored in WORK. 320* 321 STAR1 = TNORM*ZLARND( 5, ISEED ) 322 SFAC = SQRT( TNORM ) 323 PLUS1 = SFAC*ZLARND( 5, ISEED ) 324 DO 110 J = 1, N, 2 325 PLUS2 = STAR1 / PLUS1 326 WORK( J ) = PLUS1 327 WORK( N+J ) = STAR1 328 IF( J+1.LE.N ) THEN 329 WORK( J+1 ) = PLUS2 330 WORK( N+J+1 ) = ZERO 331 PLUS1 = STAR1 / PLUS2 332* 333* Generate a new *-value with norm between sqrt(TNORM) 334* and TNORM. 335* 336 REXP = DLARND( 2, ISEED ) 337 IF( REXP.LT.ZERO ) THEN 338 STAR1 = -SFAC**( ONE-REXP )*ZLARND( 5, ISEED ) 339 ELSE 340 STAR1 = SFAC**( ONE+REXP )*ZLARND( 5, ISEED ) 341 END IF 342 END IF 343 110 CONTINUE 344* 345* Copy the tridiagonal T to AB. 346* 347 IF( UPPER ) THEN 348 CALL ZCOPY( N-1, WORK, 1, AB( KD, 2 ), LDAB ) 349 CALL ZCOPY( N-2, WORK( N+1 ), 1, AB( KD-1, 3 ), LDAB ) 350 ELSE 351 CALL ZCOPY( N-1, WORK, 1, AB( 2, 1 ), LDAB ) 352 CALL ZCOPY( N-2, WORK( N+1 ), 1, AB( 3, 1 ), LDAB ) 353 END IF 354 END IF 355* 356* IMAT > 9: Pathological test cases. These triangular matrices 357* are badly scaled or badly conditioned, so when used in solving a 358* triangular system they may cause overflow in the solution vector. 359* 360 ELSE IF( IMAT.EQ.10 ) THEN 361* 362* Type 10: Generate a triangular matrix with elements between 363* -1 and 1. Give the diagonal norm 2 to make it well-conditioned. 364* Make the right hand side large so that it requires scaling. 365* 366 IF( UPPER ) THEN 367 DO 120 J = 1, N 368 LENJ = MIN( J-1, KD ) 369 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) ) 370 AB( KD+1, J ) = ZLARND( 5, ISEED )*TWO 371 120 CONTINUE 372 ELSE 373 DO 130 J = 1, N 374 LENJ = MIN( N-J, KD ) 375 IF( LENJ.GT.0 ) 376 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 377 AB( 1, J ) = ZLARND( 5, ISEED )*TWO 378 130 CONTINUE 379 END IF 380* 381* Set the right hand side so that the largest value is BIGNUM. 382* 383 CALL ZLARNV( 2, ISEED, N, B ) 384 IY = IZAMAX( N, B, 1 ) 385 BNORM = ABS( B( IY ) ) 386 BSCAL = BIGNUM / MAX( ONE, BNORM ) 387 CALL ZDSCAL( N, BSCAL, B, 1 ) 388* 389 ELSE IF( IMAT.EQ.11 ) THEN 390* 391* Type 11: Make the first diagonal element in the solve small to 392* cause immediate overflow when dividing by T(j,j). 393* In type 11, the offdiagonal elements are small (CNORM(j) < 1). 394* 395 CALL ZLARNV( 2, ISEED, N, B ) 396 TSCAL = ONE / DBLE( KD+1 ) 397 IF( UPPER ) THEN 398 DO 140 J = 1, N 399 LENJ = MIN( J-1, KD ) 400 IF( LENJ.GT.0 ) THEN 401 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 402 CALL ZDSCAL( LENJ, TSCAL, AB( KD+2-LENJ, J ), 1 ) 403 END IF 404 AB( KD+1, J ) = ZLARND( 5, ISEED ) 405 140 CONTINUE 406 AB( KD+1, N ) = SMLNUM*AB( KD+1, N ) 407 ELSE 408 DO 150 J = 1, N 409 LENJ = MIN( N-J, KD ) 410 IF( LENJ.GT.0 ) THEN 411 CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 412 CALL ZDSCAL( LENJ, TSCAL, AB( 2, J ), 1 ) 413 END IF 414 AB( 1, J ) = ZLARND( 5, ISEED ) 415 150 CONTINUE 416 AB( 1, 1 ) = SMLNUM*AB( 1, 1 ) 417 END IF 418* 419 ELSE IF( IMAT.EQ.12 ) THEN 420* 421* Type 12: Make the first diagonal element in the solve small to 422* cause immediate overflow when dividing by T(j,j). 423* In type 12, the offdiagonal elements are O(1) (CNORM(j) > 1). 424* 425 CALL ZLARNV( 2, ISEED, N, B ) 426 IF( UPPER ) THEN 427 DO 160 J = 1, N 428 LENJ = MIN( J-1, KD ) 429 IF( LENJ.GT.0 ) 430 $ CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 431 AB( KD+1, J ) = ZLARND( 5, ISEED ) 432 160 CONTINUE 433 AB( KD+1, N ) = SMLNUM*AB( KD+1, N ) 434 ELSE 435 DO 170 J = 1, N 436 LENJ = MIN( N-J, KD ) 437 IF( LENJ.GT.0 ) 438 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 439 AB( 1, J ) = ZLARND( 5, ISEED ) 440 170 CONTINUE 441 AB( 1, 1 ) = SMLNUM*AB( 1, 1 ) 442 END IF 443* 444 ELSE IF( IMAT.EQ.13 ) THEN 445* 446* Type 13: T is diagonal with small numbers on the diagonal to 447* make the growth factor underflow, but a small right hand side 448* chosen so that the solution does not overflow. 449* 450 IF( UPPER ) THEN 451 JCOUNT = 1 452 DO 190 J = N, 1, -1 453 DO 180 I = MAX( 1, KD+1-( J-1 ) ), KD 454 AB( I, J ) = ZERO 455 180 CONTINUE 456 IF( JCOUNT.LE.2 ) THEN 457 AB( KD+1, J ) = SMLNUM*ZLARND( 5, ISEED ) 458 ELSE 459 AB( KD+1, J ) = ZLARND( 5, ISEED ) 460 END IF 461 JCOUNT = JCOUNT + 1 462 IF( JCOUNT.GT.4 ) 463 $ JCOUNT = 1 464 190 CONTINUE 465 ELSE 466 JCOUNT = 1 467 DO 210 J = 1, N 468 DO 200 I = 2, MIN( N-J+1, KD+1 ) 469 AB( I, J ) = ZERO 470 200 CONTINUE 471 IF( JCOUNT.LE.2 ) THEN 472 AB( 1, J ) = SMLNUM*ZLARND( 5, ISEED ) 473 ELSE 474 AB( 1, J ) = ZLARND( 5, ISEED ) 475 END IF 476 JCOUNT = JCOUNT + 1 477 IF( JCOUNT.GT.4 ) 478 $ JCOUNT = 1 479 210 CONTINUE 480 END IF 481* 482* Set the right hand side alternately zero and small. 483* 484 IF( UPPER ) THEN 485 B( 1 ) = ZERO 486 DO 220 I = N, 2, -2 487 B( I ) = ZERO 488 B( I-1 ) = SMLNUM*ZLARND( 5, ISEED ) 489 220 CONTINUE 490 ELSE 491 B( N ) = ZERO 492 DO 230 I = 1, N - 1, 2 493 B( I ) = ZERO 494 B( I+1 ) = SMLNUM*ZLARND( 5, ISEED ) 495 230 CONTINUE 496 END IF 497* 498 ELSE IF( IMAT.EQ.14 ) THEN 499* 500* Type 14: Make the diagonal elements small to cause gradual 501* overflow when dividing by T(j,j). To control the amount of 502* scaling needed, the matrix is bidiagonal. 503* 504 TEXP = ONE / DBLE( KD+1 ) 505 TSCAL = SMLNUM**TEXP 506 CALL ZLARNV( 4, ISEED, N, B ) 507 IF( UPPER ) THEN 508 DO 250 J = 1, N 509 DO 240 I = MAX( 1, KD+2-J ), KD 510 AB( I, J ) = ZERO 511 240 CONTINUE 512 IF( J.GT.1 .AND. KD.GT.0 ) 513 $ AB( KD, J ) = DCMPLX( -ONE, -ONE ) 514 AB( KD+1, J ) = TSCAL*ZLARND( 5, ISEED ) 515 250 CONTINUE 516 B( N ) = DCMPLX( ONE, ONE ) 517 ELSE 518 DO 270 J = 1, N 519 DO 260 I = 3, MIN( N-J+1, KD+1 ) 520 AB( I, J ) = ZERO 521 260 CONTINUE 522 IF( J.LT.N .AND. KD.GT.0 ) 523 $ AB( 2, J ) = DCMPLX( -ONE, -ONE ) 524 AB( 1, J ) = TSCAL*ZLARND( 5, ISEED ) 525 270 CONTINUE 526 B( 1 ) = DCMPLX( ONE, ONE ) 527 END IF 528* 529 ELSE IF( IMAT.EQ.15 ) THEN 530* 531* Type 15: One zero diagonal element. 532* 533 IY = N / 2 + 1 534 IF( UPPER ) THEN 535 DO 280 J = 1, N 536 LENJ = MIN( J, KD+1 ) 537 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 538 IF( J.NE.IY ) THEN 539 AB( KD+1, J ) = ZLARND( 5, ISEED )*TWO 540 ELSE 541 AB( KD+1, J ) = ZERO 542 END IF 543 280 CONTINUE 544 ELSE 545 DO 290 J = 1, N 546 LENJ = MIN( N-J+1, KD+1 ) 547 CALL ZLARNV( 4, ISEED, LENJ, AB( 1, J ) ) 548 IF( J.NE.IY ) THEN 549 AB( 1, J ) = ZLARND( 5, ISEED )*TWO 550 ELSE 551 AB( 1, J ) = ZERO 552 END IF 553 290 CONTINUE 554 END IF 555 CALL ZLARNV( 2, ISEED, N, B ) 556 CALL ZDSCAL( N, TWO, B, 1 ) 557* 558 ELSE IF( IMAT.EQ.16 ) THEN 559* 560* Type 16: Make the offdiagonal elements large to cause overflow 561* when adding a column of T. In the non-transposed case, the 562* matrix is constructed to cause overflow when adding a column in 563* every other step. 564* 565 TSCAL = UNFL / ULP 566 TSCAL = ( ONE-ULP ) / TSCAL 567 DO 310 J = 1, N 568 DO 300 I = 1, KD + 1 569 AB( I, J ) = ZERO 570 300 CONTINUE 571 310 CONTINUE 572 TEXP = ONE 573 IF( KD.GT.0 ) THEN 574 IF( UPPER ) THEN 575 DO 330 J = N, 1, -KD 576 DO 320 I = J, MAX( 1, J-KD+1 ), -2 577 AB( 1+( J-I ), I ) = -TSCAL / DBLE( KD+2 ) 578 AB( KD+1, I ) = ONE 579 B( I ) = TEXP*( ONE-ULP ) 580 IF( I.GT.MAX( 1, J-KD+1 ) ) THEN 581 AB( 2+( J-I ), I-1 ) = -( TSCAL / DBLE( KD+2 ) ) 582 $ / DBLE( KD+3 ) 583 AB( KD+1, I-1 ) = ONE 584 B( I-1 ) = TEXP*DBLE( ( KD+1 )*( KD+1 )+KD ) 585 END IF 586 TEXP = TEXP*TWO 587 320 CONTINUE 588 B( MAX( 1, J-KD+1 ) ) = ( DBLE( KD+2 ) / 589 $ DBLE( KD+3 ) )*TSCAL 590 330 CONTINUE 591 ELSE 592 DO 350 J = 1, N, KD 593 TEXP = ONE 594 LENJ = MIN( KD+1, N-J+1 ) 595 DO 340 I = J, MIN( N, J+KD-1 ), 2 596 AB( LENJ-( I-J ), J ) = -TSCAL / DBLE( KD+2 ) 597 AB( 1, J ) = ONE 598 B( J ) = TEXP*( ONE-ULP ) 599 IF( I.LT.MIN( N, J+KD-1 ) ) THEN 600 AB( LENJ-( I-J+1 ), I+1 ) = -( TSCAL / 601 $ DBLE( KD+2 ) ) / DBLE( KD+3 ) 602 AB( 1, I+1 ) = ONE 603 B( I+1 ) = TEXP*DBLE( ( KD+1 )*( KD+1 )+KD ) 604 END IF 605 TEXP = TEXP*TWO 606 340 CONTINUE 607 B( MIN( N, J+KD-1 ) ) = ( DBLE( KD+2 ) / 608 $ DBLE( KD+3 ) )*TSCAL 609 350 CONTINUE 610 END IF 611 END IF 612* 613 ELSE IF( IMAT.EQ.17 ) THEN 614* 615* Type 17: Generate a unit triangular matrix with elements 616* between -1 and 1, and make the right hand side large so that it 617* requires scaling. 618* 619 IF( UPPER ) THEN 620 DO 360 J = 1, N 621 LENJ = MIN( J-1, KD ) 622 CALL ZLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) ) 623 AB( KD+1, J ) = DBLE( J ) 624 360 CONTINUE 625 ELSE 626 DO 370 J = 1, N 627 LENJ = MIN( N-J, KD ) 628 IF( LENJ.GT.0 ) 629 $ CALL ZLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 630 AB( 1, J ) = DBLE( J ) 631 370 CONTINUE 632 END IF 633* 634* Set the right hand side so that the largest value is BIGNUM. 635* 636 CALL ZLARNV( 2, ISEED, N, B ) 637 IY = IZAMAX( N, B, 1 ) 638 BNORM = ABS( B( IY ) ) 639 BSCAL = BIGNUM / MAX( ONE, BNORM ) 640 CALL ZDSCAL( N, BSCAL, B, 1 ) 641* 642 ELSE IF( IMAT.EQ.18 ) THEN 643* 644* Type 18: Generate a triangular matrix with elements between 645* BIGNUM/(KD+1) and BIGNUM so that at least one of the column 646* norms will exceed BIGNUM. 647* 1/3/91: ZLATBS no longer can handle this case 648* 649 TLEFT = BIGNUM / DBLE( KD+1 ) 650 TSCAL = BIGNUM*( DBLE( KD+1 ) / DBLE( KD+2 ) ) 651 IF( UPPER ) THEN 652 DO 390 J = 1, N 653 LENJ = MIN( J, KD+1 ) 654 CALL ZLARNV( 5, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 655 CALL DLARNV( 1, ISEED, LENJ, RWORK( KD+2-LENJ ) ) 656 DO 380 I = KD + 2 - LENJ, KD + 1 657 AB( I, J ) = AB( I, J )*( TLEFT+RWORK( I )*TSCAL ) 658 380 CONTINUE 659 390 CONTINUE 660 ELSE 661 DO 410 J = 1, N 662 LENJ = MIN( N-J+1, KD+1 ) 663 CALL ZLARNV( 5, ISEED, LENJ, AB( 1, J ) ) 664 CALL DLARNV( 1, ISEED, LENJ, RWORK ) 665 DO 400 I = 1, LENJ 666 AB( I, J ) = AB( I, J )*( TLEFT+RWORK( I )*TSCAL ) 667 400 CONTINUE 668 410 CONTINUE 669 END IF 670 CALL ZLARNV( 2, ISEED, N, B ) 671 CALL ZDSCAL( N, TWO, B, 1 ) 672 END IF 673* 674* Flip the matrix if the transpose will be used. 675* 676 IF( .NOT.LSAME( TRANS, 'N' ) ) THEN 677 IF( UPPER ) THEN 678 DO 420 J = 1, N / 2 679 LENJ = MIN( N-2*J+1, KD+1 ) 680 CALL ZSWAP( LENJ, AB( KD+1, J ), LDAB-1, 681 $ AB( KD+2-LENJ, N-J+1 ), -1 ) 682 420 CONTINUE 683 ELSE 684 DO 430 J = 1, N / 2 685 LENJ = MIN( N-2*J+1, KD+1 ) 686 CALL ZSWAP( LENJ, AB( 1, J ), 1, AB( LENJ, N-J+2-LENJ ), 687 $ -LDAB+1 ) 688 430 CONTINUE 689 END IF 690 END IF 691* 692 RETURN 693* 694* End of ZLATTB 695* 696 END 697