 LAPACK  3.10.0 LAPACK: Linear Algebra PACKage

## ◆ claqp2()

 subroutine claqp2 ( integer M, integer N, integer OFFSET, complex, dimension( lda, * ) A, integer LDA, integer, dimension( * ) JPVT, complex, dimension( * ) TAU, real, dimension( * ) VN1, real, dimension( * ) VN2, complex, dimension( * ) WORK )

CLAQP2 computes a QR factorization with column pivoting of the matrix block.

Purpose:
``` CLAQP2 computes a QR factorization with column pivoting of
the block A(OFFSET+1:M,1:N).
The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized.```
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] OFFSET ``` OFFSET is INTEGER The number of rows of the matrix A that must be pivoted but no factorized. OFFSET >= 0.``` [in,out] A ``` A is COMPLEX array, dimension (LDA,N) On entry, the M-by-N matrix A. On exit, the upper triangle of block A(OFFSET+1:M,1:N) is the triangular factor obtained; the elements in block A(OFFSET+1:M,1:N) below the diagonal, together with the array TAU, represent the orthogonal matrix Q as a product of elementary reflectors. Block A(1:OFFSET,1:N) has been accordingly pivoted, but no factorized.``` [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 array, dimension (min(M,N)) The scalar factors of the elementary reflectors.``` [in,out] VN1 ``` VN1 is REAL array, dimension (N) The vector with the partial column norms.``` [in,out] VN2 ``` VN2 is REAL array, dimension (N) The vector with the exact column norms.``` [out] WORK ` WORK is COMPLEX array, dimension (N)`
Contributors:
G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain X. Sun, Computer Science Dept., Duke University, USA
Partial column norm updating strategy modified on April 2011 Z. Drmac and Z. Bujanovic, Dept. of Mathematics, University of Zagreb, Croatia.
References:
LAPACK Working Note 176 [PDF]

Definition at line 147 of file claqp2.f.

149 *
150 * -- LAPACK auxiliary routine --
151 * -- LAPACK is a software package provided by Univ. of Tennessee, --
152 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
153 *
154 * .. Scalar Arguments ..
155  INTEGER LDA, M, N, OFFSET
156 * ..
157 * .. Array Arguments ..
158  INTEGER JPVT( * )
159  REAL VN1( * ), VN2( * )
160  COMPLEX A( LDA, * ), TAU( * ), WORK( * )
161 * ..
162 *
163 * =====================================================================
164 *
165 * .. Parameters ..
166  REAL ZERO, ONE
167  COMPLEX CONE
168  parameter( zero = 0.0e+0, one = 1.0e+0,
169  \$ cone = ( 1.0e+0, 0.0e+0 ) )
170 * ..
171 * .. Local Scalars ..
172  INTEGER I, ITEMP, J, MN, OFFPI, PVT
173  REAL TEMP, TEMP2, TOL3Z
174  COMPLEX AII
175 * ..
176 * .. External Subroutines ..
177  EXTERNAL clarf, clarfg, cswap
178 * ..
179 * .. Intrinsic Functions ..
180  INTRINSIC abs, conjg, max, min, sqrt
181 * ..
182 * .. External Functions ..
183  INTEGER ISAMAX
184  REAL SCNRM2, SLAMCH
185  EXTERNAL isamax, scnrm2, slamch
186 * ..
187 * .. Executable Statements ..
188 *
189  mn = min( m-offset, n )
190  tol3z = sqrt(slamch('Epsilon'))
191 *
192 * Compute factorization.
193 *
194  DO 20 i = 1, mn
195 *
196  offpi = offset + i
197 *
198 * Determine ith pivot column and swap if necessary.
199 *
200  pvt = ( i-1 ) + isamax( n-i+1, vn1( i ), 1 )
201 *
202  IF( pvt.NE.i ) THEN
203  CALL cswap( m, a( 1, pvt ), 1, a( 1, i ), 1 )
204  itemp = jpvt( pvt )
205  jpvt( pvt ) = jpvt( i )
206  jpvt( i ) = itemp
207  vn1( pvt ) = vn1( i )
208  vn2( pvt ) = vn2( i )
209  END IF
210 *
211 * Generate elementary reflector H(i).
212 *
213  IF( offpi.LT.m ) THEN
214  CALL clarfg( m-offpi+1, a( offpi, i ), a( offpi+1, i ), 1,
215  \$ tau( i ) )
216  ELSE
217  CALL clarfg( 1, a( m, i ), a( m, i ), 1, tau( i ) )
218  END IF
219 *
220  IF( i.LT.n ) THEN
221 *
222 * Apply H(i)**H to A(offset+i:m,i+1:n) from the left.
223 *
224  aii = a( offpi, i )
225  a( offpi, i ) = cone
226  CALL clarf( 'Left', m-offpi+1, n-i, a( offpi, i ), 1,
227  \$ conjg( tau( i ) ), a( offpi, i+1 ), lda,
228  \$ work( 1 ) )
229  a( offpi, i ) = aii
230  END IF
231 *
232 * Update partial column norms.
233 *
234  DO 10 j = i + 1, n
235  IF( vn1( j ).NE.zero ) THEN
236 *
237 * NOTE: The following 4 lines follow from the analysis in
238 * Lapack Working Note 176.
239 *
240  temp = one - ( abs( a( offpi, j ) ) / vn1( j ) )**2
241  temp = max( temp, zero )
242  temp2 = temp*( vn1( j ) / vn2( j ) )**2
243  IF( temp2 .LE. tol3z ) THEN
244  IF( offpi.LT.m ) THEN
245  vn1( j ) = scnrm2( m-offpi, a( offpi+1, j ), 1 )
246  vn2( j ) = vn1( j )
247  ELSE
248  vn1( j ) = zero
249  vn2( j ) = zero
250  END IF
251  ELSE
252  vn1( j ) = vn1( j )*sqrt( temp )
253  END IF
254  END IF
255  10 CONTINUE
256 *
257  20 CONTINUE
258 *
259  RETURN
260 *
261 * End of CLAQP2
262 *
integer function isamax(N, SX, INCX)
ISAMAX
Definition: isamax.f:71
subroutine cswap(N, CX, INCX, CY, INCY)
CSWAP
Definition: cswap.f:81
subroutine clarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
CLARF applies an elementary reflector to a general rectangular matrix.
Definition: clarf.f:128
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
Definition: clarfg.f:106
real(wp) function scnrm2(n, x, incx)
SCNRM2
Definition: scnrm2.f90:90
real function slamch(CMACH)
SLAMCH
Definition: slamch.f:68
Here is the call graph for this function:
Here is the caller graph for this function: