1*> \brief \b DQRT11
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 DQRT11( M, K, A, LDA, TAU, WORK, LWORK )
12*
13*       .. Scalar Arguments ..
14*       INTEGER            K, LDA, LWORK, M
15*       ..
16*       .. Array Arguments ..
17*       DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
18*       ..
19*
20*
21*> \par Purpose:
22*  =============
23*>
24*> \verbatim
25*>
26*> DQRT11 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 December 2016
95*
96*> \ingroup double_lin
97*
98*  =====================================================================
99      DOUBLE PRECISION FUNCTION DQRT11( M, K, A, LDA, TAU, WORK, LWORK )
100*
101*  -- LAPACK test routine (version 3.7.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*     December 2016
105*
106*     .. Scalar Arguments ..
107      INTEGER            K, LDA, LWORK, M
108*     ..
109*     .. Array Arguments ..
110      DOUBLE PRECISION   A( LDA, * ), TAU( * ), WORK( LWORK )
111*     ..
112*
113*  =====================================================================
114*
115*     .. Parameters ..
116      DOUBLE PRECISION   ZERO, ONE
117      PARAMETER          ( ZERO = 0.0D0, ONE = 1.0D0 )
118*     ..
119*     .. Local Scalars ..
120      INTEGER            INFO, J
121*     ..
122*     .. External Functions ..
123      DOUBLE PRECISION   DLAMCH, DLANGE
124      EXTERNAL           DLAMCH, DLANGE
125*     ..
126*     .. External Subroutines ..
127      EXTERNAL           DLASET, DORM2R, XERBLA
128*     ..
129*     .. Intrinsic Functions ..
130      INTRINSIC          DBLE
131*     ..
132*     .. Local Arrays ..
133      DOUBLE PRECISION   RDUMMY( 1 )
134*     ..
135*     .. Executable Statements ..
136*
137      DQRT11 = ZERO
138*
139*     Test for sufficient workspace
140*
141      IF( LWORK.LT.M*M+M ) THEN
142         CALL XERBLA( 'DQRT11', 7 )
143         RETURN
144      END IF
145*
146*     Quick return if possible
147*
148      IF( M.LE.0 )
149     $   RETURN
150*
151      CALL DLASET( 'Full', M, M, ZERO, ONE, WORK, M )
152*
153*     Form Q
154*
155      CALL DORM2R( '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 DORM2R( 'Left', 'Transpose', M, M, K, A, LDA, TAU, WORK, M,
161     $             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      DQRT11 = DLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
168     $         ( DBLE( M )*DLAMCH( 'Epsilon' ) )
169*
170      RETURN
171*
172*     End of DQRT11
173*
174      END
175