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 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 dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
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 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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j