174 SUBROUTINE stpqrt2( M, N, L, A, LDA, B, LDB, T, LDT, INFO )
182 INTEGER info, lda, ldb, ldt, n, m, l
185 REAL a( lda, * ),
b( ldb, * ), t( ldt, * )
192 parameter( one = 1.0, zero = 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(
'STPQRT2', -info )
229 IF( n.EQ.0 .OR. m.EQ.0 )
RETURN
236 CALL
slarfg( p+1, a( i, i ),
b( 1, i ), 1, t( i, 1 ) )
242 t(
j, n ) = (a( i, i+
j ))
244 CALL
sgemv(
'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
sger( 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
strmv(
'U',
'T',
'N', p,
b( mp, 1 ), ldb,
281 CALL
sgemv(
'T', l, i-1-p, alpha,
b( mp, np ), ldb,
282 $
b( mp, i ), 1, zero, t( np, i ), 1 )
286 CALL
sgemv(
'T', m-l, i-1, alpha,
b, ldb,
b( 1, i ), 1,
287 $ one, t( 1, i ), 1 )
291 CALL
strmv(
'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 strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine stpqrt2(M, N, L, A, LDA, B, LDB, T, LDT, INFO)
STPQRT2 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 sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER