180 SUBROUTINE dgglse( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
189 INTEGER info, lda, ldb, lwork, m, n, p
192 DOUBLE PRECISION a( lda, * ),
b( ldb, * ), c( * ), d( * ),
200 parameter( one = 1.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,
'DGEQRF',
' ', m, n, -1, -1 )
245 nb2 =
ilaenv( 1,
'DGERQF',
' ', m, n, -1, -1 )
246 nb3 =
ilaenv( 1,
'DORMQR',
' ', m, n, p, -1 )
247 nb4 =
ilaenv( 1,
'DORMRQ',
' ', 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(
'DGGLSE', -info )
262 ELSE IF( lquery )
THEN
280 CALL
dggrqf( 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
dormqr(
'Left',
'Transpose', m, 1, mn, a, lda, work( p+1 ),
288 $ c, max( 1, m ), work( p+mn+1 ), lwork-p-mn, info )
289 lopt = max( lopt, int( work( p+mn+1 ) ) )
294 CALL
dtrtrs(
'Upper',
'No transpose',
'Non-unit', p, 1,
295 $
b( 1, n-p+1 ), ldb, d, p, info )
304 CALL
dcopy( p, d, 1,
x( n-p+1 ), 1 )
308 CALL
dgemv(
'No transpose', n-p, p, -one, a( 1, n-p+1 ), lda,
315 CALL
dtrtrs(
'Upper',
'No transpose',
'Non-unit', n-p, 1,
316 $ a, lda, c, n-p, info )
325 CALL
dcopy( n-p, c, 1,
x, 1 )
333 $ CALL
dgemv(
'No transpose', nr, n-m, -one, a( n-p+1, m+1 ),
334 $ lda, d( nr+1 ), 1, one, c( n-p+1 ), 1 )
339 CALL
dtrmv(
'Upper',
'No transpose',
'Non unit', nr,
340 $ a( n-p+1, n-p+1 ), lda, d, 1 )
341 CALL
daxpy( nr, -one, d, 1, c( n-p+1 ), 1 )
346 CALL
dormrq(
'Left',
'Transpose', n, 1, p,
b, ldb, work( 1 ),
x,
347 $ n, work( p+mn+1 ), lwork-p-mn, info )
348 work( 1 ) = p + mn + max( lopt, int( work( p+mn+1 ) ) )
subroutine dormrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMRQ
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dggrqf(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
DGGRQF
subroutine dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dtrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
DTRTRS
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY
subroutine dgglse(M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, INFO)
DGGLSE solves overdetermined or underdetermined systems for OTHER matrices
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRMV