185 SUBROUTINE dggglm( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
194 INTEGER INFO, LDA, LDB, LWORK, M, N, P
197 DOUBLE PRECISION A( lda, * ), B( ldb, * ), D( * ), WORK( * ),
204 DOUBLE PRECISION ZERO, ONE
205 parameter( zero = 0.0d+0, one = 1.0d+0 )
209 INTEGER I, LOPT, LWKMIN, LWKOPT, NB, NB1, NB2, NB3,
221 INTRINSIC int, max, min
229 lquery = ( lwork.EQ.-1 )
232 ELSE IF( m.LT.0 .OR. m.GT.n )
THEN
234 ELSE IF( p.LT.0 .OR. p.LT.n-m )
THEN
236 ELSE IF( lda.LT.max( 1, n ) )
THEN
238 ELSE IF( ldb.LT.max( 1, n ) )
THEN
249 nb1 = ilaenv( 1,
'DGEQRF',
' ', n, m, -1, -1 )
250 nb2 = ilaenv( 1,
'DGERQF',
' ', n, m, -1, -1 )
251 nb3 = ilaenv( 1,
'DORMQR',
' ', n, m, p, -1 )
252 nb4 = ilaenv( 1,
'DORMRQ',
' ', n, m, p, -1 )
253 nb = max( nb1, nb2, nb3, nb4 )
255 lwkopt = m + np + max( n, p )*nb
259 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
THEN
265 CALL
xerbla(
'DGGGLM', -info )
267 ELSE IF( lquery )
THEN
285 CALL
dggqrf( n, m, p, a, lda, work, b, ldb, work( m+1 ),
286 $ work( m+np+1 ), lwork-m-np, info )
287 lopt = work( m+np+1 )
292 CALL
dormqr(
'Left',
'Transpose', n, 1, m, a, lda, work, d,
293 $ max( 1, n ), work( m+np+1 ), lwork-m-np, info )
294 lopt = max( lopt, int( work( m+np+1 ) ) )
299 CALL
dtrtrs(
'Upper',
'No transpose',
'Non unit', n-m, 1,
300 $ b( m+1, m+p-n+1 ), ldb, d( m+1 ), n-m, info )
307 CALL
dcopy( n-m, d( m+1 ), 1, y( m+p-n+1 ), 1 )
312 DO 10 i = 1, m + p - n
318 CALL
dgemv(
'No transpose', m, n-m, -one, b( 1, m+p-n+1 ), ldb,
319 $ y( m+p-n+1 ), 1, one, d, 1 )
324 CALL
dtrtrs(
'Upper',
'No Transpose',
'Non unit', m, 1, a, lda,
334 CALL
dcopy( m, d, 1, x, 1 )
339 CALL
dormrq(
'Left',
'Transpose', p, 1, np,
340 $ b( max( 1, n-p+1 ), 1 ), ldb, work( m+1 ), y,
341 $ max( 1, p ), work( m+np+1 ), lwork-m-np, info )
342 work( 1 ) = m + np + max( lopt, int( work( m+np+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 dormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dtrtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
DTRTRS
subroutine dggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
DGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine dggqrf(N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
DGGQRF
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV