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