1*> \brief \b ZQPT01
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 ZQPT01( 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*16         A( LDA, * ), AF( LDA, * ), TAU( * ),
20*      $                   WORK( LWORK )
21*       ..
22*
23*
24*> \par Purpose:
25*  =============
26*>
27*> \verbatim
28*>
29*> ZQPT01 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*16 array, dimension (LDA, N)
64*>          The original matrix A.
65*> \endverbatim
66*>
67*> \param[in] AF
68*> \verbatim
69*>          AF is COMPLEX*16 array, dimension (LDA,N)
70*>          The (possibly partial) output of ZGEQPF.  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*16 array, dimension (K)
86*>          Details of the Householder transformations as returned by
87*>          ZGEQPF.
88*> \endverbatim
89*>
90*> \param[in] JPVT
91*> \verbatim
92*>          JPVT is INTEGER array, dimension (N)
93*>          Pivot information as returned by ZGEQPF.
94*> \endverbatim
95*>
96*> \param[out] WORK
97*> \verbatim
98*>          WORK is COMPLEX*16 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*> \ingroup complex16_lin
116*
117*  =====================================================================
118      DOUBLE PRECISION FUNCTION ZQPT01( M, N, K, A, AF, LDA, TAU, JPVT,
119     $                 WORK, LWORK )
120*
121*  -- LAPACK test routine --
122*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
123*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
124*
125*     .. Scalar Arguments ..
126      INTEGER            K, LDA, LWORK, M, N
127*     ..
128*     .. Array Arguments ..
129      INTEGER            JPVT( * )
130      COMPLEX*16         A( LDA, * ), AF( LDA, * ), TAU( * ),
131     $                   WORK( LWORK )
132*     ..
133*
134*  =====================================================================
135*
136*     .. Parameters ..
137      DOUBLE PRECISION   ZERO, ONE
138      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
139*     ..
140*     .. Local Scalars ..
141      INTEGER            I, INFO, J
142      DOUBLE PRECISION   NORMA
143*     ..
144*     .. Local Arrays ..
145      DOUBLE PRECISION   RWORK( 1 )
146*     ..
147*     .. External Functions ..
148      DOUBLE PRECISION   DLAMCH, ZLANGE
149      EXTERNAL           DLAMCH, ZLANGE
150*     ..
151*     .. External Subroutines ..
152      EXTERNAL           XERBLA, ZAXPY, ZCOPY, ZUNMQR
153*     ..
154*     .. Intrinsic Functions ..
155      INTRINSIC          DBLE, DCMPLX, MAX, MIN
156*     ..
157*     .. Executable Statements ..
158*
159      ZQPT01 = ZERO
160*
161*     Test if there is enough workspace
162*
163      IF( LWORK.LT.M*N+N ) THEN
164         CALL XERBLA( 'ZQPT01', 10 )
165         RETURN
166      END IF
167*
168*     Quick return if possible
169*
170      IF( M.LE.0 .OR. N.LE.0 )
171     $   RETURN
172*
173      NORMA = ZLANGE( 'One-norm', M, N, A, LDA, RWORK )
174*
175      DO 30 J = 1, K
176         DO 10 I = 1, MIN( J, M )
177            WORK( ( J-1 )*M+I ) = AF( I, J )
178   10    CONTINUE
179         DO 20 I = J + 1, M
180            WORK( ( J-1 )*M+I ) = ZERO
181   20    CONTINUE
182   30 CONTINUE
183      DO 40 J = K + 1, N
184         CALL ZCOPY( M, AF( 1, J ), 1, WORK( ( J-1 )*M+1 ), 1 )
185   40 CONTINUE
186*
187      CALL ZUNMQR( 'Left', 'No transpose', M, N, K, AF, LDA, TAU, WORK,
188     $             M, WORK( M*N+1 ), LWORK-M*N, INFO )
189*
190      DO 50 J = 1, N
191*
192*        Compare i-th column of QR and jpvt(i)-th column of A
193*
194         CALL ZAXPY( M, DCMPLX( -ONE ), A( 1, JPVT( J ) ), 1,
195     $               WORK( ( J-1 )*M+1 ), 1 )
196   50 CONTINUE
197*
198      ZQPT01 = ZLANGE( 'One-norm', M, N, WORK, M, RWORK ) /
199     $         ( DBLE( MAX( M, N ) )*DLAMCH( 'Epsilon' ) )
200      IF( NORMA.NE.ZERO )
201     $   ZQPT01 = ZQPT01 / NORMA
202*
203      RETURN
204*
205*     End of ZQPT01
206*
207      END
208