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 )
284 work( iwk3i+j ) = work( iwk3i+j )*work( j )*work( iwk2i+j )
285 difl( j ) = -work( j )
286 difr( j, 1 ) = -work( j+1 )
288 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
289 $ work( iwk2i+i ) / ( dsigma( i )-
290 $ dsigma( j ) ) / ( dsigma( i )+
294 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
295 $ work( iwk2i+i ) / ( dsigma( i )-
296 $ dsigma( j ) ) / ( dsigma( i )+
304 z( i ) = sign( sqrt( abs( work( iwk3i+i ) ) ), z( i ) )
314 difrj = -difr( j, 1 )
315 dsigjp = -dsigma( j+1 )
317 work( j ) = -z( j ) / diflj / ( dsigma( j )+dj )
319 work( i ) = z( i ) / ( dlamc3( dsigma( i ), dsigj )-diflj )
320 $ / ( dsigma( i )+dj )
323 work( i ) = z( i ) / ( dlamc3( dsigma( i ), dsigjp )+difrj )
324 $ / ( dsigma( i )+dj )
326 temp = dnrm2( k, work, 1 )
327 work( iwk2i+j ) = ddot( k, work, 1, vf, 1 ) / temp
328 work( iwk3i+j ) = ddot( k, work, 1, vl, 1 ) / temp
329 IF( icompq.EQ.1 )
THEN
334 CALL dcopy( k, work( iwk2 ), 1, vf, 1 )
335 CALL dcopy( k, work( iwk3 ), 1, vl, 1 )
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 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 dcopy(N, DX, INCX, DY, INCY)
DCOPY
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 xerbla(SRNAME, INFO)
XERBLA
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...