267 SUBROUTINE dlalsa( ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U,
268 $ ldu, vt, k, difl, difr, z, poles, givptr,
269 $ givcol, ldgcol, perm, givnum, c, s, work,
278 INTEGER ICOMPQ, INFO, LDB, LDBX, LDGCOL, LDU, N, NRHS,
282 INTEGER GIVCOL( ldgcol, * ), GIVPTR( * ), IWORK( * ),
283 $ k( * ), perm( ldgcol, * )
284 DOUBLE PRECISION B( ldb, * ), BX( ldbx, * ), C( * ),
285 $ difl( ldu, * ), difr( ldu, * ),
286 $ givnum( ldu, * ), poles( ldu, * ), s( * ),
287 $ u( ldu, * ), vt( ldu, * ), work( * ),
294 DOUBLE PRECISION ZERO, ONE
295 parameter ( zero = 0.0d0, one = 1.0d0 )
298 INTEGER I, I1, IC, IM1, INODE, J, LF, LL, LVL, LVL2,
299 $ nd, ndb1, ndiml, ndimr, nl, nlf, nlp1, nlvl,
300 $ nr, nrf, nrp1, sqre
311 IF( ( icompq.LT.0 ) .OR. ( icompq.GT.1 ) )
THEN
313 ELSE IF( smlsiz.LT.3 )
THEN
315 ELSE IF( n.LT.smlsiz )
THEN
317 ELSE IF( nrhs.LT.1 )
THEN
319 ELSE IF( ldb.LT.n )
THEN
321 ELSE IF( ldbx.LT.n )
THEN
323 ELSE IF( ldu.LT.n )
THEN
325 ELSE IF( ldgcol.LT.n )
THEN
329 CALL xerbla(
'DLALSA', -info )
339 CALL dlasdt( n, nlvl, nd, iwork( inode ), iwork( ndiml ),
340 $ iwork( ndimr ), smlsiz )
345 IF( icompq.EQ.1 )
THEN
364 ic = iwork( inode+i1 )
365 nl = iwork( ndiml+i1 )
366 nr = iwork( ndimr+i1 )
369 CALL dgemm(
'T',
'N', nl, nrhs, nl, one, u( nlf, 1 ), ldu,
370 $ b( nlf, 1 ), ldb, zero, bx( nlf, 1 ), ldbx )
371 CALL dgemm(
'T',
'N', nr, nrhs, nr, one, u( nrf, 1 ), ldu,
372 $ b( nrf, 1 ), ldb, zero, bx( nrf, 1 ), ldbx )
379 ic = iwork( inode+i-1 )
380 CALL dcopy( nrhs, b( ic, 1 ), ldb, bx( ic, 1 ), ldbx )
389 DO 40 lvl = nlvl, 1, -1
404 ic = iwork( inode+im1 )
405 nl = iwork( ndiml+im1 )
406 nr = iwork( ndimr+im1 )
410 CALL dlals0( icompq, nl, nr, sqre, nrhs, bx( nlf, 1 ), ldbx,
411 $ b( nlf, 1 ), ldb, perm( nlf, lvl ),
412 $ givptr( j ), givcol( nlf, lvl2 ), ldgcol,
413 $ givnum( nlf, lvl2 ), ldu, poles( nlf, lvl2 ),
414 $ difl( nlf, lvl ), difr( nlf, lvl2 ),
415 $ z( nlf, lvl ), k( j ), c( j ), s( j ), work,
444 ic = iwork( inode+im1 )
445 nl = iwork( ndiml+im1 )
446 nr = iwork( ndimr+im1 )
455 CALL dlals0( icompq, nl, nr, sqre, nrhs, b( nlf, 1 ), ldb,
456 $ bx( nlf, 1 ), ldbx, perm( nlf, lvl ),
457 $ givptr( j ), givcol( nlf, lvl2 ), ldgcol,
458 $ givnum( nlf, lvl2 ), ldu, poles( nlf, lvl2 ),
459 $ difl( nlf, lvl ), difr( nlf, lvl2 ),
460 $ z( nlf, lvl ), k( j ), c( j ), s( j ), work,
472 ic = iwork( inode+i1 )
473 nl = iwork( ndiml+i1 )
474 nr = iwork( ndimr+i1 )
483 CALL dgemm(
'T',
'N', nlp1, nrhs, nlp1, one, vt( nlf, 1 ), ldu,
484 $ b( nlf, 1 ), ldb, zero, bx( nlf, 1 ), ldbx )
485 CALL dgemm(
'T',
'N', nrp1, nrhs, nrp1, one, vt( nrf, 1 ), ldu,
486 $ b( nrf, 1 ), ldb, zero, bx( nrf, 1 ), ldbx )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dlals0(ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO)
DLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer...
subroutine dlasdt(N, LVL, ND, INODE, NDIML, NDIMR, MSUB)
DLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.
subroutine dgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DGEMM
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlalsa(ICOMPQ, SMLSIZ, N, NRHS, B, LDB, BX, LDBX, U, LDU, VT, K, DIFL, DIFR, Z, POLES, GIVPTR, GIVCOL, LDGCOL, PERM, GIVNUM, C, S, WORK, IWORK, INFO)
DLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd.