![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZLATME 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 ZLATME( N, DIST, ISEED, D, MODE, COND, DMAX, 00012 * RSIGN, 00013 * UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, 00014 * A, 00015 * LDA, WORK, INFO ) 00016 * 00017 * .. Scalar Arguments .. 00018 * CHARACTER DIST, RSIGN, SIM, UPPER 00019 * INTEGER INFO, KL, KU, LDA, MODE, MODES, N 00020 * DOUBLE PRECISION ANORM, COND, CONDS 00021 * COMPLEX*16 DMAX 00022 * .. 00023 * .. Array Arguments .. 00024 * INTEGER ISEED( 4 ) 00025 * DOUBLE PRECISION DS( * ) 00026 * COMPLEX*16 A( LDA, * ), D( * ), WORK( * ) 00027 * .. 00028 * 00029 * 00030 *> \par Purpose: 00031 * ============= 00032 *> 00033 *> \verbatim 00034 *> 00035 *> ZLATME generates random non-symmetric square matrices with 00036 *> specified eigenvalues for testing LAPACK programs. 00037 *> 00038 *> ZLATME operates by applying the following sequence of 00039 *> operations: 00040 *> 00041 *> 1. Set the diagonal to D, where D may be input or 00042 *> computed according to MODE, COND, DMAX, and RSIGN 00043 *> as described below. 00044 *> 00045 *> 2. If UPPER='T', the upper triangle of A is set to random values 00046 *> out of distribution DIST. 00047 *> 00048 *> 3. If SIM='T', A is multiplied on the left by a random matrix 00049 *> X, whose singular values are specified by DS, MODES, and 00050 *> CONDS, and on the right by X inverse. 00051 *> 00052 *> 4. If KL < N-1, the lower bandwidth is reduced to KL using 00053 *> Householder transformations. If KU < N-1, the upper 00054 *> bandwidth is reduced to KU. 00055 *> 00056 *> 5. If ANORM is not negative, the matrix is scaled to have 00057 *> maximum-element-norm ANORM. 00058 *> 00059 *> (Note: since the matrix cannot be reduced beyond Hessenberg form, 00060 *> no packing options are available.) 00061 *> \endverbatim 00062 * 00063 * Arguments: 00064 * ========== 00065 * 00066 *> \param[in] N 00067 *> \verbatim 00068 *> N is INTEGER 00069 *> The number of columns (or rows) of A. Not modified. 00070 *> \endverbatim 00071 *> 00072 *> \param[in] DIST 00073 *> \verbatim 00074 *> DIST is CHARACTER*1 00075 *> On entry, DIST specifies the type of distribution to be used 00076 *> to generate the random eigen-/singular values, and on the 00077 *> upper triangle (see UPPER). 00078 *> 'U' => UNIFORM( 0, 1 ) ( 'U' for uniform ) 00079 *> 'S' => UNIFORM( -1, 1 ) ( 'S' for symmetric ) 00080 *> 'N' => NORMAL( 0, 1 ) ( 'N' for normal ) 00081 *> 'D' => uniform on the complex disc |z| < 1. 00082 *> Not modified. 00083 *> \endverbatim 00084 *> 00085 *> \param[in,out] ISEED 00086 *> \verbatim 00087 *> ISEED is INTEGER array, dimension ( 4 ) 00088 *> On entry ISEED specifies the seed of the random number 00089 *> generator. They should lie between 0 and 4095 inclusive, 00090 *> and ISEED(4) should be odd. The random number generator 00091 *> uses a linear congruential sequence limited to small 00092 *> integers, and so should produce machine independent 00093 *> random numbers. The values of ISEED are changed on 00094 *> exit, and can be used in the next call to ZLATME 00095 *> to continue the same random number sequence. 00096 *> Changed on exit. 00097 *> \endverbatim 00098 *> 00099 *> \param[in,out] D 00100 *> \verbatim 00101 *> D is COMPLEX*16 array, dimension ( N ) 00102 *> This array is used to specify the eigenvalues of A. If 00103 *> MODE=0, then D is assumed to contain the eigenvalues 00104 *> otherwise they will be computed according to MODE, COND, 00105 *> DMAX, and RSIGN and placed in D. 00106 *> Modified if MODE is nonzero. 00107 *> \endverbatim 00108 *> 00109 *> \param[in] MODE 00110 *> \verbatim 00111 *> MODE is INTEGER 00112 *> On entry this describes how the eigenvalues are to 00113 *> be specified: 00114 *> MODE = 0 means use D as input 00115 *> MODE = 1 sets D(1)=1 and D(2:N)=1.0/COND 00116 *> MODE = 2 sets D(1:N-1)=1 and D(N)=1.0/COND 00117 *> MODE = 3 sets D(I)=COND**(-(I-1)/(N-1)) 00118 *> MODE = 4 sets D(i)=1 - (i-1)/(N-1)*(1 - 1/COND) 00119 *> MODE = 5 sets D to random numbers in the range 00120 *> ( 1/COND , 1 ) such that their logarithms 00121 *> are uniformly distributed. 00122 *> MODE = 6 set D to random numbers from same distribution 00123 *> as the rest of the matrix. 00124 *> MODE < 0 has the same meaning as ABS(MODE), except that 00125 *> the order of the elements of D is reversed. 00126 *> Thus if MODE is between 1 and 4, D has entries ranging 00127 *> from 1 to 1/COND, if between -1 and -4, D has entries 00128 *> ranging from 1/COND to 1, 00129 *> Not modified. 00130 *> \endverbatim 00131 *> 00132 *> \param[in] COND 00133 *> \verbatim 00134 *> COND is DOUBLE PRECISION 00135 *> On entry, this is used as described under MODE above. 00136 *> If used, it must be >= 1. Not modified. 00137 *> \endverbatim 00138 *> 00139 *> \param[in] DMAX 00140 *> \verbatim 00141 *> DMAX is COMPLEX*16 00142 *> If MODE is neither -6, 0 nor 6, the contents of D, as 00143 *> computed according to MODE and COND, will be scaled by 00144 *> DMAX / max(abs(D(i))). Note that DMAX need not be 00145 *> positive or real: if DMAX is negative or complex (or zero), 00146 *> D will be scaled by a negative or complex number (or zero). 00147 *> If RSIGN='F' then the largest (absolute) eigenvalue will be 00148 *> equal to DMAX. 00149 *> Not modified. 00150 *> \endverbatim 00151 *> 00152 *> \param[in] RSIGN 00153 *> \verbatim 00154 *> RSIGN is CHARACTER*1 00155 *> If MODE is not 0, 6, or -6, and RSIGN='T', then the 00156 *> elements of D, as computed according to MODE and COND, will 00157 *> be multiplied by a random complex number from the unit 00158 *> circle |z| = 1. If RSIGN='F', they will not be. RSIGN may 00159 *> only have the values 'T' or 'F'. 00160 *> Not modified. 00161 *> \endverbatim 00162 *> 00163 *> \param[in] UPPER 00164 *> \verbatim 00165 *> UPPER is CHARACTER*1 00166 *> If UPPER='T', then the elements of A above the diagonal 00167 *> will be set to random numbers out of DIST. If UPPER='F', 00168 *> they will not. UPPER may only have the values 'T' or 'F'. 00169 *> Not modified. 00170 *> \endverbatim 00171 *> 00172 *> \param[in] SIM 00173 *> \verbatim 00174 *> SIM is CHARACTER*1 00175 *> If SIM='T', then A will be operated on by a "similarity 00176 *> transform", i.e., multiplied on the left by a matrix X and 00177 *> on the right by X inverse. X = U S V, where U and V are 00178 *> random unitary matrices and S is a (diagonal) matrix of 00179 *> singular values specified by DS, MODES, and CONDS. If 00180 *> SIM='F', then A will not be transformed. 00181 *> Not modified. 00182 *> \endverbatim 00183 *> 00184 *> \param[in,out] DS 00185 *> \verbatim 00186 *> DS is DOUBLE PRECISION array, dimension ( N ) 00187 *> This array is used to specify the singular values of X, 00188 *> in the same way that D specifies the eigenvalues of A. 00189 *> If MODE=0, the DS contains the singular values, which 00190 *> may not be zero. 00191 *> Modified if MODE is nonzero. 00192 *> \endverbatim 00193 *> 00194 *> \param[in] MODES 00195 *> \verbatim 00196 *> MODES is INTEGER 00197 *> \endverbatim 00198 *> 00199 *> \param[in] CONDS 00200 *> \verbatim 00201 *> CONDS is DOUBLE PRECISION 00202 *> Similar to MODE and COND, but for specifying the diagonal 00203 *> of S. MODES=-6 and +6 are not allowed (since they would 00204 *> result in randomly ill-conditioned eigenvalues.) 00205 *> \endverbatim 00206 *> 00207 *> \param[in] KL 00208 *> \verbatim 00209 *> KL is INTEGER 00210 *> This specifies the lower bandwidth of the matrix. KL=1 00211 *> specifies upper Hessenberg form. If KL is at least N-1, 00212 *> then A will have full lower bandwidth. 00213 *> Not modified. 00214 *> \endverbatim 00215 *> 00216 *> \param[in] KU 00217 *> \verbatim 00218 *> KU is INTEGER 00219 *> This specifies the upper bandwidth of the matrix. KU=1 00220 *> specifies lower Hessenberg form. If KU is at least N-1, 00221 *> then A will have full upper bandwidth; if KU and KL 00222 *> are both at least N-1, then A will be dense. Only one of 00223 *> KU and KL may be less than N-1. 00224 *> Not modified. 00225 *> \endverbatim 00226 *> 00227 *> \param[in] ANORM 00228 *> \verbatim 00229 *> ANORM is DOUBLE PRECISION 00230 *> If ANORM is not negative, then A will be scaled by a non- 00231 *> negative real number to make the maximum-element-norm of A 00232 *> to be ANORM. 00233 *> Not modified. 00234 *> \endverbatim 00235 *> 00236 *> \param[out] A 00237 *> \verbatim 00238 *> A is COMPLEX*16 array, dimension ( LDA, N ) 00239 *> On exit A is the desired test matrix. 00240 *> Modified. 00241 *> \endverbatim 00242 *> 00243 *> \param[in] LDA 00244 *> \verbatim 00245 *> LDA is INTEGER 00246 *> LDA specifies the first dimension of A as declared in the 00247 *> calling program. LDA must be at least M. 00248 *> Not modified. 00249 *> \endverbatim 00250 *> 00251 *> \param[out] WORK 00252 *> \verbatim 00253 *> WORK is COMPLEX*16 array, dimension ( 3*N ) 00254 *> Workspace. 00255 *> Modified. 00256 *> \endverbatim 00257 *> 00258 *> \param[out] INFO 00259 *> \verbatim 00260 *> INFO is INTEGER 00261 *> Error code. On exit, INFO will be set to one of the 00262 *> following values: 00263 *> 0 => normal return 00264 *> -1 => N negative 00265 *> -2 => DIST illegal string 00266 *> -5 => MODE not in range -6 to 6 00267 *> -6 => COND less than 1.0, and MODE neither -6, 0 nor 6 00268 *> -9 => RSIGN is not 'T' or 'F' 00269 *> -10 => UPPER is not 'T' or 'F' 00270 *> -11 => SIM is not 'T' or 'F' 00271 *> -12 => MODES=0 and DS has a zero singular value. 00272 *> -13 => MODES is not in the range -5 to 5. 00273 *> -14 => MODES is nonzero and CONDS is less than 1. 00274 *> -15 => KL is less than 1. 00275 *> -16 => KU is less than 1, or KL and KU are both less than 00276 *> N-1. 00277 *> -19 => LDA is less than M. 00278 *> 1 => Error return from ZLATM1 (computing D) 00279 *> 2 => Cannot scale to DMAX (max. eigenvalue is 0) 00280 *> 3 => Error return from DLATM1 (computing DS) 00281 *> 4 => Error return from ZLARGE 00282 *> 5 => Zero singular value from DLATM1. 00283 *> \endverbatim 00284 * 00285 * Authors: 00286 * ======== 00287 * 00288 *> \author Univ. of Tennessee 00289 *> \author Univ. of California Berkeley 00290 *> \author Univ. of Colorado Denver 00291 *> \author NAG Ltd. 00292 * 00293 *> \date November 2011 00294 * 00295 *> \ingroup complex16_matgen 00296 * 00297 * ===================================================================== 00298 SUBROUTINE ZLATME( N, DIST, ISEED, D, MODE, COND, DMAX, 00299 $ RSIGN, 00300 $ UPPER, SIM, DS, MODES, CONDS, KL, KU, ANORM, 00301 $ A, 00302 $ LDA, WORK, INFO ) 00303 * 00304 * -- LAPACK computational routine (version 3.4.0) -- 00305 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00306 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00307 * November 2011 00308 * 00309 * .. Scalar Arguments .. 00310 CHARACTER DIST, RSIGN, SIM, UPPER 00311 INTEGER INFO, KL, KU, LDA, MODE, MODES, N 00312 DOUBLE PRECISION ANORM, COND, CONDS 00313 COMPLEX*16 DMAX 00314 * .. 00315 * .. Array Arguments .. 00316 INTEGER ISEED( 4 ) 00317 DOUBLE PRECISION DS( * ) 00318 COMPLEX*16 A( LDA, * ), D( * ), WORK( * ) 00319 * .. 00320 * 00321 * ===================================================================== 00322 * 00323 * .. Parameters .. 00324 DOUBLE PRECISION ZERO 00325 PARAMETER ( ZERO = 0.0D+0 ) 00326 DOUBLE PRECISION ONE 00327 PARAMETER ( ONE = 1.0D+0 ) 00328 COMPLEX*16 CZERO 00329 PARAMETER ( CZERO = ( 0.0D+0, 0.0D+0 ) ) 00330 COMPLEX*16 CONE 00331 PARAMETER ( CONE = ( 1.0D+0, 0.0D+0 ) ) 00332 * .. 00333 * .. Local Scalars .. 00334 LOGICAL BADS 00335 INTEGER I, IC, ICOLS, IDIST, IINFO, IR, IROWS, IRSIGN, 00336 $ ISIM, IUPPER, J, JC, JCR 00337 DOUBLE PRECISION RALPHA, TEMP 00338 COMPLEX*16 ALPHA, TAU, XNORMS 00339 * .. 00340 * .. Local Arrays .. 00341 DOUBLE PRECISION TEMPA( 1 ) 00342 * .. 00343 * .. External Functions .. 00344 LOGICAL LSAME 00345 DOUBLE PRECISION ZLANGE 00346 COMPLEX*16 ZLARND 00347 EXTERNAL LSAME, ZLANGE, ZLARND 00348 * .. 00349 * .. External Subroutines .. 00350 EXTERNAL DLATM1, XERBLA, ZCOPY, ZDSCAL, ZGEMV, ZGERC, 00351 $ ZLACGV, ZLARFG, ZLARGE, ZLARNV, ZLASET, ZLATM1, 00352 $ ZSCAL 00353 * .. 00354 * .. Intrinsic Functions .. 00355 INTRINSIC ABS, DCONJG, MAX, MOD 00356 * .. 00357 * .. Executable Statements .. 00358 * 00359 * 1) Decode and Test the input parameters. 00360 * Initialize flags & seed. 00361 * 00362 INFO = 0 00363 * 00364 * Quick return if possible 00365 * 00366 IF( N.EQ.0 ) 00367 $ RETURN 00368 * 00369 * Decode DIST 00370 * 00371 IF( LSAME( DIST, 'U' ) ) THEN 00372 IDIST = 1 00373 ELSE IF( LSAME( DIST, 'S' ) ) THEN 00374 IDIST = 2 00375 ELSE IF( LSAME( DIST, 'N' ) ) THEN 00376 IDIST = 3 00377 ELSE IF( LSAME( DIST, 'D' ) ) THEN 00378 IDIST = 4 00379 ELSE 00380 IDIST = -1 00381 END IF 00382 * 00383 * Decode RSIGN 00384 * 00385 IF( LSAME( RSIGN, 'T' ) ) THEN 00386 IRSIGN = 1 00387 ELSE IF( LSAME( RSIGN, 'F' ) ) THEN 00388 IRSIGN = 0 00389 ELSE 00390 IRSIGN = -1 00391 END IF 00392 * 00393 * Decode UPPER 00394 * 00395 IF( LSAME( UPPER, 'T' ) ) THEN 00396 IUPPER = 1 00397 ELSE IF( LSAME( UPPER, 'F' ) ) THEN 00398 IUPPER = 0 00399 ELSE 00400 IUPPER = -1 00401 END IF 00402 * 00403 * Decode SIM 00404 * 00405 IF( LSAME( SIM, 'T' ) ) THEN 00406 ISIM = 1 00407 ELSE IF( LSAME( SIM, 'F' ) ) THEN 00408 ISIM = 0 00409 ELSE 00410 ISIM = -1 00411 END IF 00412 * 00413 * Check DS, if MODES=0 and ISIM=1 00414 * 00415 BADS = .FALSE. 00416 IF( MODES.EQ.0 .AND. ISIM.EQ.1 ) THEN 00417 DO 10 J = 1, N 00418 IF( DS( J ).EQ.ZERO ) 00419 $ BADS = .TRUE. 00420 10 CONTINUE 00421 END IF 00422 * 00423 * Set INFO if an error 00424 * 00425 IF( N.LT.0 ) THEN 00426 INFO = -1 00427 ELSE IF( IDIST.EQ.-1 ) THEN 00428 INFO = -2 00429 ELSE IF( ABS( MODE ).GT.6 ) THEN 00430 INFO = -5 00431 ELSE IF( ( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) .AND. COND.LT.ONE ) 00432 $ THEN 00433 INFO = -6 00434 ELSE IF( IRSIGN.EQ.-1 ) THEN 00435 INFO = -9 00436 ELSE IF( IUPPER.EQ.-1 ) THEN 00437 INFO = -10 00438 ELSE IF( ISIM.EQ.-1 ) THEN 00439 INFO = -11 00440 ELSE IF( BADS ) THEN 00441 INFO = -12 00442 ELSE IF( ISIM.EQ.1 .AND. ABS( MODES ).GT.5 ) THEN 00443 INFO = -13 00444 ELSE IF( ISIM.EQ.1 .AND. MODES.NE.0 .AND. CONDS.LT.ONE ) THEN 00445 INFO = -14 00446 ELSE IF( KL.LT.1 ) THEN 00447 INFO = -15 00448 ELSE IF( KU.LT.1 .OR. ( KU.LT.N-1 .AND. KL.LT.N-1 ) ) THEN 00449 INFO = -16 00450 ELSE IF( LDA.LT.MAX( 1, N ) ) THEN 00451 INFO = -19 00452 END IF 00453 * 00454 IF( INFO.NE.0 ) THEN 00455 CALL XERBLA( 'ZLATME', -INFO ) 00456 RETURN 00457 END IF 00458 * 00459 * Initialize random number generator 00460 * 00461 DO 20 I = 1, 4 00462 ISEED( I ) = MOD( ABS( ISEED( I ) ), 4096 ) 00463 20 CONTINUE 00464 * 00465 IF( MOD( ISEED( 4 ), 2 ).NE.1 ) 00466 $ ISEED( 4 ) = ISEED( 4 ) + 1 00467 * 00468 * 2) Set up diagonal of A 00469 * 00470 * Compute D according to COND and MODE 00471 * 00472 CALL ZLATM1( MODE, COND, IRSIGN, IDIST, ISEED, D, N, IINFO ) 00473 IF( IINFO.NE.0 ) THEN 00474 INFO = 1 00475 RETURN 00476 END IF 00477 IF( MODE.NE.0 .AND. ABS( MODE ).NE.6 ) THEN 00478 * 00479 * Scale by DMAX 00480 * 00481 TEMP = ABS( D( 1 ) ) 00482 DO 30 I = 2, N 00483 TEMP = MAX( TEMP, ABS( D( I ) ) ) 00484 30 CONTINUE 00485 * 00486 IF( TEMP.GT.ZERO ) THEN 00487 ALPHA = DMAX / TEMP 00488 ELSE 00489 INFO = 2 00490 RETURN 00491 END IF 00492 * 00493 CALL ZSCAL( N, ALPHA, D, 1 ) 00494 * 00495 END IF 00496 * 00497 CALL ZLASET( 'Full', N, N, CZERO, CZERO, A, LDA ) 00498 CALL ZCOPY( N, D, 1, A, LDA+1 ) 00499 * 00500 * 3) If UPPER='T', set upper triangle of A to random numbers. 00501 * 00502 IF( IUPPER.NE.0 ) THEN 00503 DO 40 JC = 2, N 00504 CALL ZLARNV( IDIST, ISEED, JC-1, A( 1, JC ) ) 00505 40 CONTINUE 00506 END IF 00507 * 00508 * 4) If SIM='T', apply similarity transformation. 00509 * 00510 * -1 00511 * Transform is X A X , where X = U S V, thus 00512 * 00513 * it is U S V A V' (1/S) U' 00514 * 00515 IF( ISIM.NE.0 ) THEN 00516 * 00517 * Compute S (singular values of the eigenvector matrix) 00518 * according to CONDS and MODES 00519 * 00520 CALL DLATM1( MODES, CONDS, 0, 0, ISEED, DS, N, IINFO ) 00521 IF( IINFO.NE.0 ) THEN 00522 INFO = 3 00523 RETURN 00524 END IF 00525 * 00526 * Multiply by V and V' 00527 * 00528 CALL ZLARGE( N, A, LDA, ISEED, WORK, IINFO ) 00529 IF( IINFO.NE.0 ) THEN 00530 INFO = 4 00531 RETURN 00532 END IF 00533 * 00534 * Multiply by S and (1/S) 00535 * 00536 DO 50 J = 1, N 00537 CALL ZDSCAL( N, DS( J ), A( J, 1 ), LDA ) 00538 IF( DS( J ).NE.ZERO ) THEN 00539 CALL ZDSCAL( N, ONE / DS( J ), A( 1, J ), 1 ) 00540 ELSE 00541 INFO = 5 00542 RETURN 00543 END IF 00544 50 CONTINUE 00545 * 00546 * Multiply by U and U' 00547 * 00548 CALL ZLARGE( N, A, LDA, ISEED, WORK, IINFO ) 00549 IF( IINFO.NE.0 ) THEN 00550 INFO = 4 00551 RETURN 00552 END IF 00553 END IF 00554 * 00555 * 5) Reduce the bandwidth. 00556 * 00557 IF( KL.LT.N-1 ) THEN 00558 * 00559 * Reduce bandwidth -- kill column 00560 * 00561 DO 60 JCR = KL + 1, N - 1 00562 IC = JCR - KL 00563 IROWS = N + 1 - JCR 00564 ICOLS = N + KL - JCR 00565 * 00566 CALL ZCOPY( IROWS, A( JCR, IC ), 1, WORK, 1 ) 00567 XNORMS = WORK( 1 ) 00568 CALL ZLARFG( IROWS, XNORMS, WORK( 2 ), 1, TAU ) 00569 TAU = DCONJG( TAU ) 00570 WORK( 1 ) = CONE 00571 ALPHA = ZLARND( 5, ISEED ) 00572 * 00573 CALL ZGEMV( 'C', IROWS, ICOLS, CONE, A( JCR, IC+1 ), LDA, 00574 $ WORK, 1, CZERO, WORK( IROWS+1 ), 1 ) 00575 CALL ZGERC( IROWS, ICOLS, -TAU, WORK, 1, WORK( IROWS+1 ), 1, 00576 $ A( JCR, IC+1 ), LDA ) 00577 * 00578 CALL ZGEMV( 'N', N, IROWS, CONE, A( 1, JCR ), LDA, WORK, 1, 00579 $ CZERO, WORK( IROWS+1 ), 1 ) 00580 CALL ZGERC( N, IROWS, -DCONJG( TAU ), WORK( IROWS+1 ), 1, 00581 $ WORK, 1, A( 1, JCR ), LDA ) 00582 * 00583 A( JCR, IC ) = XNORMS 00584 CALL ZLASET( 'Full', IROWS-1, 1, CZERO, CZERO, 00585 $ A( JCR+1, IC ), LDA ) 00586 * 00587 CALL ZSCAL( ICOLS+1, ALPHA, A( JCR, IC ), LDA ) 00588 CALL ZSCAL( N, DCONJG( ALPHA ), A( 1, JCR ), 1 ) 00589 60 CONTINUE 00590 ELSE IF( KU.LT.N-1 ) THEN 00591 * 00592 * Reduce upper bandwidth -- kill a row at a time. 00593 * 00594 DO 70 JCR = KU + 1, N - 1 00595 IR = JCR - KU 00596 IROWS = N + KU - JCR 00597 ICOLS = N + 1 - JCR 00598 * 00599 CALL ZCOPY( ICOLS, A( IR, JCR ), LDA, WORK, 1 ) 00600 XNORMS = WORK( 1 ) 00601 CALL ZLARFG( ICOLS, XNORMS, WORK( 2 ), 1, TAU ) 00602 TAU = DCONJG( TAU ) 00603 WORK( 1 ) = CONE 00604 CALL ZLACGV( ICOLS-1, WORK( 2 ), 1 ) 00605 ALPHA = ZLARND( 5, ISEED ) 00606 * 00607 CALL ZGEMV( 'N', IROWS, ICOLS, CONE, A( IR+1, JCR ), LDA, 00608 $ WORK, 1, CZERO, WORK( ICOLS+1 ), 1 ) 00609 CALL ZGERC( IROWS, ICOLS, -TAU, WORK( ICOLS+1 ), 1, WORK, 1, 00610 $ A( IR+1, JCR ), LDA ) 00611 * 00612 CALL ZGEMV( 'C', ICOLS, N, CONE, A( JCR, 1 ), LDA, WORK, 1, 00613 $ CZERO, WORK( ICOLS+1 ), 1 ) 00614 CALL ZGERC( ICOLS, N, -DCONJG( TAU ), WORK, 1, 00615 $ WORK( ICOLS+1 ), 1, A( JCR, 1 ), LDA ) 00616 * 00617 A( IR, JCR ) = XNORMS 00618 CALL ZLASET( 'Full', 1, ICOLS-1, CZERO, CZERO, 00619 $ A( IR, JCR+1 ), LDA ) 00620 * 00621 CALL ZSCAL( IROWS+1, ALPHA, A( IR, JCR ), 1 ) 00622 CALL ZSCAL( N, DCONJG( ALPHA ), A( JCR, 1 ), LDA ) 00623 70 CONTINUE 00624 END IF 00625 * 00626 * Scale the matrix to have norm ANORM 00627 * 00628 IF( ANORM.GE.ZERO ) THEN 00629 TEMP = ZLANGE( 'M', N, N, A, LDA, TEMPA ) 00630 IF( TEMP.GT.ZERO ) THEN 00631 RALPHA = ANORM / TEMP 00632 DO 80 J = 1, N 00633 CALL ZDSCAL( N, RALPHA, A( 1, J ), 1 ) 00634 80 CONTINUE 00635 END IF 00636 END IF 00637 * 00638 RETURN 00639 * 00640 * End of ZLATME 00641 * 00642 END