160 SUBROUTINE zgetsls( TRANS, M, N, NRHS, A, LDA, B, LDB,
161 $ work, lwork, info )
170 INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
173 COMPLEX*16 A( lda, * ), B( ldb, * ), WORK( * )
180 DOUBLE PRECISION ZERO, ONE
181 parameter ( zero = 0.0d0, one = 1.0d0 )
183 parameter ( czero = ( 0.0d+0, 0.0d+0 ) )
187 INTEGER I, IASCL, IBSCL, J, MINMN, MAXMN, BROW,
188 $ scllen, mnk, tszo, tszm, lwo, lwm, lw1, lw2,
189 $ wsizeo, wsizem, info2
190 DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM
191 COMPLEX*16 TQ( 5 ), WORKQ
196 DOUBLE PRECISION DLAMCH, ZLANGE
197 EXTERNAL lsame, ilaenv,
dlabad, dlamch, zlange
204 INTRINSIC dble, max, min, int
213 mnk = max( minmn, nrhs )
214 tran = lsame( trans,
'C' )
216 lquery = ( lwork.EQ.-1 .OR. lwork.EQ.-2 )
217 IF( .NOT.( lsame( trans,
'N' ) .OR.
218 $ lsame( trans,
'C' ) ) )
THEN
220 ELSE IF( m.LT.0 )
THEN
222 ELSE IF( n.LT.0 )
THEN
224 ELSE IF( nrhs.LT.0 )
THEN
226 ELSE IF( lda.LT.max( 1, m ) )
THEN
228 ELSE IF( ldb.LT.max( 1, m, n ) )
THEN
237 CALL zgeqr( m, n, a, lda, tq, -1, workq, -1, info2 )
238 tszo = int( tq( 1 ) )
240 CALL zgemqr(
'L', trans, m, nrhs, n, a, lda, tq,
241 $ tszo, b, ldb, workq, -1, info2 )
242 lwo = max( lwo, int( workq ) )
243 CALL zgeqr( m, n, a, lda, tq, -2, workq, -2, info2 )
244 tszm = int( tq( 1 ) )
246 CALL zgemqr(
'L', trans, m, nrhs, n, a, lda, tq,
247 $ tszm, b, ldb, workq, -1, info2 )
248 lwm = max( lwm, int( workq ) )
252 CALL zgelq( m, n, a, lda, tq, -1, workq, -1, info2 )
253 tszo = int( tq( 1 ) )
255 CALL zgemlq(
'L', trans, n, nrhs, m, a, lda, tq,
256 $ tszo, b, ldb, workq, -1, info2 )
257 lwo = max( lwo, int( workq ) )
258 CALL zgelq( m, n, a, lda, tq, -2, workq, -2, info2 )
259 tszm = int( tq( 1 ) )
261 CALL zgemlq(
'L', trans, n, nrhs, m, a, lda, tq,
262 $ tszo, b, ldb, workq, -1, info2 )
263 lwm = max( lwm, int( workq ) )
268 IF( ( lwork.LT.wsizem ).AND.( .NOT.lquery ) )
THEN
275 CALL xerbla(
'ZGETSLS', -info )
276 work( 1 ) = dble( wsizeo )
280 IF( lwork.EQ.-1 ) work( 1 ) =
REAL( wsizeo )
281 IF( lwork.EQ.-2 ) work( 1 ) =
REAL( wsizem )
284 IF( lwork.LT.wsizeo )
THEN
294 IF( min( m, n, nrhs ).EQ.0 )
THEN
295 CALL zlaset(
'FULL', max( m, n ), nrhs, czero, czero,
302 smlnum = dlamch(
'S' ) / dlamch(
'P' )
303 bignum = one / smlnum
304 CALL dlabad( smlnum, bignum )
308 anrm = zlange(
'M', m, n, a, lda, work )
310 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
314 CALL zlascl(
'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
316 ELSE IF( anrm.GT.bignum )
THEN
320 CALL zlascl(
'G', 0, 0, anrm, bignum, m, n, a, lda, info )
322 ELSE IF( anrm.EQ.zero )
THEN
326 CALL zlaset(
'F', maxmn, nrhs, czero, czero, b, ldb )
334 bnrm = zlange(
'M', brow, nrhs, b, ldb, work )
336 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
340 CALL zlascl(
'G', 0, 0, bnrm, smlnum, brow, nrhs, b, ldb,
343 ELSE IF( bnrm.GT.bignum )
THEN
347 CALL zlascl(
'G', 0, 0, bnrm, bignum, brow, nrhs, b, ldb,
356 CALL zgeqr( m, n, a, lda, work( lw2+1 ), lw1,
357 $ work( 1 ), lw2, info )
358 IF ( .NOT.tran )
THEN
364 CALL zgemqr(
'L' ,
'C', m, nrhs, n, a, lda,
365 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
370 CALL ztrtrs(
'U',
'N',
'N', n, nrhs,
371 $ a, lda, b, ldb, info )
382 CALL ztrtrs(
'U',
'C',
'N', n, nrhs,
383 $ a, lda, b, ldb, info )
399 CALL zgemqr(
'L',
'N', m, nrhs, n, a, lda,
400 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
411 CALL zgelq( m, n, a, lda, work( lw2+1 ), lw1,
412 $ work( 1 ), lw2, info )
422 CALL ztrtrs(
'L',
'N',
'N', m, nrhs,
423 $ a, lda, b, ldb, info )
439 CALL zgemlq(
'L',
'C', n, nrhs, m, a, lda,
440 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
453 CALL zgemlq(
'L',
'N', n, nrhs, m, a, lda,
454 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
461 CALL ztrtrs(
'L',
'C',
'N', m, nrhs,
462 $ a, lda, b, ldb, info )
476 IF( iascl.EQ.1 )
THEN
477 CALL zlascl(
'G', 0, 0, anrm, smlnum, scllen, nrhs, b, ldb,
479 ELSE IF( iascl.EQ.2 )
THEN
480 CALL zlascl(
'G', 0, 0, anrm, bignum, scllen, nrhs, b, ldb,
483 IF( ibscl.EQ.1 )
THEN
484 CALL zlascl(
'G', 0, 0, smlnum, bnrm, scllen, nrhs, b, ldb,
486 ELSE IF( ibscl.EQ.2 )
THEN
487 CALL zlascl(
'G', 0, 0, bignum, bnrm, scllen, nrhs, b, ldb,
492 work( 1 ) = dble( tszo + lwo )
subroutine zgetsls(TRANS, M, N, NRHS, A, LDA, B, LDB, WORK, LWORK, INFO)
subroutine zgeqr(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
subroutine zlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
ZLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine ztrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
ZTRTRS
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zlaset(UPLO, M, N, ALPHA, BETA, A, LDA)
ZLASET initializes the off-diagonal elements and the diagonal elements of a matrix to given values...
subroutine zgemqr(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)
subroutine dlabad(SMALL, LARGE)
DLABAD
subroutine zgelq(M, N, A, LDA, T, TSIZE, WORK, LWORK, INFO)
subroutine zgemlq(SIDE, TRANS, M, N, K, A, LDA, T, TSIZE, C, LDC, WORK, LWORK, INFO)