LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
subroutine sgeqpf ( integer  M,
integer  N,
real, dimension( lda, * )  A,
integer  LDA,
integer, dimension( * )  JPVT,
real, dimension( * )  TAU,
real, dimension( * )  WORK,
integer  INFO 
)

SGEQPF

Download SGEQPF + dependencies [TGZ] [ZIP] [TXT]

Purpose: 
 This routine is deprecated and has been replaced by routine SGEQP3.

 SGEQPF computes a QR factorization with column pivoting of a
 real M-by-N matrix A: A*P = Q*R.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrix A. M >= 0.
[in]N
          N is INTEGER
          The number of columns of the matrix A. N >= 0
[in,out]A
          A is REAL array, dimension (LDA,N)
          On entry, the M-by-N matrix A.
          On exit, the upper triangle of the array contains the
          min(M,N)-by-N upper triangular matrix R; the elements
          below the diagonal, together with the array TAU,
          represent the orthogonal matrix Q as a product of
          min(m,n) elementary reflectors.
[in]LDA
          LDA is INTEGER
          The leading dimension of the array A. LDA >= max(1,M).
[in,out]JPVT
          JPVT is INTEGER array, dimension (N)
          On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted
          to the front of A*P (a leading column); if JPVT(i) = 0,
          the i-th column of A is a free column.
          On exit, if JPVT(i) = k, then the i-th column of A*P
          was the k-th column of A.
[out]TAU
          TAU is REAL array, dimension (min(M,N))
          The scalar factors of the elementary reflectors.
[out]WORK
          WORK is REAL array, dimension (3*N)
[out]INFO
          INFO is INTEGER
          = 0:  successful exit
          < 0:  if INFO = -i, the i-th argument had an illegal value
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.
Date
November 2011
Further Details: 
  The matrix Q is represented as a product of elementary reflectors

     Q = H(1) H(2) . . . H(n)

  Each H(i) has the form

     H = I - tau * v * v**T

  where tau is a real scalar, and v is a real vector with
  v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i).

  The matrix P is represented in jpvt as follows: If
     jpvt(j) = i
  then the jth column of P is the ith canonical unit vector.

  Partial column norm updating strategy modified by
    Z. Drmac and Z. Bujanovic, Dept. of Mathematics,
    University of Zagreb, Croatia.
  -- April 2011                                                      --
  For more details see LAPACK Working Note 176.

Definition at line 144 of file sgeqpf.f.

