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
215 EXTERNAL slamc3, snrm2
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 sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine slaed4(N, I, D, Z, DELTA, RHO, DLAM, INFO)
SLAED4 used by sstedc. Finds a single root of the secular equation.
subroutine xerbla(SRNAME, INFO)
XERBLA
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...
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
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 scopy(N, SX, INCX, SY, INCY)
SCOPY