LAPACK: TESTING/LIN/zlattb.f Source File

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