156 SUBROUTINE slaed9( K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W,
165 INTEGER info, k, kstart, kstop, ldq, lds, n
169 REAL d( * ), dlamda( * ), q( ldq, * ), s( lds, * ),
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(
'SLAED9', -info )
237 dlamda( i ) =
slamc3( dlamda( i ), dlamda( i ) ) - dlamda( i )
240 DO 20
j = kstart, kstop
241 CALL
slaed4( 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
scopy( k, w, 1, s, 1 )
264 CALL
scopy( 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 =
snrm2( k, q( 1,
j ), 1 )
285 s( i,
j ) = q( i,
j ) / temp
REAL function slamc3(A, B)
SLAMC3
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slaed9(K, KSTART, KSTOP, N, D, Q, LDQ, RHO, DLAMDA, W, S, LDS, INFO)
SLAED9 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is dense.
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine slaed4(N, I, D, Z, DELTA, RHO, DLAM, INFO)
SLAED4 used by sstedc. Finds a single root of the secular equation.
REAL function snrm2(N, X, INCX)
SNRM2