1*> \brief \b CQPT01 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* REAL FUNCTION CQPT01( M, N, K, A, AF, LDA, TAU, JPVT, 12* WORK, LWORK ) 13* 14* .. Scalar Arguments .. 15* INTEGER K, LDA, LWORK, M, N 16* .. 17* .. Array Arguments .. 18* INTEGER JPVT( * ) 19* COMPLEX A( LDA, * ), AF( LDA, * ), TAU( * ), 20* $ WORK( LWORK ) 21* .. 22* 23* 24*> \par Purpose: 25* ============= 26*> 27*> \verbatim 28*> 29*> CQPT01 tests the QR-factorization with pivoting of a matrix A. The 30*> array AF contains the (possibly partial) QR-factorization of A, where 31*> the upper triangle of AF(1:k,1:k) is a partial triangular factor, 32*> the entries below the diagonal in the first k columns are the 33*> Householder vectors, and the rest of AF contains a partially updated 34*> matrix. 35*> 36*> This function returns ||A*P - Q*R||/(||norm(A)||*eps*M) 37*> \endverbatim 38* 39* Arguments: 40* ========== 41* 42*> \param[in] M 43*> \verbatim 44*> M is INTEGER 45*> The number of rows of the matrices A and AF. 46*> \endverbatim 47*> 48*> \param[in] N 49*> \verbatim 50*> N is INTEGER 51*> The number of columns of the matrices A and AF. 52*> \endverbatim 53*> 54*> \param[in] K 55*> \verbatim 56*> K is INTEGER 57*> The number of columns of AF that have been reduced 58*> to upper triangular form. 59*> \endverbatim 60*> 61*> \param[in] A 62*> \verbatim 63*> A is COMPLEX array, dimension (LDA, N) 64*> The original matrix A. 65*> \endverbatim 66*> 67*> \param[in] AF 68*> \verbatim 69*> AF is COMPLEX array, dimension (LDA,N) 70*> The (possibly partial) output of CGEQPF. The upper triangle 71*> of AF(1:k,1:k) is a partial triangular factor, the entries 72*> below the diagonal in the first k columns are the Householder 73*> vectors, and the rest of AF contains a partially updated 74*> matrix. 75*> \endverbatim 76*> 77*> \param[in] LDA 78*> \verbatim 79*> LDA is INTEGER 80*> The leading dimension of the arrays A and AF. 81*> \endverbatim 82*> 83*> \param[in] TAU 84*> \verbatim 85*> TAU is COMPLEX array, dimension (K) 86*> Details of the Householder transformations as returned by 87*> CGEQPF. 88*> \endverbatim 89*> 90*> \param[in] JPVT 91*> \verbatim 92*> JPVT is INTEGER array, dimension (N) 93*> Pivot information as returned by CGEQPF. 94*> \endverbatim 95*> 96*> \param[out] WORK 97*> \verbatim 98*> WORK is COMPLEX array, dimension (LWORK) 99*> \endverbatim 100*> 101*> \param[in] LWORK 102*> \verbatim 103*> LWORK is INTEGER 104*> The length of the array WORK. LWORK >= M*N+N. 105*> \endverbatim 106* 107* Authors: 108* ======== 109* 110*> \author Univ. of Tennessee 111*> \author Univ. of California Berkeley 112*> \author Univ. of Colorado Denver 113*> \author NAG Ltd. 114* 115*> \date November 2011 116* 117*> \ingroup complex_lin 118* 119* ===================================================================== 120 REAL FUNCTION CQPT01( M, N, K, A, AF, LDA, TAU, JPVT, 121 $ WORK, LWORK ) 122* 123* -- LAPACK test routine (version 3.4.0) -- 124* -- LAPACK is a software package provided by Univ. of Tennessee, -- 125* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 126* November 2011 127* 128* .. Scalar Arguments .. 129 INTEGER K, LDA, LWORK, M, N 130* .. 131* .. Array Arguments .. 132 INTEGER JPVT( * ) 133 COMPLEX A( LDA, * ), AF( LDA, * ), TAU( * ), 134 $ WORK( LWORK ) 135* .. 136* 137* ===================================================================== 138* 139* .. Parameters .. 140 REAL ZERO, ONE 141 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) 142* .. 143* .. Local Scalars .. 144 INTEGER I, INFO, J 145 REAL NORMA 146* .. 147* .. Local Arrays .. 148 REAL RWORK( 1 ) 149* .. 150* .. External Functions .. 151 REAL CLANGE, SLAMCH 152 EXTERNAL CLANGE, SLAMCH 153* .. 154* .. External Subroutines .. 155 EXTERNAL CAXPY, CCOPY, CUNMQR, XERBLA 156* .. 157* .. Intrinsic Functions .. 158 INTRINSIC CMPLX, MAX, MIN, REAL 159* .. 160* .. Executable Statements .. 161* 162 CQPT01 = ZERO 163* 164* Test if there is enough workspace 165* 166 IF( LWORK.LT.M*N+N ) THEN 167 CALL XERBLA( 'CQPT01', 10 ) 168 RETURN 169 END IF 170* 171* Quick return if possible 172* 173 IF( M.LE.0 .OR. N.LE.0 ) 174 $ RETURN 175* 176 NORMA = CLANGE( 'One-norm', M, N, A, LDA, RWORK ) 177* 178 DO 30 J = 1, K 179 DO 10 I = 1, MIN( J, M ) 180 WORK( ( J-1 )*M+I ) = AF( I, J ) 181 10 CONTINUE 182 DO 20 I = J + 1, M 183 WORK( ( J-1 )*M+I ) = ZERO 184 20 CONTINUE 185 30 CONTINUE 186 DO 40 J = K + 1, N 187 CALL CCOPY( M, AF( 1, J ), 1, WORK( ( J-1 )*M+1 ), 1 ) 188 40 CONTINUE 189* 190 CALL CUNMQR( 'Left', 'No transpose', M, N, K, AF, LDA, TAU, WORK, 191 $ M, WORK( M*N+1 ), LWORK-M*N, INFO ) 192* 193 DO 50 J = 1, N 194* 195* Compare i-th column of QR and jpvt(i)-th column of A 196* 197 CALL CAXPY( M, CMPLX( -ONE ), A( 1, JPVT( J ) ), 1, 198 $ WORK( ( J-1 )*M+1 ), 1 ) 199 50 CONTINUE 200* 201 CQPT01 = CLANGE( 'One-norm', M, N, WORK, M, RWORK ) / 202 $ ( REAL( MAX( M, N ) )*SLAMCH( 'Epsilon' ) ) 203 IF( NORMA.NE.ZERO ) 204 $ CQPT01 = CQPT01 / NORMA 205* 206 RETURN 207* 208* End of CQPT01 209* 210 END 211