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