![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLATMT 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 SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, 00012 * RANK, KL, KU, PACK, A, LDA, WORK, INFO ) 00013 * 00014 * .. Scalar Arguments .. 00015 * REAL COND, DMAX 00016 * INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK 00017 * CHARACTER DIST, PACK, SYM 00018 * .. 00019 * .. Array Arguments .. 00020 * REAL A( LDA, * ), D( * ), WORK( * ) 00021 * INTEGER ISEED( 4 ) 00022 * .. 00023 * 00024 * 00025 *> \par Purpose: 00026 * ============= 00027 *> 00028 *> \verbatim 00029 *> 00030 *> SLATMT generates random matrices with specified singular values 00031 *> (or symmetric/hermitian with specified eigenvalues) 00032 *> for testing LAPACK programs. 00033 *> 00034 *> SLATMT operates by applying the following sequence of 00035 *> operations: 00036 *> 00037 *> Set the diagonal to D, where D may be input or 00038 *> computed according to MODE, COND, DMAX, and SYM 00039 *> as described below. 00040 *> 00041 *> Generate a matrix with the appropriate band structure, by one 00042 *> of two methods: 00043 *> 00044 *> Method A: 00045 *> Generate a dense M x N matrix by multiplying D on the left 00046 *> and the right by random unitary matrices, then: 00047 *> 00048 *> Reduce the bandwidth according to KL and KU, using 00049 *> Householder transformations. 00050 *> 00051 *> Method B: 00052 *> Convert the bandwidth-0 (i.e., diagonal) matrix to a 00053 *> bandwidth-1 matrix using Givens rotations, "chasing" 00054 *> out-of-band elements back, much as in QR; then 00055 *> convert the bandwidth-1 to a bandwidth-2 matrix, etc. 00056 *> Note that for reasonably small bandwidths (relative to 00057 *> M and N) this requires less storage, as a dense matrix 00058 *> is not generated. Also, for symmetric matrices, only 00059 *> one triangle is generated. 00060 *> 00061 *> Method A is chosen if the bandwidth is a large fraction of the 00062 *> order of the matrix, and LDA is at least M (so a dense 00063 *> matrix can be stored.) Method B is chosen if the bandwidth 00064 *> is small (< 1/2 N for symmetric, < .3 N+M for 00065 *> non-symmetric), or LDA is less than M and not less than the 00066 *> bandwidth. 00067 *> 00068 *> Pack the matrix if desired. Options specified by PACK are: 00069 *> no packing 00070 *> zero out upper half (if symmetric) 00071 *> zero out lower half (if symmetric) 00072 *> store the upper half columnwise (if symmetric or upper 00073 *> triangular) 00074 *> store the lower half columnwise (if symmetric or lower 00075 *> triangular) 00076 *> store the lower triangle in banded format (if symmetric 00077 *> or lower triangular) 00078 *> store the upper triangle in banded format (if symmetric 00079 *> or upper triangular) 00080 *> store the entire matrix in banded format 00081 *> If Method B is chosen, and band format is specified, then the 00082 *> matrix will be generated in the band format, so no repacking 00083 *> will be necessary. 00084 *> \endverbatim 00085 * 00086 * Arguments: 00087 * ========== 00088 * 00089 *> \param[in] M 00090 *> \verbatim 00091 *> M is INTEGER 00092 *> The number of rows of A. Not modified. 00093 *> \endverbatim 00094 *> 00095 *> \param[in] N 00096 *> \verbatim 00097 *> N is INTEGER 00098 *> The 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 the random eigen-/singular values. 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 SLATMT 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', the generated matrix is symmetric, with 00130 *> eigenvalues specified by D, COND, MODE, and DMAX; they 00131 *> may be positive, negative, or zero. 00132 *> If SYM='P', the generated matrix is symmetric, with 00133 *> eigenvalues (= singular values) specified by D, COND, 00134 *> MODE, and DMAX; they will not be negative. 00135 *> If SYM='N', the generated matrix is nonsymmetric, with 00136 *> singular values specified by D, COND, MODE, and DMAX; 00137 *> they will not be negative. 00138 *> Not modified. 00139 *> \endverbatim 00140 *> 00141 *> \param[in,out] D 00142 *> \verbatim 00143 *> D is REAL array, dimension ( MIN( M , N ) ) 00144 *> This array is used to specify the singular values or 00145 *> eigenvalues of A (see SYM, above.) If MODE=0, then D is 00146 *> assumed to contain the singular/eigenvalues, otherwise 00147 *> they will be computed according to MODE, COND, and DMAX, 00148 *> and placed in D. 00149 *> Modified if MODE is nonzero. 00150 *> \endverbatim 00151 *> 00152 *> \param[in] MODE 00153 *> \verbatim 00154 *> MODE is INTEGER 00155 *> On entry this describes how the singular/eigenvalues are to 00156 *> be specified: 00157 *> MODE = 0 means use D as input 00158 *> 00159 *> MODE = 1 sets D(1)=1 and D(2:RANK)=1.0/COND 00160 *> MODE = 2 sets D(1:RANK-1)=1 and D(RANK)=1.0/COND 00161 *> MODE = 3 sets D(I)=COND**(-(I-1)/(RANK-1)) 00162 *> 00163 *> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) 00164 *> MODE = 5 sets D to random numbers in the range 00165 *> ( 1/COND , 1 ) such that their logarithms 00166 *> are uniformly distributed. 00167 *> MODE = 6 set D to random numbers from same distribution 00168 *> as the rest of the matrix. 00169 *> MODE < 0 has the same meaning as ABS(MODE), except that 00170 *> the order of the elements of D is reversed. 00171 *> Thus if MODE is positive, D has entries ranging from 00172 *> 1 to 1/COND, if negative, from 1/COND to 1, 00173 *> If SYM='S' or 'H', and MODE is neither 0, 6, nor -6, then 00174 *> the elements of D will also be multiplied by a random 00175 *> sign (i.e., +1 or -1.) 00176 *> Not modified. 00177 *> \endverbatim 00178 *> 00179 *> \param[in] COND 00180 *> \verbatim 00181 *> COND is REAL 00182 *> On entry, this is used as described under MODE above. 00183 *> If used, it must be >= 1. Not modified. 00184 *> \endverbatim 00185 *> 00186 *> \param[in] DMAX 00187 *> \verbatim 00188 *> DMAX is REAL 00189 *> If MODE is neither -6, 0 nor 6, the contents of D, as 00190 *> computed according to MODE and COND, will be scaled by 00191 *> DMAX / max(abs(D(i))); thus, the maximum absolute eigen- or 00192 *> singular value (which is to say the norm) will be abs(DMAX). 00193 *> Note that DMAX need not be positive: if DMAX is negative 00194 *> (or zero), D will be scaled by a negative number (or zero). 00195 *> Not modified. 00196 *> \endverbatim 00197 *> 00198 *> \param[in] RANK 00199 *> \verbatim 00200 *> RANK is INTEGER 00201 *> The rank of matrix to be generated for modes 1,2,3 only. 00202 *> D( RANK+1:N ) = 0. 00203 *> Not modified. 00204 *> \endverbatim 00205 *> 00206 *> \param[in] KL 00207 *> \verbatim 00208 *> KL is INTEGER 00209 *> This specifies the lower bandwidth of the matrix. For 00210 *> example, KL=0 implies upper triangular, KL=1 implies upper 00211 *> Hessenberg, and KL being at least M-1 means that the matrix 00212 *> has full lower bandwidth. KL must equal KU if the matrix 00213 *> is symmetric. 00214 *> Not modified. 00215 *> \endverbatim 00216 *> 00217 *> \param[in] KU 00218 *> \verbatim 00219 *> KU is INTEGER 00220 *> This specifies the upper bandwidth of the matrix. For 00221 *> example, KU=0 implies lower triangular, KU=1 implies lower 00222 *> Hessenberg, and KU being at least N-1 means that the matrix 00223 *> has full upper bandwidth. KL must equal KU if the matrix 00224 *> is symmetric. 00225 *> Not modified. 00226 *> \endverbatim 00227 *> 00228 *> \param[in] PACK 00229 *> \verbatim 00230 *> PACK is CHARACTER*1 00231 *> This specifies packing of matrix as follows: 00232 *> 'N' => no packing 00233 *> 'U' => zero out all subdiagonal entries (if symmetric) 00234 *> 'L' => zero out all superdiagonal entries (if symmetric) 00235 *> 'C' => store the upper triangle columnwise 00236 *> (only if the matrix is symmetric or upper triangular) 00237 *> 'R' => store the lower triangle columnwise 00238 *> (only if the matrix is symmetric or lower triangular) 00239 *> 'B' => store the lower triangle in band storage scheme 00240 *> (only if matrix symmetric or lower triangular) 00241 *> 'Q' => store the upper triangle in band storage scheme 00242 *> (only if matrix symmetric or upper triangular) 00243 *> 'Z' => store the entire matrix in band storage scheme 00244 *> (pivoting can be provided for by using this 00245 *> option to store A in the trailing rows of 00246 *> the allocated storage) 00247 *> 00248 *> Using these options, the various LAPACK packed and banded 00249 *> storage schemes can be obtained: 00250 *> GB - use 'Z' 00251 *> PB, SB or TB - use 'B' or 'Q' 00252 *> PP, SP or TP - use 'C' or 'R' 00253 *> 00254 *> If two calls to SLATMT differ only in the PACK parameter, 00255 *> they will generate mathematically equivalent matrices. 00256 *> Not modified. 00257 *> \endverbatim 00258 *> 00259 *> \param[in,out] A 00260 *> \verbatim 00261 *> A is REAL array, dimension ( LDA, N ) 00262 *> On exit A is the desired test matrix. A is first generated 00263 *> in full (unpacked) form, and then packed, if so specified 00264 *> by PACK. Thus, the first M elements of the first N 00265 *> columns will always be modified. If PACK specifies a 00266 *> packed or banded storage scheme, all LDA elements of the 00267 *> first N columns will be modified; the elements of the 00268 *> array which do not correspond to elements of the generated 00269 *> matrix are set to zero. 00270 *> Modified. 00271 *> \endverbatim 00272 *> 00273 *> \param[in] LDA 00274 *> \verbatim 00275 *> LDA is INTEGER 00276 *> LDA specifies the first dimension of A as declared in the 00277 *> calling program. If PACK='N', 'U', 'L', 'C', or 'R', then 00278 *> LDA must be at least M. If PACK='B' or 'Q', then LDA must 00279 *> be at least MIN( KL, M-1) (which is equal to MIN(KU,N-1)). 00280 *> If PACK='Z', LDA must be large enough to hold the packed 00281 *> array: MIN( KU, N-1) + MIN( KL, M-1) + 1. 00282 *> Not modified. 00283 *> \endverbatim 00284 *> 00285 *> \param[out] WORK 00286 *> \verbatim 00287 *> WORK is REAL array, dimension ( 3*MAX( N , M ) ) 00288 *> Workspace. 00289 *> Modified. 00290 *> \endverbatim 00291 *> 00292 *> \param[out] INFO 00293 *> \verbatim 00294 *> INFO is INTEGER 00295 *> Error code. On exit, INFO will be set to one of the 00296 *> following values: 00297 *> 0 => normal return 00298 *> -1 => M negative or unequal to N and SYM='S', 'H', or 'P' 00299 *> -2 => N negative 00300 *> -3 => DIST illegal string 00301 *> -5 => SYM illegal string 00302 *> -7 => MODE not in range -6 to 6 00303 *> -8 => COND less than 1.0, and MODE neither -6, 0 nor 6 00304 *> -10 => KL negative 00305 *> -11 => KU negative, or SYM='S' or 'H' and KU not equal to KL 00306 *> -12 => PACK illegal string, or PACK='U' or 'L', and SYM='N'; 00307 *> or PACK='C' or 'Q' and SYM='N' and KL is not zero; 00308 *> or PACK='R' or 'B' and SYM='N' and KU is not zero; 00309 *> or PACK='U', 'L', 'C', 'R', 'B', or 'Q', and M is not 00310 *> N. 00311 *> -14 => LDA is less than M, or PACK='Z' and LDA is less than 00312 *> MIN(KU,N-1) + MIN(KL,M-1) + 1. 00313 *> 1 => Error return from SLATM7 00314 *> 2 => Cannot scale to DMAX (max. sing. value is 0) 00315 *> 3 => Error return from SLAGGE or SLAGSY 00316 *> \endverbatim 00317 * 00318 * Authors: 00319 * ======== 00320 * 00321 *> \author Univ. of Tennessee 00322 *> \author Univ. of California Berkeley 00323 *> \author Univ. of Colorado Denver 00324 *> \author NAG Ltd. 00325 * 00326 *> \date November 2011 00327 * 00328 *> \ingroup real_matgen 00329 * 00330 * ===================================================================== 00331 SUBROUTINE SLATMT( M, N, DIST, ISEED, SYM, D, MODE, COND, DMAX, 00332 $ RANK, KL, KU, PACK, A, LDA, WORK, INFO ) 00333 * 00334 * -- LAPACK computational routine (version 3.4.0) -- 00335 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00336 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00337 * November 2011 00338 * 00339 * .. Scalar Arguments .. 00340 REAL COND, DMAX 00341 INTEGER INFO, KL, KU, LDA, M, MODE, N, RANK 00342 CHARACTER DIST, PACK, SYM 00343 * .. 00344 * .. Array Arguments .. 00345 REAL A( LDA, * ), D( * ), WORK( * ) 00346 INTEGER ISEED( 4 ) 00347 * .. 00348 * 00349 * ===================================================================== 00350 * 00351 * .. Parameters .. 00352 REAL ZERO 00353 PARAMETER ( ZERO = 0.0E0 ) 00354 REAL ONE 00355 PARAMETER ( ONE = 1.0E0 ) 00356 REAL TWOPI 00357 PARAMETER ( TWOPI = 6.2831853071795864769252867663E+0 ) 00358 * .. 00359 * .. Local Scalars .. 00360 REAL ALPHA, ANGLE, C, DUMMY, EXTRA, S, TEMP 00361 INTEGER I, IC, ICOL, IDIST, IENDCH, IINFO, IL, ILDA, 00362 $ IOFFG, IOFFST, IPACK, IPACKG, IR, IR1, IR2, 00363 $ IROW, IRSIGN, ISKEW, ISYM, ISYMPK, J, JC, JCH, 00364 $ JKL, JKU, JR, K, LLB, MINLDA, MNMIN, MR, NC, 00365 $ UUB 00366 LOGICAL GIVENS, ILEXTR, ILTEMP, TOPDWN 00367 * .. 00368 * .. External Functions .. 00369 REAL SLARND 00370 LOGICAL LSAME 00371 EXTERNAL SLARND, LSAME 00372 * .. 00373 * .. External Subroutines .. 00374 EXTERNAL SLATM7, SCOPY, SLAGGE, SLAGSY, SLAROT, 00375 $ SLARTG, SLASET, SSCAL, XERBLA 00376 * .. 00377 * .. Intrinsic Functions .. 00378 INTRINSIC ABS, COS, MAX, MIN, MOD, REAL, SIN 00379 * .. 00380 * .. Executable Statements .. 00381 * 00382 * 1) Decode and Test the input parameters. 00383 * Initialize flags & seed. 00384 * 00385 INFO = 0 00386 * 00387 * Quick return if possible 00388 * 00389 IF( M.EQ.0 .OR. N.EQ.0 ) 00390 $ RETURN 00391 * 00392 * Decode DIST 00393 * 00394 IF( LSAME( DIST, 'U' ) ) THEN 00395 IDIST = 1 00396 ELSE IF( LSAME( DIST, 'S' ) ) THEN 00397 IDIST = 2 00398 ELSE IF( LSAME( DIST, 'N' ) ) THEN 00399 IDIST = 3 00400 ELSE 00401 IDIST = -1 00402 END IF 00403 * 00404 * Decode SYM 00405 * 00406 IF( LSAME( SYM, 'N' ) ) THEN 00407 ISYM = 1 00408 IRSIGN = 0 00409 ELSE IF( LSAME( SYM, 'P' ) ) THEN 00410 ISYM = 2 00411 IRSIGN = 0 00412 ELSE IF( LSAME( SYM, 'S' ) ) THEN 00413 ISYM = 2 00414 IRSIGN = 1 00415 ELSE IF( LSAME( SYM, 'H' ) ) THEN 00416 ISYM = 2 00417 IRSIGN = 1 00418 ELSE 00419 ISYM = -1 00420 END IF 00421 * 00422 * Decode PACK 00423 * 00424 ISYMPK = 0 00425 IF( LSAME( PACK, 'N' ) ) THEN 00426 IPACK = 0 00427 ELSE IF( LSAME( PACK, 'U' ) ) THEN 00428 IPACK = 1 00429 ISYMPK = 1 00430 ELSE IF( LSAME( PACK, 'L' ) ) THEN 00431 IPACK = 2 00432 ISYMPK = 1 00433 ELSE IF( LSAME( PACK, 'C' ) ) THEN 00434 IPACK = 3 00435 ISYMPK = 2 00436 ELSE IF( LSAME( PACK, 'R' ) ) THEN 00437 IPACK = 4 00438 ISYMPK = 3 00439 ELSE IF( LSAME( PACK, 'B' ) ) THEN 00440 IPACK = 5 00441 ISYMPK = 3 00442 ELSE IF( LSAME( PACK, 'Q' ) ) THEN 00443 IPACK = 6 00444 ISYMPK = 2 00445 ELSE IF( LSAME( PACK, 'Z' ) ) THEN 00446 IPACK = 7 00447 ELSE 00448 IPACK = -1 00449 END IF 00450 * 00451 * Set certain internal parameters 00452 * 00453 MNMIN = MIN( M, N ) 00454 LLB = MIN( KL, M-1 ) 00455 UUB = MIN( KU, N-1 ) 00456 MR = MIN( M, N+LLB ) 00457 NC = MIN( N, M+UUB ) 00458 * 00459 IF( IPACK.EQ.5 .OR. IPACK.EQ.6 ) THEN 00460 MINLDA = UUB + 1 00461 ELSE IF( IPACK.EQ.7 ) THEN 00462 MINLDA = LLB + UUB + 1 00463 ELSE 00464 MINLDA = M 00465 END IF 00466 * 00467 * Use Givens rotation method if bandwidth small enough, 00468 * or if LDA is too small to store the matrix unpacked. 00469 * 00470 GIVENS = .FALSE. 00471 IF( ISYM.EQ.1 ) THEN 00472 IF( REAL( LLB+UUB ).LT.0.3*REAL( MAX( 1, MR+NC ) ) ) 00473 $ GIVENS = .TRUE. 00474 ELSE 00475 IF( 2*LLB.LT.M ) 00476 $ GIVENS = .TRUE. 00477 END IF 00478 IF( LDA.LT.M .AND. LDA.GE.MINLDA ) 00479 $ GIVENS = .TRUE. 00480 * 00481 * Set INFO if an error 00482 * 00483 IF( M.LT.0 ) THEN 00484 INFO = -1 00485 ELSE IF( M.NE.N .AND. ISYM.NE.1 ) THEN 00486 INFO = -1 00487 ELSE IF( N.LT.0 ) THEN 00488 INFO = -2 00489 ELSE IF( IDIST.EQ.-1 ) THEN 00490 INFO = -3 00491 ELSE IF( ISYM.EQ.-1 ) THEN 00492 INFO = -5 00493 ELSE IF( ABS( MODE ).GT.6 ) THEN 00494 INFO = -7 00495 ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE ) 00496 $ THEN 00497 INFO = -8 00498 ELSE IF( KL.LT.0 ) THEN 00499 INFO = -10 00500 ELSE IF( KU.LT.0 .OR. ( ISYM.NE.1 .AND. KL.NE.KU ) ) THEN 00501 INFO = -11 00502 ELSE IF( IPACK.EQ.-1 .OR. ( ISYMPK.EQ.1 .AND. ISYM.EQ.1 ) .OR. 00503 $ ( ISYMPK.EQ.2 .AND. ISYM.EQ.1 .AND. KL.GT.0 ) .OR. 00504 $ ( ISYMPK.EQ.3 .AND. ISYM.EQ.1 .AND. KU.GT.0 ) .OR. 00505 $ ( ISYMPK.NE.0 .AND. M.NE.N ) ) THEN 00506 INFO = -12 00507 ELSE IF( LDA.LT.MAX( 1, MINLDA ) ) THEN 00508 INFO = -14 00509 END IF 00510 * 00511 IF( INFO.NE.0 ) THEN 00512 CALL XERBLA( 'SLATMT', -INFO ) 00513 RETURN 00514 END IF 00515 * 00516 * Initialize random number generator 00517 * 00518 DO 100 I = 1, 4 00519 ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 ) 00520 100 CONTINUE 00521 * 00522 IF( MOD( ISEED( 4 ), 2 ).NE.1 ) 00523 $ ISEED( 4 ) = ISEED( 4 ) + 1 00524 * 00525 * 2) Set up D if indicated. 00526 * 00527 * Compute D according to COND and MODE 00528 * 00529 CALL SLATM7( MODE, COND, IRSIGN, IDIST, ISEED, D, MNMIN, RANK, 00530 $ IINFO ) 00531 IF( IINFO.NE.0 ) THEN 00532 INFO = 1 00533 RETURN 00534 END IF 00535 * 00536 * Choose Top-Down if D is (apparently) increasing, 00537 * Bottom-Up if D is (apparently) decreasing. 00538 * 00539 IF( ABS( D( 1 ) ).LE.ABS( D( RANK ) ) ) THEN 00540 TOPDWN = .TRUE. 00541 ELSE 00542 TOPDWN = .FALSE. 00543 END IF 00544 * 00545 IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN 00546 * 00547 * Scale by DMAX 00548 * 00549 TEMP = ABS( D( 1 ) ) 00550 DO 110 I = 2, RANK 00551 TEMP = MAX( TEMP, ABS( D( I ) ) ) 00552 110 CONTINUE 00553 * 00554 IF( TEMP.GT.ZERO ) THEN 00555 ALPHA = DMAX / TEMP 00556 ELSE 00557 INFO = 2 00558 RETURN 00559 END IF 00560 * 00561 CALL SSCAL( RANK, ALPHA, D, 1 ) 00562 * 00563 END IF 00564 * 00565 * 3) Generate Banded Matrix using Givens rotations. 00566 * Also the special case of UUB=LLB=0 00567 * 00568 * Compute Addressing constants to cover all 00569 * storage formats. Whether GE, SY, GB, or SB, 00570 * upper or lower triangle or both, 00571 * the (i,j)-th element is in 00572 * A( i - ISKEW*j + IOFFST, j ) 00573 * 00574 IF( IPACK.GT.4 ) THEN 00575 ILDA = LDA - 1 00576 ISKEW = 1 00577 IF( IPACK.GT.5 ) THEN 00578 IOFFST = UUB + 1 00579 ELSE 00580 IOFFST = 1 00581 END IF 00582 ELSE 00583 ILDA = LDA 00584 ISKEW = 0 00585 IOFFST = 0 00586 END IF 00587 * 00588 * IPACKG is the format that the matrix is generated in. If this is 00589 * different from IPACK, then the matrix must be repacked at the 00590 * end. It also signals how to compute the norm, for scaling. 00591 * 00592 IPACKG = 0 00593 CALL SLASET( 'Full', LDA, N, ZERO, ZERO, A, LDA ) 00594 * 00595 * Diagonal Matrix -- We are done, unless it 00596 * is to be stored SP/PP/TP (PACK='R' or 'C') 00597 * 00598 IF( LLB.EQ.0 .AND. UUB.EQ.0 ) THEN 00599 CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 ) 00600 IF( IPACK.LE.2 .OR. IPACK.GE.5 ) 00601 $ IPACKG = IPACK 00602 * 00603 ELSE IF( GIVENS ) THEN 00604 * 00605 * Check whether to use Givens rotations, 00606 * Householder transformations, or nothing. 00607 * 00608 IF( ISYM.EQ.1 ) THEN 00609 * 00610 * Non-symmetric -- A = U D V 00611 * 00612 IF( IPACK.GT.4 ) THEN 00613 IPACKG = IPACK 00614 ELSE 00615 IPACKG = 0 00616 END IF 00617 * 00618 CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFST, 1 ), ILDA+1 ) 00619 * 00620 IF( TOPDWN ) THEN 00621 JKL = 0 00622 DO 140 JKU = 1, UUB 00623 * 00624 * Transform from bandwidth JKL, JKU-1 to JKL, JKU 00625 * 00626 * Last row actually rotated is M 00627 * Last column actually rotated is MIN( M+JKU, N ) 00628 * 00629 DO 130 JR = 1, MIN( M+JKU, N ) + JKL - 1 00630 EXTRA = ZERO 00631 ANGLE = TWOPI*SLARND( 1, ISEED ) 00632 C = COS( ANGLE ) 00633 S = SIN( ANGLE ) 00634 ICOL = MAX( 1, JR-JKL ) 00635 IF( JR.LT.M ) THEN 00636 IL = MIN( N, JR+JKU ) + 1 - ICOL 00637 CALL SLAROT( .TRUE., JR.GT.JKL, .FALSE., IL, C, 00638 $ S, A( JR-ISKEW*ICOL+IOFFST, ICOL ), 00639 $ ILDA, EXTRA, DUMMY ) 00640 END IF 00641 * 00642 * Chase "EXTRA" back up 00643 * 00644 IR = JR 00645 IC = ICOL 00646 DO 120 JCH = JR - JKL, 1, -JKL - JKU 00647 IF( IR.LT.M ) THEN 00648 CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, 00649 $ IC+1 ), EXTRA, C, S, DUMMY ) 00650 END IF 00651 IROW = MAX( 1, JCH-JKU ) 00652 IL = IR + 2 - IROW 00653 TEMP = ZERO 00654 ILTEMP = JCH.GT.JKU 00655 CALL SLAROT( .FALSE., ILTEMP, .TRUE., IL, C, -S, 00656 $ A( IROW-ISKEW*IC+IOFFST, IC ), 00657 $ ILDA, TEMP, EXTRA ) 00658 IF( ILTEMP ) THEN 00659 CALL SLARTG( A( IROW+1-ISKEW*( IC+1 )+IOFFST, 00660 $ IC+1 ), TEMP, C, S, DUMMY ) 00661 ICOL = MAX( 1, JCH-JKU-JKL ) 00662 IL = IC + 2 - ICOL 00663 EXTRA = ZERO 00664 CALL SLAROT( .TRUE., JCH.GT.JKU+JKL, .TRUE., 00665 $ IL, C, -S, A( IROW-ISKEW*ICOL+ 00666 $ IOFFST, ICOL ), ILDA, EXTRA, 00667 $ TEMP ) 00668 IC = ICOL 00669 IR = IROW 00670 END IF 00671 120 CONTINUE 00672 130 CONTINUE 00673 140 CONTINUE 00674 * 00675 JKU = UUB 00676 DO 170 JKL = 1, LLB 00677 * 00678 * Transform from bandwidth JKL-1, JKU to JKL, JKU 00679 * 00680 DO 160 JC = 1, MIN( N+JKL, M ) + JKU - 1 00681 EXTRA = ZERO 00682 ANGLE = TWOPI*SLARND( 1, ISEED ) 00683 C = COS( ANGLE ) 00684 S = SIN( ANGLE ) 00685 IROW = MAX( 1, JC-JKU ) 00686 IF( JC.LT.N ) THEN 00687 IL = MIN( M, JC+JKL ) + 1 - IROW 00688 CALL SLAROT( .FALSE., JC.GT.JKU, .FALSE., IL, C, 00689 $ S, A( IROW-ISKEW*JC+IOFFST, JC ), 00690 $ ILDA, EXTRA, DUMMY ) 00691 END IF 00692 * 00693 * Chase "EXTRA" back up 00694 * 00695 IC = JC 00696 IR = IROW 00697 DO 150 JCH = JC - JKU, 1, -JKL - JKU 00698 IF( IC.LT.N ) THEN 00699 CALL SLARTG( A( IR+1-ISKEW*( IC+1 )+IOFFST, 00700 $ IC+1 ), EXTRA, C, S, DUMMY ) 00701 END IF 00702 ICOL = MAX( 1, JCH-JKL ) 00703 IL = IC + 2 - ICOL 00704 TEMP = ZERO 00705 ILTEMP = JCH.GT.JKL 00706 CALL SLAROT( .TRUE., ILTEMP, .TRUE., IL, C, -S, 00707 $ A( IR-ISKEW*ICOL+IOFFST, ICOL ), 00708 $ ILDA, TEMP, EXTRA ) 00709 IF( ILTEMP ) THEN 00710 CALL SLARTG( A( IR+1-ISKEW*( ICOL+1 )+IOFFST, 00711 $ ICOL+1 ), TEMP, C, S, DUMMY ) 00712 IROW = MAX( 1, JCH-JKL-JKU ) 00713 IL = IR + 2 - IROW 00714 EXTRA = ZERO 00715 CALL SLAROT( .FALSE., JCH.GT.JKL+JKU, .TRUE., 00716 $ IL, C, -S, A( IROW-ISKEW*ICOL+ 00717 $ IOFFST, ICOL ), ILDA, EXTRA, 00718 $ TEMP ) 00719 IC = ICOL 00720 IR = IROW 00721 END IF 00722 150 CONTINUE 00723 160 CONTINUE 00724 170 CONTINUE 00725 * 00726 ELSE 00727 * 00728 * Bottom-Up -- Start at the bottom right. 00729 * 00730 JKL = 0 00731 DO 200 JKU = 1, UUB 00732 * 00733 * Transform from bandwidth JKL, JKU-1 to JKL, JKU 00734 * 00735 * First row actually rotated is M 00736 * First column actually rotated is MIN( M+JKU, N ) 00737 * 00738 IENDCH = MIN( M, N+JKL ) - 1 00739 DO 190 JC = MIN( M+JKU, N ) - 1, 1 - JKL, -1 00740 EXTRA = ZERO 00741 ANGLE = TWOPI*SLARND( 1, ISEED ) 00742 C = COS( ANGLE ) 00743 S = SIN( ANGLE ) 00744 IROW = MAX( 1, JC-JKU+1 ) 00745 IF( JC.GT.0 ) THEN 00746 IL = MIN( M, JC+JKL+1 ) + 1 - IROW 00747 CALL SLAROT( .FALSE., .FALSE., JC+JKL.LT.M, IL, 00748 $ C, S, A( IROW-ISKEW*JC+IOFFST, 00749 $ JC ), ILDA, DUMMY, EXTRA ) 00750 END IF 00751 * 00752 * Chase "EXTRA" back down 00753 * 00754 IC = JC 00755 DO 180 JCH = JC + JKL, IENDCH, JKL + JKU 00756 ILEXTR = IC.GT.0 00757 IF( ILEXTR ) THEN 00758 CALL SLARTG( A( JCH-ISKEW*IC+IOFFST, IC ), 00759 $ EXTRA, C, S, DUMMY ) 00760 END IF 00761 IC = MAX( 1, IC ) 00762 ICOL = MIN( N-1, JCH+JKU ) 00763 ILTEMP = JCH + JKU.LT.N 00764 TEMP = ZERO 00765 CALL SLAROT( .TRUE., ILEXTR, ILTEMP, ICOL+2-IC, 00766 $ C, S, A( JCH-ISKEW*IC+IOFFST, IC ), 00767 $ ILDA, EXTRA, TEMP ) 00768 IF( ILTEMP ) THEN 00769 CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFST, 00770 $ ICOL ), TEMP, C, S, DUMMY ) 00771 IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH 00772 EXTRA = ZERO 00773 CALL SLAROT( .FALSE., .TRUE., 00774 $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, 00775 $ A( JCH-ISKEW*ICOL+IOFFST, 00776 $ ICOL ), ILDA, TEMP, EXTRA ) 00777 IC = ICOL 00778 END IF 00779 180 CONTINUE 00780 190 CONTINUE 00781 200 CONTINUE 00782 * 00783 JKU = UUB 00784 DO 230 JKL = 1, LLB 00785 * 00786 * Transform from bandwidth JKL-1, JKU to JKL, JKU 00787 * 00788 * First row actually rotated is MIN( N+JKL, M ) 00789 * First column actually rotated is N 00790 * 00791 IENDCH = MIN( N, M+JKU ) - 1 00792 DO 220 JR = MIN( N+JKL, M ) - 1, 1 - JKU, -1 00793 EXTRA = ZERO 00794 ANGLE = TWOPI*SLARND( 1, ISEED ) 00795 C = COS( ANGLE ) 00796 S = SIN( ANGLE ) 00797 ICOL = MAX( 1, JR-JKL+1 ) 00798 IF( JR.GT.0 ) THEN 00799 IL = MIN( N, JR+JKU+1 ) + 1 - ICOL 00800 CALL SLAROT( .TRUE., .FALSE., JR+JKU.LT.N, IL, 00801 $ C, S, A( JR-ISKEW*ICOL+IOFFST, 00802 $ ICOL ), ILDA, DUMMY, EXTRA ) 00803 END IF 00804 * 00805 * Chase "EXTRA" back down 00806 * 00807 IR = JR 00808 DO 210 JCH = JR + JKU, IENDCH, JKL + JKU 00809 ILEXTR = IR.GT.0 00810 IF( ILEXTR ) THEN 00811 CALL SLARTG( A( IR-ISKEW*JCH+IOFFST, JCH ), 00812 $ EXTRA, C, S, DUMMY ) 00813 END IF 00814 IR = MAX( 1, IR ) 00815 IROW = MIN( M-1, JCH+JKL ) 00816 ILTEMP = JCH + JKL.LT.M 00817 TEMP = ZERO 00818 CALL SLAROT( .FALSE., ILEXTR, ILTEMP, IROW+2-IR, 00819 $ C, S, A( IR-ISKEW*JCH+IOFFST, 00820 $ JCH ), ILDA, EXTRA, TEMP ) 00821 IF( ILTEMP ) THEN 00822 CALL SLARTG( A( IROW-ISKEW*JCH+IOFFST, JCH ), 00823 $ TEMP, C, S, DUMMY ) 00824 IL = MIN( IENDCH, JCH+JKL+JKU ) + 2 - JCH 00825 EXTRA = ZERO 00826 CALL SLAROT( .TRUE., .TRUE., 00827 $ JCH+JKL+JKU.LE.IENDCH, IL, C, S, 00828 $ A( IROW-ISKEW*JCH+IOFFST, JCH ), 00829 $ ILDA, TEMP, EXTRA ) 00830 IR = IROW 00831 END IF 00832 210 CONTINUE 00833 220 CONTINUE 00834 230 CONTINUE 00835 END IF 00836 * 00837 ELSE 00838 * 00839 * Symmetric -- A = U D U' 00840 * 00841 IPACKG = IPACK 00842 IOFFG = IOFFST 00843 * 00844 IF( TOPDWN ) THEN 00845 * 00846 * Top-Down -- Generate Upper triangle only 00847 * 00848 IF( IPACK.GE.5 ) THEN 00849 IPACKG = 6 00850 IOFFG = UUB + 1 00851 ELSE 00852 IPACKG = 1 00853 END IF 00854 CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 ) 00855 * 00856 DO 260 K = 1, UUB 00857 DO 250 JC = 1, N - 1 00858 IROW = MAX( 1, JC-K ) 00859 IL = MIN( JC+1, K+2 ) 00860 EXTRA = ZERO 00861 TEMP = A( JC-ISKEW*( JC+1 )+IOFFG, JC+1 ) 00862 ANGLE = TWOPI*SLARND( 1, ISEED ) 00863 C = COS( ANGLE ) 00864 S = SIN( ANGLE ) 00865 CALL SLAROT( .FALSE., JC.GT.K, .TRUE., IL, C, S, 00866 $ A( IROW-ISKEW*JC+IOFFG, JC ), ILDA, 00867 $ EXTRA, TEMP ) 00868 CALL SLAROT( .TRUE., .TRUE., .FALSE., 00869 $ MIN( K, N-JC )+1, C, S, 00870 $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, 00871 $ TEMP, DUMMY ) 00872 * 00873 * Chase EXTRA back up the matrix 00874 * 00875 ICOL = JC 00876 DO 240 JCH = JC - K, 1, -K 00877 CALL SLARTG( A( JCH+1-ISKEW*( ICOL+1 )+IOFFG, 00878 $ ICOL+1 ), EXTRA, C, S, DUMMY ) 00879 TEMP = A( JCH-ISKEW*( JCH+1 )+IOFFG, JCH+1 ) 00880 CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, -S, 00881 $ A( ( 1-ISKEW )*JCH+IOFFG, JCH ), 00882 $ ILDA, TEMP, EXTRA ) 00883 IROW = MAX( 1, JCH-K ) 00884 IL = MIN( JCH+1, K+2 ) 00885 EXTRA = ZERO 00886 CALL SLAROT( .FALSE., JCH.GT.K, .TRUE., IL, C, 00887 $ -S, A( IROW-ISKEW*JCH+IOFFG, JCH ), 00888 $ ILDA, EXTRA, TEMP ) 00889 ICOL = JCH 00890 240 CONTINUE 00891 250 CONTINUE 00892 260 CONTINUE 00893 * 00894 * If we need lower triangle, copy from upper. Note that 00895 * the order of copying is chosen to work for 'q' -> 'b' 00896 * 00897 IF( IPACK.NE.IPACKG .AND. IPACK.NE.3 ) THEN 00898 DO 280 JC = 1, N 00899 IROW = IOFFST - ISKEW*JC 00900 DO 270 JR = JC, MIN( N, JC+UUB ) 00901 A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) 00902 270 CONTINUE 00903 280 CONTINUE 00904 IF( IPACK.EQ.5 ) THEN 00905 DO 300 JC = N - UUB + 1, N 00906 DO 290 JR = N + 2 - JC, UUB + 1 00907 A( JR, JC ) = ZERO 00908 290 CONTINUE 00909 300 CONTINUE 00910 END IF 00911 IF( IPACKG.EQ.6 ) THEN 00912 IPACKG = IPACK 00913 ELSE 00914 IPACKG = 0 00915 END IF 00916 END IF 00917 ELSE 00918 * 00919 * Bottom-Up -- Generate Lower triangle only 00920 * 00921 IF( IPACK.GE.5 ) THEN 00922 IPACKG = 5 00923 IF( IPACK.EQ.6 ) 00924 $ IOFFG = 1 00925 ELSE 00926 IPACKG = 2 00927 END IF 00928 CALL SCOPY( MNMIN, D, 1, A( 1-ISKEW+IOFFG, 1 ), ILDA+1 ) 00929 * 00930 DO 330 K = 1, UUB 00931 DO 320 JC = N - 1, 1, -1 00932 IL = MIN( N+1-JC, K+2 ) 00933 EXTRA = ZERO 00934 TEMP = A( 1+( 1-ISKEW )*JC+IOFFG, JC ) 00935 ANGLE = TWOPI*SLARND( 1, ISEED ) 00936 C = COS( ANGLE ) 00937 S = -SIN( ANGLE ) 00938 CALL SLAROT( .FALSE., .TRUE., N-JC.GT.K, IL, C, S, 00939 $ A( ( 1-ISKEW )*JC+IOFFG, JC ), ILDA, 00940 $ TEMP, EXTRA ) 00941 ICOL = MAX( 1, JC-K+1 ) 00942 CALL SLAROT( .TRUE., .FALSE., .TRUE., JC+2-ICOL, C, 00943 $ S, A( JC-ISKEW*ICOL+IOFFG, ICOL ), 00944 $ ILDA, DUMMY, TEMP ) 00945 * 00946 * Chase EXTRA back down the matrix 00947 * 00948 ICOL = JC 00949 DO 310 JCH = JC + K, N - 1, K 00950 CALL SLARTG( A( JCH-ISKEW*ICOL+IOFFG, ICOL ), 00951 $ EXTRA, C, S, DUMMY ) 00952 TEMP = A( 1+( 1-ISKEW )*JCH+IOFFG, JCH ) 00953 CALL SLAROT( .TRUE., .TRUE., .TRUE., K+2, C, S, 00954 $ A( JCH-ISKEW*ICOL+IOFFG, ICOL ), 00955 $ ILDA, EXTRA, TEMP ) 00956 IL = MIN( N+1-JCH, K+2 ) 00957 EXTRA = ZERO 00958 CALL SLAROT( .FALSE., .TRUE., N-JCH.GT.K, IL, C, 00959 $ S, A( ( 1-ISKEW )*JCH+IOFFG, JCH ), 00960 $ ILDA, TEMP, EXTRA ) 00961 ICOL = JCH 00962 310 CONTINUE 00963 320 CONTINUE 00964 330 CONTINUE 00965 * 00966 * If we need upper triangle, copy from lower. Note that 00967 * the order of copying is chosen to work for 'b' -> 'q' 00968 * 00969 IF( IPACK.NE.IPACKG .AND. IPACK.NE.4 ) THEN 00970 DO 350 JC = N, 1, -1 00971 IROW = IOFFST - ISKEW*JC 00972 DO 340 JR = JC, MAX( 1, JC-UUB ), -1 00973 A( JR+IROW, JC ) = A( JC-ISKEW*JR+IOFFG, JR ) 00974 340 CONTINUE 00975 350 CONTINUE 00976 IF( IPACK.EQ.6 ) THEN 00977 DO 370 JC = 1, UUB 00978 DO 360 JR = 1, UUB + 1 - JC 00979 A( JR, JC ) = ZERO 00980 360 CONTINUE 00981 370 CONTINUE 00982 END IF 00983 IF( IPACKG.EQ.5 ) THEN 00984 IPACKG = IPACK 00985 ELSE 00986 IPACKG = 0 00987 END IF 00988 END IF 00989 END IF 00990 END IF 00991 * 00992 ELSE 00993 * 00994 * 4) Generate Banded Matrix by first 00995 * Rotating by random Unitary matrices, 00996 * then reducing the bandwidth using Householder 00997 * transformations. 00998 * 00999 * Note: we should get here only if LDA .ge. N 01000 * 01001 IF( ISYM.EQ.1 ) THEN 01002 * 01003 * Non-symmetric -- A = U D V 01004 * 01005 CALL SLAGGE( MR, NC, LLB, UUB, D, A, LDA, ISEED, WORK, 01006 $ IINFO ) 01007 ELSE 01008 * 01009 * Symmetric -- A = U D U' 01010 * 01011 CALL SLAGSY( M, LLB, D, A, LDA, ISEED, WORK, IINFO ) 01012 * 01013 END IF 01014 IF( IINFO.NE.0 ) THEN 01015 INFO = 3 01016 RETURN 01017 END IF 01018 END IF 01019 * 01020 * 5) Pack the matrix 01021 * 01022 IF( IPACK.NE.IPACKG ) THEN 01023 IF( IPACK.EQ.1 ) THEN 01024 * 01025 * 'U' -- Upper triangular, not packed 01026 * 01027 DO 390 J = 1, M 01028 DO 380 I = J + 1, M 01029 A( I, J ) = ZERO 01030 380 CONTINUE 01031 390 CONTINUE 01032 * 01033 ELSE IF( IPACK.EQ.2 ) THEN 01034 * 01035 * 'L' -- Lower triangular, not packed 01036 * 01037 DO 410 J = 2, M 01038 DO 400 I = 1, J - 1 01039 A( I, J ) = ZERO 01040 400 CONTINUE 01041 410 CONTINUE 01042 * 01043 ELSE IF( IPACK.EQ.3 ) THEN 01044 * 01045 * 'C' -- Upper triangle packed Columnwise. 01046 * 01047 ICOL = 1 01048 IROW = 0 01049 DO 430 J = 1, M 01050 DO 420 I = 1, J 01051 IROW = IROW + 1 01052 IF( IROW.GT.LDA ) THEN 01053 IROW = 1 01054 ICOL = ICOL + 1 01055 END IF 01056 A( IROW, ICOL ) = A( I, J ) 01057 420 CONTINUE 01058 430 CONTINUE 01059 * 01060 ELSE IF( IPACK.EQ.4 ) THEN 01061 * 01062 * 'R' -- Lower triangle packed Columnwise. 01063 * 01064 ICOL = 1 01065 IROW = 0 01066 DO 450 J = 1, M 01067 DO 440 I = J, M 01068 IROW = IROW + 1 01069 IF( IROW.GT.LDA ) THEN 01070 IROW = 1 01071 ICOL = ICOL + 1 01072 END IF 01073 A( IROW, ICOL ) = A( I, J ) 01074 440 CONTINUE 01075 450 CONTINUE 01076 * 01077 ELSE IF( IPACK.GE.5 ) THEN 01078 * 01079 * 'B' -- The lower triangle is packed as a band matrix. 01080 * 'Q' -- The upper triangle is packed as a band matrix. 01081 * 'Z' -- The whole matrix is packed as a band matrix. 01082 * 01083 IF( IPACK.EQ.5 ) 01084 $ UUB = 0 01085 IF( IPACK.EQ.6 ) 01086 $ LLB = 0 01087 * 01088 DO 470 J = 1, UUB 01089 DO 460 I = MIN( J+LLB, M ), 1, -1 01090 A( I-J+UUB+1, J ) = A( I, J ) 01091 460 CONTINUE 01092 470 CONTINUE 01093 * 01094 DO 490 J = UUB + 2, N 01095 DO 480 I = J - UUB, MIN( J+LLB, M ) 01096 A( I-J+UUB+1, J ) = A( I, J ) 01097 480 CONTINUE 01098 490 CONTINUE 01099 END IF 01100 * 01101 * If packed, zero out extraneous elements. 01102 * 01103 * Symmetric/Triangular Packed -- 01104 * zero out everything after A(IROW,ICOL) 01105 * 01106 IF( IPACK.EQ.3 .OR. IPACK.EQ.4 ) THEN 01107 DO 510 JC = ICOL, M 01108 DO 500 JR = IROW + 1, LDA 01109 A( JR, JC ) = ZERO 01110 500 CONTINUE 01111 IROW = 0 01112 510 CONTINUE 01113 * 01114 ELSE IF( IPACK.GE.5 ) THEN 01115 * 01116 * Packed Band -- 01117 * 1st row is now in A( UUB+2-j, j), zero above it 01118 * m-th row is now in A( M+UUB-j,j), zero below it 01119 * last non-zero diagonal is now in A( UUB+LLB+1,j ), 01120 * zero below it, too. 01121 * 01122 IR1 = UUB + LLB + 2 01123 IR2 = UUB + M + 2 01124 DO 540 JC = 1, N 01125 DO 520 JR = 1, UUB + 1 - JC 01126 A( JR, JC ) = ZERO 01127 520 CONTINUE 01128 DO 530 JR = MAX( 1, MIN( IR1, IR2-JC ) ), LDA 01129 A( JR, JC ) = ZERO 01130 530 CONTINUE 01131 540 CONTINUE 01132 END IF 01133 END IF 01134 * 01135 RETURN 01136 * 01137 * End of SLATMT 01138 * 01139 END