273 SUBROUTINE dlasda( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K,
274 $ difl, difr, z, poles, givptr, givcol, ldgcol,
275 $ perm, givnum, c, s, work, iwork, info )
283 INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE
286 INTEGER GIVCOL( ldgcol, * ), GIVPTR( * ), IWORK( * ),
287 $ k( * ), perm( ldgcol, * )
288 DOUBLE PRECISION C( * ), D( * ), DIFL( ldu, * ), DIFR( ldu, * ),
289 $ e( * ), givnum( ldu, * ), poles( ldu, * ),
290 $ s( * ), u( ldu, * ), vt( ldu, * ), work( * ),
297 DOUBLE PRECISION ZERO, ONE
298 parameter( zero = 0.0d+0, one = 1.0d+0 )
301 INTEGER I, I1, IC, IDXQ, IDXQI, IM1, INODE, ITEMP, IWK,
302 $ j, lf, ll, lvl, lvl2, m, ncc, nd, ndb1, ndiml,
303 $ ndimr, nl, nlf, nlp1, nlvl, nr, nrf, nrp1, nru,
304 $ nwork1, nwork2, smlszp, sqrei, vf, vfi, vl, vli
305 DOUBLE PRECISION ALPHA, BETA
316 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) )
THEN
318 ELSE IF( smlsiz.LT.3 )
THEN
320 ELSE IF( n.LT.0 )
THEN
322 ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) )
THEN
324 ELSE IF( ldu.LT.( n+sqre ) )
THEN
326 ELSE IF( ldgcol.LT.n )
THEN
330 CALL
xerbla(
'DLASDA', -info )
338 IF( n.LE.smlsiz )
THEN
339 IF( icompq.EQ.0 )
THEN
340 CALL
dlasdq(
'U', sqre, n, 0, 0, 0, d, e, vt, ldu, u, ldu,
341 $ u, ldu, work, info )
343 CALL
dlasdq(
'U', sqre, n, m, n, 0, d, e, vt, ldu, u, ldu,
344 $ u, ldu, work, info )
364 nwork2 = nwork1 + smlszp*smlszp
366 CALL
dlasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
367 $ iwork( ndimr ), smlsiz )
382 ic = iwork( inode+i1 )
383 nl = iwork( ndiml+i1 )
385 nr = iwork( ndimr+i1 )
388 idxqi = idxq + nlf - 2
392 IF( icompq.EQ.0 )
THEN
393 CALL
dlaset(
'A', nlp1, nlp1, zero, one, work( nwork1 ),
395 CALL
dlasdq(
'U', sqrei, nl, nlp1, nru, ncc, d( nlf ),
396 $ e( nlf ), work( nwork1 ), smlszp,
397 $ work( nwork2 ), nl, work( nwork2 ), nl,
398 $ work( nwork2 ), info )
399 itemp = nwork1 + nl*smlszp
400 CALL
dcopy( nlp1, work( nwork1 ), 1, work( vfi ), 1 )
401 CALL
dcopy( nlp1, work( itemp ), 1, work( vli ), 1 )
403 CALL
dlaset(
'A', nl, nl, zero, one, u( nlf, 1 ), ldu )
404 CALL
dlaset(
'A', nlp1, nlp1, zero, one, vt( nlf, 1 ), ldu )
405 CALL
dlasdq(
'U', sqrei, nl, nlp1, nl, ncc, d( nlf ),
406 $ e( nlf ), vt( nlf, 1 ), ldu, u( nlf, 1 ), ldu,
407 $ u( nlf, 1 ), ldu, work( nwork1 ), info )
408 CALL
dcopy( nlp1, vt( nlf, 1 ), 1, work( vfi ), 1 )
409 CALL
dcopy( nlp1, vt( nlf, nlp1 ), 1, work( vli ), 1 )
417 IF( ( i.EQ.nd ) .AND. ( sqre.EQ.0 ) )
THEN
426 IF( icompq.EQ.0 )
THEN
427 CALL
dlaset(
'A', nrp1, nrp1, zero, one, work( nwork1 ),
429 CALL
dlasdq(
'U', sqrei, nr, nrp1, nru, ncc, d( nrf ),
430 $ e( nrf ), work( nwork1 ), smlszp,
431 $ work( nwork2 ), nr, work( nwork2 ), nr,
432 $ work( nwork2 ), info )
433 itemp = nwork1 + ( nrp1-1 )*smlszp
434 CALL
dcopy( nrp1, work( nwork1 ), 1, work( vfi ), 1 )
435 CALL
dcopy( nrp1, work( itemp ), 1, work( vli ), 1 )
437 CALL
dlaset(
'A', nr, nr, zero, one, u( nrf, 1 ), ldu )
438 CALL
dlaset(
'A', nrp1, nrp1, zero, one, vt( nrf, 1 ), ldu )
439 CALL
dlasdq(
'U', sqrei, nr, nrp1, nr, ncc, d( nrf ),
440 $ e( nrf ), vt( nrf, 1 ), ldu, u( nrf, 1 ), ldu,
441 $ u( nrf, 1 ), ldu, work( nwork1 ), info )
442 CALL
dcopy( nrp1, vt( nrf, 1 ), 1, work( vfi ), 1 )
443 CALL
dcopy( nrp1, vt( nrf, nrp1 ), 1, work( vli ), 1 )
456 DO 50 lvl = nlvl, 1, -1
471 ic = iwork( inode+im1 )
472 nl = iwork( ndiml+im1 )
473 nr = iwork( ndimr+im1 )
483 idxqi = idxq + nlf - 1
486 IF( icompq.EQ.0 )
THEN
487 CALL
dlasd6( icompq, nl, nr, sqrei, d( nlf ),
488 $ work( vfi ), work( vli ), alpha, beta,
489 $ iwork( idxqi ), perm, givptr( 1 ), givcol,
490 $ ldgcol, givnum, ldu, poles, difl, difr, z,
491 $ k( 1 ), c( 1 ), s( 1 ), work( nwork1 ),
492 $ iwork( iwk ), info )
495 CALL
dlasd6( icompq, nl, nr, sqrei, d( nlf ),
496 $ work( vfi ), work( vli ), alpha, beta,
497 $ iwork( idxqi ), perm( nlf, lvl ),
498 $ givptr( j ), givcol( nlf, lvl2 ), ldgcol,
499 $ givnum( nlf, lvl2 ), ldu,
500 $ poles( nlf, lvl2 ), difl( nlf, lvl ),
501 $ difr( nlf, lvl2 ), z( nlf, lvl ), k( j ),
502 $ c( j ), s( j ), work( nwork1 ),
503 $ iwork( iwk ), info )
subroutine dlasda(ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK, IWORK, INFO)
DLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagona...
subroutine dlasdt(N, LVL, ND, INODE, NDIML, NDIMR, MSUB)
DLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.
subroutine dlasdq(UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
DLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e...
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlasd6(ICOMPQ, NL, NR, SQRE, D, VF, VL, ALPHA, BETA, IDXQ, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, IWORK, INFO)
DLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by...
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...