160 SUBROUTINE slasd8( ICOMPQ, K, D, Z, VF, VL, DIFL, DIFR, LDDIFR,
161 $ DSIGMA, WORK, INFO )
168 INTEGER ICOMPQ, INFO, K, LDDIFR
171 REAL D( * ), DIFL( * ), DIFR( LDDIFR, * ),
172 $ dsigma( * ), vf( * ), vl( * ), work( * ),
180 parameter( one = 1.0e+0 )
183 INTEGER I, IWK1, IWK2, IWK2I, IWK3, IWK3I, J
184 REAL DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP
191 REAL SDOT, SLAMC3, SNRM2
192 EXTERNAL sdot, slamc3, snrm2
195 INTRINSIC abs, sign, sqrt
203 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) )
THEN
205 ELSE IF( k.LT.1 )
THEN
207 ELSE IF( lddifr.LT.k )
THEN
211 CALL xerbla(
'SLASD8', -info )
218 d( 1 ) = abs( z( 1 ) )
220 IF( icompq.EQ.1 )
THEN
237 rho = snrm2( k, z, 1 )
238 CALL slascl(
'G', 0, 0, rho, one, k, 1, z, k, info )
243 CALL slaset(
'A', k, 1, one, one, work( iwk3 ), k )
249 CALL slasd4( k, j, dsigma, z, work( iwk1 ), rho, d( j ),
250 $ work( iwk2 ), info )
257 work( iwk3i+j ) = work( iwk3i+j )*work( j )*work( iwk2i+j )
258 difl( j ) = -work( j )
259 difr( j, 1 ) = -work( j+1 )
261 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
262 $ work( iwk2i+i ) / ( dsigma( i )-
263 $ dsigma( j ) ) / ( dsigma( i )+
267 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
268 $ work( iwk2i+i ) / ( dsigma( i )-
269 $ dsigma( j ) ) / ( dsigma( i )+
277 z( i ) = sign( sqrt( abs( work( iwk3i+i ) ) ), z( i ) )
287 difrj = -difr( j, 1 )
288 dsigjp = -dsigma( j+1 )
290 work( j ) = -z( j ) / diflj / ( dsigma( j )+dj )
297 work( i ) = z( i ) / ( slamc3( dsigma( i ),
299 $ / ( dsigma( i )+dj )
302 work( i ) = z( i ) / ( slamc3( dsigma( i ),
304 $ / ( dsigma( i )+dj )
306 temp = snrm2( k, work, 1 )
307 work( iwk2i+j ) = sdot( k, work, 1, vf, 1 ) / temp
308 work( iwk3i+j ) = sdot( k, work, 1, vl, 1 ) / temp
309 IF( icompq.EQ.1 )
THEN
314 CALL scopy( k, work( iwk2 ), 1, vf, 1 )
315 CALL scopy( k, work( iwk3 ), 1, vl, 1 )
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...
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 slaset(uplo, m, n, alpha, beta, a, lda)
SLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values.