133 RECURSIVE SUBROUTINE sgeqrt3( M, N, A, LDA, T, LDT, INFO )
141 INTEGER info, lda, m, n, ldt
144 REAL a( lda, * ), t( ldt, * )
151 parameter( one = 1.0 )
154 INTEGER i, i1,
j, j1, n1, n2, iinfo
164 ELSE IF( m .LT. n )
THEN
166 ELSE IF( lda .LT. max( 1, m ) )
THEN
168 ELSE IF( ldt .LT. max( 1, n ) )
THEN
172 CALL
xerbla(
'SGEQRT3', -info )
180 CALL
slarfg( m, a, a( min( 2, m ), 1 ), 1, t )
193 CALL
sgeqrt3( m, n1, a, lda, t, ldt, iinfo )
199 t( i,
j+n1 ) = a( i,
j+n1 )
202 CALL
strmm(
'L',
'L',
'T',
'U', n1, n2, one,
203 & a, lda, t( 1, j1 ), ldt )
205 CALL
sgemm(
'T',
'N', n1, n2, m-n1, one, a( j1, 1 ), lda,
206 & a( j1, j1 ), lda, one, t( 1, j1 ), ldt)
208 CALL
strmm(
'L',
'U',
'T',
'N', n1, n2, one,
209 & t, ldt, t( 1, j1 ), ldt )
211 CALL
sgemm(
'N',
'N', m-n1, n2, n1, -one, a( j1, 1 ), lda,
212 & t( 1, j1 ), ldt, one, a( j1, j1 ), lda )
214 CALL
strmm(
'L',
'L',
'N',
'U', n1, n2, one,
215 & a, lda, t( 1, j1 ), ldt )
219 a( i,
j+n1 ) = a( i,
j+n1 ) - t( i,
j+n1 )
225 CALL
sgeqrt3( m-n1, n2, a( j1, j1 ), lda,
226 & t( j1, j1 ), ldt, iinfo )
232 t( i,
j+n1 ) = (a(
j+n1, i ))
236 CALL
strmm(
'R',
'L',
'N',
'U', n1, n2, one,
237 & a( j1, j1 ), lda, t( 1, j1 ), ldt )
239 CALL
sgemm(
'T',
'N', n1, n2, m-n, one, a( i1, 1 ), lda,
240 & a( i1, j1 ), lda, one, t( 1, j1 ), ldt )
242 CALL
strmm(
'L',
'U',
'N',
'N', n1, n2, -one, t, ldt,
245 CALL
strmm(
'R',
'U',
'N',
'N', n1, n2, one,
246 & t( j1, j1 ), ldt, t( 1, j1 ), ldt )
subroutine xerbla(SRNAME, INFO)
XERBLA
recursive subroutine sgeqrt3(M, N, A, LDA, T, LDT, INFO)
SGEQRT3 recursively computes a QR factorization of a general real or complex matrix using the compact...
subroutine strmm(SIDE, UPLO, TRANSA, DIAG, M, N, ALPHA, A, LDA, B, LDB)
STRMM
subroutine sgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
SGEMM
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