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