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