LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
slattb.f
Go to the documentation of this file.
00001 *> \brief \b SLATTB
00002 *
00003 *  =========== DOCUMENTATION ===========
00004 *
00005 * Online html documentation available at 
00006 *            http://www.netlib.org/lapack/explore-html/ 
00007 *
00008 *  Definition:
00009 *  ===========
00010 *
00011 *       SUBROUTINE SLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB,
00012 *                          LDAB, B, WORK, INFO )
00013 * 
00014 *       .. Scalar Arguments ..
00015 *       CHARACTER          DIAG, TRANS, UPLO
00016 *       INTEGER            IMAT, INFO, KD, LDAB, N
00017 *       ..
00018 *       .. Array Arguments ..
00019 *       INTEGER            ISEED( 4 )
00020 *       REAL               AB( LDAB, * ), B( * ), WORK( * )
00021 *       ..
00022 *  
00023 *
00024 *> \par Purpose:
00025 *  =============
00026 *>
00027 *> \verbatim
00028 *>
00029 *> SLATTB generates a triangular test matrix in 2-dimensional storage.
00030 *> IMAT and UPLO uniquely specify the properties of the test matrix,
00031 *> which is returned in the array A.
00032 *> \endverbatim
00033 *
00034 *  Arguments:
00035 *  ==========
00036 *
00037 *> \param[in] IMAT
00038 *> \verbatim
00039 *>          IMAT is INTEGER
00040 *>          An integer key describing which matrix to generate for this
00041 *>          path.
00042 *> \endverbatim
00043 *>
00044 *> \param[in] UPLO
00045 *> \verbatim
00046 *>          UPLO is CHARACTER*1
00047 *>          Specifies whether the matrix A will be upper or lower
00048 *>          triangular.
00049 *>          = 'U':  Upper triangular
00050 *>          = 'L':  Lower triangular
00051 *> \endverbatim
00052 *>
00053 *> \param[in] TRANS
00054 *> \verbatim
00055 *>          TRANS is CHARACTER*1
00056 *>          Specifies whether the matrix or its transpose will be used.
00057 *>          = 'N':  No transpose
00058 *>          = 'T':  Transpose
00059 *>          = 'C':  Conjugate transpose (= transpose)
00060 *> \endverbatim
00061 *>
00062 *> \param[out] DIAG
00063 *> \verbatim
00064 *>          DIAG is CHARACTER*1
00065 *>          Specifies whether or not the matrix A is unit triangular.
00066 *>          = 'N':  Non-unit triangular
00067 *>          = 'U':  Unit triangular
00068 *> \endverbatim
00069 *>
00070 *> \param[in,out] ISEED
00071 *> \verbatim
00072 *>          ISEED is INTEGER array, dimension (4)
00073 *>          The seed vector for the random number generator (used in
00074 *>          SLATMS).  Modified on exit.
00075 *> \endverbatim
00076 *>
00077 *> \param[in] N
00078 *> \verbatim
00079 *>          N is INTEGER
00080 *>          The order of the matrix to be generated.
00081 *> \endverbatim
00082 *>
00083 *> \param[in] KD
00084 *> \verbatim
00085 *>          KD is INTEGER
00086 *>          The number of superdiagonals or subdiagonals of the banded
00087 *>          triangular matrix A.  KD >= 0.
00088 *> \endverbatim
00089 *>
00090 *> \param[out] AB
00091 *> \verbatim
00092 *>          AB is REAL array, dimension (LDAB,N)
00093 *>          The upper or lower triangular banded matrix A, stored in the
00094 *>          first KD+1 rows of AB.  Let j be a column of A, 1<=j<=n.
00095 *>          If UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j.
00096 *>          If UPLO = 'L', AB(1+i-j,j)    = A(i,j) for j<=i<=min(n,j+kd).
00097 *> \endverbatim
00098 *>
00099 *> \param[in] LDAB
00100 *> \verbatim
00101 *>          LDAB is INTEGER
00102 *>          The leading dimension of the array AB.  LDAB >= KD+1.
00103 *> \endverbatim
00104 *>
00105 *> \param[out] B
00106 *> \verbatim
00107 *>          B is REAL array, dimension (N)
00108 *> \endverbatim
00109 *>
00110 *> \param[out] WORK
00111 *> \verbatim
00112 *>          WORK is REAL array, dimension (2*N)
00113 *> \endverbatim
00114 *>
00115 *> \param[out] INFO
00116 *> \verbatim
00117 *>          INFO is INTEGER
00118 *>          = 0:  successful exit
00119 *>          < 0: if INFO = -k, the k-th argument had an illegal value
00120 *> \endverbatim
00121 *
00122 *  Authors:
00123 *  ========
00124 *
00125 *> \author Univ. of Tennessee 
00126 *> \author Univ. of California Berkeley 
00127 *> \author Univ. of Colorado Denver 
00128 *> \author NAG Ltd. 
00129 *
00130 *> \date November 2011
00131 *
00132 *> \ingroup single_lin
00133 *
00134 *  =====================================================================
00135       SUBROUTINE SLATTB( IMAT, UPLO, TRANS, DIAG, ISEED, N, KD, AB,
00136      $                   LDAB, B, WORK, INFO )
00137 *
00138 *  -- LAPACK test routine (version 3.4.0) --
00139 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
00140 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
00141 *     November 2011
00142 *
00143 *     .. Scalar Arguments ..
00144       CHARACTER          DIAG, TRANS, UPLO
00145       INTEGER            IMAT, INFO, KD, LDAB, N
00146 *     ..
00147 *     .. Array Arguments ..
00148       INTEGER            ISEED( 4 )
00149       REAL               AB( LDAB, * ), B( * ), WORK( * )
00150 *     ..
00151 *
00152 *  =====================================================================
00153 *
00154 *     .. Parameters ..
00155       REAL               ONE, TWO, ZERO
00156       PARAMETER          ( ONE = 1.0E+0, TWO = 2.0E+0, ZERO = 0.0E+0 )
00157 *     ..
00158 *     .. Local Scalars ..
00159       LOGICAL            UPPER
00160       CHARACTER          DIST, PACKIT, TYPE
00161       CHARACTER*3        PATH
00162       INTEGER            I, IOFF, IY, J, JCOUNT, KL, KU, LENJ, MODE
00163       REAL               ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, PLUS1,
00164      $                   PLUS2, REXP, SFAC, SMLNUM, STAR1, TEXP, TLEFT,
00165      $                   TNORM, TSCAL, ULP, UNFL
00166 *     ..
00167 *     .. External Functions ..
00168       LOGICAL            LSAME
00169       INTEGER            ISAMAX
00170       REAL               SLAMCH, SLARND
00171       EXTERNAL           LSAME, ISAMAX, SLAMCH, SLARND
00172 *     ..
00173 *     .. External Subroutines ..
00174       EXTERNAL           SCOPY, SLABAD, SLARNV, SLATB4, SLATMS, SSCAL,
00175      $                   SSWAP
00176 *     ..
00177 *     .. Intrinsic Functions ..
00178       INTRINSIC          ABS, MAX, MIN, REAL, SIGN, SQRT
00179 *     ..
00180 *     .. Executable Statements ..
00181 *
00182       PATH( 1: 1 ) = 'Single precision'
00183       PATH( 2: 3 ) = 'TB'
00184       UNFL = SLAMCH( 'Safe minimum' )
00185       ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
00186       SMLNUM = UNFL
00187       BIGNUM = ( ONE-ULP ) / SMLNUM
00188       CALL SLABAD( SMLNUM, BIGNUM )
00189       IF( ( IMAT.GE.6 .AND. IMAT.LE.9 ) .OR. IMAT.EQ.17 ) THEN
00190          DIAG = 'U'
00191       ELSE
00192          DIAG = 'N'
00193       END IF
00194       INFO = 0
00195 *
00196 *     Quick return if N.LE.0.
00197 *
00198       IF( N.LE.0 )
00199      $   RETURN
00200 *
00201 *     Call SLATB4 to set parameters for SLATMS.
00202 *
00203       UPPER = LSAME( UPLO, 'U' )
00204       IF( UPPER ) THEN
00205          CALL SLATB4( PATH, IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00206      $                CNDNUM, DIST )
00207          KU = KD
00208          IOFF = 1 + MAX( 0, KD-N+1 )
00209          KL = 0
00210          PACKIT = 'Q'
00211       ELSE
00212          CALL SLATB4( PATH, -IMAT, N, N, TYPE, KL, KU, ANORM, MODE,
00213      $                CNDNUM, DIST )
00214          KL = KD
00215          IOFF = 1
00216          KU = 0
00217          PACKIT = 'B'
00218       END IF
00219 *
00220 *     IMAT <= 5:  Non-unit triangular matrix
00221 *
00222       IF( IMAT.LE.5 ) THEN
00223          CALL SLATMS( N, N, DIST, ISEED, TYPE, B, MODE, CNDNUM, ANORM,
00224      $                KL, KU, PACKIT, AB( IOFF, 1 ), LDAB, WORK, INFO )
00225 *
00226 *     IMAT > 5:  Unit triangular matrix
00227 *     The diagonal is deliberately set to something other than 1.
00228 *
00229 *     IMAT = 6:  Matrix is the identity
00230 *
00231       ELSE IF( IMAT.EQ.6 ) THEN
00232          IF( UPPER ) THEN
00233             DO 20 J = 1, N
00234                DO 10 I = MAX( 1, KD+2-J ), KD
00235                   AB( I, J ) = ZERO
00236    10          CONTINUE
00237                AB( KD+1, J ) = J
00238    20       CONTINUE
00239          ELSE
00240             DO 40 J = 1, N
00241                AB( 1, J ) = J
00242                DO 30 I = 2, MIN( KD+1, N-J+1 )
00243                   AB( I, J ) = ZERO
00244    30          CONTINUE
00245    40       CONTINUE
00246          END IF
00247 *
00248 *     IMAT > 6:  Non-trivial unit triangular matrix
00249 *
00250 *     A unit triangular matrix T with condition CNDNUM is formed.
00251 *     In this version, T only has bandwidth 2, the rest of it is zero.
00252 *
00253       ELSE IF( IMAT.LE.9 ) THEN
00254          TNORM = SQRT( CNDNUM )
00255 *
00256 *        Initialize AB to zero.
00257 *
00258          IF( UPPER ) THEN
00259             DO 60 J = 1, N
00260                DO 50 I = MAX( 1, KD+2-J ), KD
00261                   AB( I, J ) = ZERO
00262    50          CONTINUE
00263                AB( KD+1, J ) = REAL( J )
00264    60       CONTINUE
00265          ELSE
00266             DO 80 J = 1, N
00267                DO 70 I = 2, MIN( KD+1, N-J+1 )
00268                   AB( I, J ) = ZERO
00269    70          CONTINUE
00270                AB( 1, J ) = REAL( J )
00271    80       CONTINUE
00272          END IF
00273 *
00274 *        Special case:  T is tridiagonal.  Set every other offdiagonal
00275 *        so that the matrix has norm TNORM+1.
00276 *
00277          IF( KD.EQ.1 ) THEN
00278             IF( UPPER ) THEN
00279                AB( 1, 2 ) = SIGN( TNORM, SLARND( 2, ISEED ) )
00280                LENJ = ( N-3 ) / 2
00281                CALL SLARNV( 2, ISEED, LENJ, WORK )
00282                DO 90 J = 1, LENJ
00283                   AB( 1, 2*( J+1 ) ) = TNORM*WORK( J )
00284    90          CONTINUE
00285             ELSE
00286                AB( 2, 1 ) = SIGN( TNORM, SLARND( 2, ISEED ) )
00287                LENJ = ( N-3 ) / 2
00288                CALL SLARNV( 2, ISEED, LENJ, WORK )
00289                DO 100 J = 1, LENJ
00290                   AB( 2, 2*J+1 ) = TNORM*WORK( J )
00291   100          CONTINUE
00292             END IF
00293          ELSE IF( KD.GT.1 ) THEN
00294 *
00295 *           Form a unit triangular matrix T with condition CNDNUM.  T is
00296 *           given by
00297 *                   | 1   +   *                      |
00298 *                   |     1   +                      |
00299 *               T = |         1   +   *              |
00300 *                   |             1   +              |
00301 *                   |                 1   +   *      |
00302 *                   |                     1   +      |
00303 *                   |                          . . . |
00304 *        Each element marked with a '*' is formed by taking the product
00305 *        of the adjacent elements marked with '+'.  The '*'s can be
00306 *        chosen freely, and the '+'s are chosen so that the inverse of
00307 *        T will have elements of the same magnitude as T.
00308 *
00309 *        The two offdiagonals of T are stored in WORK.
00310 *
00311             STAR1 = SIGN( TNORM, SLARND( 2, ISEED ) )
00312             SFAC = SQRT( TNORM )
00313             PLUS1 = SIGN( SFAC, SLARND( 2, ISEED ) )
00314             DO 110 J = 1, N, 2
00315                PLUS2 = STAR1 / PLUS1
00316                WORK( J ) = PLUS1
00317                WORK( N+J ) = STAR1
00318                IF( J+1.LE.N ) THEN
00319                   WORK( J+1 ) = PLUS2
00320                   WORK( N+J+1 ) = ZERO
00321                   PLUS1 = STAR1 / PLUS2
00322 *
00323 *                 Generate a new *-value with norm between sqrt(TNORM)
00324 *                 and TNORM.
00325 *
00326                   REXP = SLARND( 2, ISEED )
00327                   IF( REXP.LT.ZERO ) THEN
00328                      STAR1 = -SFAC**( ONE-REXP )
00329                   ELSE
00330                      STAR1 = SFAC**( ONE+REXP )
00331                   END IF
00332                END IF
00333   110       CONTINUE
00334 *
00335 *           Copy the tridiagonal T to AB.
00336 *
00337             IF( UPPER ) THEN
00338                CALL SCOPY( N-1, WORK, 1, AB( KD, 2 ), LDAB )
00339                CALL SCOPY( N-2, WORK( N+1 ), 1, AB( KD-1, 3 ), LDAB )
00340             ELSE
00341                CALL SCOPY( N-1, WORK, 1, AB( 2, 1 ), LDAB )
00342                CALL SCOPY( N-2, WORK( N+1 ), 1, AB( 3, 1 ), LDAB )
00343             END IF
00344          END IF
00345 *
00346 *     IMAT > 9:  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.10 ) THEN
00351 *
00352 *        Type 10:  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 120 J = 1, N
00358                LENJ = MIN( J, KD+1 )
00359                CALL SLARNV( 2, ISEED, LENJ, AB( KD+2-LENJ, J ) )
00360                AB( KD+1, J ) = SIGN( TWO, AB( KD+1, J ) )
00361   120       CONTINUE
00362          ELSE
00363             DO 130 J = 1, N
00364                LENJ = MIN( N-J+1, KD+1 )
00365                IF( LENJ.GT.0 )
00366      $            CALL SLARNV( 2, ISEED, LENJ, AB( 1, J ) )
00367                AB( 1, J ) = SIGN( TWO, AB( 1, J ) )
00368   130       CONTINUE
00369          END IF
00370 *
00371 *        Set the right hand side so that the largest value is BIGNUM.
00372 *
00373          CALL SLARNV( 2, ISEED, N, B )
00374          IY = ISAMAX( N, B, 1 )
00375          BNORM = ABS( B( IY ) )
00376          BSCAL = BIGNUM / MAX( ONE, BNORM )
00377          CALL SSCAL( N, BSCAL, B, 1 )
00378 *
00379       ELSE IF( IMAT.EQ.11 ) THEN
00380 *
00381 *        Type 11:  Make the first diagonal element in the solve small to
00382 *        cause immediate overflow when dividing by T(j,j).
00383 *        In type 11, the offdiagonal elements are small (CNORM(j) < 1).
00384 *
00385          CALL SLARNV( 2, ISEED, N, B )
00386          TSCAL = ONE / REAL( KD+1 )
00387          IF( UPPER ) THEN
00388             DO 140 J = 1, N
00389                LENJ = MIN( J, KD+1 )
00390                CALL SLARNV( 2, ISEED, LENJ, AB( KD+2-LENJ, J ) )
00391                CALL SSCAL( LENJ-1, TSCAL, AB( KD+2-LENJ, J ), 1 )
00392                AB( KD+1, J ) = SIGN( ONE, AB( KD+1, J ) )
00393   140       CONTINUE
00394             AB( KD+1, N ) = SMLNUM*AB( KD+1, N )
00395          ELSE
00396             DO 150 J = 1, N
00397                LENJ = MIN( N-J+1, KD+1 )
00398                CALL SLARNV( 2, ISEED, LENJ, AB( 1, J ) )
00399                IF( LENJ.GT.1 )
00400      $            CALL SSCAL( LENJ-1, TSCAL, AB( 2, J ), 1 )
00401                AB( 1, J ) = SIGN( ONE, AB( 1, J ) )
00402   150       CONTINUE
00403             AB( 1, 1 ) = SMLNUM*AB( 1, 1 )
00404          END IF
00405 *
00406       ELSE IF( IMAT.EQ.12 ) THEN
00407 *
00408 *        Type 12:  Make the first diagonal element in the solve small to
00409 *        cause immediate overflow when dividing by T(j,j).
00410 *        In type 12, the offdiagonal elements are O(1) (CNORM(j) > 1).
00411 *
00412          CALL SLARNV( 2, ISEED, N, B )
00413          IF( UPPER ) THEN
00414             DO 160 J = 1, N
00415                LENJ = MIN( J, KD+1 )
00416                CALL SLARNV( 2, ISEED, LENJ, AB( KD+2-LENJ, J ) )
00417                AB( KD+1, J ) = SIGN( ONE, AB( KD+1, J ) )
00418   160       CONTINUE
00419             AB( KD+1, N ) = SMLNUM*AB( KD+1, N )
00420          ELSE
00421             DO 170 J = 1, N
00422                LENJ = MIN( N-J+1, KD+1 )
00423                CALL SLARNV( 2, ISEED, LENJ, AB( 1, J ) )
00424                AB( 1, J ) = SIGN( ONE, AB( 1, J ) )
00425   170       CONTINUE
00426             AB( 1, 1 ) = SMLNUM*AB( 1, 1 )
00427          END IF
00428 *
00429       ELSE IF( IMAT.EQ.13 ) THEN
00430 *
00431 *        Type 13:  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 190 J = N, 1, -1
00438                DO 180 I = MAX( 1, KD+1-( J-1 ) ), KD
00439                   AB( I, J ) = ZERO
00440   180          CONTINUE
00441                IF( JCOUNT.LE.2 ) THEN
00442                   AB( KD+1, J ) = SMLNUM
00443                ELSE
00444                   AB( KD+1, J ) = ONE
00445                END IF
00446                JCOUNT = JCOUNT + 1
00447                IF( JCOUNT.GT.4 )
00448      $            JCOUNT = 1
00449   190       CONTINUE
00450          ELSE
00451             JCOUNT = 1
00452             DO 210 J = 1, N
00453                DO 200 I = 2, MIN( N-J+1, KD+1 )
00454                   AB( I, J ) = ZERO
00455   200          CONTINUE
00456                IF( JCOUNT.LE.2 ) THEN
00457                   AB( 1, J ) = SMLNUM
00458                ELSE
00459                   AB( 1, J ) = ONE
00460                END IF
00461                JCOUNT = JCOUNT + 1
00462                IF( JCOUNT.GT.4 )
00463      $            JCOUNT = 1
00464   210       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 220 I = N, 2, -2
00472                B( I ) = ZERO
00473                B( I-1 ) = SMLNUM
00474   220       CONTINUE
00475          ELSE
00476             B( N ) = ZERO
00477             DO 230 I = 1, N - 1, 2
00478                B( I ) = ZERO
00479                B( I+1 ) = SMLNUM
00480   230       CONTINUE
00481          END IF
00482 *
00483       ELSE IF( IMAT.EQ.14 ) THEN
00484 *
00485 *        Type 14:  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 / REAL( KD+1 )
00490          TSCAL = SMLNUM**TEXP
00491          CALL SLARNV( 2, ISEED, N, B )
00492          IF( UPPER ) THEN
00493             DO 250 J = 1, N
00494                DO 240 I = MAX( 1, KD+2-J ), KD
00495                   AB( I, J ) = ZERO
00496   240          CONTINUE
00497                IF( J.GT.1 .AND. KD.GT.0 )
00498      $            AB( KD, J ) = -ONE
00499                AB( KD+1, J ) = TSCAL
00500   250       CONTINUE
00501             B( N ) = ONE
00502          ELSE
00503             DO 270 J = 1, N
00504                DO 260 I = 3, MIN( N-J+1, KD+1 )
00505                   AB( I, J ) = ZERO
00506   260          CONTINUE
00507                IF( J.LT.N .AND. KD.GT.0 )
00508      $            AB( 2, J ) = -ONE
00509                AB( 1, J ) = TSCAL
00510   270       CONTINUE
00511             B( 1 ) = ONE
00512          END IF
00513 *
00514       ELSE IF( IMAT.EQ.15 ) THEN
00515 *
00516 *        Type 15:  One zero diagonal element.
00517 *
00518          IY = N / 2 + 1
00519          IF( UPPER ) THEN
00520             DO 280 J = 1, N
00521                LENJ = MIN( J, KD+1 )
00522                CALL SLARNV( 2, ISEED, LENJ, AB( KD+2-LENJ, J ) )
00523                IF( J.NE.IY ) THEN
00524                   AB( KD+1, J ) = SIGN( TWO, AB( KD+1, J ) )
00525                ELSE
00526                   AB( KD+1, J ) = ZERO
00527                END IF
00528   280       CONTINUE
00529          ELSE
00530             DO 290 J = 1, N
00531                LENJ = MIN( N-J+1, KD+1 )
00532                CALL SLARNV( 2, ISEED, LENJ, AB( 1, J ) )
00533                IF( J.NE.IY ) THEN
00534                   AB( 1, J ) = SIGN( TWO, AB( 1, J ) )
00535                ELSE
00536                   AB( 1, J ) = ZERO
00537                END IF
00538   290       CONTINUE
00539          END IF
00540          CALL SLARNV( 2, ISEED, N, B )
00541          CALL SSCAL( N, TWO, B, 1 )
00542 *
00543       ELSE IF( IMAT.EQ.16 ) THEN
00544 *
00545 *        Type 16:  Make the offdiagonal elements large to cause overflow
00546 *        when adding a column of T.  In the non-transposed case, the
00547 *        matrix is constructed to cause overflow when adding a column in
00548 *        every other step.
00549 *
00550          TSCAL = UNFL / ULP
00551          TSCAL = ( ONE-ULP ) / TSCAL
00552          DO 310 J = 1, N
00553             DO 300 I = 1, KD + 1
00554                AB( I, J ) = ZERO
00555   300       CONTINUE
00556   310    CONTINUE
00557          TEXP = ONE
00558          IF( KD.GT.0 ) THEN
00559             IF( UPPER ) THEN
00560                DO 330 J = N, 1, -KD
00561                   DO 320 I = J, MAX( 1, J-KD+1 ), -2
00562                      AB( 1+( J-I ), I ) = -TSCAL / REAL( KD+2 )
00563                      AB( KD+1, I ) = ONE
00564                      B( I ) = TEXP*( ONE-ULP )
00565                      IF( I.GT.MAX( 1, J-KD+1 ) ) THEN
00566                         AB( 2+( J-I ), I-1 ) = -( TSCAL / REAL( KD+2 ) )
00567      $                                          / REAL( KD+3 )
00568                         AB( KD+1, I-1 ) = ONE
00569                         B( I-1 ) = TEXP*REAL( ( KD+1 )*( KD+1 )+KD )
00570                      END IF
00571                      TEXP = TEXP*TWO
00572   320             CONTINUE
00573                   B( MAX( 1, J-KD+1 ) ) = ( REAL( KD+2 ) /
00574      $                                    REAL( KD+3 ) )*TSCAL
00575   330          CONTINUE
00576             ELSE
00577                DO 350 J = 1, N, KD
00578                   TEXP = ONE
00579                   LENJ = MIN( KD+1, N-J+1 )
00580                   DO 340 I = J, MIN( N, J+KD-1 ), 2
00581                      AB( LENJ-( I-J ), J ) = -TSCAL / REAL( KD+2 )
00582                      AB( 1, J ) = ONE
00583                      B( J ) = TEXP*( ONE-ULP )
00584                      IF( I.LT.MIN( N, J+KD-1 ) ) THEN
00585                         AB( LENJ-( I-J+1 ), I+1 ) = -( TSCAL /
00586      $                     REAL( KD+2 ) ) / REAL( KD+3 )
00587                         AB( 1, I+1 ) = ONE
00588                         B( I+1 ) = TEXP*REAL( ( KD+1 )*( KD+1 )+KD )
00589                      END IF
00590                      TEXP = TEXP*TWO
00591   340             CONTINUE
00592                   B( MIN( N, J+KD-1 ) ) = ( REAL( KD+2 ) /
00593      $                                    REAL( KD+3 ) )*TSCAL
00594   350          CONTINUE
00595             END IF
00596          ELSE
00597             DO 360 J = 1, N
00598                AB( 1, J ) = ONE
00599                B( J ) = REAL( J )
00600   360       CONTINUE
00601          END IF
00602 *
00603       ELSE IF( IMAT.EQ.17 ) THEN
00604 *
00605 *        Type 17:  Generate a unit triangular matrix with elements
00606 *        between -1 and 1, and make the right hand side large so that it
00607 *        requires scaling.
00608 *
00609          IF( UPPER ) THEN
00610             DO 370 J = 1, N
00611                LENJ = MIN( J-1, KD )
00612                CALL SLARNV( 2, ISEED, LENJ, AB( KD+1-LENJ, J ) )
00613                AB( KD+1, J ) = REAL( J )
00614   370       CONTINUE
00615          ELSE
00616             DO 380 J = 1, N
00617                LENJ = MIN( N-J, KD )
00618                IF( LENJ.GT.0 )
00619      $            CALL SLARNV( 2, ISEED, LENJ, AB( 2, J ) )
00620                AB( 1, J ) = REAL( J )
00621   380       CONTINUE
00622          END IF
00623 *
00624 *        Set the right hand side so that the largest value is BIGNUM.
00625 *
00626          CALL SLARNV( 2, ISEED, N, B )
00627          IY = ISAMAX( N, B, 1 )
00628          BNORM = ABS( B( IY ) )
00629          BSCAL = BIGNUM / MAX( ONE, BNORM )
00630          CALL SSCAL( N, BSCAL, B, 1 )
00631 *
00632       ELSE IF( IMAT.EQ.18 ) THEN
00633 *
00634 *        Type 18:  Generate a triangular matrix with elements between
00635 *        BIGNUM/KD and BIGNUM so that at least one of the column
00636 *        norms will exceed BIGNUM.
00637 *
00638          TLEFT = BIGNUM / MAX( ONE, REAL( KD ) )
00639          TSCAL = BIGNUM*( REAL( KD ) / REAL( KD+1 ) )
00640          IF( UPPER ) THEN
00641             DO 400 J = 1, N
00642                LENJ = MIN( J, KD+1 )
00643                CALL SLARNV( 2, ISEED, LENJ, AB( KD+2-LENJ, J ) )
00644                DO 390 I = KD + 2 - LENJ, KD + 1
00645                   AB( I, J ) = SIGN( TLEFT, AB( I, J ) ) +
00646      $                         TSCAL*AB( I, J )
00647   390          CONTINUE
00648   400       CONTINUE
00649          ELSE
00650             DO 420 J = 1, N
00651                LENJ = MIN( N-J+1, KD+1 )
00652                CALL SLARNV( 2, ISEED, LENJ, AB( 1, J ) )
00653                DO 410 I = 1, LENJ
00654                   AB( I, J ) = SIGN( TLEFT, AB( I, J ) ) +
00655      $                         TSCAL*AB( I, J )
00656   410          CONTINUE
00657   420       CONTINUE
00658          END IF
00659          CALL SLARNV( 2, ISEED, N, B )
00660          CALL SSCAL( N, TWO, B, 1 )
00661       END IF
00662 *
00663 *     Flip the matrix if the transpose will be used.
00664 *
00665       IF( .NOT.LSAME( TRANS, 'N' ) ) THEN
00666          IF( UPPER ) THEN
00667             DO 430 J = 1, N / 2
00668                LENJ = MIN( N-2*J+1, KD+1 )
00669                CALL SSWAP( LENJ, AB( KD+1, J ), LDAB-1,
00670      $                     AB( KD+2-LENJ, N-J+1 ), -1 )
00671   430       CONTINUE
00672          ELSE
00673             DO 440 J = 1, N / 2
00674                LENJ = MIN( N-2*J+1, KD+1 )
00675                CALL SSWAP( LENJ, AB( 1, J ), 1, AB( LENJ, N-J+2-LENJ ),
00676      $                     -LDAB+1 )
00677   440       CONTINUE
00678          END IF
00679       END IF
00680 *
00681       RETURN
00682 *
00683 *     End of SLATTB
00684 *
00685       END
 All Files Functions