182 SUBROUTINE cgels( TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK,
192 INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
195 COMPLEX A( lda, * ), B( ldb, * ), WORK( * )
202 parameter ( zero = 0.0e+0, one = 1.0e+0 )
204 parameter ( czero = ( 0.0e+0, 0.0e+0 ) )
208 INTEGER BROW, I, IASCL, IBSCL, J, MN, NB, SCLLEN, WSIZE
209 REAL ANRM, BIGNUM, BNRM, SMLNUM
218 EXTERNAL lsame, ilaenv, clange, slamch
225 INTRINSIC max, min, real
233 lquery = ( lwork.EQ.-1 )
234 IF( .NOT.( lsame( trans,
'N' ) .OR. lsame( trans,
'C' ) ) )
THEN
236 ELSE IF( m.LT.0 )
THEN
238 ELSE IF( n.LT.0 )
THEN
240 ELSE IF( nrhs.LT.0 )
THEN
242 ELSE IF( lda.LT.max( 1, m ) )
THEN
244 ELSE IF( ldb.LT.max( 1, m, n ) )
THEN
246 ELSE IF( lwork.LT.max( 1, mn+max( mn, nrhs ) ) .AND.
253 IF( info.EQ.0 .OR. info.EQ.-10 )
THEN
256 IF( lsame( trans,
'N' ) )
260 nb = ilaenv( 1,
'CGEQRF',
' ', m, n, -1, -1 )
262 nb = max( nb, ilaenv( 1,
'CUNMQR',
'LN', m, nrhs, n,
265 nb = max( nb, ilaenv( 1,
'CUNMQR',
'LC', m, nrhs, n,
269 nb = ilaenv( 1,
'CGELQF',
' ', m, n, -1, -1 )
271 nb = max( nb, ilaenv( 1,
'CUNMLQ',
'LC', n, nrhs, m,
274 nb = max( nb, ilaenv( 1,
'CUNMLQ',
'LN', n, nrhs, m,
279 wsize = max( 1, mn + max( mn, nrhs )*nb )
280 work( 1 ) =
REAL( wsize )
285 CALL xerbla(
'CGELS ', -info )
287 ELSE IF( lquery )
THEN
293 IF( min( m, n, nrhs ).EQ.0 )
THEN
294 CALL claset(
'Full', max( m, n ), nrhs, czero, czero, b, ldb )
300 smlnum = slamch(
'S' ) / slamch(
'P' )
301 bignum = one / smlnum
302 CALL slabad( smlnum, bignum )
306 anrm = clange(
'M', m, n, a, lda, rwork )
308 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
312 CALL clascl(
'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
314 ELSE IF( anrm.GT.bignum )
THEN
318 CALL clascl(
'G', 0, 0, anrm, bignum, m, n, a, lda, info )
320 ELSE IF( anrm.EQ.zero )
THEN
324 CALL claset(
'F', max( m, n ), nrhs, czero, czero, b, ldb )
331 bnrm = clange(
'M', brow, nrhs, b, ldb, rwork )
333 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
337 CALL clascl(
'G', 0, 0, bnrm, smlnum, brow, nrhs, b, ldb,
340 ELSE IF( bnrm.GT.bignum )
THEN
344 CALL clascl(
'G', 0, 0, bnrm, bignum, brow, nrhs, b, ldb,
353 CALL cgeqrf( m, n, a, lda, work( 1 ), work( mn+1 ), lwork-mn,
364 CALL cunmqr(
'Left',
'Conjugate transpose', m, nrhs, n, a,
365 $ lda, work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
372 CALL ctrtrs(
'Upper',
'No transpose',
'Non-unit', n, nrhs,
373 $ a, lda, b, ldb, info )
387 CALL ctrtrs(
'Upper',
'Conjugate transpose',
'Non-unit',
388 $ n, nrhs, a, lda, b, ldb, info )
404 CALL cunmqr(
'Left',
'No transpose', m, nrhs, n, a, lda,
405 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
418 CALL cgelqf( m, n, a, lda, work( 1 ), work( mn+1 ), lwork-mn,
429 CALL ctrtrs(
'Lower',
'No transpose',
'Non-unit', m, nrhs,
430 $ a, lda, b, ldb, info )
446 CALL cunmlq(
'Left',
'Conjugate transpose', n, nrhs, m, a,
447 $ lda, work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
460 CALL cunmlq(
'Left',
'No transpose', n, nrhs, m, a, lda,
461 $ work( 1 ), b, ldb, work( mn+1 ), lwork-mn,
468 CALL ctrtrs(
'Lower',
'Conjugate transpose',
'Non-unit',
469 $ m, nrhs, a, lda, b, ldb, info )
483 IF( iascl.EQ.1 )
THEN
484 CALL clascl(
'G', 0, 0, anrm, smlnum, scllen, nrhs, b, ldb,
486 ELSE IF( iascl.EQ.2 )
THEN
487 CALL clascl(
'G', 0, 0, anrm, bignum, scllen, nrhs, b, ldb,
490 IF( ibscl.EQ.1 )
THEN
491 CALL clascl(
'G', 0, 0, smlnum, bnrm, scllen, nrhs, b, ldb,
493 ELSE IF( ibscl.EQ.2 )
THEN
494 CALL clascl(
'G', 0, 0, bignum, bnrm, scllen, nrhs, b, ldb,
499 work( 1 ) =
REAL( wsize )
subroutine claset(UPLO, M, N, ALPHA, BETA, A, LDA)
CLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine ctrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
CTRTRS
subroutine clascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
CLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine cgelqf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGELQF
subroutine cgels(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO)
CGELS solves overdetermined or underdetermined systems for GE matrices
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cgeqrf(M, N, A, LDA, TAU, WORK, LWORK, INFO)
CGEQRF
subroutine slabad(SMALL, LARGE)
SLABAD
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
subroutine cunmlq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMLQ