180 SUBROUTINE zgglse( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
189 INTEGER info, lda, ldb, lwork, m, n, p
192 COMPLEX*16 a( lda, * ),
b( ldb, * ), c( * ), d( * ),
200 parameter( cone = ( 1.0d+0, 0.0d+0 ) )
204 INTEGER lopt, lwkmin, lwkopt, mn, nb, nb1, nb2, nb3,
216 INTRINSIC int, max, min
224 lquery = ( lwork.EQ.-1 )
227 ELSE IF( n.LT.0 )
THEN
229 ELSE IF( p.LT.0 .OR. p.GT.n .OR. p.LT.n-m )
THEN
231 ELSE IF( lda.LT.max( 1, m ) )
THEN
233 ELSE IF( ldb.LT.max( 1, p ) )
THEN
244 nb1 =
ilaenv( 1,
'ZGEQRF',
' ', m, n, -1, -1 )
245 nb2 =
ilaenv( 1,
'ZGERQF',
' ', m, n, -1, -1 )
246 nb3 =
ilaenv( 1,
'ZUNMQR',
' ', m, n, p, -1 )
247 nb4 =
ilaenv( 1,
'ZUNMRQ',
' ', m, n, p, -1 )
248 nb = max( nb1, nb2, nb3, nb4 )
250 lwkopt = p + mn + max( m, n )*nb
254 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
THEN
260 CALL
xerbla(
'ZGGLSE', -info )
262 ELSE IF( lquery )
THEN
280 CALL
zggrqf( p, m, n,
b, ldb, work, a, lda, work( p+1 ),
281 $ work( p+mn+1 ), lwork-p-mn, info )
282 lopt = work( p+mn+1 )
287 CALL
zunmqr(
'Left',
'Conjugate Transpose', m, 1, mn, a, lda,
288 $ work( p+1 ), c, max( 1, m ), work( p+mn+1 ),
290 lopt = max( lopt, int( work( p+mn+1 ) ) )
295 CALL
ztrtrs(
'Upper',
'No transpose',
'Non-unit', p, 1,
296 $
b( 1, n-p+1 ), ldb, d, p, info )
305 CALL
zcopy( p, d, 1, x( n-p+1 ), 1 )
309 CALL
zgemv(
'No transpose', n-p, p, -cone, a( 1, n-p+1 ), lda,
316 CALL
ztrtrs(
'Upper',
'No transpose',
'Non-unit', n-p, 1,
317 $ a, lda, c, n-p, info )
326 CALL
zcopy( n-p, c, 1, x, 1 )
334 $ CALL
zgemv(
'No transpose', nr, n-m, -cone, a( n-p+1, m+1 ),
335 $ lda, d( nr+1 ), 1, cone, c( n-p+1 ), 1 )
340 CALL
ztrmv(
'Upper',
'No transpose',
'Non unit', nr,
341 $ a( n-p+1, n-p+1 ), lda, d, 1 )
342 CALL
zaxpy( nr, -cone, d, 1, c( n-p+1 ), 1 )
347 CALL
zunmrq(
'Left',
'Conjugate Transpose', n, 1, p,
b, ldb,
348 $ work( 1 ), x, n, work( p+mn+1 ), lwork-p-mn, info )
349 work( 1 ) = p + mn + max( lopt, int( work( p+mn+1 ) ) )
subroutine zunmrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMRQ
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine zcopy(N, ZX, INCX, ZY, INCY)
ZCOPY
subroutine ztrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
ZTRTRS
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV
subroutine zunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
ZUNMQR
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine zggrqf(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
ZGGRQF
subroutine zgglse(M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, INFO)
ZGGLSE solves overdetermined or underdetermined systems for OTHER matrices