185 SUBROUTINE cggglm( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
194 INTEGER info, lda, ldb, lwork, m, n, p
197 COMPLEX a( lda, * ),
b( ldb, * ), d( * ), work( * ),
205 parameter( czero = ( 0.0e+0, 0.0e+0 ),
206 $ cone = ( 1.0e+0, 0.0e+0 ) )
210 INTEGER i, lopt, lwkmin, lwkopt, nb, nb1, nb2, nb3,
222 INTRINSIC int, max, min
230 lquery = ( lwork.EQ.-1 )
233 ELSE IF( m.LT.0 .OR. m.GT.n )
THEN
235 ELSE IF( p.LT.0 .OR. p.LT.n-m )
THEN
237 ELSE IF( lda.LT.max( 1, n ) )
THEN
239 ELSE IF( ldb.LT.max( 1, n ) )
THEN
250 nb1 =
ilaenv( 1,
'CGEQRF',
' ', n, m, -1, -1 )
251 nb2 =
ilaenv( 1,
'CGERQF',
' ', n, m, -1, -1 )
252 nb3 =
ilaenv( 1,
'CUNMQR',
' ', n, m, p, -1 )
253 nb4 =
ilaenv( 1,
'CUNMRQ',
' ', n, m, p, -1 )
254 nb = max( nb1, nb2, nb3, nb4 )
256 lwkopt = m + np + max( n, p )*nb
260 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
THEN
266 CALL
xerbla(
'CGGGLM', -info )
268 ELSE IF( lquery )
THEN
286 CALL
cggqrf( n, m, p, a, lda, work,
b, ldb, work( m+1 ),
287 $ work( m+np+1 ), lwork-m-np, info )
288 lopt = work( m+np+1 )
293 CALL
cunmqr(
'Left',
'Conjugate transpose', n, 1, m, a, lda, work,
294 $ d, max( 1, n ), work( m+np+1 ), lwork-m-np, info )
295 lopt = max( lopt, int( work( m+np+1 ) ) )
300 CALL
ctrtrs(
'Upper',
'No transpose',
'Non unit', n-m, 1,
301 $
b( m+1, m+p-n+1 ), ldb, d( m+1 ), n-m, info )
308 CALL
ccopy( n-m, d( m+1 ), 1, y( m+p-n+1 ), 1 )
313 DO 10 i = 1, m + p - n
319 CALL
cgemv(
'No transpose', m, n-m, -cone,
b( 1, m+p-n+1 ), ldb,
320 $ y( m+p-n+1 ), 1, cone, d, 1 )
325 CALL
ctrtrs(
'Upper',
'No Transpose',
'Non unit', m, 1, a, lda,
335 CALL
ccopy( m, d, 1, x, 1 )
340 CALL
cunmrq(
'Left',
'Conjugate transpose', p, 1, np,
341 $
b( max( 1, n-p+1 ), 1 ), ldb, work( m+1 ), y,
342 $ max( 1, p ), work( m+np+1 ), lwork-m-np, info )
343 work( 1 ) = m + np + max( lopt, int( work( m+np+1 ) ) )
subroutine cunmrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
CUNMRQ
subroutine cggqrf(N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
CGGQRF
subroutine cggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
CGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine xerbla(SRNAME, INFO)
XERBLA
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 ccopy(N, CX, INCX, CY, INCY)
CCOPY
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)