154 SUBROUTINE dlaed9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
162 INTEGER INFO, K, KSTART, KSTOP, LDQ, LDS, N
166 DOUBLE PRECISION D( * ), DLAMDA( * ), Q( LDQ, * ), S( LDS, * ),
174 DOUBLE PRECISION TEMP
177 DOUBLE PRECISION DLAMC3, DNRM2
178 EXTERNAL dlamc3, dnrm2
184 INTRINSIC max, sign, sqrt
194 ELSE IF( kstart.LT.1 .OR. kstart.GT.max( 1, k ) )
THEN
196 ELSE IF( max( 1, kstop ).LT.kstart .OR. kstop.GT.max( 1, k ) )
199 ELSE IF( n.LT.k )
THEN
201 ELSE IF( ldq.LT.max( 1, k ) )
THEN
203 ELSE IF( lds.LT.max( 1, k ) )
THEN
207 CALL xerbla(
'DLAED9', -info )
234 dlamda( i ) = dlamc3( dlamda( i ), dlamda( i ) ) - dlamda( i )
237 DO 20 j = kstart, kstop
238 CALL dlaed4( k, j, dlamda, w, q( 1, j ), rho, d( j ), info )
246 IF( k.EQ.1 .OR. k.EQ.2 )
THEN
249 s( j, i ) = q( j, i )
257 CALL dcopy( k, w, 1, s, 1 )
261 CALL dcopy( k, q, ldq+1, w, 1 )
264 w( i ) = w( i )*( q( i, j ) / ( dlamda( i )-dlamda( j ) ) )
267 w( i ) = w( i )*( q( i, j ) / ( dlamda( i )-dlamda( j ) ) )
271 w( i ) = sign( sqrt( -w( i ) ), s( i, 1 ) )
278 q( i, j ) = w( i ) / q( i, j )
280 temp = dnrm2( k, q( 1, j ), 1 )
282 s( i, j ) = q( i, j ) / temp
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlaed4(N, I, D, Z, DELTA, RHO, DLAM, INFO)
DLAED4 used by DSTEDC. Finds a single root of the secular equation.
subroutine dlaed9(K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W, S, LDS, INFO)
DLAED9 used by DSTEDC. Finds the roots of the secular equation and updates the eigenvectors....
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY