192 SUBROUTINE dgelst( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
201 INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
204 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
210 DOUBLE PRECISION ZERO, ONE
211 parameter( zero = 0.0d+0, one = 1.0d+0 )
215 INTEGER BROW, I, IASCL, IBSCL, J, LWOPT, MN, MNNRHS,
217 DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
220 DOUBLE PRECISION RWORK( 1 )
225 DOUBLE PRECISION DLAMCH, DLANGE
226 EXTERNAL lsame, ilaenv, dlamch, dlange
233 INTRINSIC dble, max, min
241 lquery = ( lwork.EQ.-1 )
242 IF( .NOT.( lsame( trans,
'N' ) .OR. lsame( trans,
'T' ) ) )
THEN
244 ELSE IF( m.LT.0 )
THEN
246 ELSE IF( n.LT.0 )
THEN
248 ELSE IF( nrhs.LT.0 )
THEN
250 ELSE IF( lda.LT.max( 1, m ) )
THEN
252 ELSE IF( ldb.LT.max( 1, m, n ) )
THEN
254 ELSE IF( lwork.LT.max( 1, mn+max( mn, nrhs ) ) .AND. .NOT.lquery )
261 IF( info.EQ.0 .OR. info.EQ.-10 )
THEN
264 IF( lsame( trans,
'N' ) )
267 nb = ilaenv( 1,
'DGELST',
' ', m, n, -1, -1 )
269 mnnrhs = max( mn, nrhs )
270 lwopt = max( 1, (mn+mnnrhs)*nb )
271 work( 1 ) = dble( lwopt )
276 CALL xerbla(
'DGELST ', -info )
278 ELSE IF( lquery )
THEN
284 IF( min( m, n, nrhs ).EQ.0 )
THEN
285 CALL dlaset(
'Full', max( m, n ), nrhs, zero, zero, b, ldb )
286 work( 1 ) = dble( lwopt )
292 IF( nb.GT.mn ) nb = mn
298 nb = min( nb, lwork/( mn + mnnrhs ) )
302 nbmin = max( 2, ilaenv( 2,
'DGELST',
' ', m, n, -1, -1 ) )
304 IF( nb.LT.nbmin )
THEN
310 smlnum = dlamch(
'S' ) / dlamch(
'P' )
311 bignum = one / smlnum
315 anrm = dlange(
'M', m, n, a, lda, rwork )
317 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
321 CALL dlascl(
'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
323 ELSE IF( anrm.GT.bignum )
THEN
327 CALL dlascl(
'G', 0, 0, anrm, bignum, m, n, a, lda, info )
329 ELSE IF( anrm.EQ.zero )
THEN
333 CALL dlaset(
'Full', max( m, n ), nrhs, zero, zero, b, ldb )
334 work( 1 ) = dble( lwopt )
341 bnrm = dlange(
'M', brow, nrhs, b, ldb, rwork )
343 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
347 CALL dlascl(
'G', 0, 0, bnrm, smlnum, brow, nrhs, b, ldb,
350 ELSE IF( bnrm.GT.bignum )
THEN
354 CALL dlascl(
'G', 0, 0, bnrm, bignum, brow, nrhs, b, ldb,
366 CALL dgeqrt( m, n, nb, a, lda, work( 1 ), nb,
367 $ work( mn*nb+1 ), info )
379 CALL dgemqrt(
'Left',
'Transpose', m, nrhs, n, nb, a, lda,
380 $ work( 1 ), nb, b, ldb, work( mn*nb+1 ),
385 CALL dtrtrs(
'Upper',
'No transpose',
'Non-unit', n, nrhs,
386 $ a, lda, b, ldb, info )
404 CALL dtrtrs(
'Upper',
'Transpose',
'Non-unit', n, nrhs,
405 $ a, lda, b, ldb, info )
424 CALL dgemqrt(
'Left',
'No transpose', m, nrhs, n, nb,
425 $ a, lda, work( 1 ), nb, b, ldb,
426 $ work( mn*nb+1 ), info )
439 CALL dgelqt( m, n, nb, a, lda, work( 1 ), nb,
440 $ work( mn*nb+1 ), info )
452 CALL dtrtrs(
'Lower',
'No transpose',
'Non-unit', m, nrhs,
453 $ a, lda, b, ldb, info )
472 CALL dgemlqt(
'Left',
'Transpose', n, nrhs, m, nb, a, lda,
473 $ work( 1 ), nb, b, ldb,
474 $ work( mn*nb+1 ), info )
488 CALL dgemlqt(
'Left',
'No transpose', n, nrhs, m, nb,
489 $ a, lda, work( 1 ), nb, b, ldb,
490 $ work( mn*nb+1), info )
494 CALL dtrtrs(
'Lower',
'Transpose',
'Non-unit', m, nrhs,
495 $ a, lda, b, ldb, info )
509 IF( iascl.EQ.1 )
THEN
510 CALL dlascl(
'G', 0, 0, anrm, smlnum, scllen, nrhs, b, ldb,
512 ELSE IF( iascl.EQ.2 )
THEN
513 CALL dlascl(
'G', 0, 0, anrm, bignum, scllen, nrhs, b, ldb,
516 IF( ibscl.EQ.1 )
THEN
517 CALL dlascl(
'G', 0, 0, smlnum, bnrm, scllen, nrhs, b, ldb,
519 ELSE IF( ibscl.EQ.2 )
THEN
520 CALL dlascl(
'G', 0, 0, bignum, bnrm, scllen, nrhs, b, ldb,
524 work( 1 ) = dble( lwopt )
subroutine xerbla(srname, info)
subroutine dgelqt(m, n, mb, a, lda, t, ldt, work, info)
DGELQT
subroutine dgelst(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
DGELST solves overdetermined or underdetermined systems for GE matrices using QR or LQ factorization ...
subroutine dgemlqt(side, trans, m, n, k, mb, v, ldv, t, ldt, c, ldc, work, info)
DGEMLQT
subroutine dgemqrt(side, trans, m, n, k, nb, v, ldv, t, ldt, c, ldc, work, info)
DGEMQRT
subroutine dgeqrt(m, n, nb, a, lda, t, ldt, work, info)
DGEQRT
subroutine dlascl(type, kl, ku, cfrom, cto, m, n, a, lda, info)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
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.
subroutine dtrtrs(uplo, trans, diag, n, nrhs, a, lda, b, ldb, info)
DTRTRS