![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b ZLAQP2 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download ZLAQP2 + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlaqp2.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlaqp2.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlaqp2.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, 00022 * WORK ) 00023 * 00024 * .. Scalar Arguments .. 00025 * INTEGER LDA, M, N, OFFSET 00026 * .. 00027 * .. Array Arguments .. 00028 * INTEGER JPVT( * ) 00029 * DOUBLE PRECISION VN1( * ), VN2( * ) 00030 * COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> ZLAQP2 computes a QR factorization with column pivoting of 00040 *> the block A(OFFSET+1:M,1:N). 00041 *> The block A(1:OFFSET,1:N) is accordingly pivoted, but not factorized. 00042 *> \endverbatim 00043 * 00044 * Arguments: 00045 * ========== 00046 * 00047 *> \param[in] M 00048 *> \verbatim 00049 *> M is INTEGER 00050 *> The number of rows of the matrix A. M >= 0. 00051 *> \endverbatim 00052 *> 00053 *> \param[in] N 00054 *> \verbatim 00055 *> N is INTEGER 00056 *> The number of columns of the matrix A. N >= 0. 00057 *> \endverbatim 00058 *> 00059 *> \param[in] OFFSET 00060 *> \verbatim 00061 *> OFFSET is INTEGER 00062 *> The number of rows of the matrix A that must be pivoted 00063 *> but no factorized. OFFSET >= 0. 00064 *> \endverbatim 00065 *> 00066 *> \param[in,out] A 00067 *> \verbatim 00068 *> A is COMPLEX*16 array, dimension (LDA,N) 00069 *> On entry, the M-by-N matrix A. 00070 *> On exit, the upper triangle of block A(OFFSET+1:M,1:N) is 00071 *> the triangular factor obtained; the elements in block 00072 *> A(OFFSET+1:M,1:N) below the diagonal, together with the 00073 *> array TAU, represent the orthogonal matrix Q as a product of 00074 *> elementary reflectors. Block A(1:OFFSET,1:N) has been 00075 *> accordingly pivoted, but no factorized. 00076 *> \endverbatim 00077 *> 00078 *> \param[in] LDA 00079 *> \verbatim 00080 *> LDA is INTEGER 00081 *> The leading dimension of the array A. LDA >= max(1,M). 00082 *> \endverbatim 00083 *> 00084 *> \param[in,out] JPVT 00085 *> \verbatim 00086 *> JPVT is INTEGER array, dimension (N) 00087 *> On entry, if JPVT(i) .ne. 0, the i-th column of A is permuted 00088 *> to the front of A*P (a leading column); if JPVT(i) = 0, 00089 *> the i-th column of A is a free column. 00090 *> On exit, if JPVT(i) = k, then the i-th column of A*P 00091 *> was the k-th column of A. 00092 *> \endverbatim 00093 *> 00094 *> \param[out] TAU 00095 *> \verbatim 00096 *> TAU is COMPLEX*16 array, dimension (min(M,N)) 00097 *> The scalar factors of the elementary reflectors. 00098 *> \endverbatim 00099 *> 00100 *> \param[in,out] VN1 00101 *> \verbatim 00102 *> VN1 is DOUBLE PRECISION array, dimension (N) 00103 *> The vector with the partial column norms. 00104 *> \endverbatim 00105 *> 00106 *> \param[in,out] VN2 00107 *> \verbatim 00108 *> VN2 is DOUBLE PRECISION array, dimension (N) 00109 *> The vector with the exact column norms. 00110 *> \endverbatim 00111 *> 00112 *> \param[out] WORK 00113 *> \verbatim 00114 *> WORK is COMPLEX*16 array, dimension (N) 00115 *> \endverbatim 00116 * 00117 * Authors: 00118 * ======== 00119 * 00120 *> \author Univ. of Tennessee 00121 *> \author Univ. of California Berkeley 00122 *> \author Univ. of Colorado Denver 00123 *> \author NAG Ltd. 00124 * 00125 *> \date November 2011 00126 * 00127 *> \ingroup complex16OTHERauxiliary 00128 * 00129 *> \par Contributors: 00130 * ================== 00131 *> 00132 *> G. Quintana-Orti, Depto. de Informatica, Universidad Jaime I, Spain 00133 *> X. Sun, Computer Science Dept., Duke University, USA 00134 *> \n 00135 *> Partial column norm updating strategy modified on April 2011 00136 *> Z. Drmac and Z. Bujanovic, Dept. of Mathematics, 00137 *> University of Zagreb, Croatia. 00138 * 00139 *> \par References: 00140 * ================ 00141 *> 00142 *> LAPACK Working Note 176 00143 * 00144 *> \htmlonly 00145 *> <a href="http://www.netlib.org/lapack/lawnspdf/lawn176.pdf">[PDF]</a> 00146 *> \endhtmlonly 00147 * 00148 * ===================================================================== 00149 SUBROUTINE ZLAQP2( M, N, OFFSET, A, LDA, JPVT, TAU, VN1, VN2, 00150 $ WORK ) 00151 * 00152 * -- LAPACK auxiliary routine (version 3.4.0) -- 00153 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00154 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00155 * November 2011 00156 * 00157 * .. Scalar Arguments .. 00158 INTEGER LDA, M, N, OFFSET 00159 * .. 00160 * .. Array Arguments .. 00161 INTEGER JPVT( * ) 00162 DOUBLE PRECISION VN1( * ), VN2( * ) 00163 COMPLEX*16 A( LDA, * ), TAU( * ), WORK( * ) 00164 * .. 00165 * 00166 * ===================================================================== 00167 * 00168 * .. Parameters .. 00169 DOUBLE PRECISION ZERO, ONE 00170 COMPLEX*16 CONE 00171 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0, 00172 $ CONE = ( 1.0D+0, 0.0D+0 ) ) 00173 * .. 00174 * .. Local Scalars .. 00175 INTEGER I, ITEMP, J, MN, OFFPI, PVT 00176 DOUBLE PRECISION TEMP, TEMP2, TOL3Z 00177 COMPLEX*16 AII 00178 * .. 00179 * .. External Subroutines .. 00180 EXTERNAL ZLARF, ZLARFG, ZSWAP 00181 * .. 00182 * .. Intrinsic Functions .. 00183 INTRINSIC ABS, DCONJG, MAX, MIN, SQRT 00184 * .. 00185 * .. External Functions .. 00186 INTEGER IDAMAX 00187 DOUBLE PRECISION DLAMCH, DZNRM2 00188 EXTERNAL IDAMAX, DLAMCH, DZNRM2 00189 * .. 00190 * .. Executable Statements .. 00191 * 00192 MN = MIN( M-OFFSET, N ) 00193 TOL3Z = SQRT(DLAMCH('Epsilon')) 00194 * 00195 * Compute factorization. 00196 * 00197 DO 20 I = 1, MN 00198 * 00199 OFFPI = OFFSET + I 00200 * 00201 * Determine ith pivot column and swap if necessary. 00202 * 00203 PVT = ( I-1 ) + IDAMAX( N-I+1, VN1( I ), 1 ) 00204 * 00205 IF( PVT.NE.I ) THEN 00206 CALL ZSWAP( M, A( 1, PVT ), 1, A( 1, I ), 1 ) 00207 ITEMP = JPVT( PVT ) 00208 JPVT( PVT ) = JPVT( I ) 00209 JPVT( I ) = ITEMP 00210 VN1( PVT ) = VN1( I ) 00211 VN2( PVT ) = VN2( I ) 00212 END IF 00213 * 00214 * Generate elementary reflector H(i). 00215 * 00216 IF( OFFPI.LT.M ) THEN 00217 CALL ZLARFG( M-OFFPI+1, A( OFFPI, I ), A( OFFPI+1, I ), 1, 00218 $ TAU( I ) ) 00219 ELSE 00220 CALL ZLARFG( 1, A( M, I ), A( M, I ), 1, TAU( I ) ) 00221 END IF 00222 * 00223 IF( I.LT.N ) THEN 00224 * 00225 * Apply H(i)**H to A(offset+i:m,i+1:n) from the left. 00226 * 00227 AII = A( OFFPI, I ) 00228 A( OFFPI, I ) = CONE 00229 CALL ZLARF( 'Left', M-OFFPI+1, N-I, A( OFFPI, I ), 1, 00230 $ DCONJG( TAU( I ) ), A( OFFPI, I+1 ), LDA, 00231 $ WORK( 1 ) ) 00232 A( OFFPI, I ) = AII 00233 END IF 00234 * 00235 * Update partial column norms. 00236 * 00237 DO 10 J = I + 1, N 00238 IF( VN1( J ).NE.ZERO ) THEN 00239 * 00240 * NOTE: The following 4 lines follow from the analysis in 00241 * Lapack Working Note 176. 00242 * 00243 TEMP = ONE - ( ABS( A( OFFPI, J ) ) / VN1( J ) )**2 00244 TEMP = MAX( TEMP, ZERO ) 00245 TEMP2 = TEMP*( VN1( J ) / VN2( J ) )**2 00246 IF( TEMP2 .LE. TOL3Z ) THEN 00247 IF( OFFPI.LT.M ) THEN 00248 VN1( J ) = DZNRM2( M-OFFPI, A( OFFPI+1, J ), 1 ) 00249 VN2( J ) = VN1( J ) 00250 ELSE 00251 VN1( J ) = ZERO 00252 VN2( J ) = ZERO 00253 END IF 00254 ELSE 00255 VN1( J ) = VN1( J )*SQRT( TEMP ) 00256 END IF 00257 END IF 00258 10 CONTINUE 00259 * 00260 20 CONTINUE 00261 * 00262 RETURN 00263 * 00264 * End of ZLAQP2 00265 * 00266 END