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