 LAPACK  3.9.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)`
Date
December 2016
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 151 of file claqp2.f.

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