 LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

◆ zgeqpf()

 subroutine zgeqpf ( integer M, integer N, complex*16, dimension( lda, * ) A, integer LDA, integer, dimension( * ) JPVT, complex*16, dimension( * ) TAU, complex*16, dimension( * ) WORK, double precision, dimension( * ) RWORK, integer INFO )

ZGEQPF

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

ZGEQPF computes a QR factorization with column pivoting of a
complex 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 COMPLEX*16 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 unitary 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 COMPLEX*16 array, dimension (min(M,N)) The scalar factors of the elementary reflectors. [out] WORK WORK is COMPLEX*16 array, dimension (N) [out] RWORK RWORK is DOUBLE PRECISION array, dimension (2*N) [out] INFO INFO is INTEGER = 0: successful exit < 0: if INFO = -i, the i-th argument had an illegal value
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**H

where tau is a complex scalar, and v is a complex 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 147 of file zgeqpf.f.

148 *
149 * -- LAPACK computational routine --
150 * -- LAPACK is a software package provided by Univ. of Tennessee, --
151 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
152 *
153 * .. Scalar Arguments ..
154  INTEGER INFO, LDA, M, N
155 * ..
156 * .. Array Arguments ..
157  INTEGER JPVT( * )
158  DOUBLE PRECISION RWORK( * )
159  COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * )
160 * ..
161 *
162 * =====================================================================
163 *
164 * .. Parameters ..
165  DOUBLE PRECISION ZERO, ONE
166  parameter( zero = 0.0d+0, one = 1.0d+0 )
167 * ..
168 * .. Local Scalars ..
169  INTEGER I, ITEMP, J, MA, MN, PVT
170  DOUBLE PRECISION TEMP, TEMP2, TOL3Z
171  COMPLEX*16 AII
172 * ..
173 * .. External Subroutines ..
174  EXTERNAL xerbla, zgeqr2, zlarf, zlarfg, zswap, zunm2r
175 * ..
176 * .. Intrinsic Functions ..
177  INTRINSIC abs, dcmplx, dconjg, max, min, sqrt
178 * ..
179 * .. External Functions ..
180  INTEGER IDAMAX
181  DOUBLE PRECISION DLAMCH, DZNRM2
182  EXTERNAL idamax, dlamch, dznrm2
183 * ..
184 * .. Executable Statements ..
185 *
186 * Test the input arguments
187 *
188  info = 0
189  IF( m.LT.0 ) THEN
190  info = -1
191  ELSE IF( n.LT.0 ) THEN
192  info = -2
193  ELSE IF( lda.LT.max( 1, m ) ) THEN
194  info = -4
195  END IF
196  IF( info.NE.0 ) THEN
197  CALL xerbla( 'ZGEQPF', -info )
198  RETURN
199  END IF
200 *
201  mn = min( m, n )
202  tol3z = sqrt(dlamch('Epsilon'))
203 *
204 * Move initial columns up front
205 *
206  itemp = 1
207  DO 10 i = 1, n
208  IF( jpvt( i ).NE.0 ) THEN
209  IF( i.NE.itemp ) THEN
210  CALL zswap( m, a( 1, i ), 1, a( 1, itemp ), 1 )
211  jpvt( i ) = jpvt( itemp )
212  jpvt( itemp ) = i
213  ELSE
214  jpvt( i ) = i
215  END IF
216  itemp = itemp + 1
217  ELSE
218  jpvt( i ) = i
219  END IF
220  10 CONTINUE
221  itemp = itemp - 1
222 *
223 * Compute the QR factorization and update remaining columns
224 *
225  IF( itemp.GT.0 ) THEN
226  ma = min( itemp, m )
227  CALL zgeqr2( m, ma, a, lda, tau, work, info )
228  IF( ma.LT.n ) THEN
229  CALL zunm2r( 'Left', 'Conjugate transpose', m, n-ma, ma, a,
230  \$ lda, tau, a( 1, ma+1 ), lda, work, info )
231  END IF
232  END IF
233 *
234  IF( itemp.LT.mn ) THEN
235 *
236 * Initialize partial column norms. The first n elements of
237 * work store the exact column norms.
238 *
239  DO 20 i = itemp + 1, n
240  rwork( i ) = dznrm2( m-itemp, a( itemp+1, i ), 1 )
241  rwork( n+i ) = rwork( i )
242  20 CONTINUE
243 *
244 * Compute factorization
245 *
246  DO 40 i = itemp + 1, mn
247 *
248 * Determine ith pivot column and swap if necessary
249 *
250  pvt = ( i-1 ) + idamax( n-i+1, rwork( i ), 1 )
251 *
252  IF( pvt.NE.i ) THEN
253  CALL zswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
254  itemp = jpvt( pvt )
255  jpvt( pvt ) = jpvt( i )
256  jpvt( i ) = itemp
257  rwork( pvt ) = rwork( i )
258  rwork( n+pvt ) = rwork( n+i )
259  END IF
260 *
261 * Generate elementary reflector H(i)
262 *
263  aii = a( i, i )
264  CALL zlarfg( m-i+1, aii, a( min( i+1, m ), i ), 1,
265  \$ tau( i ) )
266  a( i, i ) = aii
267 *
268  IF( i.LT.n ) THEN
269 *
270 * Apply H(i) to A(i:m,i+1:n) from the left
271 *
272  aii = a( i, i )
273  a( i, i ) = dcmplx( one )
274  CALL zlarf( 'Left', m-i+1, n-i, a( i, i ), 1,
275  \$ dconjg( tau( i ) ), a( i, i+1 ), lda, work )
276  a( i, i ) = aii
277  END IF
278 *
279 * Update partial column norms
280 *
281  DO 30 j = i + 1, n
282  IF( rwork( j ).NE.zero ) THEN
283 *
284 * NOTE: The following 4 lines follow from the analysis in
285 * Lapack Working Note 176.
286 *
287  temp = abs( a( i, j ) ) / rwork( j )
288  temp = max( zero, ( one+temp )*( one-temp ) )
289  temp2 = temp*( rwork( j ) / rwork( n+j ) )**2
290  IF( temp2 .LE. tol3z ) THEN
291  IF( m-i.GT.0 ) THEN
292  rwork( j ) = dznrm2( m-i, a( i+1, j ), 1 )
293  rwork( n+j ) = rwork( j )
294  ELSE
295  rwork( j ) = zero
296  rwork( n+j ) = zero
297  END IF
298  ELSE
299  rwork( j ) = rwork( j )*sqrt( temp )
300  END IF
301  END IF
302  30 CONTINUE
303 *
304  40 CONTINUE
305  END IF
306  RETURN
307 *
308 * End of ZGEQPF
309 *
double precision function dlamch(CMACH)
DLAMCH
Definition: dlamch.f:69
integer function idamax(N, DX, INCX)
IDAMAX
Definition: idamax.f:71
subroutine xerbla(SRNAME, INFO)
XERBLA
Definition: xerbla.f:60
subroutine zswap(N, ZX, INCX, ZY, INCY)
ZSWAP
Definition: zswap.f:81
subroutine zgeqr2(M, N, A, LDA, TAU, WORK, INFO)
ZGEQR2 computes the QR factorization of a general rectangular matrix using an unblocked algorithm.
Definition: zgeqr2.f:130
subroutine zlarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
ZLARF applies an elementary reflector to a general rectangular matrix.
Definition: zlarf.f:128
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
Definition: zlarfg.f:106
subroutine zunm2r(SIDE, TRANS, M, N, K, A, LDA, TAU, C, LDC, WORK, INFO)
ZUNM2R multiplies a general matrix by the unitary matrix from a QR factorization determined by cgeqrf...
Definition: zunm2r.f:159
real(wp) function dznrm2(n, x, incx)
DZNRM2
Definition: dznrm2.f90:90
Here is the call graph for this function:
Here is the caller graph for this function: