161 SUBROUTINE ctplqt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
169 INTEGER INFO, LDA, LDB, LDT, N, M, L
172 COMPLEX A( lda, * ), B( ldb, * ), T( ldt, * )
179 parameter( zero = ( 0.0e+0, 0.0e+0 ),one = ( 1.0e+0, 0.0e+0 ) )
182 INTEGER I, J, P, MP, NP
198 ELSE IF( n.LT.0 )
THEN
200 ELSE IF( l.LT.0 .OR. l.GT.min(m,n) )
THEN
202 ELSE IF( lda.LT.max( 1, m ) )
THEN
204 ELSE IF( ldb.LT.max( 1, m ) )
THEN
206 ELSE IF( ldt.LT.max( 1, m ) )
THEN
210 CALL xerbla(
'CTPLQT2', -info )
216 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
223 CALL clarfg( p+1, a( i, i ), b( i, 1 ), ldb, t( 1, i ) )
227 b( i, j ) = conjg(b(i,j))
233 t( m, j ) = (a( i+j, i ))
235 CALL cgemv(
'N', m-i, p, one, b( i+1, 1 ), ldb,
236 $ b( i, 1 ), ldb, one, t( m, 1 ), ldt )
242 a( i+j, i ) = a( i+j, i ) + alpha*(t( m, j ))
244 CALL cgerc( m-i, p, (alpha), t( m, 1 ), ldt,
245 $ b( i, 1 ), ldb, b( i+1, 1 ), ldb )
247 b( i, j ) = conjg(b(i,j))
270 t( i, j ) = (alpha*b( i, n-l+j ))
272 CALL ctrmv(
'L',
'N',
'N', p, b( 1, np ), ldb,
277 CALL cgemv(
'N', i-1-p, l, alpha, b( mp, np ), ldb,
278 $ b( i, np ), ldb, zero, t( i,mp ), ldt )
283 CALL cgemv(
'N', i-1, n-l, alpha, b, ldb, b( i, 1 ), ldb,
284 $ one, t( i, 1 ), ldt )
293 CALL ctrmv(
'L',
'C',
'N', i-1, t, ldt, t( i, 1 ), ldt )
303 t( i, i ) = t( 1, i )
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERC
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
subroutine ctplqt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)