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