183 SUBROUTINE dgels( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
193 INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
196 DOUBLE PRECISION A( lda, * ), B( ldb, * ), WORK( * )
202 DOUBLE PRECISION ZERO, ONE
203 parameter ( zero = 0.0d0, one = 1.0d0 )
207 INTEGER BROW, I, IASCL, IBSCL, J, MN, NB, SCLLEN, WSIZE
208 DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
211 DOUBLE PRECISION RWORK( 1 )
216 DOUBLE PRECISION DLAMCH, DLANGE
217 EXTERNAL lsame, ilaenv,
dlabad, dlamch, dlange
224 INTRINSIC dble, max, min
232 lquery = ( lwork.EQ.-1 )
233 IF( .NOT.( lsame( trans,
'N' ) .OR. lsame( trans,
'T' ) ) )
THEN
235 ELSE IF( m.LT.0 )
THEN
237 ELSE IF( n.LT.0 )
THEN
239 ELSE IF( nrhs.LT.0 )
THEN
241 ELSE IF( lda.LT.max( 1, m ) )
THEN
243 ELSE IF( ldb.LT.max( 1, m, n ) )
THEN
245 ELSE IF( lwork.LT.max( 1, mn+max( mn, nrhs ) ) .AND. .NOT.lquery )
252 IF( info.EQ.0 .OR. info.EQ.-10 )
THEN
255 IF( lsame( trans,
'N' ) )
259 nb = ilaenv( 1,
'DGEQRF',
' ', m, n, -1, -1 )
261 nb = max( nb, ilaenv( 1,
'DORMQR',
'LN', m, nrhs, n,
264 nb = max( nb, ilaenv( 1,
'DORMQR',
'LT', m, nrhs, n,
268 nb = ilaenv( 1,
'DGELQF',
' ', m, n, -1, -1 )
270 nb = max( nb, ilaenv( 1,
'DORMLQ',
'LT', n, nrhs, m,
273 nb = max( nb, ilaenv( 1,
'DORMLQ',
'LN', n, nrhs, m,
278 wsize = max( 1, mn+max( mn, nrhs )*nb )
279 work( 1 ) = dble( wsize )
284 CALL xerbla(
'DGELS ', -info )
286 ELSE IF( lquery )
THEN
292 IF( min( m, n, nrhs ).EQ.0 )
THEN
293 CALL dlaset(
'Full', max( m, n ), nrhs, zero, zero, b, ldb )
299 smlnum = dlamch(
'S' ) / dlamch(
'P' )
300 bignum = one / smlnum
301 CALL dlabad( smlnum, bignum )
305 anrm = dlange(
'M', m, n, a, lda, rwork )
307 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
311 CALL dlascl(
'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
313 ELSE IF( anrm.GT.bignum )
THEN
317 CALL dlascl(
'G', 0, 0, anrm, bignum, m, n, a, lda, info )
319 ELSE IF( anrm.EQ.zero )
THEN
323 CALL dlaset(
'F', max( m, n ), nrhs, zero, zero, b, ldb )
330 bnrm = dlange(
'M', brow, nrhs, b, ldb, rwork )
332 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
336 CALL dlascl(
'G', 0, 0, bnrm, smlnum, brow, nrhs, b, ldb,
339 ELSE IF( bnrm.GT.bignum )
THEN
343 CALL dlascl(
'G', 0, 0, bnrm, bignum, brow, nrhs, b, ldb,
352 CALL dgeqrf( m, n, a, lda, work( 1 ), work( mn+1 ), lwork-mn,
363 CALL dormqr(
'Left',
'Transpose', m, nrhs, n, a, lda,
364 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
371 CALL dtrtrs(
'Upper',
'No transpose',
'Non-unit', n, nrhs,
372 $ a, lda, b, ldb, info )
386 CALL dtrtrs(
'Upper',
'Transpose',
'Non-unit', n, nrhs,
387 $ a, lda, b, ldb, info )
403 CALL dormqr(
'Left',
'No transpose', m, nrhs, n, a, lda,
404 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
417 CALL dgelqf( m, n, a, lda, work( 1 ), work( mn+1 ), lwork-mn,
428 CALL dtrtrs(
'Lower',
'No transpose',
'Non-unit', m, nrhs,
429 $ a, lda, b, ldb, info )
445 CALL dormlq(
'Left',
'Transpose', n, nrhs, m, a, lda,
446 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
459 CALL dormlq(
'Left',
'No transpose', n, nrhs, m, a, lda,
460 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
467 CALL dtrtrs(
'Lower',
'Transpose',
'Non-unit', m, nrhs,
468 $ a, lda, b, ldb, info )
482 IF( iascl.EQ.1 )
THEN
483 CALL dlascl(
'G', 0, 0, anrm, smlnum, scllen, nrhs, b, ldb,
485 ELSE IF( iascl.EQ.2 )
THEN
486 CALL dlascl(
'G', 0, 0, anrm, bignum, scllen, nrhs, b, ldb,
489 IF( ibscl.EQ.1 )
THEN
490 CALL dlascl(
'G', 0, 0, smlnum, bnrm, scllen, nrhs, b, ldb,
492 ELSE IF( ibscl.EQ.2 )
THEN
493 CALL dlascl(
'G', 0, 0, bignum, bnrm, scllen, nrhs, b, ldb,
498 work( 1 ) = dble( wsize )
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 dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
subroutine dtrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
DTRTRS
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 dgelqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGELQF
subroutine dormlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMLQ
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dgels(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO)
DGELS solves overdetermined or underdetermined systems for GE matrices
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine dgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
DGEQRF