LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ dlasd8()

subroutine dlasd8 ( integer  icompq,
integer  k,
double precision, dimension( * )  d,
double precision, dimension( * )  z,
double precision, dimension( * )  vf,
double precision, dimension( * )  vl,
double precision, dimension( * )  difl,
double precision, dimension( lddifr, * )  difr,
integer  lddifr,
double precision, dimension( * )  dsigma,
double precision, dimension( * )  work,
integer  info 
)

DLASD8 finds the square roots of the roots of the secular equation, and stores, for each element in D, the distance to its two nearest poles. Used by sbdsdc.

Download DLASD8 + dependencies [TGZ] [ZIP] [TXT]

Purpose:
 DLASD8 finds the square roots of the roots of the secular equation,
 as defined by the values in DSIGMA and Z. It makes the appropriate
 calls to DLASD4, and stores, for each  element in D, the distance
 to its two nearest poles (elements in DSIGMA). It also updates
 the arrays VF and VL, the first and last components of all the
 right singular vectors of the original bidiagonal matrix.

 DLASD8 is called from DLASD6.
Parameters
[in]ICOMPQ
          ICOMPQ is INTEGER
          Specifies whether singular vectors are to be computed in
          factored form in the calling routine:
          = 0: Compute singular values only.
          = 1: Compute singular vectors in factored form as well.
[in]K
          K is INTEGER
          The number of terms in the rational function to be solved
          by DLASD4.  K >= 1.
[out]D
          D is DOUBLE PRECISION array, dimension ( K )
          On output, D contains the updated singular values.
[in,out]Z
          Z is DOUBLE PRECISION array, dimension ( K )
          On entry, the first K elements of this array contain the
          components of the deflation-adjusted updating row vector.
          On exit, Z is updated.
[in,out]VF
          VF is DOUBLE PRECISION array, dimension ( K )
          On entry, VF contains  information passed through DBEDE8.
          On exit, VF contains the first K components of the first
          components of all right singular vectors of the bidiagonal
          matrix.
[in,out]VL
          VL is DOUBLE PRECISION array, dimension ( K )
          On entry, VL contains  information passed through DBEDE8.
          On exit, VL contains the first K components of the last
          components of all right singular vectors of the bidiagonal
          matrix.
[out]DIFL
          DIFL is DOUBLE PRECISION array, dimension ( K )
          On exit, DIFL(I) = D(I) - DSIGMA(I).
[out]DIFR
          DIFR is DOUBLE PRECISION array,
                   dimension ( LDDIFR, 2 ) if ICOMPQ = 1 and
                   dimension ( K ) if ICOMPQ = 0.
          On exit, DIFR(I,1) = D(I) - DSIGMA(I+1), DIFR(K,1) is not
          defined and will not be referenced.

          If ICOMPQ = 1, DIFR(1:K,2) is an array containing the
          normalizing factors for the right singular vector matrix.
[in]LDDIFR
          LDDIFR is INTEGER
          The leading dimension of DIFR, must be at least K.
[in]DSIGMA
          DSIGMA is DOUBLE PRECISION array, dimension ( K )
          On entry, the first K elements of this array contain the old
          roots of the deflated updating problem.  These are the poles
          of the secular equation.
[out]WORK
          WORK is DOUBLE PRECISION array, dimension (3*K)
[out]INFO
          INFO is INTEGER
          = 0:  successful exit.
          < 0:  if INFO = -i, the i-th argument had an illegal value.
          > 0:  if INFO = 1, a singular value did not converge
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Contributors:
Ming Gu and Huan Ren, Computer Science Division, University of California at Berkeley, USA

Definition at line 162 of file dlasd8.f.

