160 SUBROUTINE zgetsls( TRANS, M, N, NRHS, A, LDA, B, LDB,
161 $ WORK, LWORK, INFO )
169 INTEGER INFO, LDA, LDB, LWORK, M, N, NRHS
172 COMPLEX*16 A( LDA, * ), B( LDB, * ), WORK( * )
179 DOUBLE PRECISION ZERO, ONE
180 parameter( zero = 0.0d0, one = 1.0d0 )
182 parameter( czero = ( 0.0d+0, 0.0d+0 ) )
186 INTEGER I, IASCL, IBSCL, J, MAXMN, BROW,
187 $ scllen, tszo, tszm, lwo, lwm, lw1, lw2,
188 $ wsizeo, wsizem, info2
189 DOUBLE PRECISION ANRM, BIGNUM, BNRM, SMLNUM, DUM( 1 )
190 COMPLEX*16 TQ( 5 ), WORKQ( 1 )
194 DOUBLE PRECISION DLAMCH, ZLANGE
195 EXTERNAL lsame, dlamch, zlange
202 INTRINSIC dble, max, min, int
210 tran = lsame( trans,
'C' )
212 lquery = ( lwork.EQ.-1 .OR. lwork.EQ.-2 )
213 IF( .NOT.( lsame( trans,
'N' ) .OR.
214 $ lsame( trans,
'C' ) ) )
THEN
216 ELSE IF( m.LT.0 )
THEN
218 ELSE IF( n.LT.0 )
THEN
220 ELSE IF( nrhs.LT.0 )
THEN
222 ELSE IF( lda.LT.max( 1, m ) )
THEN
224 ELSE IF( ldb.LT.max( 1, m, n ) )
THEN
233 CALL zgeqr( m, n, a, lda, tq, -1, workq, -1, info2 )
234 tszo = int( tq( 1 ) )
235 lwo = int( workq( 1 ) )
236 CALL zgemqr(
'L', trans, m, nrhs, n, a, lda, tq,
237 $ tszo, b, ldb, workq, -1, info2 )
238 lwo = max( lwo, int( workq( 1 ) ) )
239 CALL zgeqr( m, n, a, lda, tq, -2, workq, -2, info2 )
240 tszm = int( tq( 1 ) )
241 lwm = int( workq( 1 ) )
242 CALL zgemqr(
'L', trans, m, nrhs, n, a, lda, tq,
243 $ tszm, b, ldb, workq, -1, info2 )
244 lwm = max( lwm, int( workq( 1 ) ) )
248 CALL zgelq( m, n, a, lda, tq, -1, workq, -1, info2 )
249 tszo = int( tq( 1 ) )
250 lwo = int( workq( 1 ) )
251 CALL zgemlq(
'L', trans, n, nrhs, m, a, lda, tq,
252 $ tszo, b, ldb, workq, -1, info2 )
253 lwo = max( lwo, int( workq( 1 ) ) )
254 CALL zgelq( m, n, a, lda, tq, -2, workq, -2, info2 )
255 tszm = int( tq( 1 ) )
256 lwm = int( workq( 1 ) )
257 CALL zgemlq(
'L', trans, n, nrhs, m, a, lda, tq,
258 $ tszm, b, ldb, workq, -1, info2 )
259 lwm = max( lwm, int( workq( 1 ) ) )
264 IF( ( lwork.LT.wsizem ).AND.( .NOT.lquery ) )
THEN
268 work( 1 ) = dble( wsizeo )
273 CALL xerbla(
'ZGETSLS', -info )
277 IF( lwork.EQ.-2 ) work( 1 ) = dble( wsizem )
280 IF( lwork.LT.wsizeo )
THEN
290 IF( min( m, n, nrhs ).EQ.0 )
THEN
291 CALL zlaset(
'FULL', max( m, n ), nrhs, czero, czero,
298 smlnum = dlamch(
'S' ) / dlamch(
'P' )
299 bignum = one / smlnum
303 anrm = zlange(
'M', m, n, a, lda, dum )
305 IF( anrm.GT.zero .AND. anrm.LT.smlnum )
THEN
309 CALL zlascl(
'G', 0, 0, anrm, smlnum, m, n, a, lda, info )
311 ELSE IF( anrm.GT.bignum )
THEN
315 CALL zlascl(
'G', 0, 0, anrm, bignum, m, n, a, lda, info )
317 ELSE IF( anrm.EQ.zero )
THEN
321 CALL zlaset(
'F', maxmn, nrhs, czero, czero, b, ldb )
329 bnrm = zlange(
'M', brow, nrhs, b, ldb, dum )
331 IF( bnrm.GT.zero .AND. bnrm.LT.smlnum )
THEN
335 CALL zlascl(
'G', 0, 0, bnrm, smlnum, brow, nrhs, b, ldb,
338 ELSE IF( bnrm.GT.bignum )
THEN
342 CALL zlascl(
'G', 0, 0, bnrm, bignum, brow, nrhs, b, ldb,
351 CALL zgeqr( m, n, a, lda, work( lw2+1 ), lw1,
352 $ work( 1 ), lw2, info )
353 IF ( .NOT.tran )
THEN
359 CALL zgemqr(
'L' ,
'C', m, nrhs, n, a, lda,
360 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
365 CALL ztrtrs(
'U',
'N',
'N', n, nrhs,
366 $ a, lda, b, ldb, info )
377 CALL ztrtrs(
'U',
'C',
'N', n, nrhs,
378 $ a, lda, b, ldb, info )
394 CALL zgemqr(
'L',
'N', m, nrhs, n, a, lda,
395 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
406 CALL zgelq( m, n, a, lda, work( lw2+1 ), lw1,
407 $ work( 1 ), lw2, info )
417 CALL ztrtrs(
'L',
'N',
'N', m, nrhs,
418 $ a, lda, b, ldb, info )
434 CALL zgemlq(
'L',
'C', n, nrhs, m, a, lda,
435 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
448 CALL zgemlq(
'L',
'N', n, nrhs, m, a, lda,
449 $ work( lw2+1 ), lw1, b, ldb, work( 1 ), lw2,
456 CALL ztrtrs(
'L',
'C',
'N', m, nrhs,
457 $ a, lda, b, ldb, info )
471 IF( iascl.EQ.1 )
THEN
472 CALL zlascl(
'G', 0, 0, anrm, smlnum, scllen, nrhs, b, ldb,
474 ELSE IF( iascl.EQ.2 )
THEN
475 CALL zlascl(
'G', 0, 0, anrm, bignum, scllen, nrhs, b, ldb,
478 IF( ibscl.EQ.1 )
THEN
479 CALL zlascl(
'G', 0, 0, smlnum, bnrm, scllen, nrhs, b, ldb,
481 ELSE IF( ibscl.EQ.2 )
THEN
482 CALL zlascl(
'G', 0, 0, bignum, bnrm, scllen, nrhs, b, ldb,
487 work( 1 ) = dble( tszo + lwo )
subroutine xerbla(srname, info)
subroutine zgelq(m, n, a, lda, t, tsize, work, lwork, info)
ZGELQ
subroutine zgemlq(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
ZGEMLQ
subroutine zgemqr(side, trans, m, n, k, a, lda, t, tsize, c, ldc, work, lwork, info)
ZGEMQR
subroutine zgeqr(m, n, a, lda, t, tsize, work, lwork, info)
ZGEQR
subroutine zgetsls(trans, m, n, nrhs, a, lda, b, ldb, work, lwork, info)
ZGETSLS
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 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 ztrtrs(uplo, trans, diag, n, nrhs, a, lda, b, ldb, info)
ZTRTRS