1*> \brief \b CQRT11
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 CQRT11( M, K, A, LDA, TAU, WORK, LWORK )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            K, LDA, LWORK, M
15*       ..
16*       .. Array Arguments ..
17*       COMPLEX            A( LDA, * ), TAU( * ), WORK( LWORK )
18*       ..
19*
20*
21*> \par Purpose:
22*  =============
23*>
24*> \verbatim
25*>
26*> CQRT11 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 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 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 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 complex_lin
95*
96*  =====================================================================
97      REAL             FUNCTION CQRT11( 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            A( LDA, * ), TAU( * ), WORK( LWORK )
108*     ..
109*
110*  =====================================================================
111*
112*     .. Parameters ..
113      REAL               ZERO, ONE
114      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
115*     ..
116*     .. Local Scalars ..
117      INTEGER            INFO, J
118*     ..
119*     .. External Functions ..
120      REAL               CLANGE, SLAMCH
121      EXTERNAL           CLANGE, SLAMCH
122*     ..
123*     .. External Subroutines ..
124      EXTERNAL           CLASET, CUNM2R, XERBLA
125*     ..
126*     .. Intrinsic Functions ..
127      INTRINSIC          CMPLX, REAL
128*     ..
129*     .. Local Arrays ..
130      REAL               RDUMMY( 1 )
131*     ..
132*     .. Executable Statements ..
133*
134      CQRT11 = ZERO
135*
136*     Test for sufficient workspace
137*
138      IF( LWORK.LT.M*M+M ) THEN
139         CALL XERBLA( 'CQRT11', 7 )
140         RETURN
141      END IF
142*
143*     Quick return if possible
144*
145      IF( M.LE.0 )
146     $   RETURN
147*
148      CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ONE ), WORK, M )
149*
150*     Form Q
151*
152      CALL CUNM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK,
153     $             M, WORK( M*M+1 ), INFO )
154*
155*     Form Q'*Q
156*
157      CALL CUNM2R( 'Left', 'Conjugate transpose', M, M, K, A, LDA, TAU,
158     $             WORK, M, WORK( M*M+1 ), INFO )
159*
160      DO 10 J = 1, M
161         WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE
162   10 CONTINUE
163*
164      CQRT11 = CLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
165     $         ( REAL( M )*SLAMCH( 'Epsilon' ) )
166*
167      RETURN
168*
169*     End of CQRT11
170*
171      END
172