174 SUBROUTINE ctpqrt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
182 INTEGER info, lda, ldb, ldt, n, m, l
185 COMPLEX 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(
'CTPQRT2', -info )
229 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
236 CALL
clarfg( p+1, a( i, i ),
b( 1, i ), 1, t( i, 1 ) )
242 t(
j, n ) = conjg(a( i, i+
j ))
244 CALL
cgemv(
'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
cgerc( 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
ctrmv(
'U',
'C',
'N', p,
b( mp, 1 ), ldb,
281 CALL
cgemv(
'C', l, i-1-p, alpha,
b( mp, np ), ldb,
282 $
b( mp, i ), 1, zero, t( np, i ), 1 )
286 CALL
cgemv(
'C', m-l, i-1, alpha,
b, ldb,
b( 1, i ), 1,
287 $ one, t( 1, i ), 1 )
291 CALL
ctrmv(
'U',
'N',
'N', i-1, t, ldt, t( 1, i ), 1 )
295 t( i, i ) = t( i, 1 )
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ctpqrt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
CTPQRT2 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 ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
subroutine cgerc(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
CGERC