185 SUBROUTINE dlaed3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
194 INTEGER info, k, ldq, n, n1
198 INTEGER ctot( * ), indx( * )
199 DOUBLE PRECISION d( * ), dlamda( * ), q( ldq, * ), q2( * ),
206 DOUBLE PRECISION one, zero
207 parameter( one = 1.0d0, zero = 0.0d0 )
210 INTEGER i, ii, iq2,
j, n12, n2, n23
211 DOUBLE PRECISION temp
221 INTRINSIC max, sign, sqrt
231 ELSE IF( n.LT.k )
THEN
233 ELSE IF( ldq.LT.max( 1, n ) )
THEN
237 CALL
xerbla(
'DLAED3', -info )
264 dlamda( i ) =
dlamc3( dlamda( i ), dlamda( i ) ) - dlamda( i )
268 CALL
dlaed4( k,
j, dlamda, w, q( 1,
j ), rho, d(
j ), info )
292 CALL
dcopy( k, w, 1, s, 1 )
296 CALL
dcopy( k, q, ldq+1, w, 1 )
299 w( i ) = w( i )*( q( i,
j ) / ( dlamda( i )-dlamda(
j ) ) )
302 w( i ) = w( i )*( q( i,
j ) / ( dlamda( i )-dlamda(
j ) ) )
306 w( i ) = sign( sqrt( -w( i ) ), s( i ) )
313 s( i ) = w( i ) / q( i,
j )
315 temp =
dnrm2( k, s, 1 )
318 q( i,
j ) = s( ii ) / temp
327 n12 = ctot( 1 ) + ctot( 2 )
328 n23 = ctot( 2 ) + ctot( 3 )
330 CALL
dlacpy(
'A', n23, k, q( ctot( 1 )+1, 1 ), ldq, s, n23 )
333 CALL
dgemm(
'N',
'N', n2, k, n23, one, q2( iq2 ), n2, s, n23,
334 $ zero, q( n1+1, 1 ), ldq )
336 CALL
dlaset(
'A', n2, k, zero, zero, q( n1+1, 1 ), ldq )
339 CALL
dlacpy(
'A', n12, k, q, ldq, s, n12 )
341 CALL
dgemm(
'N',
'N', n1, k, n12, one, q2, n1, s, n12, zero, q,
344 CALL
dlaset(
'A', n1, k, zero, zero, q( 1, 1 ), ldq )
DOUBLE PRECISION function dlamc3(A, B)
DLAMC3
subroutine dlaed3(K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX, CTOT, W, S, INFO)
DLAED3 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal.
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
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
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
DLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
DOUBLE PRECISION function dnrm2(N, X, INCX)
DNRM2