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