144 *
145 * -- LAPACK computational routine (version 3.4.0) --
146 * -- LAPACK is a software package provided by Univ. of Tennessee, --
147 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
148 * November 2011
149 *
150 * .. Scalar Arguments ..
151  INTEGER info, lda, m, n
152 * ..
153 * .. Array Arguments ..
154  INTEGER jpvt( * )
155  REAL a( lda, * ), tau( * ), work( * )
156 * ..
157 *
158 * =====================================================================
159 *
160 * .. Parameters ..
161  REAL zero, one
162  parameter ( zero = 0.0e+0, one = 1.0e+0 )
163 * ..
164 * .. Local Scalars ..
165  INTEGER i, itemp, j, ma, mn, pvt
166  REAL aii, temp, temp2, tol3z
167 * ..
168 * .. External Subroutines ..
169  EXTERNAL sgeqr2, slarf, slarfg, sorm2r, sswap, xerbla
170 * ..
171 * .. Intrinsic Functions ..
172  INTRINSIC abs, max, min, sqrt
173 * ..
174 * .. External Functions ..
175  INTEGER isamax
176  REAL slamch, snrm2
177  EXTERNAL isamax, slamch, snrm2
178 * ..
179 * .. Executable Statements ..
180 *
181 * Test the input arguments
182 *
183  info = 0
184  IF( m.LT.0 ) THEN
185  info = -1
186  ELSE IF( n.LT.0 ) THEN
187  info = -2
188  ELSE IF( lda.LT.max( 1, m ) ) THEN
189  info = -4
190  END IF
191  IF( info.NE.0 ) THEN
192  CALL xerbla( 'SGEQPF', -info )
193  RETURN
194  END IF
195 *
196  mn = min( m, n )
197  tol3z = sqrt(slamch('Epsilon'))
198 *
199 * Move initial columns up front
200 *
201  itemp = 1
202  DO 10 i = 1, n
203  IF( jpvt( i ).NE.0 ) THEN
204  IF( i.NE.itemp ) THEN
205  CALL sswap( m, a( 1, i ), 1, a( 1, itemp ), 1 )
206  jpvt( i ) = jpvt( itemp )
207  jpvt( itemp ) = i
208  ELSE
209  jpvt( i ) = i
210  END IF
211  itemp = itemp + 1
212  ELSE
213  jpvt( i ) = i
214  END IF
215  10 CONTINUE
216  itemp = itemp - 1
217 *
218 * Compute the QR factorization and update remaining columns
219 *
220  IF( itemp.GT.0 ) THEN
221  ma = min( itemp, m )
222  CALL sgeqr2( m, ma, a, lda, tau, work, info )
223  IF( ma.LT.n ) THEN
224  CALL sorm2r( 'Left', 'Transpose', m, n-ma, ma, a, lda, tau,
225  $ a( 1, ma+1 ), lda, work, info )
226  END IF
227  END IF
228 *
229  IF( itemp.LT.mn ) THEN
230 *
231 * Initialize partial column norms. The first n elements of
232 * work store the exact column norms.
233 *
234  DO 20 i = itemp + 1, n
235  work( i ) = snrm2( m-itemp, a( itemp+1, i ), 1 )
236  work( n+i ) = work( i )
237  20 CONTINUE
238 *
239 * Compute factorization
240 *
241  DO 40 i = itemp + 1, mn
242 *
243 * Determine ith pivot column and swap if necessary
244 *
245  pvt = ( i-1 ) + isamax( n-i+1, work( i ), 1 )
246 *
247  IF( pvt.NE.i ) THEN
248  CALL sswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
249  itemp = jpvt( pvt )
250  jpvt( pvt ) = jpvt( i )
251  jpvt( i ) = itemp
252  work( pvt ) = work( i )
253  work( n+pvt ) = work( n+i )
254  END IF
255 *
256 * Generate elementary reflector H(i)
257 *
258  IF( i.LT.m ) THEN
259  CALL slarfg( m-i+1, a( i, i ), a( i+1, i ), 1, tau( i ) )
260  ELSE
261  CALL slarfg( 1, a( m, m ), a( m, m ), 1, tau( m ) )
262  END IF
263 *
264  IF( i.LT.n ) THEN
265 *
266 * Apply H(i) to A(i:m,i+1:n) from the left
267 *
268  aii = a( i, i )
269  a( i, i ) = one
270  CALL slarf( 'LEFT', m-i+1, n-i, a( i, i ), 1, tau( i ),
271  $ a( i, i+1 ), lda, work( 2*n+1 ) )
272  a( i, i ) = aii
273  END IF
274 *
275 * Update partial column norms
276 *
277  DO 30 j = i + 1, n
278  IF( work( j ).NE.zero ) THEN
279 *
280 * NOTE: The following 4 lines follow from the analysis in
281 * Lapack Working Note 176.
282 *
283  temp = abs( a( i, j ) ) / work( j )
284  temp = max( zero, ( one+temp )*( one-temp ) )
285  temp2 = temp*( work( j ) / work( n+j ) )**2
286  IF( temp2 .LE. tol3z ) THEN
287  IF( m-i.GT.0 ) THEN
288  work( j ) = snrm2( m-i, a( i+1, j ), 1 )
289  work( n+j ) = work( j )
290  ELSE
291  work( j ) = zero
292  work( n+j ) = zero
293  END IF
294  ELSE
295  work( j ) = work( j )*sqrt( temp )
296  END IF
297  END IF
298  30 CONTINUE
299 *
300  40 CONTINUE
301  END IF
302  RETURN
303 *
304 * End of SGEQPF
305 *
slarfg
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).
Definition: slarfg.f:108
isamax
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:53
xerbla
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:62
sgeqr2
subroutine sgeqr2(M, N, A, LDA, TAU, WORK, INFO)
SGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm...
Definition: sgeqr2.f:123
snrm2
real function snrm2(N, X, INCX)
SNRM2
Definition: snrm2.f:56
sorm2r
subroutine sorm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
SORM2R multiplies a general matrix by the orthogonal matrix from a QR factorization determined by sge...
Definition: sorm2r.f:161
slarf
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
Definition: slarf.f:126
sswap
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
Definition: sswap.f:53
slamch
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:69

Here is the call graph for this function:

Here is the caller graph for this function: