178 SUBROUTINE stplqt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
186 INTEGER INFO, LDA, LDB, LDT, N, M, L
189 REAL A( lda, * ), B( ldb, * ), T( ldt, * )
196 parameter( one = 1.0, zero = 0.0 )
199 INTEGER I, J, P, MP, NP
215 ELSE IF( n.LT.0 )
THEN
217 ELSE IF( l.LT.0 .OR. l.GT.min(m,n) )
THEN
219 ELSE IF( lda.LT.max( 1, m ) )
THEN
221 ELSE IF( ldb.LT.max( 1, m ) )
THEN
223 ELSE IF( ldt.LT.max( 1, m ) )
THEN
227 CALL xerbla(
'STPLQT2', -info )
233 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
240 CALL slarfg( p+1, a( i, i ), b( i, 1 ), ldb, t( 1, i ) )
246 t( m, j ) = (a( i+j, i ))
248 CALL sgemv(
'N', m-i, p, one, b( i+1, 1 ), ldb,
249 $ b( i, 1 ), ldb, one, t( m, 1 ), ldt )
255 a( i+j, i ) = a( i+j, i ) + alpha*(t( m, j ))
257 CALL sger( m-i, p, alpha, t( m, 1 ), ldt,
258 $ b( i, 1 ), ldb, b( i+1, 1 ), ldb )
278 t( i, j ) = alpha*b( i, n-l+j )
280 CALL strmv(
'L',
'N',
'N', p, b( 1, np ), ldb,
285 CALL sgemv(
'N', i-1-p, l, alpha, b( mp, np ), ldb,
286 $ b( i, np ), ldb, zero, t( i,mp ), ldt )
290 CALL sgemv(
'N', i-1, n-l, alpha, b, ldb, b( i, 1 ), ldb,
291 $ one, t( i, 1 ), ldt )
295 CALL strmv(
'L',
'T',
'N', i-1, t, ldt, t( i, 1 ), ldt )
299 t( i, i ) = t( 1, i )
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine stplqt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
STPLQT2 computes a LQ factorization of a real or complex "triangular-pentagonal" matrix, which is composed of a triangular block and a pentagonal block, using the compact WY representation for Q.
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).