 |
LAPACK 3.3.1
Linear Algebra PACKage
|
|
LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE SLATMR( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, 00002 $ RSIGN, GRADE, DL, MODEL, CONDL, DR, MODER, 00003 $ CONDR, PIVTNG, IPIVOT, KL, KU, SPARSE, ANORM, 00004 $ PACK, A, LDA, IWORK, INFO ) 00005 * 00006 * -- LAPACK test routine (version 3.1) -- 00007 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. 00008 * June 2010 00009 * 00010 * .. Scalar Arguments .. 00011 CHARACTER DIST, GRADE, PACK, PIVTNG, RSIGN, SYM 00012 INTEGER INFO, KL, KU, LDA, M, MODE, MODEL, MODER, N 00013 REAL ANORM, COND, CONDL, CONDR, DMAX, SPARSE 00014 * .. 00015 * .. Array Arguments .. 00016 INTEGER IPIVOT( * ), ISEED( 4 ), IWORK( * ) 00017 REAL A( LDA, * ), D( * ), DL( * ), DR( * ) 00018 * .. 00019 * 00020 * Purpose 00021 * ======= 00022 * 00023 * SLATMR generates random matrices of various types for testing 00024 * LAPACK programs. 00025 * 00026 * SLATMR operates by applying the following sequence of 00027 * operations: 00028 * 00029 * Generate a matrix A with random entries of distribution DIST 00030 * which is symmetric if SYM='S', and nonsymmetric 00031 * if SYM='N'. 00032 * 00033 * Set the diagonal to D, where D may be input or 00034 * computed according to MODE, COND, DMAX and RSIGN 00035 * as described below. 00036 * 00037 * Grade the matrix, if desired, from the left and/or right 00038 * as specified by GRADE. The inputs DL, MODEL, CONDL, DR, 00039 * MODER and CONDR also determine the grading as described 00040 * below. 00041 * 00042 * Permute, if desired, the rows and/or columns as specified by 00043 * PIVTNG and IPIVOT. 00044 * 00045 * Set random entries to zero, if desired, to get a random sparse 00046 * matrix as specified by SPARSE. 00047 * 00048 * Make A a band matrix, if desired, by zeroing out the matrix 00049 * outside a band of lower bandwidth KL and upper bandwidth KU. 00050 * 00051 * Scale A, if desired, to have maximum entry ANORM. 00052 * 00053 * Pack the matrix if desired. Options specified by PACK are: 00054 * no packing 00055 * zero out upper half (if symmetric) 00056 * zero out lower half (if symmetric) 00057 * store the upper half columnwise (if symmetric or 00058 * square upper triangular) 00059 * store the lower half columnwise (if symmetric or 00060 * square lower triangular) 00061 * same as upper half rowwise if symmetric 00062 * store the lower triangle in banded format (if symmetric) 00063 * store the upper triangle in banded format (if symmetric) 00064 * store the entire matrix in banded format 00065 * 00066 * Note: If two calls to SLATMR differ only in the PACK parameter, 00067 * they will generate mathematically equivalent matrices. 00068 * 00069 * If two calls to SLATMR both have full bandwidth (KL = M-1 00070 * and KU = N-1), and differ only in the PIVTNG and PACK 00071 * parameters, then the matrices generated will differ only 00072 * in the order of the rows and/or columns, and otherwise 00073 * contain the same data. This consistency cannot be and 00074 * is not maintained with less than full bandwidth. 00075 * 00076 * Arguments 00077 * ========= 00078 * 00079 * M (input) INTEGER 00080 * Number of rows of A. Not modified. 00081 * 00082 * N (input) INTEGER 00083 * Number of columns of A. Not modified. 00084 * 00085 * DIST (input) CHARACTER*1 00086 * On entry, DIST specifies the type of distribution to be used 00087 * to generate a random matrix . 00088 * 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform ) 00089 * 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) 00090 * 'N' => NORMAL( 0, 1 ) ( 'N' for normal ) 00091 * Not modified. 00092 * 00093 * ISEED (input/output) INTEGER array, dimension (4) 00094 * On entry ISEED specifies the seed of the random number 00095 * generator. They should lie between 0 and 4095 inclusive, 00096 * and ISEED(4) should be odd. The random number generator 00097 * uses a linear congruential sequence limited to small 00098 * integers, and so should produce machine independent 00099 * random numbers. The values of ISEED are changed on 00100 * exit, and can be used in the next call to SLATMR 00101 * to continue the same random number sequence. 00102 * Changed on exit. 00103 * 00104 * SYM (input) CHARACTER*1 00105 * If SYM='S' or 'H', generated matrix is symmetric. 00106 * If SYM='N', generated matrix is nonsymmetric. 00107 * Not modified. 00108 * 00109 * D (input) REAL array, dimension (min(M,N)) 00110 * On entry this array specifies the diagonal entries 00111 * of the diagonal of A. D may either be specified 00112 * on entry, or set according to MODE and COND as described 00113 * below. May be changed on exit if MODE is nonzero. 00114 * 00115 * MODE (input) INTEGER 00116 * On entry describes how D is to be used: 00117 * MODE = 0 means use D as input 00118 * MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND 00119 * MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND 00120 * MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) 00121 * MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) 00122 * MODE = 5 sets D to random numbers in the range 00123 * ( 1/COND , 1 ) such that their logarithms 00124 * are uniformly distributed. 00125 * MODE = 6 set D to random numbers from same distribution 00126 * as the rest of the matrix. 00127 * MODE < 0 has the same meaning as ABS(MODE), except that 00128 * the order of the elements of D is reversed. 00129 * Thus if MODE is positive, D has entries ranging from 00130 * 1 to 1/COND, if negative, from 1/COND to 1, 00131 * Not modified. 00132 * 00133 * COND (input) REAL 00134 * On entry, used as described under MODE above. 00135 * If used, it must be >= 1. Not modified. 00136 * 00137 * DMAX (input) REAL 00138 * If MODE neither -6, 0 nor 6, the diagonal is scaled by 00139 * DMAX / max(abs(D(i))), so that maximum absolute entry 00140 * of diagonal is abs(DMAX). If DMAX is negative (or zero), 00141 * diagonal will be scaled by a negative number (or zero). 00142 * 00143 * RSIGN (input) CHARACTER*1 00144 * If MODE neither -6, 0 nor 6, specifies sign of diagonal 00145 * as follows: 00146 * 'T' => diagonal entries are multiplied by 1 or -1 00147 * with probability .5 00148 * 'F' => diagonal unchanged 00149 * Not modified. 00150 * 00151 * GRADE (input) CHARACTER*1 00152 * Specifies grading of matrix as follows: 00153 * 'N' => no grading 00154 * 'L' => matrix premultiplied by diag( DL ) 00155 * (only if matrix nonsymmetric) 00156 * 'R' => matrix postmultiplied by diag( DR ) 00157 * (only if matrix nonsymmetric) 00158 * 'B' => matrix premultiplied by diag( DL ) and 00159 * postmultiplied by diag( DR ) 00160 * (only if matrix nonsymmetric) 00161 * 'S' or 'H' => matrix premultiplied by diag( DL ) and 00162 * postmultiplied by diag( DL ) 00163 * ('S' for symmetric, or 'H' for Hermitian) 00164 * 'E' => matrix premultiplied by diag( DL ) and 00165 * postmultiplied by inv( diag( DL ) ) 00166 * ( 'E' for eigenvalue invariance) 00167 * (only if matrix nonsymmetric) 00168 * Note: if GRADE='E', then M must equal N. 00169 * Not modified. 00170 * 00171 * DL (input/output) REAL array, dimension (M) 00172 * If MODEL=0, then on entry this array specifies the diagonal 00173 * entries of a diagonal matrix used as described under GRADE 00174 * above. If MODEL is not zero, then DL will be set according 00175 * to MODEL and CONDL, analogous to the way D is set according 00176 * to MODE and COND (except there is no DMAX parameter for DL). 00177 * If GRADE='E', then DL cannot have zero entries. 00178 * Not referenced if GRADE = 'N' or 'R'. Changed on exit. 00179 * 00180 * MODEL (input) INTEGER 00181 * This specifies how the diagonal array DL is to be computed, 00182 * just as MODE specifies how D is to be computed. 00183 * Not modified. 00184 * 00185 * CONDL (input) REAL 00186 * When MODEL is not zero, this specifies the condition number 00187 * of the computed DL. Not modified. 00188 * 00189 * DR (input/output) REAL array, dimension (N) 00190 * If MODER=0, then on entry this array specifies the diagonal 00191 * entries of a diagonal matrix used as described under GRADE 00192 * above. If MODER is not zero, then DR will be set according 00193 * to MODER and CONDR, analogous to the way D is set according 00194 * to MODE and COND (except there is no DMAX parameter for DR). 00195 * Not referenced if GRADE = 'N', 'L', 'H', 'S' or 'E'. 00196 * Changed on exit. 00197 * 00198 * MODER (input) INTEGER 00199 * This specifies how the diagonal array DR is to be computed, 00200 * just as MODE specifies how D is to be computed. 00201 * Not modified. 00202 * 00203 * CONDR (input) REAL 00204 * When MODER is not zero, this specifies the condition number 00205 * of the computed DR. Not modified. 00206 * 00207 * PIVTNG (input) CHARACTER*1 00208 * On entry specifies pivoting permutations as follows: 00209 * 'N' or ' ' => none. 00210 * 'L' => left or row pivoting (matrix must be nonsymmetric). 00211 * 'R' => right or column pivoting (matrix must be 00212 * nonsymmetric). 00213 * 'B' or 'F' => both or full pivoting, i.e., on both sides. 00214 * In this case, M must equal N 00215 * 00216 * If two calls to SLATMR both have full bandwidth (KL = M-1 00217 * and KU = N-1), and differ only in the PIVTNG and PACK 00218 * parameters, then the matrices generated will differ only 00219 * in the order of the rows and/or columns, and otherwise 00220 * contain the same data. This consistency cannot be 00221 * maintained with less than full bandwidth. 00222 * 00223 * IPIVOT (input) INTEGER array, dimension (N or M) 00224 * This array specifies the permutation used. After the 00225 * basic matrix is generated, the rows, columns, or both 00226 * are permuted. If, say, row pivoting is selected, SLATMR 00227 * starts with the *last* row and interchanges the M-th and 00228 * IPIVOT(M)-th rows, then moves to the next-to-last row, 00229 * interchanging the (M-1)-th and the IPIVOT(M-1)-th rows, 00230 * and so on. In terms of "2-cycles", the permutation is 00231 * (1 IPIVOT(1)) (2 IPIVOT(2)) ... (M IPIVOT(M)) 00232 * where the rightmost cycle is applied first. This is the 00233 * *inverse* of the effect of pivoting in LINPACK. The idea 00234 * is that factoring (with pivoting) an identity matrix 00235 * which has been inverse-pivoted in this way should 00236 * result in a pivot vector identical to IPIVOT. 00237 * Not referenced if PIVTNG = 'N'. Not modified. 00238 * 00239 * SPARSE (input) REAL 00240 * On entry specifies the sparsity of the matrix if a sparse 00241 * matrix is to be generated. SPARSE should lie between 00242 * 0 and 1. To generate a sparse matrix, for each matrix entry 00243 * a uniform ( 0, 1 ) random number x is generated and 00244 * compared to SPARSE; if x is larger the matrix entry 00245 * is unchanged and if x is smaller the entry is set 00246 * to zero. Thus on the average a fraction SPARSE of the 00247 * entries will be set to zero. 00248 * Not modified. 00249 * 00250 * KL (input) INTEGER 00251 * On entry specifies the lower bandwidth of the matrix. For 00252 * example, KL=0 implies upper triangular, KL=1 implies upper 00253 * Hessenberg, and KL at least M-1 implies the matrix is not 00254 * banded. Must equal KU if matrix is symmetric. 00255 * Not modified. 00256 * 00257 * KU (input) INTEGER 00258 * On entry specifies the upper bandwidth of the matrix. For 00259 * example, KU=0 implies lower triangular, KU=1 implies lower 00260 * Hessenberg, and KU at least N-1 implies the matrix is not 00261 * banded. Must equal KL if matrix is symmetric. 00262 * Not modified. 00263 * 00264 * ANORM (input) REAL 00265 * On entry specifies maximum entry of output matrix 00266 * (output matrix will by multiplied by a constant so that 00267 * its largest absolute entry equal ANORM) 00268 * if ANORM is nonnegative. If ANORM is negative no scaling 00269 * is done. Not modified. 00270 * 00271 * PACK (input) CHARACTER*1 00272 * On entry specifies packing of matrix as follows: 00273 * 'N' => no packing 00274 * 'U' => zero out all subdiagonal entries (if symmetric) 00275 * 'L' => zero out all superdiagonal entries (if symmetric) 00276 * 'C' => store the upper triangle columnwise 00277 * (only if matrix symmetric or square upper triangular) 00278 * 'R' => store the lower triangle columnwise 00279 * (only if matrix symmetric or square lower triangular) 00280 * (same as upper half rowwise if symmetric) 00281 * 'B' => store the lower triangle in band storage scheme 00282 * (only if matrix symmetric) 00283 * 'Q' => store the upper triangle in band storage scheme 00284 * (only if matrix symmetric) 00285 * 'Z' => store the entire matrix in band storage scheme 00286 * (pivoting can be provided for by using this 00287 * option to store A in the trailing rows of 00288 * the allocated storage) 00289 * 00290 * Using these options, the various LAPACK packed and banded 00291 * storage schemes can be obtained: 00292 * GB - use 'Z' 00293 * PB, SB or TB - use 'B' or 'Q' 00294 * PP, SP or TP - use 'C' or 'R' 00295 * 00296 * If two calls to SLATMR differ only in the PACK parameter, 00297 * they will generate mathematically equivalent matrices. 00298 * Not modified. 00299 * 00300 * A (input/output) REAL array, dimension (LDA,N) 00301 * On exit A is the desired test matrix. Only those 00302 * entries of A which are significant on output 00303 * will be referenced (even if A is in packed or band 00304 * storage format). The 'unoccupied corners' of A in 00305 * band format will be zeroed out. 00306 * 00307 * LDA (input) INTEGER 00308 * on entry LDA specifies the first dimension of A as 00309 * declared in the calling program. 00310 * If PACK='N', 'U' or 'L', LDA must be at least max ( 1, M ). 00311 * If PACK='C' or 'R', LDA must be at least 1. 00312 * If PACK='B', or 'Q', LDA must be MIN ( KU+1, N ) 00313 * If PACK='Z', LDA must be at least KUU+KLL+1, where 00314 * KUU = MIN ( KU, N-1 ) and KLL = MIN ( KL, N-1 ) 00315 * Not modified. 00316 * 00317 * IWORK (workspace) INTEGER array, dimension ( N or M) 00318 * Workspace. Not referenced if PIVTNG = 'N'. Changed on exit. 00319 * 00320 * INFO (output) INTEGER 00321 * Error parameter on exit: 00322 * 0 => normal return 00323 * -1 => M negative or unequal to N and SYM='S' or 'H' 00324 * -2 => N negative 00325 * -3 => DIST illegal string 00326 * -5 => SYM illegal string 00327 * -7 => MODE not in range -6 to 6 00328 * -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 00329 * -10 => MODE neither -6, 0 nor 6 and RSIGN illegal string 00330 * -11 => GRADE illegal string, or GRADE='E' and 00331 * M not equal to N, or GRADE='L', 'R', 'B' or 'E' and 00332 * SYM = 'S' or 'H' 00333 * -12 => GRADE = 'E' and DL contains zero 00334 * -13 => MODEL not in range -6 to 6 and GRADE= 'L', 'B', 'H', 00335 * 'S' or 'E' 00336 * -14 => CONDL less than 1.0, GRADE='L', 'B', 'H', 'S' or 'E', 00337 * and MODEL neither -6, 0 nor 6 00338 * -16 => MODER not in range -6 to 6 and GRADE= 'R' or 'B' 00339 * -17 => CONDR less than 1.0, GRADE='R' or 'B', and 00340 * MODER neither -6, 0 nor 6 00341 * -18 => PIVTNG illegal string, or PIVTNG='B' or 'F' and 00342 * M not equal to N, or PIVTNG='L' or 'R' and SYM='S' 00343 * or 'H' 00344 * -19 => IPIVOT contains out of range number and 00345 * PIVTNG not equal to 'N' 00346 * -20 => KL negative 00347 * -21 => KU negative, or SYM='S' or 'H' and KU not equal to KL 00348 * -22 => SPARSE not in range 0. to 1. 00349 * -24 => PACK illegal string, or PACK='U', 'L', 'B' or 'Q' 00350 * and SYM='N', or PACK='C' and SYM='N' and either KL 00351 * not equal to 0 or N not equal to M, or PACK='R' and 00352 * SYM='N', and either KU not equal to 0 or N not equal 00353 * to M 00354 * -26 => LDA too small 00355 * 1 => Error return from SLATM1 (computing D) 00356 * 2 => Cannot scale diagonal to DMAX (max. entry is 0) 00357 * 3 => Error return from SLATM1 (computing DL) 00358 * 4 => Error return from SLATM1 (computing DR) 00359 * 5 => ANORM is positive, but matrix constructed prior to 00360 * attempting to scale it to have norm ANORM, is zero 00361 * 00362 * ===================================================================== 00363 * 00364 * .. Parameters .. 00365 REAL ZERO 00366 PARAMETER ( ZERO = 0.0E0 ) 00367 REAL ONE 00368 PARAMETER ( ONE = 1.0E0 ) 00369 * .. 00370 * .. Local Scalars .. 00371 LOGICAL BADPVT, DZERO, FULBND 00372 INTEGER I, IDIST, IGRADE, IISUB, IPACK, IPVTNG, IRSIGN, 00373 $ ISUB, ISYM, J, JJSUB, JSUB, K, KLL, KUU, MNMIN, 00374 $ MNSUB, MXSUB, NPVTS 00375 REAL ALPHA, ONORM, TEMP 00376 * .. 00377 * .. Local Arrays .. 00378 REAL TEMPA( 1 ) 00379 * .. 00380 * .. External Functions .. 00381 LOGICAL LSAME 00382 REAL SLANGB, SLANGE, SLANSB, SLANSP, SLANSY, SLATM2, 00383 $ SLATM3 00384 EXTERNAL LSAME, SLANGB, SLANGE, SLANSB, SLANSP, SLANSY, 00385 $ SLATM2, SLATM3 00386 * .. 00387 * .. External Subroutines .. 00388 EXTERNAL SLATM1, SSCAL, XERBLA 00389 * .. 00390 * .. Intrinsic Functions .. 00391 INTRINSIC ABS, MAX, MIN, MOD 00392 * .. 00393 * .. Executable Statements .. 00394 * 00395 * 1) Decode and Test the input parameters. 00396 * Initialize flags & seed. 00397 * 00398 INFO = 0 00399 * 00400 * Quick return if possible 00401 * 00402 IF( M.EQ.0 .OR. N.EQ.0 ) 00403 $ RETURN 00404 * 00405 * Decode DIST 00406 * 00407 IF( LSAME( DIST, 'U' ) ) THEN 00408 IDIST = 1 00409 ELSE IF( LSAME( DIST, 'S' ) ) THEN 00410 IDIST = 2 00411 ELSE IF( LSAME( DIST, 'N' ) ) THEN 00412 IDIST = 3 00413 ELSE 00414 IDIST = -1 00415 END IF 00416 * 00417 * Decode SYM 00418 * 00419 IF( LSAME( SYM, 'S' ) ) THEN 00420 ISYM = 0 00421 ELSE IF( LSAME( SYM, 'N' ) ) THEN 00422 ISYM = 1 00423 ELSE IF( LSAME( SYM, 'H' ) ) THEN 00424 ISYM = 0 00425 ELSE 00426 ISYM = -1 00427 END IF 00428 * 00429 * Decode RSIGN 00430 * 00431 IF( LSAME( RSIGN, 'F' ) ) THEN 00432 IRSIGN = 0 00433 ELSE IF( LSAME( RSIGN, 'T' ) ) THEN 00434 IRSIGN = 1 00435 ELSE 00436 IRSIGN = -1 00437 END IF 00438 * 00439 * Decode PIVTNG 00440 * 00441 IF( LSAME( PIVTNG, 'N' ) ) THEN 00442 IPVTNG = 0 00443 ELSE IF( LSAME( PIVTNG, ' ' ) ) THEN 00444 IPVTNG = 0 00445 ELSE IF( LSAME( PIVTNG, 'L' ) ) THEN 00446 IPVTNG = 1 00447 NPVTS = M 00448 ELSE IF( LSAME( PIVTNG, 'R' ) ) THEN 00449 IPVTNG = 2 00450 NPVTS = N 00451 ELSE IF( LSAME( PIVTNG, 'B' ) ) THEN 00452 IPVTNG = 3 00453 NPVTS = MIN( N, M ) 00454 ELSE IF( LSAME( PIVTNG, 'F' ) ) THEN 00455 IPVTNG = 3 00456 NPVTS = MIN( N, M ) 00457 ELSE 00458 IPVTNG = -1 00459 END IF 00460 * 00461 * Decode GRADE 00462 * 00463 IF( LSAME( GRADE, 'N' ) ) THEN 00464 IGRADE = 0 00465 ELSE IF( LSAME( GRADE, 'L' ) ) THEN 00466 IGRADE = 1 00467 ELSE IF( LSAME( GRADE, 'R' ) ) THEN 00468 IGRADE = 2 00469 ELSE IF( LSAME( GRADE, 'B' ) ) THEN 00470 IGRADE = 3 00471 ELSE IF( LSAME( GRADE, 'E' ) ) THEN 00472 IGRADE = 4 00473 ELSE IF( LSAME( GRADE, 'H' ) .OR. LSAME( GRADE, 'S' ) ) THEN 00474 IGRADE = 5 00475 ELSE 00476 IGRADE = -1 00477 END IF 00478 * 00479 * Decode PACK 00480 * 00481 IF( LSAME( PACK, 'N' ) ) THEN 00482 IPACK = 0 00483 ELSE IF( LSAME( PACK, 'U' ) ) THEN 00484 IPACK = 1 00485 ELSE IF( LSAME( PACK, 'L' ) ) THEN 00486 IPACK = 2 00487 ELSE IF( LSAME( PACK, 'C' ) ) THEN 00488 IPACK = 3 00489 ELSE IF( LSAME( PACK, 'R' ) ) THEN 00490 IPACK = 4 00491 ELSE IF( LSAME( PACK, 'B' ) ) THEN 00492 IPACK = 5 00493 ELSE IF( LSAME( PACK, 'Q' ) ) THEN 00494 IPACK = 6 00495 ELSE IF( LSAME( PACK, 'Z' ) ) THEN 00496 IPACK = 7 00497 ELSE 00498 IPACK = -1 00499 END IF 00500 * 00501 * Set certain internal parameters 00502 * 00503 MNMIN = MIN( M, N ) 00504 KLL = MIN( KL, M-1 ) 00505 KUU = MIN( KU, N-1 ) 00506 * 00507 * If inv(DL) is used, check to see if DL has a zero entry. 00508 * 00509 DZERO = .FALSE. 00510 IF( IGRADE.EQ.4 .AND. MODEL.EQ.0 ) THEN 00511 DO 10 I = 1, M 00512 IF( DL( I ).EQ.ZERO ) 00513 $ DZERO = .TRUE. 00514 10 CONTINUE 00515 END IF 00516 * 00517 * Check values in IPIVOT 00518 * 00519 BADPVT = .FALSE. 00520 IF( IPVTNG.GT.0 ) THEN 00521 DO 20 J = 1, NPVTS 00522 IF( IPIVOT( J ).LE.0 .OR. IPIVOT( J ).GT.NPVTS ) 00523 $ BADPVT = .TRUE. 00524 20 CONTINUE 00525 END IF 00526 * 00527 * Set INFO if an error 00528 * 00529 IF( M.LT.0 ) THEN 00530 INFO = -1 00531 ELSE IF( M.NE.N .AND. ISYM.EQ.0 ) THEN 00532 INFO = -1 00533 ELSE IF( N.LT.0 ) THEN 00534 INFO = -2 00535 ELSE IF( IDIST.EQ.-1 ) THEN 00536 INFO = -3 00537 ELSE IF( ISYM.EQ.-1 ) THEN 00538 INFO = -5 00539 ELSE IF( MODE.LT.-6 .OR. MODE.GT.6 ) THEN 00540 INFO = -7 00541 ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. 00542 $ COND.LT.ONE ) THEN 00543 INFO = -8 00544 ELSE IF( ( MODE.NE.-6 .AND. MODE.NE.0 .AND. MODE.NE.6 ) .AND. 00545 $ IRSIGN.EQ.-1 ) THEN 00546 INFO = -10 00547 ELSE IF( IGRADE.EQ.-1 .OR. ( IGRADE.EQ.4 .AND. M.NE.N ) .OR. 00548 $ ( ( IGRADE.GE.1 .AND. IGRADE.LE.4 ) .AND. ISYM.EQ.0 ) ) 00549 $ THEN 00550 INFO = -11 00551 ELSE IF( IGRADE.EQ.4 .AND. DZERO ) THEN 00552 INFO = -12 00553 ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. 00554 $ IGRADE.EQ.5 ) .AND. ( MODEL.LT.-6 .OR. MODEL.GT.6 ) ) 00555 $ THEN 00556 INFO = -13 00557 ELSE IF( ( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. 00558 $ IGRADE.EQ.5 ) .AND. ( MODEL.NE.-6 .AND. MODEL.NE.0 .AND. 00559 $ MODEL.NE.6 ) .AND. CONDL.LT.ONE ) THEN 00560 INFO = -14 00561 ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND. 00562 $ ( MODER.LT.-6 .OR. MODER.GT.6 ) ) THEN 00563 INFO = -16 00564 ELSE IF( ( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) .AND. 00565 $ ( MODER.NE.-6 .AND. MODER.NE.0 .AND. MODER.NE.6 ) .AND. 00566 $ CONDR.LT.ONE ) THEN 00567 INFO = -17 00568 ELSE IF( IPVTNG.EQ.-1 .OR. ( IPVTNG.EQ.3 .AND. M.NE.N ) .OR. 00569 $ ( ( IPVTNG.EQ.1 .OR. IPVTNG.EQ.2 ) .AND. ISYM.EQ.0 ) ) 00570 $ THEN 00571 INFO = -18 00572 ELSE IF( IPVTNG.NE.0 .AND. BADPVT ) THEN 00573 INFO = -19 00574 ELSE IF( KL.LT.0 ) THEN 00575 INFO = -20 00576 ELSE IF( KU.LT.0 .OR. ( ISYM.EQ.0 .AND. KL.NE.KU ) ) THEN 00577 INFO = -21 00578 ELSE IF( SPARSE.LT.ZERO .OR. SPARSE.GT.ONE ) THEN 00579 INFO = -22 00580 ELSE IF( IPACK.EQ.-1 .OR. ( ( IPACK.EQ.1 .OR. IPACK.EQ.2 .OR. 00581 $ IPACK.EQ.5 .OR. IPACK.EQ.6 ) .AND. ISYM.EQ.1 ) .OR. 00582 $ ( IPACK.EQ.3 .AND. ISYM.EQ.1 .AND. ( KL.NE.0 .OR. M.NE. 00583 $ N ) ) .OR. ( IPACK.EQ.4 .AND. ISYM.EQ.1 .AND. ( KU.NE. 00584 $ 0 .OR. M.NE.N ) ) ) THEN 00585 INFO = -24 00586 ELSE IF( ( ( IPACK.EQ.0 .OR. IPACK.EQ.1 .OR. IPACK.EQ.2 ) .AND. 00587 $ LDA.LT.MAX( 1, M ) ) .OR. ( ( IPACK.EQ.3 .OR. IPACK.EQ. 00588 $ 4 ) .AND. LDA.LT.1 ) .OR. ( ( IPACK.EQ.5 .OR. IPACK.EQ. 00589 $ 6 ) .AND. LDA.LT.KUU+1 ) .OR. 00590 $ ( IPACK.EQ.7 .AND. LDA.LT.KLL+KUU+1 ) ) THEN 00591 INFO = -26 00592 END IF 00593 * 00594 IF( INFO.NE.0 ) THEN 00595 CALL XERBLA( 'SLATMR', -INFO ) 00596 RETURN 00597 END IF 00598 * 00599 * Decide if we can pivot consistently 00600 * 00601 FULBND = .FALSE. 00602 IF( KUU.EQ.N-1 .AND. KLL.EQ.M-1 ) 00603 $ FULBND = .TRUE. 00604 * 00605 * Initialize random number generator 00606 * 00607 DO 30 I = 1, 4 00608 ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 ) 00609 30 CONTINUE 00610 * 00611 ISEED( 4 ) = 2*( ISEED( 4 ) / 2 ) + 1 00612 * 00613 * 2) Set up D, DL, and DR, if indicated. 00614 * 00615 * Compute D according to COND and MODE 00616 * 00617 CALL SLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, INFO ) 00618 IF( INFO.NE.0 ) THEN 00619 INFO = 1 00620 RETURN 00621 END IF 00622 IF( MODE.NE.0 .AND. MODE.NE.-6 .AND. MODE.NE.6 ) THEN 00623 * 00624 * Scale by DMAX 00625 * 00626 TEMP = ABS( D( 1 ) ) 00627 DO 40 I = 2, MNMIN 00628 TEMP = MAX( TEMP, ABS( D( I ) ) ) 00629 40 CONTINUE 00630 IF( TEMP.EQ.ZERO .AND. DMAX.NE.ZERO ) THEN 00631 INFO = 2 00632 RETURN 00633 END IF 00634 IF( TEMP.NE.ZERO ) THEN 00635 ALPHA = DMAX / TEMP 00636 ELSE 00637 ALPHA = ONE 00638 END IF 00639 DO 50 I = 1, MNMIN 00640 D( I ) = ALPHA*D( I ) 00641 50 CONTINUE 00642 * 00643 END IF 00644 * 00645 * Compute DL if grading set 00646 * 00647 IF( IGRADE.EQ.1 .OR. IGRADE.EQ.3 .OR. IGRADE.EQ.4 .OR. IGRADE.EQ. 00648 $ 5 ) THEN 00649 CALL SLATM1( MODEL, CONDL, 0, IDIST, ISEED, DL, M, INFO ) 00650 IF( INFO.NE.0 ) THEN 00651 INFO = 3 00652 RETURN 00653 END IF 00654 END IF 00655 * 00656 * Compute DR if grading set 00657 * 00658 IF( IGRADE.EQ.2 .OR. IGRADE.EQ.3 ) THEN 00659 CALL SLATM1( MODER, CONDR, 0, IDIST, ISEED, DR, N, INFO ) 00660 IF( INFO.NE.0 ) THEN 00661 INFO = 4 00662 RETURN 00663 END IF 00664 END IF 00665 * 00666 * 3) Generate IWORK if pivoting 00667 * 00668 IF( IPVTNG.GT.0 ) THEN 00669 DO 60 I = 1, NPVTS 00670 IWORK( I ) = I 00671 60 CONTINUE 00672 IF( FULBND ) THEN 00673 DO 70 I = 1, NPVTS 00674 K = IPIVOT( I ) 00675 J = IWORK( I ) 00676 IWORK( I ) = IWORK( K ) 00677 IWORK( K ) = J 00678 70 CONTINUE 00679 ELSE 00680 DO 80 I = NPVTS, 1, -1 00681 K = IPIVOT( I ) 00682 J = IWORK( I ) 00683 IWORK( I ) = IWORK( K ) 00684 IWORK( K ) = J 00685 80 CONTINUE 00686 END IF 00687 END IF 00688 * 00689 * 4) Generate matrices for each kind of PACKing 00690 * Always sweep matrix columnwise (if symmetric, upper 00691 * half only) so that matrix generated does not depend 00692 * on PACK 00693 * 00694 IF( FULBND ) THEN 00695 * 00696 * Use SLATM3 so matrices generated with differing PIVOTing only 00697 * differ only in the order of their rows and/or columns. 00698 * 00699 IF( IPACK.EQ.0 ) THEN 00700 IF( ISYM.EQ.0 ) THEN 00701 DO 100 J = 1, N 00702 DO 90 I = 1, J 00703 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, 00704 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, 00705 $ IWORK, SPARSE ) 00706 A( ISUB, JSUB ) = TEMP 00707 A( JSUB, ISUB ) = TEMP 00708 90 CONTINUE 00709 100 CONTINUE 00710 ELSE IF( ISYM.EQ.1 ) THEN 00711 DO 120 J = 1, N 00712 DO 110 I = 1, M 00713 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, 00714 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, 00715 $ IWORK, SPARSE ) 00716 A( ISUB, JSUB ) = TEMP 00717 110 CONTINUE 00718 120 CONTINUE 00719 END IF 00720 * 00721 ELSE IF( IPACK.EQ.1 ) THEN 00722 * 00723 DO 140 J = 1, N 00724 DO 130 I = 1, J 00725 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, 00726 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, 00727 $ SPARSE ) 00728 MNSUB = MIN( ISUB, JSUB ) 00729 MXSUB = MAX( ISUB, JSUB ) 00730 A( MNSUB, MXSUB ) = TEMP 00731 IF( MNSUB.NE.MXSUB ) 00732 $ A( MXSUB, MNSUB ) = ZERO 00733 130 CONTINUE 00734 140 CONTINUE 00735 * 00736 ELSE IF( IPACK.EQ.2 ) THEN 00737 * 00738 DO 160 J = 1, N 00739 DO 150 I = 1, J 00740 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, 00741 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, 00742 $ SPARSE ) 00743 MNSUB = MIN( ISUB, JSUB ) 00744 MXSUB = MAX( ISUB, JSUB ) 00745 A( MXSUB, MNSUB ) = TEMP 00746 IF( MNSUB.NE.MXSUB ) 00747 $ A( MNSUB, MXSUB ) = ZERO 00748 150 CONTINUE 00749 160 CONTINUE 00750 * 00751 ELSE IF( IPACK.EQ.3 ) THEN 00752 * 00753 DO 180 J = 1, N 00754 DO 170 I = 1, J 00755 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, 00756 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, 00757 $ SPARSE ) 00758 * 00759 * Compute K = location of (ISUB,JSUB) entry in packed 00760 * array 00761 * 00762 MNSUB = MIN( ISUB, JSUB ) 00763 MXSUB = MAX( ISUB, JSUB ) 00764 K = MXSUB*( MXSUB-1 ) / 2 + MNSUB 00765 * 00766 * Convert K to (IISUB,JJSUB) location 00767 * 00768 JJSUB = ( K-1 ) / LDA + 1 00769 IISUB = K - LDA*( JJSUB-1 ) 00770 * 00771 A( IISUB, JJSUB ) = TEMP 00772 170 CONTINUE 00773 180 CONTINUE 00774 * 00775 ELSE IF( IPACK.EQ.4 ) THEN 00776 * 00777 DO 200 J = 1, N 00778 DO 190 I = 1, J 00779 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, 00780 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, 00781 $ SPARSE ) 00782 * 00783 * Compute K = location of (I,J) entry in packed array 00784 * 00785 MNSUB = MIN( ISUB, JSUB ) 00786 MXSUB = MAX( ISUB, JSUB ) 00787 IF( MNSUB.EQ.1 ) THEN 00788 K = MXSUB 00789 ELSE 00790 K = N*( N+1 ) / 2 - ( N-MNSUB+1 )*( N-MNSUB+2 ) / 00791 $ 2 + MXSUB - MNSUB + 1 00792 END IF 00793 * 00794 * Convert K to (IISUB,JJSUB) location 00795 * 00796 JJSUB = ( K-1 ) / LDA + 1 00797 IISUB = K - LDA*( JJSUB-1 ) 00798 * 00799 A( IISUB, JJSUB ) = TEMP 00800 190 CONTINUE 00801 200 CONTINUE 00802 * 00803 ELSE IF( IPACK.EQ.5 ) THEN 00804 * 00805 DO 220 J = 1, N 00806 DO 210 I = J - KUU, J 00807 IF( I.LT.1 ) THEN 00808 A( J-I+1, I+N ) = ZERO 00809 ELSE 00810 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, 00811 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, 00812 $ IWORK, SPARSE ) 00813 MNSUB = MIN( ISUB, JSUB ) 00814 MXSUB = MAX( ISUB, JSUB ) 00815 A( MXSUB-MNSUB+1, MNSUB ) = TEMP 00816 END IF 00817 210 CONTINUE 00818 220 CONTINUE 00819 * 00820 ELSE IF( IPACK.EQ.6 ) THEN 00821 * 00822 DO 240 J = 1, N 00823 DO 230 I = J - KUU, J 00824 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, IDIST, 00825 $ ISEED, D, IGRADE, DL, DR, IPVTNG, IWORK, 00826 $ SPARSE ) 00827 MNSUB = MIN( ISUB, JSUB ) 00828 MXSUB = MAX( ISUB, JSUB ) 00829 A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP 00830 230 CONTINUE 00831 240 CONTINUE 00832 * 00833 ELSE IF( IPACK.EQ.7 ) THEN 00834 * 00835 IF( ISYM.EQ.0 ) THEN 00836 DO 260 J = 1, N 00837 DO 250 I = J - KUU, J 00838 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, 00839 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, 00840 $ IWORK, SPARSE ) 00841 MNSUB = MIN( ISUB, JSUB ) 00842 MXSUB = MAX( ISUB, JSUB ) 00843 A( MNSUB-MXSUB+KUU+1, MXSUB ) = TEMP 00844 IF( I.LT.1 ) 00845 $ A( J-I+1+KUU, I+N ) = ZERO 00846 IF( I.GE.1 .AND. MNSUB.NE.MXSUB ) 00847 $ A( MXSUB-MNSUB+1+KUU, MNSUB ) = TEMP 00848 250 CONTINUE 00849 260 CONTINUE 00850 ELSE IF( ISYM.EQ.1 ) THEN 00851 DO 280 J = 1, N 00852 DO 270 I = J - KUU, J + KLL 00853 TEMP = SLATM3( M, N, I, J, ISUB, JSUB, KL, KU, 00854 $ IDIST, ISEED, D, IGRADE, DL, DR, IPVTNG, 00855 $ IWORK, SPARSE ) 00856 A( ISUB-JSUB+KUU+1, JSUB ) = TEMP 00857 270 CONTINUE 00858 280 CONTINUE 00859 END IF 00860 * 00861 END IF 00862 * 00863 ELSE 00864 * 00865 * Use SLATM2 00866 * 00867 IF( IPACK.EQ.0 ) THEN 00868 IF( ISYM.EQ.0 ) THEN 00869 DO 300 J = 1, N 00870 DO 290 I = 1, J 00871 A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, 00872 $ ISEED, D, IGRADE, DL, DR, IPVTNG, 00873 $ IWORK, SPARSE ) 00874 A( J, I ) = A( I, J ) 00875 290 CONTINUE 00876 300 CONTINUE 00877 ELSE IF( ISYM.EQ.1 ) THEN 00878 DO 320 J = 1, N 00879 DO 310 I = 1, M 00880 A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, 00881 $ ISEED, D, IGRADE, DL, DR, IPVTNG, 00882 $ IWORK, SPARSE ) 00883 310 CONTINUE 00884 320 CONTINUE 00885 END IF 00886 * 00887 ELSE IF( IPACK.EQ.1 ) THEN 00888 * 00889 DO 340 J = 1, N 00890 DO 330 I = 1, J 00891 A( I, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED, 00892 $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) 00893 IF( I.NE.J ) 00894 $ A( J, I ) = ZERO 00895 330 CONTINUE 00896 340 CONTINUE 00897 * 00898 ELSE IF( IPACK.EQ.2 ) THEN 00899 * 00900 DO 360 J = 1, N 00901 DO 350 I = 1, J 00902 A( J, I ) = SLATM2( M, N, I, J, KL, KU, IDIST, ISEED, 00903 $ D, IGRADE, DL, DR, IPVTNG, IWORK, SPARSE ) 00904 IF( I.NE.J ) 00905 $ A( I, J ) = ZERO 00906 350 CONTINUE 00907 360 CONTINUE 00908 * 00909 ELSE IF( IPACK.EQ.3 ) THEN 00910 * 00911 ISUB = 0 00912 JSUB = 1 00913 DO 380 J = 1, N 00914 DO 370 I = 1, J 00915 ISUB = ISUB + 1 00916 IF( ISUB.GT.LDA ) THEN 00917 ISUB = 1 00918 JSUB = JSUB + 1 00919 END IF 00920 A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU, IDIST, 00921 $ ISEED, D, IGRADE, DL, DR, IPVTNG, 00922 $ IWORK, SPARSE ) 00923 370 CONTINUE 00924 380 CONTINUE 00925 * 00926 ELSE IF( IPACK.EQ.4 ) THEN 00927 * 00928 IF( ISYM.EQ.0 ) THEN 00929 DO 400 J = 1, N 00930 DO 390 I = 1, J 00931 * 00932 * Compute K = location of (I,J) entry in packed array 00933 * 00934 IF( I.EQ.1 ) THEN 00935 K = J 00936 ELSE 00937 K = N*( N+1 ) / 2 - ( N-I+1 )*( N-I+2 ) / 2 + 00938 $ J - I + 1 00939 END IF 00940 * 00941 * Convert K to (ISUB,JSUB) location 00942 * 00943 JSUB = ( K-1 ) / LDA + 1 00944 ISUB = K - LDA*( JSUB-1 ) 00945 * 00946 A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU, 00947 $ IDIST, ISEED, D, IGRADE, DL, DR, 00948 $ IPVTNG, IWORK, SPARSE ) 00949 390 CONTINUE 00950 400 CONTINUE 00951 ELSE 00952 ISUB = 0 00953 JSUB = 1 00954 DO 420 J = 1, N 00955 DO 410 I = J, M 00956 ISUB = ISUB + 1 00957 IF( ISUB.GT.LDA ) THEN 00958 ISUB = 1 00959 JSUB = JSUB + 1 00960 END IF 00961 A( ISUB, JSUB ) = SLATM2( M, N, I, J, KL, KU, 00962 $ IDIST, ISEED, D, IGRADE, DL, DR, 00963 $ IPVTNG, IWORK, SPARSE ) 00964 410 CONTINUE 00965 420 CONTINUE 00966 END IF 00967 * 00968 ELSE IF( IPACK.EQ.5 ) THEN 00969 * 00970 DO 440 J = 1, N 00971 DO 430 I = J - KUU, J 00972 IF( I.LT.1 ) THEN 00973 A( J-I+1, I+N ) = ZERO 00974 ELSE 00975 A( J-I+1, I ) = SLATM2( M, N, I, J, KL, KU, IDIST, 00976 $ ISEED, D, IGRADE, DL, DR, IPVTNG, 00977 $ IWORK, SPARSE ) 00978 END IF 00979 430 CONTINUE 00980 440 CONTINUE 00981 * 00982 ELSE IF( IPACK.EQ.6 ) THEN 00983 * 00984 DO 460 J = 1, N 00985 DO 450 I = J - KUU, J 00986 A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU, IDIST, 00987 $ ISEED, D, IGRADE, DL, DR, IPVTNG, 00988 $ IWORK, SPARSE ) 00989 450 CONTINUE 00990 460 CONTINUE 00991 * 00992 ELSE IF( IPACK.EQ.7 ) THEN 00993 * 00994 IF( ISYM.EQ.0 ) THEN 00995 DO 480 J = 1, N 00996 DO 470 I = J - KUU, J 00997 A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU, 00998 $ IDIST, ISEED, D, IGRADE, DL, 00999 $ DR, IPVTNG, IWORK, SPARSE ) 01000 IF( I.LT.1 ) 01001 $ A( J-I+1+KUU, I+N ) = ZERO 01002 IF( I.GE.1 .AND. I.NE.J ) 01003 $ A( J-I+1+KUU, I ) = A( I-J+KUU+1, J ) 01004 470 CONTINUE 01005 480 CONTINUE 01006 ELSE IF( ISYM.EQ.1 ) THEN 01007 DO 500 J = 1, N 01008 DO 490 I = J - KUU, J + KLL 01009 A( I-J+KUU+1, J ) = SLATM2( M, N, I, J, KL, KU, 01010 $ IDIST, ISEED, D, IGRADE, DL, 01011 $ DR, IPVTNG, IWORK, SPARSE ) 01012 490 CONTINUE 01013 500 CONTINUE 01014 END IF 01015 * 01016 END IF 01017 * 01018 END IF 01019 * 01020 * 5) Scaling the norm 01021 * 01022 IF( IPACK.EQ.0 ) THEN 01023 ONORM = SLANGE( 'M', M, N, A, LDA, TEMPA ) 01024 ELSE IF( IPACK.EQ.1 ) THEN 01025 ONORM = SLANSY( 'M', 'U', N, A, LDA, TEMPA ) 01026 ELSE IF( IPACK.EQ.2 ) THEN 01027 ONORM = SLANSY( 'M', 'L', N, A, LDA, TEMPA ) 01028 ELSE IF( IPACK.EQ.3 ) THEN 01029 ONORM = SLANSP( 'M', 'U', N, A, TEMPA ) 01030 ELSE IF( IPACK.EQ.4 ) THEN 01031 ONORM = SLANSP( 'M', 'L', N, A, TEMPA ) 01032 ELSE IF( IPACK.EQ.5 ) THEN 01033 ONORM = SLANSB( 'M', 'L', N, KLL, A, LDA, TEMPA ) 01034 ELSE IF( IPACK.EQ.6 ) THEN 01035 ONORM = SLANSB( 'M', 'U', N, KUU, A, LDA, TEMPA ) 01036 ELSE IF( IPACK.EQ.7 ) THEN 01037 ONORM = SLANGB( 'M', N, KLL, KUU, A, LDA, TEMPA ) 01038 END IF 01039 * 01040 IF( ANORM.GE.ZERO ) THEN 01041 * 01042 IF( ANORM.GT.ZERO .AND. ONORM.EQ.ZERO ) THEN 01043 * 01044 * Desired scaling impossible 01045 * 01046 INFO = 5 01047 RETURN 01048 * 01049 ELSE IF( ( ANORM.GT.ONE .AND. ONORM.LT.ONE ) .OR. 01050 $ ( ANORM.LT.ONE .AND. ONORM.GT.ONE ) ) THEN 01051 * 01052 * Scale carefully to avoid over / underflow 01053 * 01054 IF( IPACK.LE.2 ) THEN 01055 DO 510 J = 1, N 01056 CALL SSCAL( M, ONE / ONORM, A( 1, J ), 1 ) 01057 CALL SSCAL( M, ANORM, A( 1, J ), 1 ) 01058 510 CONTINUE 01059 * 01060 ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN 01061 * 01062 CALL SSCAL( N*( N+1 ) / 2, ONE / ONORM, A, 1 ) 01063 CALL SSCAL( N*( N+1 ) / 2, ANORM, A, 1 ) 01064 * 01065 ELSE IF( IPACK.GE.5 ) THEN 01066 * 01067 DO 520 J = 1, N 01068 CALL SSCAL( KLL+KUU+1, ONE / ONORM, A( 1, J ), 1 ) 01069 CALL SSCAL( KLL+KUU+1, ANORM, A( 1, J ), 1 ) 01070 520 CONTINUE 01071 * 01072 END IF 01073 * 01074 ELSE 01075 * 01076 * Scale straightforwardly 01077 * 01078 IF( IPACK.LE.2 ) THEN 01079 DO 530 J = 1, N 01080 CALL SSCAL( M, ANORM / ONORM, A( 1, J ), 1 ) 01081 530 CONTINUE 01082 * 01083 ELSE IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN 01084 * 01085 CALL SSCAL( N*( N+1 ) / 2, ANORM / ONORM, A, 1 ) 01086 * 01087 ELSE IF( IPACK.GE.5 ) THEN 01088 * 01089 DO 540 J = 1, N 01090 CALL SSCAL( KLL+KUU+1, ANORM / ONORM, A( 1, J ), 1 ) 01091 540 CONTINUE 01092 END IF 01093 * 01094 END IF 01095 * 01096 END IF 01097 * 01098 * End of SLATMR 01099 * 01100 END
1.7.3 
