1*> \brief \b ZQRT11
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 ZQRT11( M, K, A, LDA, TAU, WORK, LWORK )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            K, LDA, LWORK, M
15*       ..
16*       .. Array Arguments ..
17*       COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
18*       ..
19*
20*
21*> \par Purpose:
22*  =============
23*>
24*> \verbatim
25*>
26*> ZQRT11 computes the test ratio
27*>
28*>       || Q'*Q - I || / (eps * m)
29*>
30*> where the orthogonal matrix Q is represented as a product of
31*> elementary transformations.  Each transformation has the form
32*>
33*>    H(k) = I - tau(k) v(k) v(k)'
34*>
35*> where tau(k) is stored in TAU(k) and v(k) is an m-vector of the form
36*> [ 0 ... 0 1 x(k) ]', where x(k) is a vector of length m-k stored
37*> in A(k+1:m,k).
38*> \endverbatim
39*
40*  Arguments:
41*  ==========
42*
43*> \param[in] M
44*> \verbatim
45*>          M is INTEGER
46*>          The number of rows of the matrix A.
47*> \endverbatim
48*>
49*> \param[in] K
50*> \verbatim
51*>          K is INTEGER
52*>          The number of columns of A whose subdiagonal entries
53*>          contain information about orthogonal transformations.
54*> \endverbatim
55*>
56*> \param[in] A
57*> \verbatim
58*>          A is COMPLEX*16 array, dimension (LDA,K)
59*>          The (possibly partial) output of a QR reduction routine.
60*> \endverbatim
61*>
62*> \param[in] LDA
63*> \verbatim
64*>          LDA is INTEGER
65*>          The leading dimension of the array A.
66*> \endverbatim
67*>
68*> \param[in] TAU
69*> \verbatim
70*>          TAU is COMPLEX*16 array, dimension (K)
71*>          The scaling factors tau for the elementary transformations as
72*>          computed by the QR factorization routine.
73*> \endverbatim
74*>
75*> \param[out] WORK
76*> \verbatim
77*>          WORK is COMPLEX*16 array, dimension (LWORK)
78*> \endverbatim
79*>
80*> \param[in] LWORK
81*> \verbatim
82*>          LWORK is INTEGER
83*>          The length of the array WORK.  LWORK >= M*M + M.
84*> \endverbatim
85*
86*  Authors:
87*  ========
88*
89*> \author Univ. of Tennessee
90*> \author Univ. of California Berkeley
91*> \author Univ. of Colorado Denver
92*> \author NAG Ltd.
93*
94*> \ingroup complex16_lin
95*
96*  =====================================================================
97      DOUBLE PRECISION FUNCTION ZQRT11( M, K, A, LDA, TAU, WORK, LWORK )
98*
99*  -- LAPACK test routine --
100*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
101*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
102*
103*     .. Scalar Arguments ..
104      INTEGER            K, LDA, LWORK, M
105*     ..
106*     .. Array Arguments ..
107      COMPLEX*16         A( LDA, * ), TAU( * ), WORK( LWORK )
108*     ..
109*
110*  =====================================================================
111*
112*     .. Parameters ..
113      DOUBLE PRECISION   ZERO, ONE
114      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
115*     ..
116*     .. Local Scalars ..
117      INTEGER            INFO, J
118*     ..
119*     .. External Functions ..
120      DOUBLE PRECISION   DLAMCH, ZLANGE
121      EXTERNAL           DLAMCH, ZLANGE
122*     ..
123*     .. External Subroutines ..
124      EXTERNAL           XERBLA, ZLASET, ZUNM2R
125*     ..
126*     .. Intrinsic Functions ..
127      INTRINSIC          DBLE, DCMPLX
128*     ..
129*     .. Local Arrays ..
130      DOUBLE PRECISION   RDUMMY( 1 )
131*     ..
132*     .. Executable Statements ..
133*
134      ZQRT11 = ZERO
135*
136*     Test for sufficient workspace
137*
138      IF( LWORK.LT.M*M+M ) THEN
139         CALL XERBLA( 'ZQRT11', 7 )
140         RETURN
141      END IF
142*
143*     Quick return if possible
144*
145      IF( M.LE.0 )
146     $   RETURN
147*
148      CALL ZLASET( 'Full', M, M, DCMPLX( ZERO ), DCMPLX( ONE ), WORK,
149     $             M )
150*
151*     Form Q
152*
153      CALL ZUNM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK,
154     $             M, WORK( M*M+1 ), INFO )
155*
156*     Form Q'*Q
157*
158      CALL ZUNM2R( 'Left', 'Conjugate transpose', M, M, K, A, LDA, TAU,
159     $             WORK, M, WORK( M*M+1 ), INFO )
160*
161      DO 10 J = 1, M
162         WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE
163   10 CONTINUE
164*
165      ZQRT11 = ZLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
166     $         ( DBLE( M )*DLAMCH( 'Epsilon' ) )
167*
168      RETURN
169*
170*     End of ZQRT11
171*
172      END
173