164*
165* -- LAPACK auxiliary routine --
166* -- LAPACK is a software package provided by Univ. of Tennessee, --
167* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
168*
169* .. Scalar Arguments ..
170 INTEGER ICOMPQ, INFO, K, LDDIFR
171* ..
172* .. Array Arguments ..
173 DOUBLE PRECISION D( * ), DIFL( * ), DIFR( LDDIFR, * ),
174 $ DSIGMA( * ), VF( * ), VL( * ), WORK( * ),
175 $ Z( * )
176* ..
177*
178* =====================================================================
179*
180* .. Parameters ..
181 DOUBLE PRECISION ONE
182 parameter( one = 1.0d+0 )
183* ..
184* .. Local Scalars ..
185 INTEGER I, IWK1, IWK2, IWK2I, IWK3, IWK3I, J
186 DOUBLE PRECISION DIFLJ, DIFRJ, DJ, DSIGJ, DSIGJP, RHO, TEMP
187* ..
188* .. External Subroutines ..
189 EXTERNAL dcopy, dlascl, dlasd4, dlaset, xerbla
190* ..
191* .. External Functions ..
192 DOUBLE PRECISION DDOT, DLAMC3, DNRM2
193 EXTERNAL ddot, dlamc3, dnrm2
194* ..
195* .. Intrinsic Functions ..
196 INTRINSIC abs, sign, sqrt
197* ..
198* .. Executable Statements ..
199*
200* Test the input parameters.
201*
202 info = 0
203*
204 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) ) THEN
205 info = -1
206 ELSE IF( k.LT.1 ) THEN
207 info = -2
208 ELSE IF( lddifr.LT.k ) THEN
209 info = -9
210 END IF
211 IF( info.NE.0 ) THEN
212 CALL xerbla( 'DLASD8', -info )
213 RETURN
214 END IF
215*
216* Quick return if possible
217*
218 IF( k.EQ.1 ) THEN
219 d( 1 ) = abs( z( 1 ) )
220 difl( 1 ) = d( 1 )
221 IF( icompq.EQ.1 ) THEN
222 difl( 2 ) = one
223 difr( 1, 2 ) = one
224 END IF
225 RETURN
226 END IF
227*
228* Book keeping.
229*
230 iwk1 = 1
231 iwk2 = iwk1 + k
232 iwk3 = iwk2 + k
233 iwk2i = iwk2 - 1
234 iwk3i = iwk3 - 1
235*
236* Normalize Z.
237*
238 rho = dnrm2( k, z, 1 )
239 CALL dlascl( 'G', 0, 0, rho, one, k, 1, z, k, info )
240 rho = rho*rho
241*
242* Initialize WORK(IWK3).
243*
244 CALL dlaset( 'A', k, 1, one, one, work( iwk3 ), k )
245*
246* Compute the updated singular values, the arrays DIFL, DIFR,
247* and the updated Z.
248*
249 DO 40 j = 1, k
250 CALL dlasd4( k, j, dsigma, z, work( iwk1 ), rho, d( j ),
251 $ work( iwk2 ), info )
252*
253* If the root finder fails, report the convergence failure.
254*
255 IF( info.NE.0 ) THEN
256 RETURN
257 END IF
258 work( iwk3i+j ) = work( iwk3i+j )*work( j )*work( iwk2i+j )
259 difl( j ) = -work( j )
260 difr( j, 1 ) = -work( j+1 )
261 DO 20 i = 1, j - 1
262 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
263 $ work( iwk2i+i ) / ( dsigma( i )-
264 $ dsigma( j ) ) / ( dsigma( i )+
265 $ dsigma( j ) )
266 20 CONTINUE
267 DO 30 i = j + 1, k
268 work( iwk3i+i ) = work( iwk3i+i )*work( i )*
269 $ work( iwk2i+i ) / ( dsigma( i )-
270 $ dsigma( j ) ) / ( dsigma( i )+
271 $ dsigma( j ) )
272 30 CONTINUE
273 40 CONTINUE
274*
275* Compute updated Z.
276*
277 DO 50 i = 1, k
278 z( i ) = sign( sqrt( abs( work( iwk3i+i ) ) ), z( i ) )
279 50 CONTINUE
280*
281* Update VF and VL.
282*
283 DO 80 j = 1, k
284 diflj = difl( j )
285 dj = d( j )
286 dsigj = -dsigma( j )
287 IF( j.LT.k ) THEN
288 difrj = -difr( j, 1 )
289 dsigjp = -dsigma( j+1 )
290 END IF
291 work( j ) = -z( j ) / diflj / ( dsigma( j )+dj )
292*
293* Use calls to the subroutine DLAMC3 to enforce the parentheses
294* (x+y)+z. The goal is to prevent optimizing compilers
295* from doing x+(y+z).
296*
297 DO 60 i = 1, j - 1
298 work( i ) = z( i ) / ( dlamc3( dsigma( i ), dsigj )-diflj )
299 $ / ( dsigma( i )+dj )
300 60 CONTINUE
301 DO 70 i = j + 1, k
302 work( i ) = z( i ) / ( dlamc3( dsigma( i ), dsigjp )+difrj )
303 $ / ( dsigma( i )+dj )
304 70 CONTINUE
305 temp = dnrm2( k, work, 1 )
306 work( iwk2i+j ) = ddot( k, work, 1, vf, 1 ) / temp
307 work( iwk3i+j ) = ddot( k, work, 1, vl, 1 ) / temp
308 IF( icompq.EQ.1 ) THEN
309 difr( j, 2 ) = temp
310 END IF
311 80 CONTINUE
312*
313 CALL dcopy( k, work( iwk2 ), 1, vf, 1 )
314 CALL dcopy( k, work( iwk3 ), 1, vl, 1 )
315*
316 RETURN
317*
318* End of DLASD8
319*
xerbla
subroutine xerbla(srname, info)
Definition cblat2.f:3285
dcopy
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
ddot
double precision function ddot(n, dx, incx, dy, incy)
DDOT
Definition ddot.f:82
dlamc3
double precision function dlamc3(a, b)
DLAMC3
Definition dlamch.f:172
dlascl
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.
Definition dlascl.f:143
dlasd4
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...
Definition dlasd4.f:153
dlaset
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.
Definition dlaset.f:110
dnrm2
real(wp) function dnrm2(n, x, incx)
DNRM2
Definition dnrm2.f90:89
Here is the call graph for this function:
Here is the caller graph for this function: