|
2329
|
1 SUBROUTINE DGEQR2( M, N, A, LDA, TAU, WORK, INFO ) |
|
|
2 * |
|
3333
|
3 * -- LAPACK routine (version 3.0) -- |
|
2329
|
4 * Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd., |
|
|
5 * Courant Institute, Argonne National Lab, and Rice University |
|
|
6 * February 29, 1992 |
|
|
7 * |
|
|
8 * .. Scalar Arguments .. |
|
|
9 INTEGER INFO, LDA, M, N |
|
|
10 * .. |
|
|
11 * .. Array Arguments .. |
|
|
12 DOUBLE PRECISION A( LDA, * ), TAU( * ), WORK( * ) |
|
|
13 * .. |
|
|
14 * |
|
|
15 * Purpose |
|
|
16 * ======= |
|
|
17 * |
|
|
18 * DGEQR2 computes a QR factorization of a real m by n matrix A: |
|
|
19 * A = Q * R. |
|
|
20 * |
|
|
21 * Arguments |
|
|
22 * ========= |
|
|
23 * |
|
|
24 * M (input) INTEGER |
|
|
25 * The number of rows of the matrix A. M >= 0. |
|
|
26 * |
|
|
27 * N (input) INTEGER |
|
|
28 * The number of columns of the matrix A. N >= 0. |
|
|
29 * |
|
|
30 * A (input/output) DOUBLE PRECISION array, dimension (LDA,N) |
|
|
31 * On entry, the m by n matrix A. |
|
|
32 * On exit, the elements on and above the diagonal of the array |
|
|
33 * contain the min(m,n) by n upper trapezoidal matrix R (R is |
|
|
34 * upper triangular if m >= n); the elements below the diagonal, |
|
|
35 * with the array TAU, represent the orthogonal matrix Q as a |
|
|
36 * product of elementary reflectors (see Further Details). |
|
|
37 * |
|
|
38 * LDA (input) INTEGER |
|
|
39 * The leading dimension of the array A. LDA >= max(1,M). |
|
|
40 * |
|
|
41 * TAU (output) DOUBLE PRECISION array, dimension (min(M,N)) |
|
|
42 * The scalar factors of the elementary reflectors (see Further |
|
|
43 * Details). |
|
|
44 * |
|
|
45 * WORK (workspace) DOUBLE PRECISION array, dimension (N) |
|
|
46 * |
|
|
47 * INFO (output) INTEGER |
|
|
48 * = 0: successful exit |
|
|
49 * < 0: if INFO = -i, the i-th argument had an illegal value |
|
|
50 * |
|
|
51 * Further Details |
|
|
52 * =============== |
|
|
53 * |
|
|
54 * The matrix Q is represented as a product of elementary reflectors |
|
|
55 * |
|
|
56 * Q = H(1) H(2) . . . H(k), where k = min(m,n). |
|
|
57 * |
|
|
58 * Each H(i) has the form |
|
|
59 * |
|
|
60 * H(i) = I - tau * v * v' |
|
|
61 * |
|
|
62 * where tau is a real scalar, and v is a real vector with |
|
|
63 * v(1:i-1) = 0 and v(i) = 1; v(i+1:m) is stored on exit in A(i+1:m,i), |
|
|
64 * and tau in TAU(i). |
|
|
65 * |
|
|
66 * ===================================================================== |
|
|
67 * |
|
|
68 * .. Parameters .. |
|
|
69 DOUBLE PRECISION ONE |
|
|
70 PARAMETER ( ONE = 1.0D+0 ) |
|
|
71 * .. |
|
|
72 * .. Local Scalars .. |
|
|
73 INTEGER I, K |
|
|
74 DOUBLE PRECISION AII |
|
|
75 * .. |
|
|
76 * .. External Subroutines .. |
|
|
77 EXTERNAL DLARF, DLARFG, XERBLA |
|
|
78 * .. |
|
|
79 * .. Intrinsic Functions .. |
|
|
80 INTRINSIC MAX, MIN |
|
|
81 * .. |
|
|
82 * .. Executable Statements .. |
|
|
83 * |
|
|
84 * Test the input arguments |
|
|
85 * |
|
|
86 INFO = 0 |
|
|
87 IF( M.LT.0 ) THEN |
|
|
88 INFO = -1 |
|
|
89 ELSE IF( N.LT.0 ) THEN |
|
|
90 INFO = -2 |
|
|
91 ELSE IF( LDA.LT.MAX( 1, M ) ) THEN |
|
|
92 INFO = -4 |
|
|
93 END IF |
|
|
94 IF( INFO.NE.0 ) THEN |
|
|
95 CALL XERBLA( 'DGEQR2', -INFO ) |
|
|
96 RETURN |
|
|
97 END IF |
|
|
98 * |
|
|
99 K = MIN( M, N ) |
|
|
100 * |
|
|
101 DO 10 I = 1, K |
|
|
102 * |
|
|
103 * Generate elementary reflector H(i) to annihilate A(i+1:m,i) |
|
|
104 * |
|
|
105 CALL DLARFG( M-I+1, A( I, I ), A( MIN( I+1, M ), I ), 1, |
|
|
106 $ TAU( I ) ) |
|
|
107 IF( I.LT.N ) THEN |
|
|
108 * |
|
|
109 * Apply H(i) to A(i:m,i+1:n) from the left |
|
|
110 * |
|
|
111 AII = A( I, I ) |
|
|
112 A( I, I ) = ONE |
|
|
113 CALL DLARF( 'Left', M-I+1, N-I, A( I, I ), 1, TAU( I ), |
|
|
114 $ A( I, I+1 ), LDA, WORK ) |
|
|
115 A( I, I ) = AII |
|
|
116 END IF |
|
|
117 10 CONTINUE |
|
|
118 RETURN |
|
|
119 * |
|
|
120 * End of DGEQR2 |
|
|
121 * |
|
|
122 END |
