181 SUBROUTINE dgels( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
190 INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
193 DOUBLE PRECISION A( LDA, * ), B( LDB, * ), WORK( * )
199 DOUBLE PRECISION ZERO, ONE
200 parameter( zero = 0.0d0, one = 1.0d0 )
204 INTEGER BROW, I, IASCL, IBSCL, J, MN, NB, SCLLEN, WSIZE
205 DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
208 DOUBLE PRECISION RWORK( 1 )
213 DOUBLE PRECISION DLAMCH, DLANGE
214 EXTERNAL lsame, ilaenv, dlamch, dlange
221 INTRINSIC dble, max, min
229 lquery = ( lwork.EQ.-1 )
230 IF( .NOT.( lsame( trans,
'N' ) .OR. lsame( trans,
'T' ) ) )
THEN
232 ELSE IF( m.LT.0 )
THEN
234 ELSE IF( n.LT.0 )
THEN
236 ELSE IF( nrhs.LT.0 )
THEN
238 ELSE IF( lda.LT.max( 1, m ) )
THEN
240 ELSE IF( ldb.LT.max( 1, m, n ) )
THEN
242 ELSE IF( lwork.LT.max( 1, mn+max( mn, nrhs ) ) .AND. .NOT.lquery )
249 IF( info.EQ.0 .OR. info.EQ.-10 )
THEN
252 IF( lsame( trans,
'N' ) )
256 nb = ilaenv( 1,
'DGEQRF',
' ', m, n, -1, -1 )
258 nb = max( nb, ilaenv( 1,
'DORMQR',
'LN', m, nrhs, n,
261 nb = max( nb, ilaenv( 1,
'DORMQR',
'LT', m, nrhs, n,
265 nb = ilaenv( 1,
'DGELQF',
' ', m, n, -1, -1 )
267 nb = max( nb, ilaenv( 1,
'DORMLQ',
'LT', n, nrhs, m,
270 nb = max( nb, ilaenv( 1,
'DORMLQ',
'LN', n, nrhs, m,
275 wsize = max( 1, mn+max( mn, nrhs )*nb )
276 work( 1 ) = dble( wsize )
281 CALL xerbla(
'DGELS ', -info )
283 ELSE IF( lquery )
THEN
289 IF( min( m, n, nrhs ).EQ.0 )
THEN
290 CALL dlaset(
'Full', max( m, n ), nrhs, zero, zero, b, ldb )
296 smlnum = dlamch(
'S' ) / dlamch(
'P' )
297 bignum = one / smlnum
301 anrm = dlange(
'M', m, n, a, lda, rwork )
303 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
307 CALL dlascl(
'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
309 ELSE IF( anrm.GT.bignum )
THEN
313 CALL dlascl(
'G', 0, 0, anrm, bignum, m, n, a, lda, info )
315 ELSE IF( anrm.EQ.zero )
THEN
319 CALL dlaset(
'F', max( m, n ), nrhs, zero, zero, b, ldb )
326 bnrm = dlange(
'M', brow, nrhs, b, ldb, rwork )
328 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
332 CALL dlascl(
'G', 0, 0, bnrm, smlnum, brow, nrhs, b, ldb,
335 ELSE IF( bnrm.GT.bignum )
THEN
339 CALL dlascl(
'G', 0, 0, bnrm, bignum, brow, nrhs, b, ldb,
348 CALL dgeqrf( m, n, a, lda, work( 1 ), work( mn+1 ), lwork-mn,
359 CALL dormqr(
'Left',
'Transpose', m, nrhs, n, a, lda,
360 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
367 CALL dtrtrs(
'Upper',
'No transpose',
'Non-unit', n, nrhs,
368 $ a, lda, b, ldb, info )
382 CALL dtrtrs(
'Upper',
'Transpose',
'Non-unit', n, nrhs,
383 $ a, lda, b, ldb, info )
399 CALL dormqr(
'Left',
'No transpose', m, nrhs, n, a, lda,
400 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
413 CALL dgelqf( m, n, a, lda, work( 1 ), work( mn+1 ), lwork-mn,
424 CALL dtrtrs(
'Lower',
'No transpose',
'Non-unit', m, nrhs,
425 $ a, lda, b, ldb, info )
441 CALL dormlq(
'Left',
'Transpose', n, nrhs, m, a, lda,
442 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
455 CALL dormlq(
'Left',
'No transpose', n, nrhs, m, a, lda,
456 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
463 CALL dtrtrs(
'Lower',
'Transpose',
'Non-unit', m, nrhs,
464 $ a, lda, b, ldb, info )
478 IF( iascl.EQ.1 )
THEN
479 CALL dlascl(
'G', 0, 0, anrm, smlnum, scllen, nrhs, b, ldb,
481 ELSE IF( iascl.EQ.2 )
THEN
482 CALL dlascl(
'G', 0, 0, anrm, bignum, scllen, nrhs, b, ldb,
485 IF( ibscl.EQ.1 )
THEN
486 CALL dlascl(
'G', 0, 0, smlnum, bnrm, scllen, nrhs, b, ldb,
488 ELSE IF( ibscl.EQ.2 )
THEN
489 CALL dlascl(
'G', 0, 0, bignum, bnrm, scllen, nrhs, b, ldb,
494 work( 1 ) = dble( wsize )
subroutine xerbla(srname, info)
subroutine dgelqf(m, n, a, lda, tau, work, lwork, info)
DGELQF
subroutine dgels(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
DGELS solves overdetermined or underdetermined systems for GE matrices
subroutine dgeqrf(m, n, a, lda, tau, work, lwork, info)
DGEQRF
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
subroutine dormlq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
DORMLQ
subroutine dormqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
DORMQR