185 SUBROUTINE slaed3( K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX,
194 INTEGER info, k, ldq, n, n1
198 INTEGER ctot( * ), indx( * )
199 REAL d( * ), dlamda( * ), q( ldq, * ), q2( * ),
207 parameter( one = 1.0e0, zero = 0.0e0 )
210 INTEGER i, ii, iq2,
j, n12, n2, n23
221 INTRINSIC max, sign, sqrt
231 ELSE IF( n.LT.k )
THEN
233 ELSE IF( ldq.LT.max( 1, n ) )
THEN
237 CALL
xerbla(
'SLAED3', -info )
264 dlamda( i ) =
slamc3( dlamda( i ), dlamda( i ) ) - dlamda( i )
268 CALL
slaed4( k,
j, dlamda, w, q( 1,
j ), rho, d(
j ), info )
292 CALL
scopy( k, w, 1, s, 1 )
296 CALL
scopy( 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 =
snrm2( k, s, 1 )
318 q( i,
j ) = s( ii ) / temp
327 n12 = ctot( 1 ) + ctot( 2 )
328 n23 = ctot( 2 ) + ctot( 3 )
330 CALL
slacpy(
'A', n23, k, q( ctot( 1 )+1, 1 ), ldq, s, n23 )
333 CALL
sgemm(
'N',
'N', n2, k, n23, one, q2( iq2 ), n2, s, n23,
334 $ zero, q( n1+1, 1 ), ldq )
336 CALL
slaset(
'A', n2, k, zero, zero, q( n1+1, 1 ), ldq )
339 CALL
slacpy(
'A', n12, k, q, ldq, s, n12 )
341 CALL
sgemm(
'N',
'N', n1, k, n12, one, q2, n1, s, n12, zero, q,
344 CALL
slaset(
'A', n1, k, zero, zero, q( 1, 1 ), ldq )
subroutine slaset(UPLO, M, N, ALPHA, BETA, A, LDA)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
real function slamc3(A, B)
SLAMC3
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slaed3(K, N, N1, D, Q, LDQ, RHO, DLAMDA, Q2, INDX, CTOT, W, S, INFO)
SLAED3 used by sstedc. Finds the roots of the secular equation and updates the eigenvectors. Used when the original matrix is tridiagonal.
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
real function snrm2(N, X, INCX)
SNRM2
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.