![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DLASQ2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DLASQ2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DLASQ2( N, Z, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INFO, N 00025 * .. 00026 * .. Array Arguments .. 00027 * DOUBLE PRECISION Z( * ) 00028 * .. 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> DLASQ2 computes all the eigenvalues of the symmetric positive 00037 *> definite tridiagonal matrix associated with the qd array Z to high 00038 *> relative accuracy are computed to high relative accuracy, in the 00039 *> absence of denormalization, underflow and overflow. 00040 *> 00041 *> To see the relation of Z to the tridiagonal matrix, let L be a 00042 *> unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and 00043 *> let U be an upper bidiagonal matrix with 1's above and diagonal 00044 *> Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the 00045 *> symmetric tridiagonal to which it is similar. 00046 *> 00047 *> Note : DLASQ2 defines a logical variable, IEEE, which is true 00048 *> on machines which follow ieee-754 floating-point standard in their 00049 *> handling of infinities and NaNs, and false otherwise. This variable 00050 *> is passed to DLASQ3. 00051 *> \endverbatim 00052 * 00053 * Arguments: 00054 * ========== 00055 * 00056 *> \param[in] N 00057 *> \verbatim 00058 *> N is INTEGER 00059 *> The number of rows and columns in the matrix. N >= 0. 00060 *> \endverbatim 00061 *> 00062 *> \param[in,out] Z 00063 *> \verbatim 00064 *> Z is DOUBLE PRECISION array, dimension ( 4*N ) 00065 *> On entry Z holds the qd array. On exit, entries 1 to N hold 00066 *> the eigenvalues in decreasing order, Z( 2*N+1 ) holds the 00067 *> trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If 00068 *> N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 ) 00069 *> holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of 00070 *> shifts that failed. 00071 *> \endverbatim 00072 *> 00073 *> \param[out] INFO 00074 *> \verbatim 00075 *> INFO is INTEGER 00076 *> = 0: successful exit 00077 *> < 0: if the i-th argument is a scalar and had an illegal 00078 *> value, then INFO = -i, if the i-th argument is an 00079 *> array and the j-entry had an illegal value, then 00080 *> INFO = -(i*100+j) 00081 *> > 0: the algorithm failed 00082 *> = 1, a split was marked by a positive value in E 00083 *> = 2, current block of Z not diagonalized after 100*N 00084 *> iterations (in inner while loop). On exit Z holds 00085 *> a qd array with the same eigenvalues as the given Z. 00086 *> = 3, termination criterion of outer while loop not met 00087 *> (program created more than N unreduced blocks) 00088 *> \endverbatim 00089 * 00090 * Authors: 00091 * ======== 00092 * 00093 *> \author Univ. of Tennessee 00094 *> \author Univ. of California Berkeley 00095 *> \author Univ. of Colorado Denver 00096 *> \author NAG Ltd. 00097 * 00098 *> \date November 2011 00099 * 00100 *> \ingroup auxOTHERcomputational 00101 * 00102 *> \par Further Details: 00103 * ===================== 00104 *> 00105 *> \verbatim 00106 *> 00107 *> Local Variables: I0:N0 defines a current unreduced segment of Z. 00108 *> The shifts are accumulated in SIGMA. Iteration count is in ITER. 00109 *> Ping-pong is controlled by PP (alternates between 0 and 1). 00110 *> \endverbatim 00111 *> 00112 * ===================================================================== 00113 SUBROUTINE DLASQ2( N, Z, INFO ) 00114 * 00115 * -- LAPACK computational routine (version 3.4.0) -- 00116 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00117 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00118 * November 2011 00119 * 00120 * .. Scalar Arguments .. 00121 INTEGER INFO, N 00122 * .. 00123 * .. Array Arguments .. 00124 DOUBLE PRECISION Z( * ) 00125 * .. 00126 * 00127 * ===================================================================== 00128 * 00129 * .. Parameters .. 00130 DOUBLE PRECISION CBIAS 00131 PARAMETER ( CBIAS = 1.50D0 ) 00132 DOUBLE PRECISION ZERO, HALF, ONE, TWO, FOUR, HUNDRD 00133 PARAMETER ( ZERO = 0.0D0, HALF = 0.5D0, ONE = 1.0D0, 00134 $ TWO = 2.0D0, FOUR = 4.0D0, HUNDRD = 100.0D0 ) 00135 * .. 00136 * .. Local Scalars .. 00137 LOGICAL IEEE 00138 INTEGER I0, I1, I4, IINFO, IPN4, ITER, IWHILA, IWHILB, 00139 $ K, KMIN, N0, N1, NBIG, NDIV, NFAIL, PP, SPLT, 00140 $ TTYPE 00141 DOUBLE PRECISION D, DEE, DEEMIN, DESIG, DMIN, DMIN1, DMIN2, DN, 00142 $ DN1, DN2, E, EMAX, EMIN, EPS, G, OLDEMN, QMAX, 00143 $ QMIN, S, SAFMIN, SIGMA, T, TAU, TEMP, TOL, 00144 $ TOL2, TRACE, ZMAX, TEMPE, TEMPQ 00145 * .. 00146 * .. External Subroutines .. 00147 EXTERNAL DLASQ3, DLASRT, XERBLA 00148 * .. 00149 * .. External Functions .. 00150 INTEGER ILAENV 00151 DOUBLE PRECISION DLAMCH 00152 EXTERNAL DLAMCH, ILAENV 00153 * .. 00154 * .. Intrinsic Functions .. 00155 INTRINSIC ABS, DBLE, MAX, MIN, SQRT 00156 * .. 00157 * .. Executable Statements .. 00158 * 00159 * Test the input arguments. 00160 * (in case DLASQ2 is not called by DLASQ1) 00161 * 00162 INFO = 0 00163 EPS = DLAMCH( 'Precision' ) 00164 SAFMIN = DLAMCH( 'Safe minimum' ) 00165 TOL = EPS*HUNDRD 00166 TOL2 = TOL**2 00167 * 00168 IF( N.LT.0 ) THEN 00169 INFO = -1 00170 CALL XERBLA( 'DLASQ2', 1 ) 00171 RETURN 00172 ELSE IF( N.EQ.0 ) THEN 00173 RETURN 00174 ELSE IF( N.EQ.1 ) THEN 00175 * 00176 * 1-by-1 case. 00177 * 00178 IF( Z( 1 ).LT.ZERO ) THEN 00179 INFO = -201 00180 CALL XERBLA( 'DLASQ2', 2 ) 00181 END IF 00182 RETURN 00183 ELSE IF( N.EQ.2 ) THEN 00184 * 00185 * 2-by-2 case. 00186 * 00187 IF( Z( 2 ).LT.ZERO .OR. Z( 3 ).LT.ZERO ) THEN 00188 INFO = -2 00189 CALL XERBLA( 'DLASQ2', 2 ) 00190 RETURN 00191 ELSE IF( Z( 3 ).GT.Z( 1 ) ) THEN 00192 D = Z( 3 ) 00193 Z( 3 ) = Z( 1 ) 00194 Z( 1 ) = D 00195 END IF 00196 Z( 5 ) = Z( 1 ) + Z( 2 ) + Z( 3 ) 00197 IF( Z( 2 ).GT.Z( 3 )*TOL2 ) THEN 00198 T = HALF*( ( Z( 1 )-Z( 3 ) )+Z( 2 ) ) 00199 S = Z( 3 )*( Z( 2 ) / T ) 00200 IF( S.LE.T ) THEN 00201 S = Z( 3 )*( Z( 2 ) / ( T*( ONE+SQRT( ONE+S / T ) ) ) ) 00202 ELSE 00203 S = Z( 3 )*( Z( 2 ) / ( T+SQRT( T )*SQRT( T+S ) ) ) 00204 END IF 00205 T = Z( 1 ) + ( S+Z( 2 ) ) 00206 Z( 3 ) = Z( 3 )*( Z( 1 ) / T ) 00207 Z( 1 ) = T 00208 END IF 00209 Z( 2 ) = Z( 3 ) 00210 Z( 6 ) = Z( 2 ) + Z( 1 ) 00211 RETURN 00212 END IF 00213 * 00214 * Check for negative data and compute sums of q's and e's. 00215 * 00216 Z( 2*N ) = ZERO 00217 EMIN = Z( 2 ) 00218 QMAX = ZERO 00219 ZMAX = ZERO 00220 D = ZERO 00221 E = ZERO 00222 * 00223 DO 10 K = 1, 2*( N-1 ), 2 00224 IF( Z( K ).LT.ZERO ) THEN 00225 INFO = -( 200+K ) 00226 CALL XERBLA( 'DLASQ2', 2 ) 00227 RETURN 00228 ELSE IF( Z( K+1 ).LT.ZERO ) THEN 00229 INFO = -( 200+K+1 ) 00230 CALL XERBLA( 'DLASQ2', 2 ) 00231 RETURN 00232 END IF 00233 D = D + Z( K ) 00234 E = E + Z( K+1 ) 00235 QMAX = MAX( QMAX, Z( K ) ) 00236 EMIN = MIN( EMIN, Z( K+1 ) ) 00237 ZMAX = MAX( QMAX, ZMAX, Z( K+1 ) ) 00238 10 CONTINUE 00239 IF( Z( 2*N-1 ).LT.ZERO ) THEN 00240 INFO = -( 200+2*N-1 ) 00241 CALL XERBLA( 'DLASQ2', 2 ) 00242 RETURN 00243 END IF 00244 D = D + Z( 2*N-1 ) 00245 QMAX = MAX( QMAX, Z( 2*N-1 ) ) 00246 ZMAX = MAX( QMAX, ZMAX ) 00247 * 00248 * Check for diagonality. 00249 * 00250 IF( E.EQ.ZERO ) THEN 00251 DO 20 K = 2, N 00252 Z( K ) = Z( 2*K-1 ) 00253 20 CONTINUE 00254 CALL DLASRT( 'D', N, Z, IINFO ) 00255 Z( 2*N-1 ) = D 00256 RETURN 00257 END IF 00258 * 00259 TRACE = D + E 00260 * 00261 * Check for zero data. 00262 * 00263 IF( TRACE.EQ.ZERO ) THEN 00264 Z( 2*N-1 ) = ZERO 00265 RETURN 00266 END IF 00267 * 00268 * Check whether the machine is IEEE conformable. 00269 * 00270 IEEE = ILAENV( 10, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND. 00271 $ ILAENV( 11, 'DLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 00272 * 00273 * Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...). 00274 * 00275 DO 30 K = 2*N, 2, -2 00276 Z( 2*K ) = ZERO 00277 Z( 2*K-1 ) = Z( K ) 00278 Z( 2*K-2 ) = ZERO 00279 Z( 2*K-3 ) = Z( K-1 ) 00280 30 CONTINUE 00281 * 00282 I0 = 1 00283 N0 = N 00284 * 00285 * Reverse the qd-array, if warranted. 00286 * 00287 IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN 00288 IPN4 = 4*( I0+N0 ) 00289 DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4 00290 TEMP = Z( I4-3 ) 00291 Z( I4-3 ) = Z( IPN4-I4-3 ) 00292 Z( IPN4-I4-3 ) = TEMP 00293 TEMP = Z( I4-1 ) 00294 Z( I4-1 ) = Z( IPN4-I4-5 ) 00295 Z( IPN4-I4-5 ) = TEMP 00296 40 CONTINUE 00297 END IF 00298 * 00299 * Initial split checking via dqd and Li's test. 00300 * 00301 PP = 0 00302 * 00303 DO 80 K = 1, 2 00304 * 00305 D = Z( 4*N0+PP-3 ) 00306 DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4 00307 IF( Z( I4-1 ).LE.TOL2*D ) THEN 00308 Z( I4-1 ) = -ZERO 00309 D = Z( I4-3 ) 00310 ELSE 00311 D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) ) 00312 END IF 00313 50 CONTINUE 00314 * 00315 * dqd maps Z to ZZ plus Li's test. 00316 * 00317 EMIN = Z( 4*I0+PP+1 ) 00318 D = Z( 4*I0+PP-3 ) 00319 DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4 00320 Z( I4-2*PP-2 ) = D + Z( I4-1 ) 00321 IF( Z( I4-1 ).LE.TOL2*D ) THEN 00322 Z( I4-1 ) = -ZERO 00323 Z( I4-2*PP-2 ) = D 00324 Z( I4-2*PP ) = ZERO 00325 D = Z( I4+1 ) 00326 ELSE IF( SAFMIN*Z( I4+1 ).LT.Z( I4-2*PP-2 ) .AND. 00327 $ SAFMIN*Z( I4-2*PP-2 ).LT.Z( I4+1 ) ) THEN 00328 TEMP = Z( I4+1 ) / Z( I4-2*PP-2 ) 00329 Z( I4-2*PP ) = Z( I4-1 )*TEMP 00330 D = D*TEMP 00331 ELSE 00332 Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) / Z( I4-2*PP-2 ) ) 00333 D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) ) 00334 END IF 00335 EMIN = MIN( EMIN, Z( I4-2*PP ) ) 00336 60 CONTINUE 00337 Z( 4*N0-PP-2 ) = D 00338 * 00339 * Now find qmax. 00340 * 00341 QMAX = Z( 4*I0-PP-2 ) 00342 DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4 00343 QMAX = MAX( QMAX, Z( I4 ) ) 00344 70 CONTINUE 00345 * 00346 * Prepare for the next iteration on K. 00347 * 00348 PP = 1 - PP 00349 80 CONTINUE 00350 * 00351 * Initialise variables to pass to DLASQ3. 00352 * 00353 TTYPE = 0 00354 DMIN1 = ZERO 00355 DMIN2 = ZERO 00356 DN = ZERO 00357 DN1 = ZERO 00358 DN2 = ZERO 00359 G = ZERO 00360 TAU = ZERO 00361 * 00362 ITER = 2 00363 NFAIL = 0 00364 NDIV = 2*( N0-I0 ) 00365 * 00366 DO 160 IWHILA = 1, N + 1 00367 IF( N0.LT.1 ) 00368 $ GO TO 170 00369 * 00370 * While array unfinished do 00371 * 00372 * E(N0) holds the value of SIGMA when submatrix in I0:N0 00373 * splits from the rest of the array, but is negated. 00374 * 00375 DESIG = ZERO 00376 IF( N0.EQ.N ) THEN 00377 SIGMA = ZERO 00378 ELSE 00379 SIGMA = -Z( 4*N0-1 ) 00380 END IF 00381 IF( SIGMA.LT.ZERO ) THEN 00382 INFO = 1 00383 RETURN 00384 END IF 00385 * 00386 * Find last unreduced submatrix's top index I0, find QMAX and 00387 * EMIN. Find Gershgorin-type bound if Q's much greater than E's. 00388 * 00389 EMAX = ZERO 00390 IF( N0.GT.I0 ) THEN 00391 EMIN = ABS( Z( 4*N0-5 ) ) 00392 ELSE 00393 EMIN = ZERO 00394 END IF 00395 QMIN = Z( 4*N0-3 ) 00396 QMAX = QMIN 00397 DO 90 I4 = 4*N0, 8, -4 00398 IF( Z( I4-5 ).LE.ZERO ) 00399 $ GO TO 100 00400 IF( QMIN.GE.FOUR*EMAX ) THEN 00401 QMIN = MIN( QMIN, Z( I4-3 ) ) 00402 EMAX = MAX( EMAX, Z( I4-5 ) ) 00403 END IF 00404 QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) ) 00405 EMIN = MIN( EMIN, Z( I4-5 ) ) 00406 90 CONTINUE 00407 I4 = 4 00408 * 00409 100 CONTINUE 00410 I0 = I4 / 4 00411 PP = 0 00412 * 00413 IF( N0-I0.GT.1 ) THEN 00414 DEE = Z( 4*I0-3 ) 00415 DEEMIN = DEE 00416 KMIN = I0 00417 DO 110 I4 = 4*I0+1, 4*N0-3, 4 00418 DEE = Z( I4 )*( DEE /( DEE+Z( I4-2 ) ) ) 00419 IF( DEE.LE.DEEMIN ) THEN 00420 DEEMIN = DEE 00421 KMIN = ( I4+3 )/4 00422 END IF 00423 110 CONTINUE 00424 IF( (KMIN-I0)*2.LT.N0-KMIN .AND. 00425 $ DEEMIN.LE.HALF*Z(4*N0-3) ) THEN 00426 IPN4 = 4*( I0+N0 ) 00427 PP = 2 00428 DO 120 I4 = 4*I0, 2*( I0+N0-1 ), 4 00429 TEMP = Z( I4-3 ) 00430 Z( I4-3 ) = Z( IPN4-I4-3 ) 00431 Z( IPN4-I4-3 ) = TEMP 00432 TEMP = Z( I4-2 ) 00433 Z( I4-2 ) = Z( IPN4-I4-2 ) 00434 Z( IPN4-I4-2 ) = TEMP 00435 TEMP = Z( I4-1 ) 00436 Z( I4-1 ) = Z( IPN4-I4-5 ) 00437 Z( IPN4-I4-5 ) = TEMP 00438 TEMP = Z( I4 ) 00439 Z( I4 ) = Z( IPN4-I4-4 ) 00440 Z( IPN4-I4-4 ) = TEMP 00441 120 CONTINUE 00442 END IF 00443 END IF 00444 * 00445 * Put -(initial shift) into DMIN. 00446 * 00447 DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) ) 00448 * 00449 * Now I0:N0 is unreduced. 00450 * PP = 0 for ping, PP = 1 for pong. 00451 * PP = 2 indicates that flipping was applied to the Z array and 00452 * and that the tests for deflation upon entry in DLASQ3 00453 * should not be performed. 00454 * 00455 NBIG = 100*( N0-I0+1 ) 00456 DO 140 IWHILB = 1, NBIG 00457 IF( I0.GT.N0 ) 00458 $ GO TO 150 00459 * 00460 * While submatrix unfinished take a good dqds step. 00461 * 00462 CALL DLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, 00463 $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, 00464 $ DN2, G, TAU ) 00465 * 00466 PP = 1 - PP 00467 * 00468 * When EMIN is very small check for splits. 00469 * 00470 IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN 00471 IF( Z( 4*N0 ).LE.TOL2*QMAX .OR. 00472 $ Z( 4*N0-1 ).LE.TOL2*SIGMA ) THEN 00473 SPLT = I0 - 1 00474 QMAX = Z( 4*I0-3 ) 00475 EMIN = Z( 4*I0-1 ) 00476 OLDEMN = Z( 4*I0 ) 00477 DO 130 I4 = 4*I0, 4*( N0-3 ), 4 00478 IF( Z( I4 ).LE.TOL2*Z( I4-3 ) .OR. 00479 $ Z( I4-1 ).LE.TOL2*SIGMA ) THEN 00480 Z( I4-1 ) = -SIGMA 00481 SPLT = I4 / 4 00482 QMAX = ZERO 00483 EMIN = Z( I4+3 ) 00484 OLDEMN = Z( I4+4 ) 00485 ELSE 00486 QMAX = MAX( QMAX, Z( I4+1 ) ) 00487 EMIN = MIN( EMIN, Z( I4-1 ) ) 00488 OLDEMN = MIN( OLDEMN, Z( I4 ) ) 00489 END IF 00490 130 CONTINUE 00491 Z( 4*N0-1 ) = EMIN 00492 Z( 4*N0 ) = OLDEMN 00493 I0 = SPLT + 1 00494 END IF 00495 END IF 00496 * 00497 140 CONTINUE 00498 * 00499 INFO = 2 00500 * 00501 * Maximum number of iterations exceeded, restore the shift 00502 * SIGMA and place the new d's and e's in a qd array. 00503 * This might need to be done for several blocks 00504 * 00505 I1 = I0 00506 N1 = N0 00507 145 CONTINUE 00508 TEMPQ = Z( 4*I0-3 ) 00509 Z( 4*I0-3 ) = Z( 4*I0-3 ) + SIGMA 00510 DO K = I0+1, N0 00511 TEMPE = Z( 4*K-5 ) 00512 Z( 4*K-5 ) = Z( 4*K-5 ) * (TEMPQ / Z( 4*K-7 )) 00513 TEMPQ = Z( 4*K-3 ) 00514 Z( 4*K-3 ) = Z( 4*K-3 ) + SIGMA + TEMPE - Z( 4*K-5 ) 00515 END DO 00516 * 00517 * Prepare to do this on the previous block if there is one 00518 * 00519 IF( I1.GT.1 ) THEN 00520 N1 = I1-1 00521 DO WHILE( ( I1.GE.2 ) .AND. ( Z(4*I1-5).GE.ZERO ) ) 00522 I1 = I1 - 1 00523 END DO 00524 SIGMA = -Z(4*N1-1) 00525 GO TO 145 00526 END IF 00527 00528 DO K = 1, N 00529 Z( 2*K-1 ) = Z( 4*K-3 ) 00530 * 00531 * Only the block 1..N0 is unfinished. The rest of the e's 00532 * must be essentially zero, although sometimes other data 00533 * has been stored in them. 00534 * 00535 IF( K.LT.N0 ) THEN 00536 Z( 2*K ) = Z( 4*K-1 ) 00537 ELSE 00538 Z( 2*K ) = 0 00539 END IF 00540 END DO 00541 RETURN 00542 * 00543 * end IWHILB 00544 * 00545 150 CONTINUE 00546 * 00547 160 CONTINUE 00548 * 00549 INFO = 3 00550 RETURN 00551 * 00552 * end IWHILA 00553 * 00554 170 CONTINUE 00555 * 00556 * Move q's to the front. 00557 * 00558 DO 180 K = 2, N 00559 Z( K ) = Z( 4*K-3 ) 00560 180 CONTINUE 00561 * 00562 * Sort and compute sum of eigenvalues. 00563 * 00564 CALL DLASRT( 'D', N, Z, IINFO ) 00565 * 00566 E = ZERO 00567 DO 190 K = N, 1, -1 00568 E = E + Z( K ) 00569 190 CONTINUE 00570 * 00571 * Store trace, sum(eigenvalues) and information on performance. 00572 * 00573 Z( 2*N+1 ) = TRACE 00574 Z( 2*N+2 ) = E 00575 Z( 2*N+3 ) = DBLE( ITER ) 00576 Z( 2*N+4 ) = DBLE( NDIV ) / DBLE( N**2 ) 00577 Z( 2*N+5 ) = HUNDRD*NFAIL / DBLE( ITER ) 00578 RETURN 00579 * 00580 * End of DLASQ2 00581 * 00582 END