174 SUBROUTINE ztpqrt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
182 INTEGER INFO, LDA, LDB, LDT, N, M, L
185 COMPLEX*16 A( lda, * ), B( ldb, * ), T( ldt, * )
192 parameter( one = (1.0,0.0), zero = (0.0,0.0) )
195 INTEGER I, J, P, MP, NP
211 ELSE IF( n.LT.0 )
THEN
213 ELSE IF( l.LT.0 .OR. l.GT.min(m,n) )
THEN
215 ELSE IF( lda.LT.max( 1, n ) )
THEN
217 ELSE IF( ldb.LT.max( 1, m ) )
THEN
219 ELSE IF( ldt.LT.max( 1, n ) )
THEN
223 CALL
xerbla(
'ZTPQRT2', -info )
229 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
236 CALL
zlarfg( p+1, a( i, i ), b( 1, i ), 1, t( i, 1 ) )
242 t( j, n ) = conjg(a( i, i+j ))
244 CALL
zgemv(
'C', p, n-i, one, b( 1, i+1 ), ldb,
245 $ b( 1, i ), 1, one, t( 1, n ), 1 )
249 alpha = -conjg(t( i, 1 ))
251 a( i, i+j ) = a( i, i+j ) + alpha*conjg(t( j, n ))
253 CALL
zgerc( p, n-i, alpha, b( 1, i ), 1,
254 $ t( 1, n ), 1, b( 1, i+1 ), ldb )
274 t( j, i ) = alpha*b( m-l+j, i )
276 CALL
ztrmv(
'U',
'C',
'N', p, b( mp, 1 ), ldb,
281 CALL
zgemv(
'C', l, i-1-p, alpha, b( mp, np ), ldb,
282 $ b( mp, i ), 1, zero, t( np, i ), 1 )
286 CALL
zgemv(
'C', m-l, i-1, alpha, b, ldb, b( 1, i ), 1,
287 $ one, t( 1, i ), 1 )
291 CALL
ztrmv(
'U',
'N',
'N', i-1, t, ldt, t( 1, i ), 1 )
295 t( i, i ) = t( i, 1 )
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine ztpqrt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
ZTPQRT2 computes a QR 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 zgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERC
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).