185 SUBROUTINE sggglm( N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK,
194 INTEGER INFO, LDA, LDB, LWORK, M, N, P
197 REAL A( lda, * ), B( ldb, * ), D( * ), WORK( * ),
205 parameter( zero = 0.0e+0, one = 1.0e+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,
'SGEQRF',
' ', n, m, -1, -1 )
250 nb2 = ilaenv( 1,
'SGERQF',
' ', n, m, -1, -1 )
251 nb3 = ilaenv( 1,
'SORMQR',
' ', n, m, p, -1 )
252 nb4 = ilaenv( 1,
'SORMRQ',
' ', 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(
'SGGGLM', -info )
267 ELSE IF( lquery )
THEN
285 CALL
sggqrf( 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
sormqr(
'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
strtrs(
'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
scopy( n-m, d( m+1 ), 1, y( m+p-n+1 ), 1 )
312 DO 10 i = 1, m + p - n
318 CALL
sgemv(
'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
strtrs(
'Upper',
'No Transpose',
'Non unit', m, 1, a, lda,
334 CALL
scopy( m, d, 1, x, 1 )
339 CALL
sormrq(
'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 sormqr(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMQR
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine sggglm(N, M, P, A, LDA, B, LDB, D, X, Y, WORK, LWORK, INFO)
SGGEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for GE matrices ...
subroutine sormrq(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMRQ
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine strtrs(UPLO, TRANS, DIAG, N, NRHS, A, LDA, B, LDB, INFO)
STRTRS
subroutine sggqrf(N, M, P, A, LDA, TAUA, B, LDB, TAUB, WORK, LWORK, INFO)
SGGQRF