156 SUBROUTINE dlaed9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
165 INTEGER info, k, kstart, kstop, ldq, lds, n
169 DOUBLE PRECISION d( * ), dlamda( * ), q( ldq, * ), s( lds, * ),
177 DOUBLE PRECISION temp
187 INTRINSIC max, sign, sqrt
197 ELSE IF( kstart.LT.1 .OR. kstart.GT.max( 1, k ) )
THEN
199 ELSE IF( max( 1, kstop ).LT.kstart .OR. kstop.GT.max( 1, k ) )
202 ELSE IF( n.LT.k )
THEN
204 ELSE IF( ldq.LT.max( 1, k ) )
THEN
206 ELSE IF( lds.LT.max( 1, k ) )
THEN
210 CALL
xerbla(
'DLAED9', -info )
237 dlamda( i ) =
dlamc3( dlamda( i ), dlamda( i ) ) - dlamda( i )
240 DO 20
j = kstart, kstop
241 CALL
dlaed4( k,
j, dlamda, w, q( 1,
j ), rho, d(
j ), info )
249 IF( k.EQ.1 .OR. k.EQ.2 )
THEN
252 s(
j, i ) = q(
j, i )
260 CALL
dcopy( k, w, 1, s, 1 )
264 CALL
dcopy( k, q, ldq+1, w, 1 )
267 w( i ) = w( i )*( q( i,
j ) / ( dlamda( i )-dlamda(
j ) ) )
270 w( i ) = w( i )*( q( i,
j ) / ( dlamda( i )-dlamda(
j ) ) )
274 w( i ) = sign( sqrt( -w( i ) ), s( i, 1 ) )
281 q( i,
j ) = w( i ) / q( i,
j )
283 temp =
dnrm2( k, q( 1,
j ), 1 )
285 s( i,
j ) = q( i,
j ) / temp
subroutine dlaed9(K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W, S, LDS, INFO)
DLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense.
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
double precision function dlamc3(A, B)
DLAMC3
subroutine dlaed4(N, I, D, Z, DELTA, RHO, DLAM, INFO)
DLAED4 used by sstedc. Finds a single root of the secular equation.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
double precision function dnrm2(N, X, INCX)
DNRM2