178 SUBROUTINE ztplqt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
186 INTEGER INFO, LDA, LDB, LDT, N, M, L
189 COMPLEX*16 A( lda, * ), B( ldb, * ), T( ldt, * )
196 parameter( zero = ( 0.0d+0, 0.0d+0 ),one = ( 1.0d+0, 0.0d+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(
'ZTPLQT2', -info )
233 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
240 CALL zlarfg( p+1, a( i, i ), b( i, 1 ), ldb, t( 1, i ) )
244 b( i, j ) = conjg(b(i,j))
250 t( m, j ) = (a( i+j, i ))
252 CALL zgemv(
'N', m-i, p, one, b( i+1, 1 ), ldb,
253 $ b( i, 1 ), ldb, one, t( m, 1 ), ldt )
259 a( i+j, i ) = a( i+j, i ) + alpha*(t( m, j ))
261 CALL zgerc( m-i, p, (alpha), t( m, 1 ), ldt,
262 $ b( i, 1 ), ldb, b( i+1, 1 ), ldb )
264 b( i, j ) = conjg(b(i,j))
287 t( i, j ) = (alpha*b( i, n-l+j ))
289 CALL ztrmv(
'L',
'N',
'N', p, b( 1, np ), ldb,
294 CALL zgemv(
'N', i-1-p, l, alpha, b( mp, np ), ldb,
295 $ b( i, np ), ldb, zero, t( i,mp ), ldt )
300 CALL zgemv(
'N', i-1, n-l, alpha, b, ldb, b( i, 1 ), ldb,
301 $ one, t( i, 1 ), ldt )
310 CALL ztrmv(
'L',
'C',
'N', i-1, t, ldt, t( i, 1 ), ldt )
320 t( i, i ) = t( 1, i )
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERC
subroutine ztplqt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
ZTPLQT2 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 xerbla(SRNAME, INFO)
XERBLA
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).