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*> \date November 2011
95*
96*> \ingroup complex_lin
97*
98*  =====================================================================
99      REAL             FUNCTION CQRT11( M, K, A, LDA, TAU, WORK, LWORK )
100*
101*  -- LAPACK test routine (version 3.4.0) --
102*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
103*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
104*     November 2011
105*
106*     .. Scalar Arguments ..
107      INTEGER            K, LDA, LWORK, M
108*     ..
109*     .. Array Arguments ..
110      COMPLEX            A( LDA, * ), TAU( * ), WORK( LWORK )
111*     ..
112*
113*  =====================================================================
114*
115*     .. Parameters ..
116      REAL               ZERO, ONE
117      PARAMETER          ( ZERO = 0.0E0, ONE = 1.0E0 )
118*     ..
119*     .. Local Scalars ..
120      INTEGER            INFO, J
121*     ..
122*     .. External Functions ..
123      REAL               CLANGE, SLAMCH
124      EXTERNAL           CLANGE, SLAMCH
125*     ..
126*     .. External Subroutines ..
127      EXTERNAL           CLASET, CUNM2R, XERBLA
128*     ..
129*     .. Intrinsic Functions ..
130      INTRINSIC          CMPLX, REAL
131*     ..
132*     .. Local Arrays ..
133      REAL               RDUMMY( 1 )
134*     ..
135*     .. Executable Statements ..
136*
137      CQRT11 = ZERO
138*
139*     Test for sufficient workspace
140*
141      IF( LWORK.LT.M*M+M ) THEN
142         CALL XERBLA( 'CQRT11', 7 )
143         RETURN
144      END IF
145*
146*     Quick return if possible
147*
148      IF( M.LE.0 )
149     $   RETURN
150*
151      CALL CLASET( 'Full', M, M, CMPLX( ZERO ), CMPLX( ONE ), WORK, M )
152*
153*     Form Q
154*
155      CALL CUNM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK,
156     $             M, WORK( M*M+1 ), INFO )
157*
158*     Form Q'*Q
159*
160      CALL CUNM2R( 'Left', 'Conjugate transpose', M, M, K, A, LDA, TAU,
161     $             WORK, M, WORK( M*M+1 ), INFO )
162*
163      DO 10 J = 1, M
164         WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE
165   10 CONTINUE
166*
167      CQRT11 = CLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
168     $         ( REAL( M )*SLAMCH( 'Epsilon' ) )
169*
170      RETURN
171*
172*     End of CQRT11
173*
174      END
175