LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches

◆ cqpt01()

real function cqpt01 ( integer  m,
integer  n,
integer  k,
complex, dimension( lda, * )  a,
complex, dimension( lda, * )  af,
integer  lda,
complex, dimension( * )  tau,
integer, dimension( * )  jpvt,
complex, dimension( lwork )  work,
integer  lwork 
)

CQPT01

Purpose:
 CQPT01 tests the QR-factorization with pivoting of a matrix A.  The
 array AF contains the (possibly partial) QR-factorization of A, where
 the upper triangle of AF(1:k,1:k) is a partial triangular factor,
 the entries below the diagonal in the first k columns are the
 Householder vectors, and the rest of AF contains a partially updated
 matrix.

 This function returns ||A*P - Q*R|| / ( ||norm(A)||*eps*max(M,N) )
 where || . || is matrix one norm.
Parameters
[in]M
          M is INTEGER
          The number of rows of the matrices A and AF.
[in]N
          N is INTEGER
          The number of columns of the matrices A and AF.
[in]K
          K is INTEGER
          The number of columns of AF that have been reduced
          to upper triangular form.
[in]A
          A is COMPLEX array, dimension (LDA, N)
          The original matrix A.
[in]AF
          AF is COMPLEX array, dimension (LDA,N)
          The (possibly partial) output of CGEQPF.  The upper triangle
          of AF(1:k,1:k) is a partial triangular factor, the entries
          below the diagonal in the first k columns are the Householder
          vectors, and the rest of AF contains a partially updated
          matrix.
[in]LDA
          LDA is INTEGER
          The leading dimension of the arrays A and AF.
[in]TAU
          TAU is COMPLEX array, dimension (K)
          Details of the Householder transformations as returned by
          CGEQPF.
[in]JPVT
          JPVT is INTEGER array, dimension (N)
          Pivot information as returned by CGEQPF.
[out]WORK
          WORK is COMPLEX array, dimension (LWORK)
[in]LWORK
          LWORK is INTEGER
          The length of the array WORK.  LWORK >= M*N+N.
Author
Univ. of Tennessee
Univ. of California Berkeley
Univ. of Colorado Denver
NAG Ltd.

Definition at line 119 of file cqpt01.f.

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*
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
Here is the call graph for this function:
Here is the caller graph for this function: