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 zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
subroutine zgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZGERC
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 xerbla(SRNAME, INFO)
XERBLA
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV