TESTING/LIN/clattr.f

   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 *> \date November 2011
 134 *
 135 *> \ingroup complex_lin
 136 *
 137 *  =====================================================================
 138       SUBROUTINE CLATTR( 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       REAL               RWORK( * )
 153       COMPLEX            A( LDA, * ), 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, TYPE
 165       CHARACTER*3        PATH
 166       INTEGER            I, IY, J, JCOUNT, KL, KU, MODE
 167       REAL               ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
 168      $                   SFAC, SMLNUM, TEXP, TLEFT, TSCAL, ULP, UNFL, X,
 169      $                   Y, Z
 170       COMPLEX            PLUS1, PLUS2, RA, RB, S, 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, CROT, CROTG,
 181      $                   CSSCAL, CSWAP, SLABAD, SLARNV
 182 *     ..
 183 *     .. Intrinsic Functions ..
 184       INTRINSIC          ABS, CMPLX, CONJG, MAX, REAL, SQRT
 185 *     ..
 186 *     .. Executable Statements ..
 187 *
 188       PATH( 1: 1 ) = 'Complex precision'
 189       PATH( 2: 3 ) = 'TR'
 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.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 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       ELSE
 214          CALL CLATB4( 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 CLATMS( 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.25*CLARND( 5, ISEED )
 328          SFAC = 0.5
 329          PLUS1 = SFAC*CLARND( 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 = SLARND( 2, ISEED )
 339                IF( REXP.LT.ZERO ) THEN
 340                   STAR1 = -SFAC**( ONE-REXP )*CLARND( 5, ISEED )
 341                ELSE
 342                   STAR1 = SFAC**( ONE+REXP )*CLARND( 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. / ( 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 CCOPY( N-3, WORK, 1, A( 2, 3 ), LDA+1 )
 358                IF( N.GT.4 )
 359      $            CALL CCOPY( 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 CCOPY( N-3, WORK, 1, A( 3, 2 ), LDA+1 )
 369                IF( N.GT.4 )
 370      $            CALL CCOPY( 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.0
 385                CALL CROTG( 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 CROT( 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 CROT( 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.0
 406                CALL CROTG( RA, RB, C, S )
 407                S = CONJG( S )
 408 *
 409 *              Multiply by [ c -s;  conjg(s) c] on the right.
 410 *
 411                IF( N.GT.J+1 )
 412      $            CALL CROT( 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 CROT( 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 CLARNV( 4, ISEED, J-1, A( 1, J ) )
 440                A( J, J ) = CLARND( 5, ISEED )*TWO
 441   140       CONTINUE
 442          ELSE
 443             DO 150 J = 1, N
 444                IF( J.LT.N )
 445      $            CALL CLARNV( 4, ISEED, N-J, A( J+1, J ) )
 446                A( J, J ) = CLARND( 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 CLARNV( 2, ISEED, N, B )
 453          IY = ICAMAX( N, B, 1 )
 454          BNORM = ABS( B( IY ) )
 455          BSCAL = BIGNUM / MAX( ONE, BNORM )
 456          CALL CSSCAL( 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 CLARNV( 2, ISEED, N, B )
 465          TSCAL = ONE / MAX( ONE, REAL( N-1 ) )
 466          IF( UPPER ) THEN
 467             DO 160 J = 1, N
 468                CALL CLARNV( 4, ISEED, J-1, A( 1, J ) )
 469                CALL CSSCAL( J-1, TSCAL, A( 1, J ), 1 )
 470                A( J, J ) = CLARND( 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 CLARNV( 4, ISEED, N-J, A( J+1, J ) )
 477                   CALL CSSCAL( N-J, TSCAL, A( J+1, J ), 1 )
 478                END IF
 479                A( J, J ) = CLARND( 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 CLARNV( 2, ISEED, N, B )
 491          IF( UPPER ) THEN
 492             DO 180 J = 1, N
 493                CALL CLARNV( 4, ISEED, J-1, A( 1, J ) )
 494                A( J, J ) = CLARND( 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 CLARNV( 4, ISEED, N-J, A( J+1, J ) )
 501                A( J, J ) = CLARND( 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*CLARND( 5, ISEED )
 520                ELSE
 521                   A( J, J ) = CLARND( 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*CLARND( 5, ISEED )
 535                ELSE
 536                   A( J, J ) = CLARND( 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*CLARND( 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*CLARND( 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, REAL( N-1 ) )
 567          TSCAL = SMLNUM**TEXP
 568          CALL CLARNV( 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.
 573   260          CONTINUE
 574                IF( J.GT.1 )
 575      $            A( J-1, J ) = CMPLX( -ONE, -ONE )
 576                A( J, J ) = TSCAL*CLARND( 5, ISEED )
 577   270       CONTINUE
 578             B( N ) = CMPLX( ONE, ONE )
 579          ELSE
 580             DO 290 J = 1, N
 581                DO 280 I = J + 2, N
 582                   A( I, J ) = 0.
 583   280          CONTINUE
 584                IF( J.LT.N )
 585      $            A( J+1, J ) = CMPLX( -ONE, -ONE )
 586                A( J, J ) = TSCAL*CLARND( 5, ISEED )
 587   290       CONTINUE
 588             B( 1 ) = CMPLX( 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 CLARNV( 4, ISEED, J-1, A( 1, J ) )
 599                IF( J.NE.IY ) THEN
 600                   A( J, J ) = CLARND( 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 CLARNV( 4, ISEED, N-J, A( J+1, J ) )
 609                IF( J.NE.IY ) THEN
 610                   A( J, J ) = CLARND( 5, ISEED )*TWO
 611                ELSE
 612                   A( J, J ) = ZERO
 613                END IF
 614   310       CONTINUE
 615          END IF
 616          CALL CLARNV( 2, ISEED, N, B )
 617          CALL CSSCAL( 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.
 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 / REAL( N+1 )
 637                A( J, J ) = ONE
 638                B( J ) = TEXP*( ONE-ULP )
 639                A( 1, J-1 ) = -( TSCAL / REAL( N+1 ) ) / REAL( N+2 )
 640                A( J-1, J-1 ) = ONE
 641                B( J-1 ) = TEXP*REAL( N*N+N-1 )
 642                TEXP = TEXP*2.
 643   340       CONTINUE
 644             B( 1 ) = ( REAL( N+1 ) / REAL( N+2 ) )*TSCAL
 645          ELSE
 646             DO 350 J = 1, N - 1, 2
 647                A( N, J ) = -TSCAL / REAL( N+1 )
 648                A( J, J ) = ONE
 649                B( J ) = TEXP*( ONE-ULP )
 650                A( N, J+1 ) = -( TSCAL / REAL( N+1 ) ) / REAL( N+2 )
 651                A( J+1, J+1 ) = ONE
 652                B( J+1 ) = TEXP*REAL( N*N+N-1 )
 653                TEXP = TEXP*2.
 654   350       CONTINUE
 655             B( N ) = ( REAL( N+1 ) / REAL( 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 CLARNV( 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 CLARNV( 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 CLARNV( 2, ISEED, N, B )
 680          IY = ICAMAX( N, B, 1 )
 681          BNORM = ABS( B( IY ) )
 682          BSCAL = BIGNUM / MAX( ONE, BNORM )
 683          CALL CSSCAL( 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:  CLATRS no longer can handle this case
 691 *
 692          TLEFT = BIGNUM / MAX( ONE, REAL( N-1 ) )
 693          TSCAL = BIGNUM*( REAL( N-1 ) / MAX( ONE, REAL( N ) ) )
 694          IF( UPPER ) THEN
 695             DO 390 J = 1, N
 696                CALL CLARNV( 5, ISEED, J, A( 1, J ) )
 697                CALL SLARNV( 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 CLARNV( 5, ISEED, N-J+1, A( J, J ) )
 705                CALL SLARNV( 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 CLARNV( 2, ISEED, N, B )
 712          CALL CSSCAL( 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 CSWAP( 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 CSWAP( 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 CLATTR
 734 *
 735       END