LAPACK: TESTING/LIN/zlattr.f Source File

Go to the documentation of this file.
00001       SUBROUTINE ZLATTR( IMAT, UPLO, TRANS, DIAG, ISEED, N, A, LDA, B,
00002      $                   WORK, RWORK, INFO )
00003 *
00004 *  -- LAPACK test routine (version 3.1) --
00005 *     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
00006 *     November 2006
00007 *
00008 *     .. Scalar Arguments ..
00009       CHARACTER          DIAG, TRANS, UPLO
00010       INTEGER            IMAT, INFO, LDA, N
00011 *     ..
00012 *     .. Array Arguments ..
00013       INTEGER            ISEED( 4 )
00014       DOUBLE PRECISION   RWORK( * )
00015       COMPLEX*16         A( LDA, * ), B( * ), WORK( * )
00016 *     ..
00017 *
00018 *  Purpose
00019 *  =======
00020 *
00021 *  ZLATTR generates a triangular test matrix in 2-dimensional storage.
00022 *  IMAT and UPLO uniquely specify the properties of the test matrix,
00023 *  which is returned in the array A.
00024 *
00025 *  Arguments
00026 *  =========
00027 *
00028 *  IMAT    (input) INTEGER
00029 *          An integer key describing which matrix to generate for this
00030 *          path.
00031 *
00032 *  UPLO    (input) CHARACTER*1
00033 *          Specifies whether the matrix A will be upper or lower
00034 *          triangular.
00035 *          = 'U':  Upper triangular
00036 *          = 'L':  Lower triangular
00037 *
00038 *  TRANS   (input) CHARACTER*1
00039 *          Specifies whether the matrix or its transpose will be used.
00040 *          = 'N':  No transpose
00041 *          = 'T':  Transpose
00042 *          = 'C':  Conjugate transpose
00043 *
00044 *  DIAG    (output) CHARACTER*1
00045 *          Specifies whether or not the matrix A is unit triangular.
00046 *          = 'N':  Non-unit triangular
00047 *          = 'U':  Unit triangular
00048 *
00049 *  ISEED   (input/output) INTEGER array, dimension (4)
00050 *          The seed vector for the random number generator (used in
00051 *          ZLATMS).  Modified on exit.
00052 *
00053 *  N       (input) INTEGER
00054 *          The order of the matrix to be generated.
00055 *
00056 *  A       (output) COMPLEX*16 array, dimension (LDA,N)
00057 *          The triangular matrix A.  If UPLO = 'U', the leading N x N
00058 *          upper triangular part of the array A contains the upper
00059 *          triangular matrix, and the strictly lower triangular part of
00060 *          A is not referenced.  If UPLO = 'L', the leading N x N lower
00061 *          triangular part of the array A contains the lower triangular
00062 *          matrix and the strictly upper triangular part of A is not
00063 *          referenced.
00064 *
00065 *  LDA     (input) INTEGER
00066 *          The leading dimension of the array A.  LDA >= max(1,N).
00067 *
00068 *  B       (output) COMPLEX*16 array, dimension (N)
00069 *          The right hand side vector, if IMAT > 10.
00070 *
00071 *  WORK    (workspace) COMPLEX*16 array, dimension (2*N)
00072 *
00073 *  RWORK   (workspace) DOUBLE PRECISION array, dimension (N)
00074 *
00075 *  INFO    (output) INTEGER
00076 *          = 0:  successful exit
00077 *          < 0:  if INFO = -i, the i-th argument had an illegal value
00078 *
00079 *  =====================================================================
00080 *
00081 *     .. Parameters ..
00082       DOUBLE PRECISION   ONE, TWO, ZERO
00083       PARAMETER          ( ONE = 1.0D+0, TWO = 2.0D+0, ZERO = 0.0D+0 )
00084 *     ..
00085 *     .. Local Scalars ..
00086       LOGICAL            UPPER
00087       CHARACTER          DIST, TYPE
00088       CHARACTER*3        PATH
00089       INTEGER            I, IY, J, JCOUNT, KL, KU, MODE
00090       DOUBLE PRECISION   ANORM, BIGNUM, BNORM, BSCAL, C, CNDNUM, REXP,
00091      $                   SFAC, SMLNUM, TEXP, TLEFT, TSCAL, ULP, UNFL, X,
00092      $                   Y, Z
00093       COMPLEX*16         PLUS1, PLUS2, RA, RB, S, STAR1
00094 *     ..
00095 *     .. External Functions ..
00096       LOGICAL            LSAME
00097       INTEGER            IZAMAX
00098       DOUBLE PRECISION   DLAMCH, DLARND
00099       COMPLEX*16         ZLARND
00100       EXTERNAL           LSAME, IZAMAX, DLAMCH, DLARND, ZLARND
00101 *     ..
00102 *     .. External Subroutines ..
00103       EXTERNAL           DLABAD, DLARNV, ZCOPY, ZDSCAL, ZLARNV, ZLATB4,
00104      $                   ZLATMS, ZROT, ZROTG, ZSWAP
00105 *     ..
00106 *     .. Intrinsic Functions ..
00107       INTRINSIC          ABS, DBLE, DCMPLX, DCONJG, MAX, SQRT
00108 *     ..
00109 *     .. Executable Statements ..
00110 *
00111       PATH( 1: 1 ) = 'Zomplex precision'
00112       PATH( 2: 3 ) = 'TR'
00113       UNFL = DLAMCH( 'Safe minimum' )
00114       ULP = DLAMCH( 'Epsilon' )*DLAMCH( 'Base' )
00115       SMLNUM = UNFL
00116       BIGNUM = ( ONE-ULP ) / SMLNUM
00117       CALL DLABAD( SMLNUM, BIGNUM )
00118       IF( ( IMAT.GE.7 .AND. IMAT.LE.10 ) .OR. IMAT.EQ.18 ) THEN
00119          DIAG = 'U'
00120       ELSE
00121          DIAG = 'N'
00122       END IF
00123       INFO = 0
00124 *
00125 *     Quick return if N.LE.0.
00126 *
00127       IF( N.LE.0 )
00128      $   RETURN
00129 *
00130 *     Call ZLATB4 to set parameters for CLATMS.
00131 *
00132       UPPER = LSAME( UPLO, 'U' )
00133       IF( UPPER ) THEN
00134          CALL ZLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00135      $                CNDNUM, DIST )
00136       ELSE
00137          CALL ZLATB4( PATH, -IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00138      $                CNDNUM, DIST )
00139       END IF
00140 *
00141 *     IMAT <= 6:  Non-unit triangular matrix
00142 *
00143       IF( IMAT.LE.6 ) THEN
00144          CALL ZLATMS( N, N, DIST, ISEED, TYPE, RWORK, MODE, CNDNUM,
00145      $                ANORM, KL, KU, 'No packing', A, LDA, WORK, INFO )
00146 *
00147 *     IMAT > 6:  Unit triangular matrix
00148 *     The diagonal is deliberately set to something other than 1.
00149 *
00150 *     IMAT = 7:  Matrix is the identity
00151 *
00152       ELSE IF( IMAT.EQ.7 ) THEN
00153          IF( UPPER ) THEN
00154             DO 20 J = 1, N
00155                DO 10 I = 1, J - 1
00156                   A( I, J ) = ZERO
00157    10          CONTINUE
00158                A( J, J ) = J
00159    20       CONTINUE
00160          ELSE
00161             DO 40 J = 1, N
00162                A( J, J ) = J
00163                DO 30 I = J + 1, N
00164                   A( I, J ) = ZERO
00165    30          CONTINUE
00166    40       CONTINUE
00167          END IF
00168 *
00169 *     IMAT > 7:  Non-trivial unit triangular matrix
00170 *
00171 *     Generate a unit triangular matrix T with condition CNDNUM by
00172 *     forming a triangular matrix with known singular values and
00173 *     filling in the zero entries with Givens rotations.
00174 *
00175       ELSE IF( IMAT.LE.10 ) THEN
00176          IF( UPPER ) THEN
00177             DO 60 J = 1, N
00178                DO 50 I = 1, J - 1
00179                   A( I, J ) = ZERO
00180    50          CONTINUE
00181                A( J, J ) = J
00182    60       CONTINUE
00183          ELSE
00184             DO 80 J = 1, N
00185                A( J, J ) = J
00186                DO 70 I = J + 1, N
00187                   A( I, J ) = ZERO
00188    70          CONTINUE
00189    80       CONTINUE
00190          END IF
00191 *
00192 *        Since the trace of a unit triangular matrix is 1, the product
00193 *        of its singular values must be 1.  Let s = sqrt(CNDNUM),
00194 *        x = sqrt(s) - 1/sqrt(s), y = sqrt(2/(n-2))*x, and z = x**2.
00195 *        The following triangular matrix has singular values s, 1, 1,
00196 *        ..., 1, 1/s:
00197 *
00198 *        1  y  y  y  ...  y  y  z
00199 *           1  0  0  ...  0  0  y
00200 *              1  0  ...  0  0  y
00201 *                 .  ...  .  .  .
00202 *                     .   .  .  .
00203 *                         1  0  y
00204 *                            1  y
00205 *                               1
00206 *
00207 *        To fill in the zeros, we first multiply by a matrix with small
00208 *        condition number of the form
00209 *
00210 *        1  0  0  0  0  ...
00211 *           1  +  *  0  0  ...
00212 *              1  +  0  0  0
00213 *                 1  +  *  0  0
00214 *                    1  +  0  0
00215 *                       ...
00216 *                          1  +  0
00217 *                             1  0
00218 *                                1
00219 *
00220 *        Each element marked with a '*' is formed by taking the product
00221 *        of the adjacent elements marked with '+'.  The '*'s can be
00222 *        chosen freely, and the '+'s are chosen so that the inverse of
00223 *        T will have elements of the same magnitude as T.  If the *'s in
00224 *        both T and inv(T) have small magnitude, T is well conditioned.
00225 *        The two offdiagonals of T are stored in WORK.
00226 *
00227 *        The product of these two matrices has the form
00228 *
00229 *        1  y  y  y  y  y  .  y  y  z
00230 *           1  +  *  0  0  .  0  0  y
00231 *              1  +  0  0  .  0  0  y
00232 *                 1  +  *  .  .  .  .
00233 *                    1  +  .  .  .  .
00234 *                       .  .  .  .  .
00235 *                          .  .  .  .
00236 *                             1  +  y
00237 *                                1  y
00238 *                                   1
00239 *
00240 *        Now we multiply by Givens rotations, using the fact that
00241 *
00242 *              [  c   s ] [  1   w ] [ -c  -s ] =  [  1  -w ]
00243 *              [ -s   c ] [  0   1 ] [  s  -c ]    [  0   1 ]
00244 *        and
00245 *              [ -c  -s ] [  1   0 ] [  c   s ] =  [  1   0 ]
00246 *              [  s  -c ] [  w   1 ] [ -s   c ]    [ -w   1 ]
00247 *
00248 *        where c = w / sqrt(w**2+4) and s = 2 / sqrt(w**2+4).
00249 *
00250          STAR1 = 0.25D0*ZLARND( 5, ISEED )
00251          SFAC = 0.5D0
00252          PLUS1 = SFAC*ZLARND( 5, ISEED )
00253          DO 90 J = 1, N, 2
00254             PLUS2 = STAR1 / PLUS1
00255             WORK( J ) = PLUS1
00256             WORK( N+J ) = STAR1
00257             IF( J+1.LE.N ) THEN
00258                WORK( J+1 ) = PLUS2
00259                WORK( N+J+1 ) = ZERO
00260                PLUS1 = STAR1 / PLUS2
00261                REXP = DLARND( 2, ISEED )
00262                IF( REXP.LT.ZERO ) THEN
00263                   STAR1 = -SFAC**( ONE-REXP )*ZLARND( 5, ISEED )
00264                ELSE
00265                   STAR1 = SFAC**( ONE+REXP )*ZLARND( 5, ISEED )
00266                END IF
00267             END IF
00268    90    CONTINUE
00269 *
00270          X = SQRT( CNDNUM ) - 1 / SQRT( CNDNUM )
00271          IF( N.GT.2 ) THEN
00272             Y = SQRT( 2.D0 / ( N-2 ) )*X
00273          ELSE
00274             Y = ZERO
00275          END IF
00276          Z = X*X
00277 *
00278          IF( UPPER ) THEN
00279             IF( N.GT.3 ) THEN
00280                CALL ZCOPY( N-3, WORK, 1, A( 2, 3 ), LDA+1 )
00281                IF( N.GT.4 )
00282      $            CALL ZCOPY( N-4, WORK( N+1 ), 1, A( 2, 4 ), LDA+1 )
00283             END IF
00284             DO 100 J = 2, N - 1
00285                A( 1, J ) = Y
00286                A( J, N ) = Y
00287   100       CONTINUE
00288             A( 1, N ) = Z
00289          ELSE
00290             IF( N.GT.3 ) THEN
00291                CALL ZCOPY( N-3, WORK, 1, A( 3, 2 ), LDA+1 )
00292                IF( N.GT.4 )
00293      $            CALL ZCOPY( N-4, WORK( N+1 ), 1, A( 4, 2 ), LDA+1 )
00294             END IF
00295             DO 110 J = 2, N - 1
00296                A( J, 1 ) = Y
00297                A( N, J ) = Y
00298   110       CONTINUE
00299             A( N, 1 ) = Z
00300          END IF
00301 *
00302 *        Fill in the zeros using Givens rotations.
00303 *
00304          IF( UPPER ) THEN
00305             DO 120 J = 1, N - 1
00306                RA = A( J, J+1 )
00307                RB = 2.0D0
00308                CALL ZROTG( RA, RB, C, S )
00309 *
00310 *              Multiply by [ c  s; -conjg(s)  c] on the left.
00311 *
00312                IF( N.GT.J+1 )
00313      $            CALL ZROT( N-J-1, A( J, J+2 ), LDA, A( J+1, J+2 ),
00314      $                       LDA, C, S )
00315 *
00316 *              Multiply by [-c -s;  conjg(s) -c] on the right.
00317 *
00318                IF( J.GT.1 )
00319      $            CALL ZROT( J-1, A( 1, J+1 ), 1, A( 1, J ), 1, -C, -S )
00320 *
00321 *              Negate A(J,J+1).
00322 *
00323                A( J, J+1 ) = -A( J, J+1 )
00324   120       CONTINUE
00325          ELSE
00326             DO 130 J = 1, N - 1
00327                RA = A( J+1, J )
00328                RB = 2.0D0
00329                CALL ZROTG( RA, RB, C, S )
00330                S = DCONJG( S )
00331 *
00332 *              Multiply by [ c -s;  conjg(s) c] on the right.
00333 *
00334                IF( N.GT.J+1 )
00335      $            CALL ZROT( N-J-1, A( J+2, J+1 ), 1, A( J+2, J ), 1, C,
00336      $                       -S )
00337 *
00338 *              Multiply by [-c  s; -conjg(s) -c] on the left.
00339 *
00340                IF( J.GT.1 )
00341      $            CALL ZROT( J-1, A( J, 1 ), LDA, A( J+1, 1 ), LDA, -C,
00342      $                       S )
00343 *
00344 *              Negate A(J+1,J).
00345 *
00346                A( J+1, J ) = -A( J+1, J )
00347   130       CONTINUE
00348          END IF
00349 *
00350 *     IMAT > 10:  Pathological test cases.  These triangular matrices
00351 *     are badly scaled or badly conditioned, so when used in solving a
00352 *     triangular system they may cause overflow in the solution vector.
00353 *
00354       ELSE IF( IMAT.EQ.11 ) THEN
00355 *
00356 *        Type 11:  Generate a triangular matrix with elements between
00357 *        -1 and 1. Give the diagonal norm 2 to make it well-conditioned.
00358 *        Make the right hand side large so that it requires scaling.
00359 *
00360          IF( UPPER ) THEN
00361             DO 140 J = 1, N
00362                CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
00363                A( J, J ) = ZLARND( 5, ISEED )*TWO
00364   140       CONTINUE
00365          ELSE
00366             DO 150 J = 1, N
00367                IF( J.LT.N )
00368      $            CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
00369                A( J, J ) = ZLARND( 5, ISEED )*TWO
00370   150       CONTINUE
00371          END IF
00372 *
00373 *        Set the right hand side so that the largest value is BIGNUM.
00374 *
00375          CALL ZLARNV( 2, ISEED, N, B )
00376          IY = IZAMAX( N, B, 1 )
00377          BNORM = ABS( B( IY ) )
00378          BSCAL = BIGNUM / MAX( ONE, BNORM )
00379          CALL ZDSCAL( N, BSCAL, B, 1 )
00380 *
00381       ELSE IF( IMAT.EQ.12 ) THEN
00382 *
00383 *        Type 12:  Make the first diagonal element in the solve small to
00384 *        cause immediate overflow when dividing by T(j,j).
00385 *        In type 12, the offdiagonal elements are small (CNORM(j) < 1).
00386 *
00387          CALL ZLARNV( 2, ISEED, N, B )
00388          TSCAL = ONE / MAX( ONE, DBLE( N-1 ) )
00389          IF( UPPER ) THEN
00390             DO 160 J = 1, N
00391                CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
00392                CALL ZDSCAL( J-1, TSCAL, A( 1, J ), 1 )
00393                A( J, J ) = ZLARND( 5, ISEED )
00394   160       CONTINUE
00395             A( N, N ) = SMLNUM*A( N, N )
00396          ELSE
00397             DO 170 J = 1, N
00398                IF( J.LT.N ) THEN
00399                   CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
00400                   CALL ZDSCAL( N-J, TSCAL, A( J+1, J ), 1 )
00401                END IF
00402                A( J, J ) = ZLARND( 5, ISEED )
00403   170       CONTINUE
00404             A( 1, 1 ) = SMLNUM*A( 1, 1 )
00405          END IF
00406 *
00407       ELSE IF( IMAT.EQ.13 ) THEN
00408 *
00409 *        Type 13:  Make the first diagonal element in the solve small to
00410 *        cause immediate overflow when dividing by T(j,j).
00411 *        In type 13, the offdiagonal elements are O(1) (CNORM(j) > 1).
00412 *
00413          CALL ZLARNV( 2, ISEED, N, B )
00414          IF( UPPER ) THEN
00415             DO 180 J = 1, N
00416                CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
00417                A( J, J ) = ZLARND( 5, ISEED )
00418   180       CONTINUE
00419             A( N, N ) = SMLNUM*A( N, N )
00420          ELSE
00421             DO 190 J = 1, N
00422                IF( J.LT.N )
00423      $            CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
00424                A( J, J ) = ZLARND( 5, ISEED )
00425   190       CONTINUE
00426             A( 1, 1 ) = SMLNUM*A( 1, 1 )
00427          END IF
00428 *
00429       ELSE IF( IMAT.EQ.14 ) THEN
00430 *
00431 *        Type 14:  T is diagonal with small numbers on the diagonal to
00432 *        make the growth factor underflow, but a small right hand side
00433 *        chosen so that the solution does not overflow.
00434 *
00435          IF( UPPER ) THEN
00436             JCOUNT = 1
00437             DO 210 J = N, 1, -1
00438                DO 200 I = 1, J - 1
00439                   A( I, J ) = ZERO
00440   200          CONTINUE
00441                IF( JCOUNT.LE.2 ) THEN
00442                   A( J, J ) = SMLNUM*ZLARND( 5, ISEED )
00443                ELSE
00444                   A( J, J ) = ZLARND( 5, ISEED )
00445                END IF
00446                JCOUNT = JCOUNT + 1
00447                IF( JCOUNT.GT.4 )
00448      $            JCOUNT = 1
00449   210       CONTINUE
00450          ELSE
00451             JCOUNT = 1
00452             DO 230 J = 1, N
00453                DO 220 I = J + 1, N
00454                   A( I, J ) = ZERO
00455   220          CONTINUE
00456                IF( JCOUNT.LE.2 ) THEN
00457                   A( J, J ) = SMLNUM*ZLARND( 5, ISEED )
00458                ELSE
00459                   A( J, J ) = ZLARND( 5, ISEED )
00460                END IF
00461                JCOUNT = JCOUNT + 1
00462                IF( JCOUNT.GT.4 )
00463      $            JCOUNT = 1
00464   230       CONTINUE
00465          END IF
00466 *
00467 *        Set the right hand side alternately zero and small.
00468 *
00469          IF( UPPER ) THEN
00470             B( 1 ) = ZERO
00471             DO 240 I = N, 2, -2
00472                B( I ) = ZERO
00473                B( I-1 ) = SMLNUM*ZLARND( 5, ISEED )
00474   240       CONTINUE
00475          ELSE
00476             B( N ) = ZERO
00477             DO 250 I = 1, N - 1, 2
00478                B( I ) = ZERO
00479                B( I+1 ) = SMLNUM*ZLARND( 5, ISEED )
00480   250       CONTINUE
00481          END IF
00482 *
00483       ELSE IF( IMAT.EQ.15 ) THEN
00484 *
00485 *        Type 15:  Make the diagonal elements small to cause gradual
00486 *        overflow when dividing by T(j,j).  To control the amount of
00487 *        scaling needed, the matrix is bidiagonal.
00488 *
00489          TEXP = ONE / MAX( ONE, DBLE( N-1 ) )
00490          TSCAL = SMLNUM**TEXP
00491          CALL ZLARNV( 4, ISEED, N, B )
00492          IF( UPPER ) THEN
00493             DO 270 J = 1, N
00494                DO 260 I = 1, J - 2
00495                   A( I, J ) = 0.D0
00496   260          CONTINUE
00497                IF( J.GT.1 )
00498      $            A( J-1, J ) = DCMPLX( -ONE, -ONE )
00499                A( J, J ) = TSCAL*ZLARND( 5, ISEED )
00500   270       CONTINUE
00501             B( N ) = DCMPLX( ONE, ONE )
00502          ELSE
00503             DO 290 J = 1, N
00504                DO 280 I = J + 2, N
00505                   A( I, J ) = 0.D0
00506   280          CONTINUE
00507                IF( J.LT.N )
00508      $            A( J+1, J ) = DCMPLX( -ONE, -ONE )
00509                A( J, J ) = TSCAL*ZLARND( 5, ISEED )
00510   290       CONTINUE
00511             B( 1 ) = DCMPLX( ONE, ONE )
00512          END IF
00513 *
00514       ELSE IF( IMAT.EQ.16 ) THEN
00515 *
00516 *        Type 16:  One zero diagonal element.
00517 *
00518          IY = N / 2 + 1
00519          IF( UPPER ) THEN
00520             DO 300 J = 1, N
00521                CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
00522                IF( J.NE.IY ) THEN
00523                   A( J, J ) = ZLARND( 5, ISEED )*TWO
00524                ELSE
00525                   A( J, J ) = ZERO
00526                END IF
00527   300       CONTINUE
00528          ELSE
00529             DO 310 J = 1, N
00530                IF( J.LT.N )
00531      $            CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
00532                IF( J.NE.IY ) THEN
00533                   A( J, J ) = ZLARND( 5, ISEED )*TWO
00534                ELSE
00535                   A( J, J ) = ZERO
00536                END IF
00537   310       CONTINUE
00538          END IF
00539          CALL ZLARNV( 2, ISEED, N, B )
00540          CALL ZDSCAL( N, TWO, B, 1 )
00541 *
00542       ELSE IF( IMAT.EQ.17 ) THEN
00543 *
00544 *        Type 17:  Make the offdiagonal elements large to cause overflow
00545 *        when adding a column of T.  In the non-transposed case, the
00546 *        matrix is constructed to cause overflow when adding a column in
00547 *        every other step.
00548 *
00549          TSCAL = UNFL / ULP
00550          TSCAL = ( ONE-ULP ) / TSCAL
00551          DO 330 J = 1, N
00552             DO 320 I = 1, N
00553                A( I, J ) = 0.D0
00554   320       CONTINUE
00555   330    CONTINUE
00556          TEXP = ONE
00557          IF( UPPER ) THEN
00558             DO 340 J = N, 2, -2
00559                A( 1, J ) = -TSCAL / DBLE( N+1 )
00560                A( J, J ) = ONE
00561                B( J ) = TEXP*( ONE-ULP )
00562                A( 1, J-1 ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
00563                A( J-1, J-1 ) = ONE
00564                B( J-1 ) = TEXP*DBLE( N*N+N-1 )
00565                TEXP = TEXP*2.D0
00566   340       CONTINUE
00567             B( 1 ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
00568          ELSE
00569             DO 350 J = 1, N - 1, 2
00570                A( N, J ) = -TSCAL / DBLE( N+1 )
00571                A( J, J ) = ONE
00572                B( J ) = TEXP*( ONE-ULP )
00573                A( N, J+1 ) = -( TSCAL / DBLE( N+1 ) ) / DBLE( N+2 )
00574                A( J+1, J+1 ) = ONE
00575                B( J+1 ) = TEXP*DBLE( N*N+N-1 )
00576                TEXP = TEXP*2.D0
00577   350       CONTINUE
00578             B( N ) = ( DBLE( N+1 ) / DBLE( N+2 ) )*TSCAL
00579          END IF
00580 *
00581       ELSE IF( IMAT.EQ.18 ) THEN
00582 *
00583 *        Type 18:  Generate a unit triangular matrix with elements
00584 *        between -1 and 1, and make the right hand side large so that it
00585 *        requires scaling.
00586 *
00587          IF( UPPER ) THEN
00588             DO 360 J = 1, N
00589                CALL ZLARNV( 4, ISEED, J-1, A( 1, J ) )
00590                A( J, J ) = ZERO
00591   360       CONTINUE
00592          ELSE
00593             DO 370 J = 1, N
00594                IF( J.LT.N )
00595      $            CALL ZLARNV( 4, ISEED, N-J, A( J+1, J ) )
00596                A( J, J ) = ZERO
00597   370       CONTINUE
00598          END IF
00599 *
00600 *        Set the right hand side so that the largest value is BIGNUM.
00601 *
00602          CALL ZLARNV( 2, ISEED, N, B )
00603          IY = IZAMAX( N, B, 1 )
00604          BNORM = ABS( B( IY ) )
00605          BSCAL = BIGNUM / MAX( ONE, BNORM )
00606          CALL ZDSCAL( N, BSCAL, B, 1 )
00607 *
00608       ELSE IF( IMAT.EQ.19 ) THEN
00609 *
00610 *        Type 19:  Generate a triangular matrix with elements between
00611 *        BIGNUM/(n-1) and BIGNUM so that at least one of the column
00612 *        norms will exceed BIGNUM.
00613 *        1/3/91:  ZLATRS no longer can handle this case
00614 *
00615          TLEFT = BIGNUM / MAX( ONE, DBLE( N-1 ) )
00616          TSCAL = BIGNUM*( DBLE( N-1 ) / MAX( ONE, DBLE( N ) ) )
00617          IF( UPPER ) THEN
00618             DO 390 J = 1, N
00619                CALL ZLARNV( 5, ISEED, J, A( 1, J ) )
00620                CALL DLARNV( 1, ISEED, J, RWORK )
00621                DO 380 I = 1, J
00622                   A( I, J ) = A( I, J )*( TLEFT+RWORK( I )*TSCAL )
00623   380          CONTINUE
00624   390       CONTINUE
00625          ELSE
00626             DO 410 J = 1, N
00627                CALL ZLARNV( 5, ISEED, N-J+1, A( J, J ) )
00628                CALL DLARNV( 1, ISEED, N-J+1, RWORK )
00629                DO 400 I = J, N
00630                   A( I, J ) = A( I, J )*( TLEFT+RWORK( I-J+1 )*TSCAL )
00631   400          CONTINUE
00632   410       CONTINUE
00633          END IF
00634          CALL ZLARNV( 2, ISEED, N, B )
00635          CALL ZDSCAL( N, TWO, B, 1 )
00636       END IF
00637 *
00638 *     Flip the matrix if the transpose will be used.
00639 *
00640       IF( .NOT.LSAME( TRANS, 'N' ) ) THEN
00641          IF( UPPER ) THEN
00642             DO 420 J = 1, N / 2
00643                CALL ZSWAP( N-2*J+1, A( J, J ), LDA, A( J+1, N-J+1 ),
00644      $                     -1 )
00645   420       CONTINUE
00646          ELSE
00647             DO 430 J = 1, N / 2
00648                CALL ZSWAP( N-2*J+1, A( J, J ), 1, A( N-J+1, J+1 ),
00649      $                     -LDA )
00650   430       CONTINUE
00651          END IF
00652       END IF
00653 *
00654       RETURN
00655 *
00656 *     End of ZLATTR
00657 *
00658       END