LAPACK: TESTING/LIN/dlattb.f Source File

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