138 SUBROUTINE sgeqrt( M, N, NB, A, LDA, T, LDT, WORK, INFO )
145 INTEGER INFO, LDA, LDT, M, N, NB
148 REAL A( LDA, * ), T( LDT, * ), WORK( * )
155 INTEGER I, IB, IINFO, K
156 LOGICAL USE_RECURSIVE_QR
157 parameter( use_recursive_qr=.true. )
169 ELSE IF( n.LT.0 )
THEN
171 ELSE IF( nb.LT.1 .OR. ( nb.GT.min(m,n) .AND. min(m,n).GT.0 ) )
THEN
173 ELSE IF( lda.LT.max( 1, m ) )
THEN
175 ELSE IF( ldt.LT.nb )
THEN
179 CALL xerbla(
'SGEQRT', -info )
191 ib = min( k-i+1, nb )
195 IF( use_recursive_qr )
THEN
196 CALL sgeqrt3( m-i+1, ib, a(i,i), lda, t(1,i), ldt,
199 CALL sgeqrt2( m-i+1, ib, a(i,i), lda, t(1,i), ldt,
206 CALL slarfb(
'L',
'T',
'F',
'C', m-i+1, n-i-ib+1, ib,
207 $ a( i, i ), lda, t( 1, i ), ldt,
208 $ a( i, i+ib ), lda, work , n-i-ib+1 )
subroutine sgeqrt2(m, n, a, lda, t, ldt, info)
SGEQRT2 computes a QR factorization of a general real or complex matrix using the compact WY represen...
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 sgeqrt(m, n, nb, a, lda, t, ldt, work, info)
SGEQRT
subroutine slarfb(side, trans, direct, storev, m, n, k, v, ldv, t, ldt, c, ldc, work, ldwork)
SLARFB applies a block reflector or its transpose to a general rectangular matrix.