|
LAPACK 3.3.0
|
|
LAPACK 3.3.0
|
00001 SUBROUTINE CLATTB( 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 REAL RWORK( * ) 00015 COMPLEX AB( LDAB, * ), B( * ), WORK( * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * CLATTB 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 * CLATMS). 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 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 array, dimension (N) 00070 * 00071 * WORK (workspace) COMPLEX array, dimension (2*N) 00072 * 00073 * RWORK (workspace) REAL 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 REAL ONE, TWO, ZERO 00083 PARAMETER ( ONE = 1.0E+0, TWO = 2.0E+0, ZERO = 0.0E+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 REAL ANORM, BIGNUM, BNORM, BSCAL, CNDNUM, REXP, 00091 $ SFAC, SMLNUM, TEXP, TLEFT, TNORM, TSCAL, ULP, 00092 $ UNFL 00093 COMPLEX PLUS1, PLUS2, STAR1 00094 * .. 00095 * .. External Functions .. 00096 LOGICAL LSAME 00097 INTEGER ICAMAX 00098 REAL SLAMCH, SLARND 00099 COMPLEX CLARND 00100 EXTERNAL LSAME, ICAMAX, SLAMCH, SLARND, CLARND 00101 * .. 00102 * .. External Subroutines .. 00103 EXTERNAL CCOPY, CLARNV, CLATB4, CLATMS, CSSCAL, CSWAP, 00104 $ SLABAD, SLARNV 00105 * .. 00106 * .. Intrinsic Functions .. 00107 INTRINSIC ABS, CMPLX, MAX, MIN, REAL, SQRT 00108 * .. 00109 * .. Executable Statements .. 00110 * 00111 PATH( 1: 1 ) = 'Complex precision' 00112 PATH( 2: 3 ) = 'TB' 00113 UNFL = SLAMCH( 'Safe minimum' ) 00114 ULP = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' ) 00115 SMLNUM = UNFL 00116 BIGNUM = ( ONE-ULP ) / SMLNUM 00117 CALL SLABAD( 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 CLATB4 to set parameters for CLATMS. 00131 * 00132 UPPER = LSAME( UPLO, 'U' ) 00133 IF( UPPER ) THEN 00134 CALL CLATB4( 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 CLATB4( 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 CLATMS( 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 ) = REAL( 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 ) = REAL( 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*CLARND( 5, ISEED ) 00210 LENJ = ( N-3 ) / 2 00211 CALL CLARNV( 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*CLARND( 5, ISEED ) 00217 LENJ = ( N-3 ) / 2 00218 CALL CLARNV( 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*CLARND( 5, ISEED ) 00242 SFAC = SQRT( TNORM ) 00243 PLUS1 = SFAC*CLARND( 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 = SLARND( 2, ISEED ) 00257 IF( REXP.LT.ZERO ) THEN 00258 STAR1 = -SFAC**( ONE-REXP )*CLARND( 5, ISEED ) 00259 ELSE 00260 STAR1 = SFAC**( ONE+REXP )*CLARND( 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 CCOPY( N-1, WORK, 1, AB( KD, 2 ), LDAB ) 00269 CALL CCOPY( N-2, WORK( N+1 ), 1, AB( KD-1, 3 ), LDAB ) 00270 ELSE 00271 CALL CCOPY( N-1, WORK, 1, AB( 2, 1 ), LDAB ) 00272 CALL CCOPY( 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 CLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) ) 00290 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00297 AB( 1, J ) = CLARND( 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 CLARNV( 2, ISEED, N, B ) 00304 IY = ICAMAX( N, B, 1 ) 00305 BNORM = ABS( B( IY ) ) 00306 BSCAL = BIGNUM / MAX( ONE, BNORM ) 00307 CALL CSSCAL( 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 CLARNV( 2, ISEED, N, B ) 00316 TSCAL = ONE / REAL( 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 CLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00322 CALL CSSCAL( LENJ, TSCAL, AB( KD+2-LENJ, J ), 1 ) 00323 END IF 00324 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00332 CALL CSSCAL( LENJ, TSCAL, AB( 2, J ), 1 ) 00333 END IF 00334 AB( 1, J ) = CLARND( 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 CLARNV( 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 CLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00351 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00359 AB( 1, J ) = CLARND( 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*CLARND( 5, ISEED ) 00378 ELSE 00379 AB( KD+1, J ) = CLARND( 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*CLARND( 5, ISEED ) 00393 ELSE 00394 AB( 1, J ) = CLARND( 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*CLARND( 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*CLARND( 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 / REAL( KD+1 ) 00425 TSCAL = SMLNUM**TEXP 00426 CALL CLARNV( 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 ) = CMPLX( -ONE, -ONE ) 00434 AB( KD+1, J ) = TSCAL*CLARND( 5, ISEED ) 00435 250 CONTINUE 00436 B( N ) = CMPLX( 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 ) = CMPLX( -ONE, -ONE ) 00444 AB( 1, J ) = TSCAL*CLARND( 5, ISEED ) 00445 270 CONTINUE 00446 B( 1 ) = CMPLX( 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 CLARNV( 4, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00458 IF( J.NE.IY ) THEN 00459 AB( KD+1, J ) = CLARND( 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 CLARNV( 4, ISEED, LENJ, AB( 1, J ) ) 00468 IF( J.NE.IY ) THEN 00469 AB( 1, J ) = CLARND( 5, ISEED )*TWO 00470 ELSE 00471 AB( 1, J ) = ZERO 00472 END IF 00473 290 CONTINUE 00474 END IF 00475 CALL CLARNV( 2, ISEED, N, B ) 00476 CALL CSSCAL( 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 / REAL( 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 / REAL( KD+2 ) ) 00502 $ / REAL( KD+3 ) 00503 AB( KD+1, I-1 ) = ONE 00504 B( I-1 ) = TEXP*REAL( ( KD+1 )*( KD+1 )+KD ) 00505 END IF 00506 TEXP = TEXP*TWO 00507 320 CONTINUE 00508 B( MAX( 1, J-KD+1 ) ) = ( REAL( KD+2 ) / 00509 $ REAL( 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 / REAL( 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 $ REAL( KD+2 ) ) / REAL( KD+3 ) 00522 AB( 1, I+1 ) = ONE 00523 B( I+1 ) = TEXP*REAL( ( KD+1 )*( KD+1 )+KD ) 00524 END IF 00525 TEXP = TEXP*TWO 00526 340 CONTINUE 00527 B( MIN( N, J+KD-1 ) ) = ( REAL( KD+2 ) / 00528 $ REAL( 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 CLARNV( 4, ISEED, LENJ, AB( KD+1-LENJ, J ) ) 00543 AB( KD+1, J ) = REAL( 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 CLARNV( 4, ISEED, LENJ, AB( 2, J ) ) 00550 AB( 1, J ) = REAL( J ) 00551 370 CONTINUE 00552 END IF 00553 * 00554 * Set the right hand side so that the largest value is BIGNUM. 00555 * 00556 CALL CLARNV( 2, ISEED, N, B ) 00557 IY = ICAMAX( N, B, 1 ) 00558 BNORM = ABS( B( IY ) ) 00559 BSCAL = BIGNUM / MAX( ONE, BNORM ) 00560 CALL CSSCAL( 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: CLATBS no longer can handle this case 00568 * 00569 TLEFT = BIGNUM / REAL( KD+1 ) 00570 TSCAL = BIGNUM*( REAL( KD+1 ) / REAL( KD+2 ) ) 00571 IF( UPPER ) THEN 00572 DO 390 J = 1, N 00573 LENJ = MIN( J, KD+1 ) 00574 CALL CLARNV( 5, ISEED, LENJ, AB( KD+2-LENJ, J ) ) 00575 CALL SLARNV( 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 CLARNV( 5, ISEED, LENJ, AB( 1, J ) ) 00584 CALL SLARNV( 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 CLARNV( 2, ISEED, N, B ) 00591 CALL CSSCAL( 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 CSWAP( 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 CSWAP( 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 CLATTB 00615 * 00616 END
1.7.3 
