267 SUBROUTINE slalsa( 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 REAL B( ldb, * ), BX( ldbx, * ), C( * ),
285 $ difl( ldu, * ), difr( ldu, * ),
286 $ givnum( ldu, * ), poles( ldu, * ), s( * ),
287 $ u( ldu, * ), vt( ldu, * ), work( * ),
295 parameter( zero = 0.0e0, one = 1.0e0 )
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(
'SLALSA', -info )
339 CALL
slasdt( 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
sgemm(
'T',
'N', nl, nrhs, nl, one, u( nlf, 1 ), ldu,
370 $ b( nlf, 1 ), ldb, zero, bx( nlf, 1 ), ldbx )
371 CALL
sgemm(
'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
scopy( 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
slals0( 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
slals0( 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
sgemm(
'T',
'N', nlp1, nrhs, nlp1, one, vt( nlf, 1 ), ldu,
484 $ b( nlf, 1 ), ldb, zero, bx( nlf, 1 ), ldbx )
485 CALL
sgemm(
'T',
'N', nrp1, nrhs, nrp1, one, vt( nrf, 1 ), ldu,
486 $ b( nrf, 1 ), ldb, zero, bx( nrf, 1 ), ldbx )
subroutine slalsa(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)
SLALSA computes the SVD of the coefficient matrix in compact form. Used by sgelsd.
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
subroutine slals0(ICOMPQ, NL, NR, SQRE, NRHS, B, LDB, BX, LDBX, PERM, GIVPTR, GIVCOL, LDGCOL, GIVNUM, LDGNUM, POLES, DIFL, DIFR, Z, K, C, S, WORK, INFO)
SLALS0 applies back multiplying factors in solving the least squares problem using divide and conquer...
subroutine slasdt(N, LVL, ND, INODE, NDIML, NDIMR, MSUB)
SLASDT creates a tree of subproblems for bidiagonal divide and conquer. Used by sbdsdc.