![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b CLATTB 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 CLATTB( 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 * REAL RWORK( * ) 00021 * COMPLEX AB( LDAB, * ), B( * ), WORK( * ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> CLATTB 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 *> CLATMS). 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 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 array, dimension (N) 00109 *> \endverbatim 00110 *> 00111 *> \param[out] WORK 00112 *> \verbatim 00113 *> WORK is COMPLEX array, dimension (2*N) 00114 *> \endverbatim 00115 *> 00116 *> \param[out] RWORK 00117 *> \verbatim 00118 *> RWORK is REAL 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 complex_lin 00139 * 00140 * ===================================================================== 00141 SUBROUTINE CLATTB( 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 REAL RWORK( * ) 00156 COMPLEX AB( LDAB, * ), B( * ), WORK( * ) 00157 * .. 00158 * 00159 * ===================================================================== 00160 * 00161 * .. Parameters .. 00162 REAL ONE, TWO, ZERO 00163 PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0, ZERO = 0.0E+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 REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP, 00171 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP, 00172 $ UNFL 00173 COMPLEX PLUS1, PLUS2, STAR1 00174 * .. 00175 * .. External Functions .. 00176 LOGICAL LSAME 00177 INTEGER ICAMAX 00178 REAL SLAMCH, SLARND 00179 COMPLEX CLARND 00180 EXTERNAL LSAME, ICAMAX, SLAMCH, SLARND, CLARND 00181 * .. 00182 * .. External Subroutines .. 00183 EXTERNAL CCOPY, CLARNV, CLATB4, CLATMS, CSSCAL, CSWAP, 00184 $ SLABAD, SLARNV 00185 * .. 00186 * .. Intrinsic Functions .. 00187 INTRINSIC ABS, CMPLX, MAX, MIN, REAL, SQRT 00188 * .. 00189 * .. Executable Statements .. 00190 * 00191 PATH( 1: 1 ) = 'Complex precision' 00192 PATH( 2: 3 ) = 'TB' 00193 UNFL = SLAMCH( 'Safe minimum' ) 00194 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) 00195 SMLNUM = UNFL 00196 BIGNUM = ( ONE-ULP ) / SMLNUM 00197 CALL SLABAD( 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 CLATB4 to set parameters for CLATMS. 00211 * 00212 UPPER = LSAME( UPLO, 'U' ) 00213 IF( UPPER ) THEN 00214 CALL CLATB4( 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 CLATB4( 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 CLATMS( 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 ) = REAL( 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 ) = REAL( 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*CLARND( 5, ISEED ) 00290 LENJ = ( N-3 ) / 2 00291 CALL CLARNV( 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*CLARND( 5, ISEED ) 00297 LENJ = ( N-3 ) / 2 00298 CALL CLARNV( 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*CLARND( 5, ISEED ) 00322 SFAC = SQRT( TNORM ) 00323 PLUS1 = SFAC*CLARND( 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 = SLARND( 2, ISEED ) 00337 IF( REXP.LT.ZERO ) THEN 00338 STAR1 = -SFAC**( ONE-REXP )*CLARND( 5, ISEED ) 00339 ELSE 00340 STAR1 = SFAC**( ONE+REXP )*CLARND( 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 CCOPY( N-1, WORK, 1, AB( KD, 2 ), LDAB ) 00349 CALL CCOPY( N-2, WORK( N+1 ), 1, AB( KD-1, 3 ), LDAB ) 00350 ELSE 00351 CALL CCOPY( N-1, WORK, 1, AB( 2, 1 ), LDAB ) 00352 CALL CCOPY( 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 CLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) ) 00370 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00377 AB( 1, J ) = CLARND( 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 CLARNV( 2, ISEED, N, B ) 00384 IY = ICAMAX( N, B, 1 ) 00385 BNORM = ABS( B( IY ) ) 00386 BSCAL = BIGNUM / MAX( ONE, BNORM ) 00387 CALL CSSCAL( 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 CLARNV( 2, ISEED, N, B ) 00396 TSCAL = ONE / REAL( 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 CLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00402 CALL CSSCAL( LENJ, TSCAL, AB( KD+2-LENJ, J ), 1 ) 00403 END IF 00404 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00412 CALL CSSCAL( LENJ, TSCAL, AB( 2, J ), 1 ) 00413 END IF 00414 AB( 1, J ) = CLARND( 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 CLARNV( 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 CLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00431 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00439 AB( 1, J ) = CLARND( 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*CLARND( 5, ISEED ) 00458 ELSE 00459 AB( KD+1, J ) = CLARND( 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*CLARND( 5, ISEED ) 00473 ELSE 00474 AB( 1, J ) = CLARND( 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*CLARND( 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*CLARND( 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 / REAL( KD+1 ) 00505 TSCAL = SMLNUM**TEXP 00506 CALL CLARNV( 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 ) = CMPLX( -ONE, -ONE ) 00514 AB( KD+1, J ) = TSCAL*CLARND( 5, ISEED ) 00515 250 CONTINUE 00516 B( N ) = CMPLX( 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 ) = CMPLX( -ONE, -ONE ) 00524 AB( 1, J ) = TSCAL*CLARND( 5, ISEED ) 00525 270 CONTINUE 00526 B( 1 ) = CMPLX( 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 CLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00538 IF( J.NE.IY ) THEN 00539 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 1, J ) ) 00548 IF( J.NE.IY ) THEN 00549 AB( 1, J ) = CLARND( 5, ISEED )*TWO 00550 ELSE 00551 AB( 1, J ) = ZERO 00552 END IF 00553 290 CONTINUE 00554 END IF 00555 CALL CLARNV( 2, ISEED, N, B ) 00556 CALL CSSCAL( 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 / REAL( 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 / REAL( KD+2 ) ) 00582 $ / REAL( KD+3 ) 00583 AB( KD+1, I-1 ) = ONE 00584 B( I-1 ) = TEXP*REAL( ( KD+1 )*( KD+1 )+KD ) 00585 END IF 00586 TEXP = TEXP*TWO 00587 320 CONTINUE 00588 B( MAX( 1, J-KD+1 ) ) = ( REAL( KD+2 ) / 00589 $ REAL( 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 / REAL( 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 $ REAL( KD+2 ) ) / REAL( KD+3 ) 00602 AB( 1, I+1 ) = ONE 00603 B( I+1 ) = TEXP*REAL( ( KD+1 )*( KD+1 )+KD ) 00604 END IF 00605 TEXP = TEXP*TWO 00606 340 CONTINUE 00607 B( MIN( N, J+KD-1 ) ) = ( REAL( KD+2 ) / 00608 $ REAL( 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 CLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) ) 00623 AB( KD+1, J ) = REAL( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00630 AB( 1, J ) = REAL( J ) 00631 370 CONTINUE 00632 END IF 00633 * 00634 * Set the right hand side so that the largest value is BIGNUM. 00635 * 00636 CALL CLARNV( 2, ISEED, N, B ) 00637 IY = ICAMAX( N, B, 1 ) 00638 BNORM = ABS( B( IY ) ) 00639 BSCAL = BIGNUM / MAX( ONE, BNORM ) 00640 CALL CSSCAL( 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: CLATBS no longer can handle this case 00648 * 00649 TLEFT = BIGNUM / REAL( KD+1 ) 00650 TSCAL = BIGNUM*( REAL( KD+1 ) / REAL( KD+2 ) ) 00651 IF( UPPER ) THEN 00652 DO 390 J = 1, N 00653 LENJ = MIN( J, KD+1 ) 00654 CALL CLARNV( 5, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00655 CALL SLARNV( 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 CLARNV( 5, ISEED, LENJ, AB( 1, J ) ) 00664 CALL SLARNV( 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 CLARNV( 2, ISEED, N, B ) 00671 CALL CSSCAL( 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 CSWAP( 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 CSWAP( 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 CLATTB 00695 * 00696 END