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