180 SUBROUTINE cgglse( M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK,
189 INTEGER info, lda, ldb, lwork, m, n, p
192 COMPLEX a( lda, * ),
b( ldb, * ), c( * ), d( * ),
200 parameter( cone = ( 1.0e+0, 0.0e+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,
'CGEQRF',
' ', m, n, -1, -1 )
245 nb2 =
ilaenv( 1,
'CGERQF',
' ', m, n, -1, -1 )
246 nb3 =
ilaenv( 1,
'CUNMQR',
' ', m, n, p, -1 )
247 nb4 =
ilaenv( 1,
'CUNMRQ',
' ', 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(
'CGGLSE', -info )
262 ELSE IF( lquery )
THEN
280 CALL
cggrqf( 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
cunmqr(
'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
ctrtrs(
'Upper',
'No transpose',
'Non-unit', p, 1,
296 $
b( 1, n-p+1 ), ldb, d, p, info )
305 CALL
ccopy( p, d, 1, x( n-p+1 ), 1 )
309 CALL
cgemv(
'No transpose', n-p, p, -cone, a( 1, n-p+1 ), lda,
316 CALL
ctrtrs(
'Upper',
'No transpose',
'Non-unit', n-p, 1,
317 $ a, lda, c, n-p, info )
326 CALL
ccopy( n-p, c, 1, x, 1 )
334 $ CALL
cgemv(
'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
ctrmv(
'Upper',
'No transpose',
'Non unit', nr,
341 $ a( n-p+1, n-p+1 ), lda, d, 1 )
342 CALL
caxpy( nr, -cone, d, 1, c( n-p+1 ), 1 )
347 CALL
cunmrq(
'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 cunmrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMRQ
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine cggrqf(M, P, N, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
CGGRQF
subroutine cunmqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMQR
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine ctrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
CTRTRS
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine cgglse(M, N, P, A, LDA, B, LDB, C, D, X, WORK, LWORK, INFO)
CGGLSE solves overdetermined or underdetermined systems for OTHER matrices
subroutine ccopy(N, CX, INCX, CY, INCY)
CCOPY
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV