1 DOUBLE PRECISION FUNCTION DQRT11( M, K, A, LDA, TAU, WORK, LWORK )
2 *
3 * -- LAPACK routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER K, LDA, LWORK, M
9 * ..
10 * .. Array Arguments ..
11 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( LWORK )
12 * ..
13 *
14 * Purpose
15 * =======
16 *
17 * DQRT11 computes the test ratio
18 *
19 * || Q'*Q - I || / (eps * m)
20 *
21 * where the orthogonal matrix Q is represented as a product of
22 * elementary transformations. Each transformation has the form
23 *
24 * H(k) = I - tau(k) v(k) v(k)'
25 *
26 * where tau(k) is stored in TAU(k) and v(k) is an m-vector of the form
27 * [ 0 ... 0 1 x(k) ]', where x(k) is a vector of length m-k stored
28 * in A(k+1:m,k).
29 *
30 * Arguments
31 * =========
32 *
33 * M (input) INTEGER
34 * The number of rows of the matrix A.
35 *
36 * K (input) INTEGER
37 * The number of columns of A whose subdiagonal entries
38 * contain information about orthogonal transformations.
39 *
40 * A (input) DOUBLE PRECISION array, dimension (LDA,K)
41 * The (possibly partial) output of a QR reduction routine.
42 *
43 * LDA (input) INTEGER
44 * The leading dimension of the array A.
45 *
46 * TAU (input) DOUBLE PRECISION array, dimension (K)
47 * The scaling factors tau for the elementary transformations as
48 * computed by the QR factorization routine.
49 *
50 * WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
51 *
52 * LWORK (input) INTEGER
53 * The length of the array WORK. LWORK >= M*M + M.
54 *
55 * =====================================================================
56 *
57 * .. Parameters ..
58 DOUBLE PRECISION ZERO, ONE
59 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
60 * ..
61 * .. Local Scalars ..
62 INTEGER INFO, J
63 * ..
64 * .. External Functions ..
65 DOUBLE PRECISION DLAMCH, DLANGE
66 EXTERNAL DLAMCH, DLANGE
67 * ..
68 * .. External Subroutines ..
69 EXTERNAL DLASET, DORM2R, XERBLA
70 * ..
71 * .. Intrinsic Functions ..
72 INTRINSIC DBLE
73 * ..
74 * .. Local Arrays ..
75 DOUBLE PRECISION RDUMMY( 1 )
76 * ..
77 * .. Executable Statements ..
78 *
79 DQRT11 = ZERO
80 *
81 * Test for sufficient workspace
82 *
83 IF( LWORK.LT.M*M+M ) THEN
84 CALL XERBLA( 'DQRT11', 7 )
85 RETURN
86 END IF
87 *
88 * Quick return if possible
89 *
90 IF( M.LE.0 )
91 $ RETURN
92 *
93 CALL DLASET( 'Full', M, M, ZERO, ONE, WORK, M )
94 *
95 * Form Q
96 *
97 CALL DORM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK,
98 $ M, WORK( M*M+1 ), INFO )
99 *
100 * Form Q'*Q
101 *
102 CALL DORM2R( 'Left', 'Transpose', M, M, K, A, LDA, TAU, WORK, M,
103 $ WORK( M*M+1 ), INFO )
104 *
105 DO 10 J = 1, M
106 WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE
107 10 CONTINUE
108 *
109 DQRT11 = DLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
110 $ ( DBLE( M )*DLAMCH( 'Epsilon' ) )
111 *
112 RETURN
113 *
114 * End of DQRT11
115 *
116 END
2 *
3 * -- LAPACK routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER K, LDA, LWORK, M
9 * ..
10 * .. Array Arguments ..
11 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( LWORK )
12 * ..
13 *
14 * Purpose
15 * =======
16 *
17 * DQRT11 computes the test ratio
18 *
19 * || Q'*Q - I || / (eps * m)
20 *
21 * where the orthogonal matrix Q is represented as a product of
22 * elementary transformations. Each transformation has the form
23 *
24 * H(k) = I - tau(k) v(k) v(k)'
25 *
26 * where tau(k) is stored in TAU(k) and v(k) is an m-vector of the form
27 * [ 0 ... 0 1 x(k) ]', where x(k) is a vector of length m-k stored
28 * in A(k+1:m,k).
29 *
30 * Arguments
31 * =========
32 *
33 * M (input) INTEGER
34 * The number of rows of the matrix A.
35 *
36 * K (input) INTEGER
37 * The number of columns of A whose subdiagonal entries
38 * contain information about orthogonal transformations.
39 *
40 * A (input) DOUBLE PRECISION array, dimension (LDA,K)
41 * The (possibly partial) output of a QR reduction routine.
42 *
43 * LDA (input) INTEGER
44 * The leading dimension of the array A.
45 *
46 * TAU (input) DOUBLE PRECISION array, dimension (K)
47 * The scaling factors tau for the elementary transformations as
48 * computed by the QR factorization routine.
49 *
50 * WORK (workspace) DOUBLE PRECISION array, dimension (LWORK)
51 *
52 * LWORK (input) INTEGER
53 * The length of the array WORK. LWORK >= M*M + M.
54 *
55 * =====================================================================
56 *
57 * .. Parameters ..
58 DOUBLE PRECISION ZERO, ONE
59 PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
60 * ..
61 * .. Local Scalars ..
62 INTEGER INFO, J
63 * ..
64 * .. External Functions ..
65 DOUBLE PRECISION DLAMCH, DLANGE
66 EXTERNAL DLAMCH, DLANGE
67 * ..
68 * .. External Subroutines ..
69 EXTERNAL DLASET, DORM2R, XERBLA
70 * ..
71 * .. Intrinsic Functions ..
72 INTRINSIC DBLE
73 * ..
74 * .. Local Arrays ..
75 DOUBLE PRECISION RDUMMY( 1 )
76 * ..
77 * .. Executable Statements ..
78 *
79 DQRT11 = ZERO
80 *
81 * Test for sufficient workspace
82 *
83 IF( LWORK.LT.M*M+M ) THEN
84 CALL XERBLA( 'DQRT11', 7 )
85 RETURN
86 END IF
87 *
88 * Quick return if possible
89 *
90 IF( M.LE.0 )
91 $ RETURN
92 *
93 CALL DLASET( 'Full', M, M, ZERO, ONE, WORK, M )
94 *
95 * Form Q
96 *
97 CALL DORM2R( 'Left', 'No transpose', M, M, K, A, LDA, TAU, WORK,
98 $ M, WORK( M*M+1 ), INFO )
99 *
100 * Form Q'*Q
101 *
102 CALL DORM2R( 'Left', 'Transpose', M, M, K, A, LDA, TAU, WORK, M,
103 $ WORK( M*M+1 ), INFO )
104 *
105 DO 10 J = 1, M
106 WORK( ( J-1 )*M+J ) = WORK( ( J-1 )*M+J ) - ONE
107 10 CONTINUE
108 *
109 DQRT11 = DLANGE( 'One-norm', M, M, WORK, M, RDUMMY ) /
110 $ ( DBLE( M )*DLAMCH( 'Epsilon' ) )
111 *
112 RETURN
113 *
114 * End of DQRT11
115 *
116 END