166 SUBROUTINE slasd8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
167 $ dsigma, work, info )
175 INTEGER ICOMPQ, INFO, K, LDDIFR
178 REAL D( * ), DIFL( * ), DIFR( lddifr, * ),
179 $ dsigma( * ), vf( * ), vl( * ), work( * ),
187 parameter( one = 1.0e+0 )
190 INTEGER I, IWK1, IWK2, IWK2I, IWK3, IWK3I, J
191 REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP
197 REAL SDOT, SLAMC3, SNRM2
198 EXTERNAL sdot, slamc3, snrm2
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(
'SLASD8', -info )
224 d( 1 ) = abs( z( 1 ) )
226 IF( icompq.EQ.1 )
THEN
251 dsigma( i ) = slamc3( dsigma( i ), dsigma( i ) ) - dsigma( i )
264 rho = snrm2( k, z, 1 )
265 CALL slascl(
'G', 0, 0, rho, one, k, 1, z, k, info )
270 CALL slaset(
'A', k, 1, one, one, work( iwk3 ), k )
276 CALL slasd4( k, j, dsigma, z, work( iwk1 ), rho, d( j ),
277 $ work( iwk2 ), info )
282 CALL xerbla(
'SLASD4', -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 ) / ( slamc3( dsigma( i ), dsigj )-diflj )
321 $ / ( dsigma( i )+dj )
324 work( i ) = z( i ) / ( slamc3( dsigma( i ), dsigjp )+difrj )
325 $ / ( dsigma( i )+dj )
327 temp = snrm2( k, work, 1 )
328 work( iwk2i+j ) = sdot( k, work, 1, vf, 1 ) / temp
329 work( iwk3i+j ) = sdot( k, work, 1, vl, 1 ) / temp
330 IF( icompq.EQ.1 )
THEN
335 CALL scopy( k, work( iwk2 ), 1, vf, 1 )
336 CALL scopy( k, work( iwk3 ), 1, vl, 1 )
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 slasd8(ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR, DSIGMA, WORK, INFO)
SLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine slasd4(N, I, D, Z, DELTA, RHO, SIGMA, WORK, INFO)
SLASD4 computes the square root of the i-th updated eigenvalue of a positive symmetric rank-one modif...