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
214 DOUBLE PRECISION DLAMC3, DNRM2
215 EXTERNAL dlamc3, dnrm2
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 )