191 SUBROUTINE sggglm( N, M, P, A, LDA, B, LDB, D, X, Y, WORK,
200 INTEGER INFO, LDA, LDB, LWORK, M, N, P
203 REAL A( LDA, * ), B( LDB, * ), D( * ), WORK( * ),
211 PARAMETER ( ZERO = 0.0e+0, one = 1.0e+0 )
215 INTEGER I, LOPT, LWKMIN, LWKOPT, NB, NB1, NB2, NB3,
226 EXTERNAL ilaenv, sroundup_lwork
229 INTRINSIC int, max, min
237 lquery = ( lwork.EQ.-1 )
240 ELSE IF( m.LT.0 .OR. m.GT.n )
THEN
242 ELSE IF( p.LT.0 .OR. p.LT.n-m )
THEN
244 ELSE IF( lda.LT.max( 1, n ) )
THEN
246 ELSE IF( ldb.LT.max( 1, n ) )
THEN
257 nb1 = ilaenv( 1,
'SGEQRF',
' ', n, m, -1, -1 )
258 nb2 = ilaenv( 1,
'SGERQF',
' ', n, m, -1, -1 )
259 nb3 = ilaenv( 1,
'SORMQR',
' ', n, m, p, -1 )
260 nb4 = ilaenv( 1,
'SORMRQ',
' ', n, m, p, -1 )
261 nb = max( nb1, nb2, nb3, nb4 )
263 lwkopt = m + np + max( n, p )*nb
265 work( 1 ) = sroundup_lwork(lwkopt)
267 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
THEN
273 CALL xerbla(
'SGGGLM', -info )
275 ELSE IF( lquery )
THEN
300 CALL sggqrf( n, m, p, a, lda, work, b, ldb, work( m+1 ),
301 $ work( m+np+1 ), lwork-m-np, info )
302 lopt = int( work( m+np+1 ) )
307 CALL sormqr(
'Left',
'Transpose', n, 1, m, a, lda, work, d,
308 $ max( 1, n ), work( m+np+1 ), lwork-m-np, info )
309 lopt = max( lopt, int( work( m+np+1 ) ) )
314 CALL strtrs(
'Upper',
'No transpose',
'Non unit', n-m, 1,
315 $ b( m+1, m+p-n+1 ), ldb, d( m+1 ), n-m, info )
322 CALL scopy( n-m, d( m+1 ), 1, y( m+p-n+1 ), 1 )
327 DO 10 i = 1, m + p - n
333 CALL sgemv(
'No transpose', m, n-m, -one, b( 1, m+p-n+1 ), ldb,
334 $ y( m+p-n+1 ), 1, one, d, 1 )
339 CALL strtrs(
'Upper',
'No Transpose',
'Non unit', m, 1, a,
350 CALL scopy( m, d, 1, x, 1 )
355 CALL sormrq(
'Left',
'Transpose', p, 1, np,
356 $ b( max( 1, n-p+1 ), 1 ), ldb, work( m+1 ), y,
357 $ max( 1, p ), work( m+np+1 ), lwork-m-np, info )
358 work( 1 ) = real( m + np + max( lopt, int( work( m+np+1 ) ) ) )
subroutine sggglm(n, m, p, a, lda, b, ldb, d, x, y, work, lwork, info)
SGGGLM
subroutine sggqrf(n, m, p, a, lda, taua, b, ldb, taub, work, lwork, info)
SGGQRF
subroutine sormqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMQR
subroutine sormrq(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
SORMRQ