185 SUBROUTINE zggglm( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
194 INTEGER info, lda, ldb, lwork, m, n, p
197 COMPLEX*16 a( lda, * ),
b( ldb, * ), d( * ), work( * ),
204 COMPLEX*16 czero, cone
205 parameter( czero = ( 0.0d+0, 0.0d+0 ),
206 $ cone = ( 1.0d+0, 0.0d+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,
'ZGEQRF',
' ', n, m, -1, -1 )
251 nb2 =
ilaenv( 1,
'ZGERQF',
' ', n, m, -1, -1 )
252 nb3 =
ilaenv( 1,
'ZUNMQR',
' ', n, m, p, -1 )
253 nb4 =
ilaenv( 1,
'ZUNMRQ',
' ', 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(
'ZGGGLM', -info )
268 ELSE IF( lquery )
THEN
286 CALL
zggqrf( 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
zunmqr(
'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
ztrtrs(
'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
zcopy( n-m, d( m+1 ), 1, y( m+p-n+1 ), 1 )
313 DO 10 i = 1, m + p - n
319 CALL
zgemv(
'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
ztrtrs(
'Upper',
'No Transpose',
'Non unit', m, 1, a, lda,
335 CALL
zcopy( m, d, 1, x, 1 )
340 CALL
zunmrq(
'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 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 zggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
ZGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine zggqrf(N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
ZGGQRF
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 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)