178 SUBROUTINE dtplqt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
186 INTEGER INFO, LDA, LDB, LDT, N, M, L
189 DOUBLE PRECISION A( lda, * ), B( ldb, * ), T( ldt, * )
195 DOUBLE PRECISION ONE, ZERO
196 parameter( one = 1.0, zero = 0.0 )
199 INTEGER I, J, P, MP, NP
200 DOUBLE PRECISION ALPHA
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(
'DTPLQT2', -info )
233 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
240 CALL dlarfg( p+1, a( i, i ), b( i, 1 ), ldb, t( 1, i ) )
246 t( m, j ) = (a( i+j, i ))
248 CALL dgemv(
'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 dger( 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 dtrmv(
'L',
'N',
'N', p, b( 1, np ), ldb,
285 CALL dgemv(
'N', i-1-p, l, alpha, b( mp, np ), ldb,
286 $ b( i, np ), ldb, zero, t( i,mp ), ldt )
290 CALL dgemv(
'N', i-1, n-l, alpha, b, ldb, b( i, 1 ), ldb,
291 $ one, t( i, 1 ), ldt )
295 CALL dtrmv(
'L',
'T',
'N', i-1, t, ldt, t( i, 1 ), ldt )
299 t( i, i ) = t( 1, i )
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dtplqt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
DTPLQT2 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 dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRMV