272 SUBROUTINE slasda( ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K,
273 $ difl, difr, z, poles, givptr, givcol, ldgcol,
274 $ perm, givnum, c, s, work, iwork, info )
282 INTEGER ICOMPQ, INFO, LDGCOL, LDU, N, SMLSIZ, SQRE
285 INTEGER GIVCOL( ldgcol, * ), GIVPTR( * ), IWORK( * ),
286 $ k( * ), perm( ldgcol, * )
287 REAL C( * ), D( * ), DIFL( ldu, * ), DIFR( ldu, * ),
288 $ e( * ), givnum( ldu, * ), poles( ldu, * ),
289 $ s( * ), u( ldu, * ), vt( ldu, * ), work( * ),
297 parameter( zero = 0.0e+0, one = 1.0e+0 )
300 INTEGER I, I1, IC, IDXQ, IDXQI, IM1, INODE, ITEMP, IWK,
301 $ j, lf, ll, lvl, lvl2, m, ncc, nd, ndb1, ndiml,
302 $ ndimr, nl, nlf, nlp1, nlvl, nr, nrf, nrp1, nru,
303 $ nwork1, nwork2, smlszp, sqrei, vf, vfi, vl, vli
315 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) )
THEN
317 ELSE IF( smlsiz.LT.3 )
THEN
319 ELSE IF( n.LT.0 )
THEN
321 ELSE IF( ( sqre.LT.0 ) .OR. ( sqre.GT.1 ) )
THEN
323 ELSE IF( ldu.LT.( n+sqre ) )
THEN
325 ELSE IF( ldgcol.LT.n )
THEN
329 CALL
xerbla(
'SLASDA', -info )
337 IF( n.LE.smlsiz )
THEN
338 IF( icompq.EQ.0 )
THEN
339 CALL
slasdq(
'U', sqre, n, 0, 0, 0, d, e, vt, ldu, u, ldu,
340 $ u, ldu, work, info )
342 CALL
slasdq(
'U', sqre, n, m, n, 0, d, e, vt, ldu, u, ldu,
343 $ u, ldu, work, info )
363 nwork2 = nwork1 + smlszp*smlszp
365 CALL
slasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
366 $ iwork( ndimr ), smlsiz )
381 ic = iwork( inode+i1 )
382 nl = iwork( ndiml+i1 )
384 nr = iwork( ndimr+i1 )
387 idxqi = idxq + nlf - 2
391 IF( icompq.EQ.0 )
THEN
392 CALL
slaset(
'A', nlp1, nlp1, zero, one, work( nwork1 ),
394 CALL
slasdq(
'U', sqrei, nl, nlp1, nru, ncc, d( nlf ),
395 $ e( nlf ), work( nwork1 ), smlszp,
396 $ work( nwork2 ), nl, work( nwork2 ), nl,
397 $ work( nwork2 ), info )
398 itemp = nwork1 + nl*smlszp
399 CALL
scopy( nlp1, work( nwork1 ), 1, work( vfi ), 1 )
400 CALL
scopy( nlp1, work( itemp ), 1, work( vli ), 1 )
402 CALL
slaset(
'A', nl, nl, zero, one, u( nlf, 1 ), ldu )
403 CALL
slaset(
'A', nlp1, nlp1, zero, one, vt( nlf, 1 ), ldu )
404 CALL
slasdq(
'U', sqrei, nl, nlp1, nl, ncc, d( nlf ),
405 $ e( nlf ), vt( nlf, 1 ), ldu, u( nlf, 1 ), ldu,
406 $ u( nlf, 1 ), ldu, work( nwork1 ), info )
407 CALL
scopy( nlp1, vt( nlf, 1 ), 1, work( vfi ), 1 )
408 CALL
scopy( nlp1, vt( nlf, nlp1 ), 1, work( vli ), 1 )
416 IF( ( i.EQ.nd ) .AND. ( sqre.EQ.0 ) )
THEN
425 IF( icompq.EQ.0 )
THEN
426 CALL
slaset(
'A', nrp1, nrp1, zero, one, work( nwork1 ),
428 CALL
slasdq(
'U', sqrei, nr, nrp1, nru, ncc, d( nrf ),
429 $ e( nrf ), work( nwork1 ), smlszp,
430 $ work( nwork2 ), nr, work( nwork2 ), nr,
431 $ work( nwork2 ), info )
432 itemp = nwork1 + ( nrp1-1 )*smlszp
433 CALL
scopy( nrp1, work( nwork1 ), 1, work( vfi ), 1 )
434 CALL
scopy( nrp1, work( itemp ), 1, work( vli ), 1 )
436 CALL
slaset(
'A', nr, nr, zero, one, u( nrf, 1 ), ldu )
437 CALL
slaset(
'A', nrp1, nrp1, zero, one, vt( nrf, 1 ), ldu )
438 CALL
slasdq(
'U', sqrei, nr, nrp1, nr, ncc, d( nrf ),
439 $ e( nrf ), vt( nrf, 1 ), ldu, u( nrf, 1 ), ldu,
440 $ u( nrf, 1 ), ldu, work( nwork1 ), info )
441 CALL
scopy( nrp1, vt( nrf, 1 ), 1, work( vfi ), 1 )
442 CALL
scopy( nrp1, vt( nrf, nrp1 ), 1, work( vli ), 1 )
455 DO 50 lvl = nlvl, 1, -1
470 ic = iwork( inode+im1 )
471 nl = iwork( ndiml+im1 )
472 nr = iwork( ndimr+im1 )
482 idxqi = idxq + nlf - 1
485 IF( icompq.EQ.0 )
THEN
486 CALL
slasd6( icompq, nl, nr, sqrei, d( nlf ),
487 $ work( vfi ), work( vli ), alpha, beta,
488 $ iwork( idxqi ), perm, givptr( 1 ), givcol,
489 $ ldgcol, givnum, ldu, poles, difl, difr, z,
490 $ k( 1 ), c( 1 ), s( 1 ), work( nwork1 ),
491 $ iwork( iwk ), info )
494 CALL
slasd6( icompq, nl, nr, sqrei, d( nlf ),
495 $ work( vfi ), work( vli ), alpha, beta,
496 $ iwork( idxqi ), perm( nlf, lvl ),
497 $ givptr( j ), givcol( nlf, lvl2 ), ldgcol,
498 $ givnum( nlf, lvl2 ), ldu,
499 $ poles( nlf, lvl2 ), difl( nlf, lvl ),
500 $ difr( nlf, lvl2 ), z( nlf, lvl ), k( j ),
501 $ c( j ), s( j ), work( nwork1 ),
502 $ iwork( iwk ), info )
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 slasd6(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)
SLASD6 computes the SVD of an updated upper bidiagonal matrix obtained by merging two smaller ones by...
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine slasdq(UPLO, SQRE, N, NCVT, NRU, NCC, D, E, VT, LDVT, U, LDU, C, LDC, WORK, INFO)
SLASDQ computes the SVD of a real bidiagonal matrix with diagonal d and off-diagonal e...
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine slasdt(N, LVL, ND, INODE, NDIML, NDIMR, MSUB)
SLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.
subroutine slasda(ICOMPQ, SMLSIZ, N, SQRE, D, E, U, LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK, IWORK, INFO)
SLASDA computes the singular value decomposition (SVD) of a real upper bidiagonal matrix with diagona...