LAPACK  3.4.1
LAPACK: Linear Algebra PACKage
slasq2.f
Go to the documentation of this file.
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
 All Files Functions