174 SUBROUTINE dtpqrt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
182 INTEGER info, lda, ldb, ldt, n, m, l
185 DOUBLE PRECISION a( lda, * ),
b( ldb, * ), t( ldt, * )
191 DOUBLE PRECISION one, zero
192 parameter( one = 1.0, zero = 0.0 )
195 INTEGER i,
j, p, mp, np
196 DOUBLE PRECISION alpha
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(
'DTPQRT2', -info )
229 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
236 CALL
dlarfg( p+1, a( i, i ),
b( 1, i ), 1, t( i, 1 ) )
242 t(
j, n ) = (a( i, i+
j ))
244 CALL
dgemv(
'T', p, n-i, one,
b( 1, i+1 ), ldb,
245 $
b( 1, i ), 1, one, t( 1, n ), 1 )
251 a( i, i+
j ) = a( i, i+
j ) + alpha*(t(
j, n ))
253 CALL
dger( 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
dtrmv(
'U',
'T',
'N', p,
b( mp, 1 ), ldb,
281 CALL
dgemv(
'T', l, i-1-p, alpha,
b( mp, np ), ldb,
282 $
b( mp, i ), 1, zero, t( np, i ), 1 )
286 CALL
dgemv(
'T', m-l, i-1, alpha,
b, ldb,
b( 1, i ), 1,
287 $ one, t( 1, i ), 1 )
291 CALL
dtrmv(
'U',
'N',
'N', i-1, t, ldt, t( 1, i ), 1 )
295 t( i, i ) = t( i, 1 )
subroutine dger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
DGER
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
DLARFG generates an elementary reflector (Householder matrix).
subroutine xerbla(SRNAME, INFO)
XERBLA
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real b(3) integer i
subroutine dtpqrt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
DTPQRT2 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.
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
subroutine dtrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
DTRMV