LAPACK: TESTING/LIN/slattr.f Source File

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