1: #region Translated by Jose Antonio De Santiago-Castillo.
2:
3: //Translated by Jose Antonio De Santiago-Castillo.
4: //E-mail:JAntonioDeSantiago@gmail.com
5: //Web: www.DotNumerics.com
6: //
7: //Fortran to C# Translation.
8: //Translated by:
9: //F2CSharp Version 0.71 (November 10, 2009)
10: //Code Optimizations: None
11: //
12: #endregion
13:
14: using System;
15: using DotNumerics.FortranLibrary;
16:
17: namespace DotNumerics.CSLapack
18: {
19: /// <summary>
20: /// -- LAPACK routine (version 3.1) --
21: /// Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
22: /// November 2006
23: /// Purpose
24: /// =======
25: ///
26: /// DORG2R generates an m by n real matrix Q with orthonormal columns,
27: /// which is defined as the first n columns of a product of k elementary
28: /// reflectors of order m
29: ///
30: /// Q = H(1) H(2) . . . H(k)
31: ///
32: /// as returned by DGEQRF.
33: ///
34: ///</summary>
35: public class DORG2R
36: {
37:
38:
39: #region Dependencies
40:
41: DLARF _dlarf; DSCAL _dscal; XERBLA _xerbla;
42:
43: #endregion
44:
45:
46: #region Fields
47:
48: const double ONE = 1.0E+0; const double ZERO = 0.0E+0; int I = 0; int J = 0; int L = 0;
49:
50: #endregion
51:
52: public DORG2R(DLARF dlarf, DSCAL dscal, XERBLA xerbla)
53: {
54:
55:
56: #region Set Dependencies
57:
58: this._dlarf = dlarf; this._dscal = dscal; this._xerbla = xerbla;
59:
60: #endregion
61:
62: }
63:
64: public DORG2R()
65: {
66:
67:
68: #region Dependencies (Initialization)
69:
70: LSAME lsame = new LSAME();
71: XERBLA xerbla = new XERBLA();
72: DSCAL dscal = new DSCAL();
73: DGEMV dgemv = new DGEMV(lsame, xerbla);
74: DGER dger = new DGER(xerbla);
75: DLARF dlarf = new DLARF(dgemv, dger, lsame);
76:
77: #endregion
78:
79:
80: #region Set Dependencies
81:
82: this._dlarf = dlarf; this._dscal = dscal; this._xerbla = xerbla;
83:
84: #endregion
85:
86: }
87: /// <summary>
88: /// Purpose
89: /// =======
90: ///
91: /// DORG2R generates an m by n real matrix Q with orthonormal columns,
92: /// which is defined as the first n columns of a product of k elementary
93: /// reflectors of order m
94: ///
95: /// Q = H(1) H(2) . . . H(k)
96: ///
97: /// as returned by DGEQRF.
98: ///
99: ///</summary>
100: /// <param name="M">
101: /// (input) INTEGER
102: /// The number of rows of the matrix Q. M .GE. 0.
103: ///</param>
104: /// <param name="N">
105: /// (input) INTEGER
106: /// The number of columns of the matrix Q. M .GE. N .GE. 0.
107: ///</param>
108: /// <param name="K">
109: /// (input) INTEGER
110: /// The number of elementary reflectors whose product defines the
111: /// matrix Q. N .GE. K .GE. 0.
112: ///</param>
113: /// <param name="A">
114: /// (input/output) DOUBLE PRECISION array, dimension (LDA,N)
115: /// On entry, the i-th column must contain the vector which
116: /// defines the elementary reflector H(i), for i = 1,2,...,k, as
117: /// returned by DGEQRF in the first k columns of its array
118: /// argument A.
119: /// On exit, the m-by-n matrix Q.
120: ///</param>
121: /// <param name="LDA">
122: /// (input) INTEGER
123: /// The first dimension of the array A. LDA .GE. max(1,M).
124: ///</param>
125: /// <param name="TAU">
126: /// (input) DOUBLE PRECISION array, dimension (K)
127: /// TAU(i) must contain the scalar factor of the elementary
128: /// reflector H(i), as returned by DGEQRF.
129: ///</param>
130: /// <param name="WORK">
131: /// (workspace) DOUBLE PRECISION array, dimension (N)
132: ///</param>
133: /// <param name="INFO">
134: /// (output) INTEGER
135: /// = 0: successful exit
136: /// .LT. 0: if INFO = -i, the i-th argument has an illegal value
137: ///</param>
138: public void Run(int M, int N, int K, ref double[] A, int offset_a, int LDA, double[] TAU, int offset_tau
139: , ref double[] WORK, int offset_work, ref int INFO)
140: {
141:
142: #region Array Index Correction
143:
144: int o_a = -1 - LDA + offset_a; int o_tau = -1 + offset_tau; int o_work = -1 + offset_work;
145:
146: #endregion
147:
148:
149: #region Prolog
150:
151: // *
152: // * -- LAPACK routine (version 3.1) --
153: // * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
154: // * November 2006
155: // *
156: // * .. Scalar Arguments ..
157: // * ..
158: // * .. Array Arguments ..
159: // * ..
160: // *
161: // * Purpose
162: // * =======
163: // *
164: // * DORG2R generates an m by n real matrix Q with orthonormal columns,
165: // * which is defined as the first n columns of a product of k elementary
166: // * reflectors of order m
167: // *
168: // * Q = H(1) H(2) . . . H(k)
169: // *
170: // * as returned by DGEQRF.
171: // *
172: // * Arguments
173: // * =========
174: // *
175: // * M (input) INTEGER
176: // * The number of rows of the matrix Q. M >= 0.
177: // *
178: // * N (input) INTEGER
179: // * The number of columns of the matrix Q. M >= N >= 0.
180: // *
181: // * K (input) INTEGER
182: // * The number of elementary reflectors whose product defines the
183: // * matrix Q. N >= K >= 0.
184: // *
185: // * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
186: // * On entry, the i-th column must contain the vector which
187: // * defines the elementary reflector H(i), for i = 1,2,...,k, as
188: // * returned by DGEQRF in the first k columns of its array
189: // * argument A.
190: // * On exit, the m-by-n matrix Q.
191: // *
192: // * LDA (input) INTEGER
193: // * The first dimension of the array A. LDA >= max(1,M).
194: // *
195: // * TAU (input) DOUBLE PRECISION array, dimension (K)
196: // * TAU(i) must contain the scalar factor of the elementary
197: // * reflector H(i), as returned by DGEQRF.
198: // *
199: // * WORK (workspace) DOUBLE PRECISION array, dimension (N)
200: // *
201: // * INFO (output) INTEGER
202: // * = 0: successful exit
203: // * < 0: if INFO = -i, the i-th argument has an illegal value
204: // *
205: // * =====================================================================
206: // *
207: // * .. Parameters ..
208: // * ..
209: // * .. Local Scalars ..
210: // * ..
211: // * .. External Subroutines ..
212: // * ..
213: // * .. Intrinsic Functions ..
214: // INTRINSIC MAX;
215: // * ..
216: // * .. Executable Statements ..
217: // *
218: // * Test the input arguments
219: // *
220:
221: #endregion
222:
223:
224: #region Body
225:
226: INFO = 0;
227: if (M < 0)
228: {
229: INFO = - 1;
230: }
231: else
232: {
233: if (N < 0 || N > M)
234: {
235: INFO = - 2;
236: }
237: else
238: {
239: if (K < 0 || K > N)
240: {
241: INFO = - 3;
242: }
243: else
244: {
245: if (LDA < Math.Max(1, M))
246: {
247: INFO = - 5;
248: }
249: }
250: }
251: }
252: if (INFO != 0)
253: {
254: this._xerbla.Run("DORG2R", - INFO);
255: return;
256: }
257: // *
258: // * Quick return if possible
259: // *
260: if (N <= 0) return;
261: // *
262: // * Initialise columns k+1:n to columns of the unit matrix
263: // *
264: for (J = K + 1; J <= N; J++)
265: {
266: for (L = 1; L <= M; L++)
267: {
268: A[L+J * LDA + o_a] = ZERO;
269: }
270: A[J+J * LDA + o_a] = ONE;
271: }
272: // *
273: for (I = K; I >= 1; I += - 1)
274: {
275: // *
276: // * Apply H(i) to A(i:m,i:n) from the left
277: // *
278: if (I < N)
279: {
280: A[I+I * LDA + o_a] = ONE;
281: this._dlarf.Run("Left", M - I + 1, N - I, A, I+I * LDA + o_a, 1, TAU[I + o_tau]
282: , ref A, I+(I + 1) * LDA + o_a, LDA, ref WORK, offset_work);
283: }
284: if (I < M) this._dscal.Run(M - I, - TAU[I + o_tau], ref A, I + 1+I * LDA + o_a, 1);
285: A[I+I * LDA + o_a] = ONE - TAU[I + o_tau];
286: // *
287: // * Set A(1:i-1,i) to zero
288: // *
289: for (L = 1; L <= I - 1; L++)
290: {
291: A[L+I * LDA + o_a] = ZERO;
292: }
293: }
294: return;
295: // *
296: // * End of DORG2R
297: // *
298:
299: #endregion
300:
301: }
302: }
303: }