1*> \brief \b DQPT01 2* 3* =========== DOCUMENTATION =========== 4* 5* Online html documentation available at 6* http://www.netlib.org/lapack/explore-html/ 7* 8* Definition: 9* =========== 10* 11* DOUBLE PRECISION FUNCTION DQPT01( 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* DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), TAU( * ), 20* $ WORK( LWORK ) 21* .. 22* 23* 24*> \par Purpose: 25* ============= 26*> 27*> \verbatim 28*> 29*> DQPT01 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 DOUBLE PRECISION array, dimension (LDA, N) 64*> The original matrix A. 65*> \endverbatim 66*> 67*> \param[in] AF 68*> \verbatim 69*> AF is DOUBLE PRECISION array, dimension (LDA,N) 70*> The (possibly partial) output of DGEQPF. 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 DOUBLE PRECISION array, dimension (K) 86*> Details of the Householder transformations as returned by 87*> DGEQPF. 88*> \endverbatim 89*> 90*> \param[in] JPVT 91*> \verbatim 92*> JPVT is INTEGER array, dimension (N) 93*> Pivot information as returned by DGEQPF. 94*> \endverbatim 95*> 96*> \param[out] WORK 97*> \verbatim 98*> WORK is DOUBLE PRECISION 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 December 2016 116* 117*> \ingroup double_lin 118* 119* ===================================================================== 120 DOUBLE PRECISION FUNCTION DQPT01( M, N, K, A, AF, LDA, TAU, JPVT, 121 $ WORK, LWORK ) 122* 123* -- LAPACK test routine (version 3.7.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* December 2016 127* 128* .. Scalar Arguments .. 129 INTEGER K, LDA, LWORK, M, N 130* .. 131* .. Array Arguments .. 132 INTEGER JPVT( * ) 133 DOUBLE PRECISION A( LDA, * ), AF( LDA, * ), TAU( * ), 134 $ WORK( LWORK ) 135* .. 136* 137* ===================================================================== 138* 139* .. Parameters .. 140 DOUBLE PRECISION ZERO, ONE 141 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 ) 142* .. 143* .. Local Scalars .. 144 INTEGER I, INFO, J 145 DOUBLE PRECISION NORMA 146* .. 147* .. Local Arrays .. 148 DOUBLE PRECISION RWORK( 1 ) 149* .. 150* .. External Functions .. 151 DOUBLE PRECISION DLAMCH, DLANGE 152 EXTERNAL DLAMCH, DLANGE 153* .. 154* .. External Subroutines .. 155 EXTERNAL DAXPY, DCOPY, DORMQR, XERBLA 156* .. 157* .. Intrinsic Functions .. 158 INTRINSIC DBLE, MAX, MIN 159* .. 160* .. Executable Statements .. 161* 162 DQPT01 = ZERO 163* 164* Test if there is enough workspace 165* 166 IF( LWORK.LT.M*N+N ) THEN 167 CALL XERBLA( 'DQPT01', 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 = DLANGE( '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 DCOPY( M, AF( 1, J ), 1, WORK( ( J-1 )*M+1 ), 1 ) 188 40 CONTINUE 189* 190 CALL DORMQR( '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 DAXPY( M, -ONE, A( 1, JPVT( J ) ), 1, WORK( ( J-1 )*M+1 ), 198 $ 1 ) 199 50 CONTINUE 200* 201 DQPT01 = DLANGE( 'One-norm', M, N, WORK, M, RWORK ) / 202 $ ( DBLE( MAX( M, N ) )*DLAMCH( 'Epsilon' ) ) 203 IF( NORMA.NE.ZERO ) 204 $ DQPT01 = DQPT01 / NORMA 205* 206 RETURN 207* 208* End of DQPT01 209* 210 END 211