166 SUBROUTINE dlasd8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
167 $ dsigma, work, info )
175 INTEGER ICOMPQ, INFO, K, LDDIFR
178 DOUBLE PRECISION D( * ), DIFL( * ), DIFR( lddifr, * ),
179 $ dsigma( * ), vf( * ), vl( * ), work( * ),
187 parameter( one = 1.0d+0 )
190 INTEGER I, IWK1, IWK2, IWK2I, IWK3, IWK3I, J
191 DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP
197 DOUBLE PRECISION DDOT, DLAMC3, DNRM2
198 EXTERNAL ddot, dlamc3, dnrm2
201 INTRINSIC abs, sign, sqrt
209 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) )
THEN
211 ELSE IF( k.LT.1 )
THEN
213 ELSE IF( lddifr.LT.k )
THEN
217 CALL xerbla(
'DLASD8', -info )
224 d( 1 ) = abs( z( 1 ) )
226 IF( icompq.EQ.1 )
THEN
251 dsigma( i ) = dlamc3( dsigma( i ), dsigma( i ) ) - dsigma( i )
264 rho = dnrm2( k, z, 1 )
265 CALL dlascl(
'G', 0, 0, rho, one, k, 1, z, k, info )
270 CALL dlaset(
'A', k, 1, one, one, work( iwk3 ), k )
276 CALL dlasd4( k, j, dsigma, z, work( iwk1 ), rho, d( j ),
277 $ work( iwk2 ), info )
282 CALL xerbla(
'DLASD4', -info )
285 work( iwk3i+j ) = work( iwk3i+j )*work( j )*work( iwk2i+j )
286 difl( j ) = -work( j )
287 difr( j, 1 ) = -work( j+1 )
289 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
290 $ work( iwk2i+i ) / ( dsigma( i )-
291 $ dsigma( j ) ) / ( dsigma( i )+
295 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
296 $ work( iwk2i+i ) / ( dsigma( i )-
297 $ dsigma( j ) ) / ( dsigma( i )+
305 z( i ) = sign( sqrt( abs( work( iwk3i+i ) ) ), z( i ) )
315 difrj = -difr( j, 1 )
316 dsigjp = -dsigma( j+1 )
318 work( j ) = -z( j ) / diflj / ( dsigma( j )+dj )
320 work( i ) = z( i ) / ( dlamc3( dsigma( i ), dsigj )-diflj )
321 $ / ( dsigma( i )+dj )
324 work( i ) = z( i ) / ( dlamc3( dsigma( i ), dsigjp )+difrj )
325 $ / ( dsigma( i )+dj )
327 temp = dnrm2( k, work, 1 )
328 work( iwk2i+j ) = ddot( k, work, 1, vf, 1 ) / temp
329 work( iwk3i+j ) = ddot( k, work, 1, vl, 1 ) / temp
330 IF( icompq.EQ.1 )
THEN
335 CALL dcopy( k, work( iwk2 ), 1, vf, 1 )
336 CALL dcopy( k, work( iwk3 ), 1, vl, 1 )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine dlasd8(ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, DSIGMA, WORK, INFO)
DLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D...
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...
subroutine dlasd4(N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO)
DLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modif...