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