TESTING/LIN/dlattr.f

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