![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b SLASQ2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download SLASQ2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE SLASQ2( N, Z, INFO ) 00022 * 00023 * .. Scalar Arguments .. 00024 * INTEGER INFO, N 00025 * .. 00026 * .. Array Arguments .. 00027 * REAL Z( * ) 00028 * .. 00029 * 00030 * 00031 *> \par Purpose: 00032 * ============= 00033 *> 00034 *> \verbatim 00035 *> 00036 *> SLASQ2 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 : SLASQ2 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 SLASQ3. 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 REAL 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 SLASQ2( 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 REAL Z( * ) 00125 * .. 00126 * 00127 * ===================================================================== 00128 * 00129 * .. Parameters .. 00130 REAL CBIAS 00131 PARAMETER ( CBIAS = 1.50E0 ) 00132 REAL ZERO, HALF, ONE, TWO, FOUR, HUNDRD 00133 PARAMETER ( ZERO = 0.0E0, HALF = 0.5E0, ONE = 1.0E0, 00134 $ TWO = 2.0E0, FOUR = 4.0E0, HUNDRD = 100.0E0 ) 00135 * .. 00136 * .. Local Scalars .. 00137 LOGICAL IEEE 00138 INTEGER I0, I4, IINFO, IPN4, ITER, IWHILA, IWHILB, K, 00139 $ KMIN, N0, NBIG, NDIV, NFAIL, PP, SPLT, TTYPE, 00140 $ I1, N1 00141 REAL 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 SLASQ3, SLASRT, XERBLA 00148 * .. 00149 * .. External Functions .. 00150 INTEGER ILAENV 00151 REAL SLAMCH 00152 EXTERNAL ILAENV, SLAMCH 00153 * .. 00154 * .. Intrinsic Functions .. 00155 INTRINSIC ABS, MAX, MIN, REAL, SQRT 00156 * .. 00157 * .. Executable Statements .. 00158 * 00159 * Test the input arguments. 00160 * (in case SLASQ2 is not called by SLASQ1) 00161 * 00162 INFO = 0 00163 EPS = SLAMCH( 'Precision' ) 00164 SAFMIN = SLAMCH( 'Safe minimum' ) 00165 TOL = EPS*HUNDRD 00166 TOL2 = TOL**2 00167 * 00168 IF( N.LT.0 ) THEN 00169 INFO = -1 00170 CALL XERBLA( 'SLASQ2', 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( 'SLASQ2', 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( 'SLASQ2', 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( 'SLASQ2', 2 ) 00227 RETURN 00228 ELSE IF( Z( K+1 ).LT.ZERO ) THEN 00229 INFO = -( 200+K+1 ) 00230 CALL XERBLA( 'SLASQ2', 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( 'SLASQ2', 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 SLASRT( '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, 'SLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 .AND. 00271 * $ ILAENV( 11, 'SLASQ2', 'N', 1, 2, 3, 4 ).EQ.1 00272 * 00273 * [11/15/2008] The case IEEE=.TRUE. has a problem in single precision with 00274 * some the test matrices of type 16. The double precision code is fine. 00275 * 00276 IEEE = .FALSE. 00277 * 00278 * Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...). 00279 * 00280 DO 30 K = 2*N, 2, -2 00281 Z( 2*K ) = ZERO 00282 Z( 2*K-1 ) = Z( K ) 00283 Z( 2*K-2 ) = ZERO 00284 Z( 2*K-3 ) = Z( K-1 ) 00285 30 CONTINUE 00286 * 00287 I0 = 1 00288 N0 = N 00289 * 00290 * Reverse the qd-array, if warranted. 00291 * 00292 IF( CBIAS*Z( 4*I0-3 ).LT.Z( 4*N0-3 ) ) THEN 00293 IPN4 = 4*( I0+N0 ) 00294 DO 40 I4 = 4*I0, 2*( I0+N0-1 ), 4 00295 TEMP = Z( I4-3 ) 00296 Z( I4-3 ) = Z( IPN4-I4-3 ) 00297 Z( IPN4-I4-3 ) = TEMP 00298 TEMP = Z( I4-1 ) 00299 Z( I4-1 ) = Z( IPN4-I4-5 ) 00300 Z( IPN4-I4-5 ) = TEMP 00301 40 CONTINUE 00302 END IF 00303 * 00304 * Initial split checking via dqd and Li's test. 00305 * 00306 PP = 0 00307 * 00308 DO 80 K = 1, 2 00309 * 00310 D = Z( 4*N0+PP-3 ) 00311 DO 50 I4 = 4*( N0-1 ) + PP, 4*I0 + PP, -4 00312 IF( Z( I4-1 ).LE.TOL2*D ) THEN 00313 Z( I4-1 ) = -ZERO 00314 D = Z( I4-3 ) 00315 ELSE 00316 D = Z( I4-3 )*( D / ( D+Z( I4-1 ) ) ) 00317 END IF 00318 50 CONTINUE 00319 * 00320 * dqd maps Z to ZZ plus Li's test. 00321 * 00322 EMIN = Z( 4*I0+PP+1 ) 00323 D = Z( 4*I0+PP-3 ) 00324 DO 60 I4 = 4*I0 + PP, 4*( N0-1 ) + PP, 4 00325 Z( I4-2*PP-2 ) = D + Z( I4-1 ) 00326 IF( Z( I4-1 ).LE.TOL2*D ) THEN 00327 Z( I4-1 ) = -ZERO 00328 Z( I4-2*PP-2 ) = D 00329 Z( I4-2*PP ) = ZERO 00330 D = Z( I4+1 ) 00331 ELSE IF( SAFMIN*Z( I4+1 ).LT.Z( I4-2*PP-2 ) .AND. 00332 $ SAFMIN*Z( I4-2*PP-2 ).LT.Z( I4+1 ) ) THEN 00333 TEMP = Z( I4+1 ) / Z( I4-2*PP-2 ) 00334 Z( I4-2*PP ) = Z( I4-1 )*TEMP 00335 D = D*TEMP 00336 ELSE 00337 Z( I4-2*PP ) = Z( I4+1 )*( Z( I4-1 ) / Z( I4-2*PP-2 ) ) 00338 D = Z( I4+1 )*( D / Z( I4-2*PP-2 ) ) 00339 END IF 00340 EMIN = MIN( EMIN, Z( I4-2*PP ) ) 00341 60 CONTINUE 00342 Z( 4*N0-PP-2 ) = D 00343 * 00344 * Now find qmax. 00345 * 00346 QMAX = Z( 4*I0-PP-2 ) 00347 DO 70 I4 = 4*I0 - PP + 2, 4*N0 - PP - 2, 4 00348 QMAX = MAX( QMAX, Z( I4 ) ) 00349 70 CONTINUE 00350 * 00351 * Prepare for the next iteration on K. 00352 * 00353 PP = 1 - PP 00354 80 CONTINUE 00355 * 00356 * Initialise variables to pass to SLASQ3. 00357 * 00358 TTYPE = 0 00359 DMIN1 = ZERO 00360 DMIN2 = ZERO 00361 DN = ZERO 00362 DN1 = ZERO 00363 DN2 = ZERO 00364 G = ZERO 00365 TAU = ZERO 00366 * 00367 ITER = 2 00368 NFAIL = 0 00369 NDIV = 2*( N0-I0 ) 00370 * 00371 DO 160 IWHILA = 1, N + 1 00372 IF( N0.LT.1 ) 00373 $ GO TO 170 00374 * 00375 * While array unfinished do 00376 * 00377 * E(N0) holds the value of SIGMA when submatrix in I0:N0 00378 * splits from the rest of the array, but is negated. 00379 * 00380 DESIG = ZERO 00381 IF( N0.EQ.N ) THEN 00382 SIGMA = ZERO 00383 ELSE 00384 SIGMA = -Z( 4*N0-1 ) 00385 END IF 00386 IF( SIGMA.LT.ZERO ) THEN 00387 INFO = 1 00388 RETURN 00389 END IF 00390 * 00391 * Find last unreduced submatrix's top index I0, find QMAX and 00392 * EMIN. Find Gershgorin-type bound if Q's much greater than E's. 00393 * 00394 EMAX = ZERO 00395 IF( N0.GT.I0 ) THEN 00396 EMIN = ABS( Z( 4*N0-5 ) ) 00397 ELSE 00398 EMIN = ZERO 00399 END IF 00400 QMIN = Z( 4*N0-3 ) 00401 QMAX = QMIN 00402 DO 90 I4 = 4*N0, 8, -4 00403 IF( Z( I4-5 ).LE.ZERO ) 00404 $ GO TO 100 00405 IF( QMIN.GE.FOUR*EMAX ) THEN 00406 QMIN = MIN( QMIN, Z( I4-3 ) ) 00407 EMAX = MAX( EMAX, Z( I4-5 ) ) 00408 END IF 00409 QMAX = MAX( QMAX, Z( I4-7 )+Z( I4-5 ) ) 00410 EMIN = MIN( EMIN, Z( I4-5 ) ) 00411 90 CONTINUE 00412 I4 = 4 00413 * 00414 100 CONTINUE 00415 I0 = I4 / 4 00416 PP = 0 00417 * 00418 IF( N0-I0.GT.1 ) THEN 00419 DEE = Z( 4*I0-3 ) 00420 DEEMIN = DEE 00421 KMIN = I0 00422 DO 110 I4 = 4*I0+1, 4*N0-3, 4 00423 DEE = Z( I4 )*( DEE /( DEE+Z( I4-2 ) ) ) 00424 IF( DEE.LE.DEEMIN ) THEN 00425 DEEMIN = DEE 00426 KMIN = ( I4+3 )/4 00427 END IF 00428 110 CONTINUE 00429 IF( (KMIN-I0)*2.LT.N0-KMIN .AND. 00430 $ DEEMIN.LE.HALF*Z(4*N0-3) ) THEN 00431 IPN4 = 4*( I0+N0 ) 00432 PP = 2 00433 DO 120 I4 = 4*I0, 2*( I0+N0-1 ), 4 00434 TEMP = Z( I4-3 ) 00435 Z( I4-3 ) = Z( IPN4-I4-3 ) 00436 Z( IPN4-I4-3 ) = TEMP 00437 TEMP = Z( I4-2 ) 00438 Z( I4-2 ) = Z( IPN4-I4-2 ) 00439 Z( IPN4-I4-2 ) = TEMP 00440 TEMP = Z( I4-1 ) 00441 Z( I4-1 ) = Z( IPN4-I4-5 ) 00442 Z( IPN4-I4-5 ) = TEMP 00443 TEMP = Z( I4 ) 00444 Z( I4 ) = Z( IPN4-I4-4 ) 00445 Z( IPN4-I4-4 ) = TEMP 00446 120 CONTINUE 00447 END IF 00448 END IF 00449 * 00450 * Put -(initial shift) into DMIN. 00451 * 00452 DMIN = -MAX( ZERO, QMIN-TWO*SQRT( QMIN )*SQRT( EMAX ) ) 00453 * 00454 * Now I0:N0 is unreduced. 00455 * PP = 0 for ping, PP = 1 for pong. 00456 * PP = 2 indicates that flipping was applied to the Z array and 00457 * and that the tests for deflation upon entry in SLASQ3 00458 * should not be performed. 00459 * 00460 NBIG = 100*( N0-I0+1 ) 00461 DO 140 IWHILB = 1, NBIG 00462 IF( I0.GT.N0 ) 00463 $ GO TO 150 00464 * 00465 * While submatrix unfinished take a good dqds step. 00466 * 00467 CALL SLASQ3( I0, N0, Z, PP, DMIN, SIGMA, DESIG, QMAX, NFAIL, 00468 $ ITER, NDIV, IEEE, TTYPE, DMIN1, DMIN2, DN, DN1, 00469 $ DN2, G, TAU ) 00470 * 00471 PP = 1 - PP 00472 * 00473 * When EMIN is very small check for splits. 00474 * 00475 IF( PP.EQ.0 .AND. N0-I0.GE.3 ) THEN 00476 IF( Z( 4*N0 ).LE.TOL2*QMAX .OR. 00477 $ Z( 4*N0-1 ).LE.TOL2*SIGMA ) THEN 00478 SPLT = I0 - 1 00479 QMAX = Z( 4*I0-3 ) 00480 EMIN = Z( 4*I0-1 ) 00481 OLDEMN = Z( 4*I0 ) 00482 DO 130 I4 = 4*I0, 4*( N0-3 ), 4 00483 IF( Z( I4 ).LE.TOL2*Z( I4-3 ) .OR. 00484 $ Z( I4-1 ).LE.TOL2*SIGMA ) THEN 00485 Z( I4-1 ) = -SIGMA 00486 SPLT = I4 / 4 00487 QMAX = ZERO 00488 EMIN = Z( I4+3 ) 00489 OLDEMN = Z( I4+4 ) 00490 ELSE 00491 QMAX = MAX( QMAX, Z( I4+1 ) ) 00492 EMIN = MIN( EMIN, Z( I4-1 ) ) 00493 OLDEMN = MIN( OLDEMN, Z( I4 ) ) 00494 END IF 00495 130 CONTINUE 00496 Z( 4*N0-1 ) = EMIN 00497 Z( 4*N0 ) = OLDEMN 00498 I0 = SPLT + 1 00499 END IF 00500 END IF 00501 * 00502 140 CONTINUE 00503 * 00504 INFO = 2 00505 * 00506 * Maximum number of iterations exceeded, restore the shift 00507 * SIGMA and place the new d's and e's in a qd array. 00508 * This might need to be done for several blocks 00509 * 00510 I1 = I0 00511 N1 = N0 00512 145 CONTINUE 00513 TEMPQ = Z( 4*I0-3 ) 00514 Z( 4*I0-3 ) = Z( 4*I0-3 ) + SIGMA 00515 DO K = I0+1, N0 00516 TEMPE = Z( 4*K-5 ) 00517 Z( 4*K-5 ) = Z( 4*K-5 ) * (TEMPQ / Z( 4*K-7 )) 00518 TEMPQ = Z( 4*K-3 ) 00519 Z( 4*K-3 ) = Z( 4*K-3 ) + SIGMA + TEMPE - Z( 4*K-5 ) 00520 END DO 00521 * 00522 * Prepare to do this on the previous block if there is one 00523 * 00524 IF( I1.GT.1 ) THEN 00525 N1 = I1-1 00526 DO WHILE( ( I1.GE.2 ) .AND. ( Z(4*I1-5).GE.ZERO ) ) 00527 I1 = I1 - 1 00528 END DO 00529 IF( I1.GE.1 ) THEN 00530 SIGMA = -Z(4*N1-1) 00531 GO TO 145 00532 END IF 00533 END IF 00534 00535 DO K = 1, N 00536 Z( 2*K-1 ) = Z( 4*K-3 ) 00537 * 00538 * Only the block 1..N0 is unfinished. The rest of the e's 00539 * must be essentially zero, although sometimes other data 00540 * has been stored in them. 00541 * 00542 IF( K.LT.N0 ) THEN 00543 Z( 2*K ) = Z( 4*K-1 ) 00544 ELSE 00545 Z( 2*K ) = 0 00546 END IF 00547 END DO 00548 RETURN 00549 * 00550 * end IWHILB 00551 * 00552 150 CONTINUE 00553 * 00554 160 CONTINUE 00555 * 00556 INFO = 3 00557 RETURN 00558 * 00559 * end IWHILA 00560 * 00561 170 CONTINUE 00562 * 00563 * Move q's to the front. 00564 * 00565 DO 180 K = 2, N 00566 Z( K ) = Z( 4*K-3 ) 00567 180 CONTINUE 00568 * 00569 * Sort and compute sum of eigenvalues. 00570 * 00571 CALL SLASRT( 'D', N, Z, IINFO ) 00572 * 00573 E = ZERO 00574 DO 190 K = N, 1, -1 00575 E = E + Z( K ) 00576 190 CONTINUE 00577 * 00578 * Store trace, sum(eigenvalues) and information on performance. 00579 * 00580 Z( 2*N+1 ) = TRACE 00581 Z( 2*N+2 ) = E 00582 Z( 2*N+3 ) = REAL( ITER ) 00583 Z( 2*N+4 ) = REAL( NDIV ) / REAL( N**2 ) 00584 Z( 2*N+5 ) = HUNDRD*NFAIL / REAL( ITER ) 00585 RETURN 00586 * 00587 * End of SLASQ2 00588 * 00589 END