2014-10-30 23:22:01 +08:00
*> \brief \b DLASQ2 computes all the eigenvalues of the symmetric positive definite tridiagonal matrix associated with the qd Array Z to high relative accuracy. Used by sbdsqr and sstegr.
*
* =========== DOCUMENTATION ===========
*
2018-05-19 05:17:13 +08:00
* Online html documentation available at
* http://www.netlib.org/lapack/explore-html/
2014-10-30 23:22:01 +08:00
*
*> \htmlonly
2018-05-19 05:17:13 +08:00
*> Download DLASQ2 + dependencies
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlasq2.f">
*> [TGZ]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlasq2.f">
*> [ZIP]</a>
*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlasq2.f">
2014-10-30 23:22:01 +08:00
*> [TXT]</a>
2018-05-19 05:17:13 +08:00
*> \endhtmlonly
2014-10-30 23:22:01 +08:00
*
* Definition:
* ===========
*
* SUBROUTINE DLASQ2( N, Z, INFO )
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
* .. Scalar Arguments ..
* INTEGER INFO, N
* ..
* .. Array Arguments ..
* DOUBLE PRECISION Z( * )
* ..
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
*
*> \par Purpose:
* =============
*>
*> \verbatim
*>
2018-05-19 05:17:13 +08:00
*> DLASQ2 computes all the eigenvalues of the symmetric positive
2014-10-30 23:22:01 +08:00
*> definite tridiagonal matrix associated with the qd array Z to high
*> relative accuracy are computed to high relative accuracy, in the
*> absence of denormalization, underflow and overflow.
*>
*> To see the relation of Z to the tridiagonal matrix, let L be a
*> unit lower bidiagonal matrix with subdiagonals Z(2,4,6,,..) and
*> let U be an upper bidiagonal matrix with 1's above and diagonal
*> Z(1,3,5,,..). The tridiagonal is L*U or, if you prefer, the
*> symmetric tridiagonal to which it is similar.
*>
*> Note : DLASQ2 defines a logical variable, IEEE, which is true
*> on machines which follow ieee-754 floating-point standard in their
*> handling of infinities and NaNs, and false otherwise. This variable
*> is passed to DLASQ3.
*> \endverbatim
*
* Arguments:
* ==========
*
*> \param[in] N
*> \verbatim
*> N is INTEGER
*> The number of rows and columns in the matrix. N >= 0.
*> \endverbatim
*>
*> \param[in,out] Z
*> \verbatim
*> Z is DOUBLE PRECISION array, dimension ( 4*N )
*> On entry Z holds the qd array. On exit, entries 1 to N hold
*> the eigenvalues in decreasing order, Z( 2*N+1 ) holds the
*> trace, and Z( 2*N+2 ) holds the sum of the eigenvalues. If
*> N > 2, then Z( 2*N+3 ) holds the iteration count, Z( 2*N+4 )
*> holds NDIVS/NIN^2, and Z( 2*N+5 ) holds the percentage of
*> shifts that failed.
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*> INFO is INTEGER
*> = 0: successful exit
*> < 0: if the i-th argument is a scalar and had an illegal
*> value, then INFO = -i, if the i-th argument is an
*> array and the j-entry had an illegal value, then
*> INFO = -(i*100+j)
*> > 0: the algorithm failed
*> = 1, a split was marked by a positive value in E
*> = 2, current block of Z not diagonalized after 100*N
*> iterations (in inner while loop). On exit Z holds
*> a qd array with the same eigenvalues as the given Z.
2018-05-19 05:17:13 +08:00
*> = 3, termination criterion of outer while loop not met
2014-10-30 23:22:01 +08:00
*> (program created more than N unreduced blocks)
*> \endverbatim
*
* Authors:
* ========
*
2018-05-19 05:17:13 +08:00
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
2014-10-30 23:22:01 +08:00
*
2018-05-19 05:17:13 +08:00
*> \date December 2016
2014-10-30 23:22:01 +08:00
*
*> \ingroup auxOTHERcomputational
*
*> \par Further Details:
* =====================
*>
*> \verbatim
*>
*> Local Variables: I0:N0 defines a current unreduced segment of Z.
*> The shifts are accumulated in SIGMA. Iteration count is in ITER.
*> Ping-pong is controlled by PP (alternates between 0 and 1).
*> \endverbatim
*>
* =====================================================================
SUBROUTINE DLASQ2 ( N , Z , INFO )
*
2018-05-19 05:17:13 +08:00
* -- LAPACK computational routine (version 3.7.0) --
2014-10-30 23:22:01 +08:00
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
2018-05-19 05:17:13 +08:00
* December 2016
2014-10-30 23:22:01 +08:00
*
* .. Scalar Arguments ..
INTEGER INFO , N
* ..
* .. Array Arguments ..
DOUBLE PRECISION Z ( * )
* ..
*
* =====================================================================
*
* .. Parameters ..
DOUBLE PRECISION CBIAS
PARAMETER ( CBIAS = 1.50D0 )
DOUBLE PRECISION ZERO , HALF , ONE , TWO , FOUR , HUNDRD
PARAMETER ( ZERO = 0.0D0 , HALF = 0.5D0 , ONE = 1.0D0 ,
$ TWO = 2.0D0 , FOUR = 4.0D0 , HUNDRD = 10 0.0D0 )
* ..
* .. Local Scalars ..
LOGICAL IEEE
INTEGER I0 , I1 , I4 , IINFO , IPN4 , ITER , IWHILA , IWHILB ,
2018-05-19 05:17:13 +08:00
$ K , KMIN , N0 , N1 , NBIG , NDIV , NFAIL , PP , SPLT ,
2014-10-30 23:22:01 +08:00
$ TTYPE
DOUBLE PRECISION D , DEE , DEEMIN , DESIG , DMIN , DMIN1 , DMIN2 , DN ,
$ DN1 , DN2 , E , EMAX , EMIN , EPS , G , OLDEMN , QMAX ,
$ QMIN , S , SAFMIN , SIGMA , T , TAU , TEMP , TOL ,
$ TOL2 , TRACE , ZMAX , TEMPE , TEMPQ
* ..
* .. External Subroutines ..
EXTERNAL DLASQ3 , DLASRT , XERBLA
* ..
* .. External Functions ..
INTEGER ILAENV
DOUBLE PRECISION DLAMCH
EXTERNAL DLAMCH , ILAENV
* ..
* .. Intrinsic Functions ..
INTRINSIC ABS , DBLE , MAX , MIN , SQRT
* ..
* .. Executable Statements ..
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
* Test the input arguments.
* (in case DLASQ2 is not called by DLASQ1)
*
INFO = 0
EPS = DLAMCH ( 'Precision' )
SAFMIN = DLAMCH ( 'Safe minimum' )
TOL = EPS * HUNDRD
TOL2 = TOL ** 2
*
IF ( N . LT . 0 ) THEN
INFO = - 1
CALL XERBLA ( 'DLASQ2' , 1 )
RETURN
ELSE IF ( N . EQ . 0 ) THEN
RETURN
ELSE IF ( N . EQ . 1 ) THEN
*
* 1-by-1 case.
*
IF ( Z ( 1 ) . LT . ZERO ) THEN
INFO = - 201
CALL XERBLA ( 'DLASQ2' , 2 )
END IF
RETURN
ELSE IF ( N . EQ . 2 ) THEN
*
* 2-by-2 case.
*
IF ( Z ( 2 ) . LT . ZERO . OR . Z ( 3 ) . LT . ZERO ) THEN
INFO = - 2
CALL XERBLA ( 'DLASQ2' , 2 )
RETURN
ELSE IF ( Z ( 3 ) . GT . Z ( 1 ) ) THEN
D = Z ( 3 )
Z ( 3 ) = Z ( 1 )
Z ( 1 ) = D
END IF
Z ( 5 ) = Z ( 1 ) + Z ( 2 ) + Z ( 3 )
IF ( Z ( 2 ) . GT . Z ( 3 ) * TOL2 ) THEN
2018-05-19 05:17:13 +08:00
T = HALF * ( ( Z ( 1 ) - Z ( 3 ) ) + Z ( 2 ) )
2014-10-30 23:22:01 +08:00
S = Z ( 3 ) * ( Z ( 2 ) / T )
IF ( S . LE . T ) THEN
S = Z ( 3 ) * ( Z ( 2 ) / ( T * ( ONE + SQRT ( ONE + S / T ) ) ) )
ELSE
S = Z ( 3 ) * ( Z ( 2 ) / ( T + SQRT ( T ) * SQRT ( T + S ) ) )
END IF
T = Z ( 1 ) + ( S + Z ( 2 ) )
Z ( 3 ) = Z ( 3 ) * ( Z ( 1 ) / T )
Z ( 1 ) = T
END IF
Z ( 2 ) = Z ( 3 )
Z ( 6 ) = Z ( 2 ) + Z ( 1 )
RETURN
END IF
*
* Check for negative data and compute sums of q's and e's.
*
Z ( 2 * N ) = ZERO
EMIN = Z ( 2 )
QMAX = ZERO
ZMAX = ZERO
D = ZERO
E = ZERO
*
DO 10 K = 1 , 2 * ( N - 1 ) , 2
IF ( Z ( K ) . LT . ZERO ) THEN
INFO = - ( 200 + K )
CALL XERBLA ( 'DLASQ2' , 2 )
RETURN
ELSE IF ( Z ( K + 1 ) . LT . ZERO ) THEN
INFO = - ( 200 + K + 1 )
CALL XERBLA ( 'DLASQ2' , 2 )
RETURN
END IF
D = D + Z ( K )
E = E + Z ( K + 1 )
QMAX = MAX ( QMAX , Z ( K ) )
EMIN = MIN ( EMIN , Z ( K + 1 ) )
ZMAX = MAX ( QMAX , ZMAX , Z ( K + 1 ) )
10 CONTINUE
IF ( Z ( 2 * N - 1 ) . LT . ZERO ) THEN
INFO = - ( 200 + 2 * N - 1 )
CALL XERBLA ( 'DLASQ2' , 2 )
RETURN
END IF
D = D + Z ( 2 * N - 1 )
QMAX = MAX ( QMAX , Z ( 2 * N - 1 ) )
ZMAX = MAX ( QMAX , ZMAX )
*
* Check for diagonality.
*
IF ( E . EQ . ZERO ) THEN
DO 20 K = 2 , N
Z ( K ) = Z ( 2 * K - 1 )
20 CONTINUE
CALL DLASRT ( 'D' , N , Z , IINFO )
Z ( 2 * N - 1 ) = D
RETURN
END IF
*
TRACE = D + E
*
* Check for zero data.
*
IF ( TRACE . EQ . ZERO ) THEN
Z ( 2 * N - 1 ) = ZERO
RETURN
END IF
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
* Check whether the machine is IEEE conformable.
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
IEEE = ILAENV ( 10 , 'DLASQ2' , 'N' , 1 , 2 , 3 , 4 ) . EQ . 1 . AND .
2018-05-19 05:17:13 +08:00
$ ILAENV ( 11 , 'DLASQ2' , 'N' , 1 , 2 , 3 , 4 ) . EQ . 1
*
2014-10-30 23:22:01 +08:00
* Rearrange data for locality: Z=(q1,qq1,e1,ee1,q2,qq2,e2,ee2,...).
*
DO 30 K = 2 * N , 2 , - 2
2018-05-19 05:17:13 +08:00
Z ( 2 * K ) = ZERO
Z ( 2 * K - 1 ) = Z ( K )
Z ( 2 * K - 2 ) = ZERO
Z ( 2 * K - 3 ) = Z ( K - 1 )
2014-10-30 23:22:01 +08:00
30 CONTINUE
*
I0 = 1
N0 = N
*
* Reverse the qd-array, if warranted.
*
IF ( CBIAS * Z ( 4 * I0 - 3 ) . LT . Z ( 4 * N0 - 3 ) ) THEN
IPN4 = 4 * ( I0 + N0 )
DO 40 I4 = 4 * I0 , 2 * ( I0 + N0 - 1 ) , 4
TEMP = Z ( I4 - 3 )
Z ( I4 - 3 ) = Z ( IPN4 - I4 - 3 )
Z ( IPN4 - I4 - 3 ) = TEMP
TEMP = Z ( I4 - 1 )
Z ( I4 - 1 ) = Z ( IPN4 - I4 - 5 )
Z ( IPN4 - I4 - 5 ) = TEMP
40 CONTINUE
END IF
*
* Initial split checking via dqd and Li's test.
*
PP = 0
*
DO 80 K = 1 , 2
*
D = Z ( 4 * N0 + PP - 3 )
DO 50 I4 = 4 * ( N0 - 1 ) + PP , 4 * I0 + PP , - 4
IF ( Z ( I4 - 1 ) . LE . TOL2 * D ) THEN
Z ( I4 - 1 ) = - ZERO
D = Z ( I4 - 3 )
ELSE
D = Z ( I4 - 3 ) * ( D / ( D + Z ( I4 - 1 ) ) )
END IF
50 CONTINUE
*
* dqd maps Z to ZZ plus Li's test.
*
EMIN = Z ( 4 * I0 + PP + 1 )
D = Z ( 4 * I0 + PP - 3 )
DO 60 I4 = 4 * I0 + PP , 4 * ( N0 - 1 ) + PP , 4
Z ( I4 - 2 * PP - 2 ) = D + Z ( I4 - 1 )
IF ( Z ( I4 - 1 ) . LE . TOL2 * D ) THEN
Z ( I4 - 1 ) = - ZERO
Z ( I4 - 2 * PP - 2 ) = D
Z ( I4 - 2 * PP ) = ZERO
D = Z ( I4 + 1 )
ELSE IF ( SAFMIN * Z ( I4 + 1 ) . LT . Z ( I4 - 2 * PP - 2 ) . AND .
$ SAFMIN * Z ( I4 - 2 * PP - 2 ) . LT . Z ( I4 + 1 ) ) THEN
TEMP = Z ( I4 + 1 ) / Z ( I4 - 2 * PP - 2 )
Z ( I4 - 2 * PP ) = Z ( I4 - 1 ) * TEMP
D = D * TEMP
ELSE
Z ( I4 - 2 * PP ) = Z ( I4 + 1 ) * ( Z ( I4 - 1 ) / Z ( I4 - 2 * PP - 2 ) )
D = Z ( I4 + 1 ) * ( D / Z ( I4 - 2 * PP - 2 ) )
END IF
EMIN = MIN ( EMIN , Z ( I4 - 2 * PP ) )
2018-05-19 05:17:13 +08:00
60 CONTINUE
2014-10-30 23:22:01 +08:00
Z ( 4 * N0 - PP - 2 ) = D
*
* Now find qmax.
*
QMAX = Z ( 4 * I0 - PP - 2 )
DO 70 I4 = 4 * I0 - PP + 2 , 4 * N0 - PP - 2 , 4
QMAX = MAX ( QMAX , Z ( I4 ) )
70 CONTINUE
*
* Prepare for the next iteration on K.
*
PP = 1 - PP
80 CONTINUE
*
* Initialise variables to pass to DLASQ3.
*
TTYPE = 0
DMIN1 = ZERO
DMIN2 = ZERO
DN = ZERO
DN1 = ZERO
DN2 = ZERO
G = ZERO
TAU = ZERO
*
ITER = 2
NFAIL = 0
NDIV = 2 * ( N0 - I0 )
*
DO 160 IWHILA = 1 , N + 1
2018-05-19 05:17:13 +08:00
IF ( N0 . LT . 1 )
2014-10-30 23:22:01 +08:00
$ GO TO 170
*
2018-05-19 05:17:13 +08:00
* While array unfinished do
2014-10-30 23:22:01 +08:00
*
* E(N0) holds the value of SIGMA when submatrix in I0:N0
* splits from the rest of the array, but is negated.
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
DESIG = ZERO
IF ( N0 . EQ . N ) THEN
SIGMA = ZERO
ELSE
SIGMA = - Z ( 4 * N0 - 1 )
END IF
IF ( SIGMA . LT . ZERO ) THEN
INFO = 1
RETURN
END IF
*
* Find last unreduced submatrix's top index I0, find QMAX and
* EMIN. Find Gershgorin-type bound if Q's much greater than E's.
*
2018-05-19 05:17:13 +08:00
EMAX = ZERO
2014-10-30 23:22:01 +08:00
IF ( N0 . GT . I0 ) THEN
EMIN = ABS ( Z ( 4 * N0 - 5 ) )
ELSE
EMIN = ZERO
END IF
QMIN = Z ( 4 * N0 - 3 )
QMAX = QMIN
DO 90 I4 = 4 * N0 , 8 , - 4
IF ( Z ( I4 - 5 ) . LE . ZERO )
$ GO TO 100
IF ( QMIN . GE . FOUR * EMAX ) THEN
QMIN = MIN ( QMIN , Z ( I4 - 3 ) )
EMAX = MAX ( EMAX , Z ( I4 - 5 ) )
END IF
QMAX = MAX ( QMAX , Z ( I4 - 7 ) + Z ( I4 - 5 ) )
EMIN = MIN ( EMIN , Z ( I4 - 5 ) )
90 CONTINUE
2018-05-19 05:17:13 +08:00
I4 = 4
2014-10-30 23:22:01 +08:00
*
100 CONTINUE
I0 = I4 / 4
PP = 0
*
IF ( N0 - I0 . GT . 1 ) THEN
DEE = Z ( 4 * I0 - 3 )
DEEMIN = DEE
KMIN = I0
DO 110 I4 = 4 * I0 + 1 , 4 * N0 - 3 , 4
DEE = Z ( I4 ) * ( DEE / ( DEE + Z ( I4 - 2 ) ) )
IF ( DEE . LE . DEEMIN ) THEN
DEEMIN = DEE
KMIN = ( I4 + 3 ) / 4
END IF
110 CONTINUE
2018-05-19 05:17:13 +08:00
IF ( ( KMIN - I0 ) * 2. LT . N0 - KMIN . AND .
2014-10-30 23:22:01 +08:00
$ DEEMIN . LE . HALF * Z ( 4 * N0 - 3 ) ) THEN
IPN4 = 4 * ( I0 + N0 )
PP = 2
DO 120 I4 = 4 * I0 , 2 * ( I0 + N0 - 1 ) , 4
TEMP = Z ( I4 - 3 )
Z ( I4 - 3 ) = Z ( IPN4 - I4 - 3 )
Z ( IPN4 - I4 - 3 ) = TEMP
TEMP = Z ( I4 - 2 )
Z ( I4 - 2 ) = Z ( IPN4 - I4 - 2 )
Z ( IPN4 - I4 - 2 ) = TEMP
TEMP = Z ( I4 - 1 )
Z ( I4 - 1 ) = Z ( IPN4 - I4 - 5 )
Z ( IPN4 - I4 - 5 ) = TEMP
TEMP = Z ( I4 )
Z ( I4 ) = Z ( IPN4 - I4 - 4 )
Z ( IPN4 - I4 - 4 ) = TEMP
120 CONTINUE
END IF
END IF
*
* Put -(initial shift) into DMIN.
*
DMIN = - MAX ( ZERO , QMIN - TWO * SQRT ( QMIN ) * SQRT ( EMAX ) )
*
2018-05-19 05:17:13 +08:00
* Now I0:N0 is unreduced.
2014-10-30 23:22:01 +08:00
* PP = 0 for ping, PP = 1 for pong.
* PP = 2 indicates that flipping was applied to the Z array and
2018-05-19 05:17:13 +08:00
* and that the tests for deflation upon entry in DLASQ3
2014-10-30 23:22:01 +08:00
* should not be performed.
*
NBIG = 100 * ( N0 - I0 + 1 )
DO 140 IWHILB = 1 , NBIG
2018-05-19 05:17:13 +08:00
IF ( I0 . GT . N0 )
2014-10-30 23:22:01 +08:00
$ GO TO 150
*
* While submatrix unfinished take a good dqds step.
*
CALL DLASQ3 ( I0 , N0 , Z , PP , DMIN , SIGMA , DESIG , QMAX , NFAIL ,
$ ITER , NDIV , IEEE , TTYPE , DMIN1 , DMIN2 , DN , DN1 ,
$ DN2 , G , TAU )
*
PP = 1 - PP
*
* When EMIN is very small check for splits.
*
IF ( PP . EQ . 0 . AND . N0 - I0 . GE . 3 ) THEN
IF ( Z ( 4 * N0 ) . LE . TOL2 * QMAX . OR .
$ Z ( 4 * N0 - 1 ) . LE . TOL2 * SIGMA ) THEN
SPLT = I0 - 1
QMAX = Z ( 4 * I0 - 3 )
EMIN = Z ( 4 * I0 - 1 )
OLDEMN = Z ( 4 * I0 )
DO 130 I4 = 4 * I0 , 4 * ( N0 - 3 ) , 4
IF ( Z ( I4 ) . LE . TOL2 * Z ( I4 - 3 ) . OR .
$ Z ( I4 - 1 ) . LE . TOL2 * SIGMA ) THEN
Z ( I4 - 1 ) = - SIGMA
SPLT = I4 / 4
QMAX = ZERO
EMIN = Z ( I4 + 3 )
OLDEMN = Z ( I4 + 4 )
ELSE
QMAX = MAX ( QMAX , Z ( I4 + 1 ) )
EMIN = MIN ( EMIN , Z ( I4 - 1 ) )
OLDEMN = MIN ( OLDEMN , Z ( I4 ) )
END IF
130 CONTINUE
Z ( 4 * N0 - 1 ) = EMIN
Z ( 4 * N0 ) = OLDEMN
I0 = SPLT + 1
END IF
END IF
*
140 CONTINUE
*
INFO = 2
2018-05-19 05:17:13 +08:00
*
* Maximum number of iterations exceeded, restore the shift
2014-10-30 23:22:01 +08:00
* SIGMA and place the new d's and e's in a qd array.
* This might need to be done for several blocks
*
I1 = I0
N1 = N0
145 CONTINUE
TEMPQ = Z ( 4 * I0 - 3 )
Z ( 4 * I0 - 3 ) = Z ( 4 * I0 - 3 ) + SIGMA
DO K = I0 + 1 , N0
TEMPE = Z ( 4 * K - 5 )
Z ( 4 * K - 5 ) = Z ( 4 * K - 5 ) * ( TEMPQ / Z ( 4 * K - 7 ) )
TEMPQ = Z ( 4 * K - 3 )
Z ( 4 * K - 3 ) = Z ( 4 * K - 3 ) + SIGMA + TEMPE - Z ( 4 * K - 5 )
END DO
*
* Prepare to do this on the previous block if there is one
*
IF ( I1 . GT . 1 ) THEN
N1 = I1 - 1
DO WHILE ( ( I1 . GE . 2 ) . AND . ( Z ( 4 * I1 - 5 ) . GE . ZERO ) )
I1 = I1 - 1
END DO
SIGMA = - Z ( 4 * N1 - 1 )
GO TO 145
END IF
DO K = 1 , N
Z ( 2 * K - 1 ) = Z ( 4 * K - 3 )
*
* Only the block 1..N0 is unfinished. The rest of the e's
* must be essentially zero, although sometimes other data
* has been stored in them.
*
IF ( K . LT . N0 ) THEN
Z ( 2 * K ) = Z ( 4 * K - 1 )
ELSE
Z ( 2 * K ) = 0
END IF
END DO
RETURN
*
* end IWHILB
*
150 CONTINUE
*
160 CONTINUE
*
INFO = 3
RETURN
*
2018-05-19 05:17:13 +08:00
* end IWHILA
2014-10-30 23:22:01 +08:00
*
170 CONTINUE
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
* Move q's to the front.
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
DO 180 K = 2 , N
Z ( K ) = Z ( 4 * K - 3 )
180 CONTINUE
2018-05-19 05:17:13 +08:00
*
2014-10-30 23:22:01 +08:00
* Sort and compute sum of eigenvalues.
*
CALL DLASRT ( 'D' , N , Z , IINFO )
*
E = ZERO
DO 190 K = N , 1 , - 1
E = E + Z ( K )
190 CONTINUE
*
* Store trace, sum(eigenvalues) and information on performance.
*
2018-05-19 05:17:13 +08:00
Z ( 2 * N + 1 ) = TRACE
2014-10-30 23:22:01 +08:00
Z ( 2 * N + 2 ) = E
Z ( 2 * N + 3 ) = DBLE ( ITER )
Z ( 2 * N + 4 ) = DBLE ( NDIV ) / DBLE ( N ** 2 )
Z ( 2 * N + 5 ) = HUNDRD * NFAIL / DBLE ( ITER )
RETURN
*
* End of DLASQ2
*
END