LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
dqpt01.f
Go to the documentation of this file.
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*max(M,N) ),
37*> where || . || is matrix one norm.
38*> \endverbatim
39*
40* Arguments:
41* ==========
42*
43*> \param[in] M
44*> \verbatim
45*> M is INTEGER
46*> The number of rows of the matrices A and AF.
47*> \endverbatim
48*>
49*> \param[in] N
50*> \verbatim
51*> N is INTEGER
52*> The number of columns of the matrices A and AF.
53*> \endverbatim
54*>
55*> \param[in] K
56*> \verbatim
57*> K is INTEGER
58*> The number of columns of AF that have been reduced
59*> to upper triangular form.
60*> \endverbatim
61*>
62*> \param[in] A
63*> \verbatim
64*> A is DOUBLE PRECISION array, dimension (LDA, N)
65*> The original matrix A.
66*> \endverbatim
67*>
68*> \param[in] AF
69*> \verbatim
70*> AF is DOUBLE PRECISION array, dimension (LDA,N)
71*> The (possibly partial) output of DGEQPF. The upper triangle
72*> of AF(1:k,1:k) is a partial triangular factor, the entries
73*> below the diagonal in the first k columns are the Householder
74*> vectors, and the rest of AF contains a partially updated
75*> matrix.
76*> \endverbatim
77*>
78*> \param[in] LDA
79*> \verbatim
80*> LDA is INTEGER
81*> The leading dimension of the arrays A and AF.
82*> \endverbatim
83*>
84*> \param[in] TAU
85*> \verbatim
86*> TAU is DOUBLE PRECISION array, dimension (K)
87*> Details of the Householder transformations as returned by
88*> DGEQPF.
89*> \endverbatim
90*>
91*> \param[in] JPVT
92*> \verbatim
93*> JPVT is INTEGER array, dimension (N)
94*> Pivot information as returned by DGEQPF.
95*> \endverbatim
96*>
97*> \param[out] WORK
98*> \verbatim
99*> WORK is DOUBLE PRECISION array, dimension (LWORK)
100*> \endverbatim
101*>
102*> \param[in] LWORK
103*> \verbatim
104*> LWORK is INTEGER
105*> The length of the array WORK. LWORK >= M*N+N.
106*> \endverbatim
107*
108* Authors:
109* ========
110*
111*> \author Univ. of Tennessee
112*> \author Univ. of California Berkeley
113*> \author Univ. of Colorado Denver
114*> \author NAG Ltd.
115*
116*> \ingroup double_lin
117*
118* =====================================================================
119 DOUBLE PRECISION FUNCTION dqpt01( M, N, K, A, AF, LDA, TAU, JPVT,
120 $ WORK, LWORK )
121*
122* -- LAPACK test routine --
123* -- LAPACK is a software package provided by Univ. of Tennessee, --
124* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
125*
126* .. Scalar Arguments ..
127 INTEGER k, lda, lwork, m, n
128* ..
129* .. Array Arguments ..
130 INTEGER jpvt( * )
131 DOUBLE PRECISION a( lda, * ), af( lda, * ), tau( * ),
132 $ work( lwork )
133* ..
134*
135* =====================================================================
136*
137* .. Parameters ..
138 DOUBLE PRECISION zero, one
139 parameter( zero = 0.0d0, one = 1.0d0 )
140* ..
141* .. Local Scalars ..
142 INTEGER i, info, j
143 DOUBLE PRECISION norma
144* ..
145* .. Local Arrays ..
146 DOUBLE PRECISION rwork( 1 )
147* ..
148* .. External Functions ..
149 DOUBLE PRECISION dlamch, dlange
150 EXTERNAL dlamch, dlange
151* ..
152* .. External Subroutines ..
153 EXTERNAL daxpy, dcopy, dormqr, xerbla
154* ..
155* .. Intrinsic Functions ..
156 INTRINSIC dble, max, min
157* ..
158* .. Executable Statements ..
159*
160 dqpt01 = zero
161*
162* Test if there is enough workspace
163*
164 IF( lwork.LT.m*n+n ) THEN
165 CALL xerbla( 'DQPT01', 10 )
166 RETURN
167 END IF
168*
169* Quick return if possible
170*
171 IF( m.LE.0 .OR. n.LE.0 )
172 $ RETURN
173*
174 norma = dlange( 'One-norm', m, n, a, lda, rwork )
175*
176 DO j = 1, k
177*
178* Copy the upper triangular part of the factor R stored
179* in AF(1:K,1:K) into the work array WORK.
180*
181 DO i = 1, min( j, m )
182 work( ( j-1 )*m+i ) = af( i, j )
183 END DO
184*
185* Zero out the elements below the diagonal in the work array.
186*
187 DO i = j + 1, m
188 work( ( j-1 )*m+i ) = zero
189 END DO
190 END DO
191*
192* Copy columns (K+1,N) from AF into the work array WORK.
193* AF(1:K,K+1:N) contains the rectangular block of the upper trapezoidal
194* factor R, AF(K+1:M,K+1:N) contains the partially updated residual
195* matrix of R.
196*
197 DO j = k + 1, n
198 CALL dcopy( m, af( 1, j ), 1, work( ( j-1 )*m+1 ), 1 )
199 END DO
200*
201 CALL dormqr( 'Left', 'No transpose', m, n, k, af, lda, tau, work,
202 $ m, work( m*n+1 ), lwork-m*n, info )
203*
204 DO j = 1, n
205*
206* Compare J-th column of QR and JPVT(J)-th column of A.
207*
208 CALL daxpy( m, -one, a( 1, jpvt( j ) ), 1, work( ( j-1 )*m+1 ),
209 $ 1 )
210 END DO
211*
212 dqpt01 = dlange( 'One-norm', m, n, work, m, rwork ) /
213 $ ( dble( max( m, n ) )*dlamch( 'Epsilon' ) )
214 IF( norma.NE.zero )
215 $ dqpt01 = dqpt01 / norma
216*
217 RETURN
218*
219* End of DQPT01
220*
221 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
double precision function dqpt01(m, n, k, a, af, lda, tau, jpvt, work, lwork)
DQPT01
Definition dqpt01.f:121
subroutine daxpy(n, da, dx, incx, dy, incy)
DAXPY
Definition daxpy.f:89
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
Definition dcopy.f:82
double precision function dlamch(cmach)
DLAMCH
Definition dlamch.f:69
double precision function dlange(norm, m, n, a, lda, work)
DLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition dlange.f:114
subroutine dormqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
DORMQR
Definition dormqr.f:167