139 SUBROUTINE dgeqpf( M, N, A, LDA, JPVT, TAU, WORK, INFO )
146 INTEGER INFO, LDA, M, N
150 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * )
156 DOUBLE PRECISION ZERO, ONE
157 parameter( zero = 0.0d+0, one = 1.0d+0 )
160 INTEGER I, ITEMP, J, MA, MN, PVT
161 DOUBLE PRECISION AII, TEMP, TEMP2, TOL3Z
167 INTRINSIC abs, max, min, sqrt
171 DOUBLE PRECISION DLAMCH, DNRM2
172 EXTERNAL idamax, dlamch, dnrm2
181 ELSE IF( n.LT.0 )
THEN
183 ELSE IF( lda.LT.max( 1, m ) )
THEN
187 CALL xerbla(
'DGEQPF', -info )
192 tol3z = sqrt(dlamch(
'Epsilon'))
198 IF( jpvt( i ).NE.0 )
THEN
199 IF( i.NE.itemp )
THEN
200 CALL dswap( m, a( 1, i ), 1, a( 1, itemp ), 1 )
201 jpvt( i ) = jpvt( itemp )
215 IF( itemp.GT.0 )
THEN
217 CALL dgeqr2( m, ma, a, lda, tau, work, info )
219 CALL dorm2r(
'Left',
'Transpose', m, n-ma, ma, a, lda,
220 $ tau, a( 1, ma+1 ), lda, work, info )
224 IF( itemp.LT.mn )
THEN
229 DO 20 i = itemp + 1, n
230 work( i ) = dnrm2( m-itemp, a( itemp+1, i ), 1 )
231 work( n+i ) = work( i )
236 DO 40 i = itemp + 1, mn
240 pvt = ( i-1 ) + idamax( n-i+1, work( i ), 1 )
243 CALL dswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
245 jpvt( pvt ) = jpvt( i )
247 work( pvt ) = work( i )
248 work( n+pvt ) = work( n+i )
254 CALL dlarfg( m-i+1, a( i, i ), a( i+1, i ), 1,
257 CALL dlarfg( 1, a( m, m ), a( m, m ), 1, tau( m ) )
266 CALL dlarf(
'LEFT', m-i+1, n-i, a( i, i ), 1,
267 $ tau( i ), a( i, i+1 ), lda, work( 2*n+1 ) )
274 IF( work( j ).NE.zero )
THEN
279 temp = abs( a( i, j ) ) / work( j )
280 temp = max( zero, ( one+temp )*( one-temp ) )
281 temp2 = temp*( work( j ) / work( n+j ) )**2
282 IF( temp2 .LE. tol3z )
THEN
284 work( j ) = dnrm2( m-i, a( i+1, j ), 1 )
285 work( n+j ) = work( j )
291 work( j ) = work( j )*sqrt( temp )
subroutine dgeqr2(m, n, a, lda, tau, work, info)
DGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
subroutine dlarf(side, m, n, v, incv, tau, c, ldc, work)
DLARF applies an elementary reflector to a general rectangular matrix.
subroutine dlarfg(n, alpha, x, incx, tau)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dorm2r(side, trans, m, n, k, a, lda, tau, c, ldc, work, info)
DORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sge...