LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
cqpt01.f
Go to the documentation of this file.
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*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 COMPLEX array, dimension (LDA, N)
65*> The original matrix A.
66*> \endverbatim
67*>
68*> \param[in] AF
69*> \verbatim
70*> AF is COMPLEX array, dimension (LDA,N)
71*> The (possibly partial) output of CGEQPF. 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 COMPLEX array, dimension (K)
87*> Details of the Householder transformations as returned by
88*> CGEQPF.
89*> \endverbatim
90*>
91*> \param[in] JPVT
92*> \verbatim
93*> JPVT is INTEGER array, dimension (N)
94*> Pivot information as returned by CGEQPF.
95*> \endverbatim
96*>
97*> \param[out] WORK
98*> \verbatim
99*> WORK is COMPLEX 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 complex_lin
117*
118* =====================================================================
119 REAL function cqpt01( 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 COMPLEX a( lda, * ), af( lda, * ), tau( * ),
132 $ work( lwork )
133* ..
134*
135* =====================================================================
136*
137* .. Parameters ..
138 REAL zero, one
139 parameter( zero = 0.0e0, one = 1.0e0 )
140* ..
141* .. Local Scalars ..
142 INTEGER i, info, j
143 REAL norma
144* ..
145* .. Local Arrays ..
146 REAL rwork( 1 )
147* ..
148* .. External Functions ..
149 REAL clange, slamch
150 EXTERNAL clange, slamch
151* ..
152* .. External Subroutines ..
153 EXTERNAL caxpy, ccopy, cunmqr, xerbla
154* ..
155* .. Intrinsic Functions ..
156 INTRINSIC cmplx, max, min, real
157* ..
158* .. Executable Statements ..
159*
160 cqpt01 = zero
161*
162* Test if there is enough workspace
163*
164 IF( lwork.LT.m*n+n ) THEN
165 CALL xerbla( 'CQPT01', 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 = clange( 'One-norm', m, n, a, lda, rwork )
175*
176 DO j = 1, k
177 DO i = 1, min( j, m )
178 work( ( j-1 )*m+i ) = af( i, j )
179 END DO
180 DO i = j + 1, m
181 work( ( j-1 )*m+i ) = zero
182 END DO
183 END DO
184 DO j = k + 1, n
185 CALL ccopy( m, af( 1, j ), 1, work( ( j-1 )*m+1 ), 1 )
186 END DO
187*
188 CALL cunmqr( 'Left', 'No transpose', m, n, k, af, lda, tau, work,
189 $ m, work( m*n+1 ), lwork-m*n, info )
190*
191 DO j = 1, n
192*
193* Compare i-th column of QR and jpvt(i)-th column of A
194*
195 CALL caxpy( m, cmplx( -one ), a( 1, jpvt( j ) ), 1,
196 $ work( ( j-1 )*m+1 ), 1 )
197 END DO
198*
199 cqpt01 = clange( 'One-norm', m, n, work, m, rwork ) /
200 $ ( real( max( m, n ) )*slamch( 'Epsilon' ) )
201 IF( norma.NE.zero )
202 $ cqpt01 = cqpt01 / norma
203*
204 RETURN
205*
206* End of CQPT01
207*
208 END
subroutine xerbla(srname, info)
Definition cblat2.f:3285
real function cqpt01(m, n, k, a, af, lda, tau, jpvt, work, lwork)
CQPT01
Definition cqpt01.f:121
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
Definition caxpy.f:88
subroutine ccopy(n, cx, incx, cy, incy)
CCOPY
Definition ccopy.f:81
real function slamch(cmach)
SLAMCH
Definition slamch.f:68
real function clange(norm, m, n, a, lda, work)
CLANGE returns the value of the 1-norm, Frobenius norm, infinity-norm, or the largest absolute value ...
Definition clange.f:115
subroutine cunmqr(side, trans, m, n, k, a, lda, tau, c, ldc, work, lwork, info)
CUNMQR
Definition cunmqr.f:168