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: /// DORGL2 generates an m by n real matrix Q with orthonormal rows,
27: /// which is defined as the first m rows of a product of k elementary
28: /// reflectors of order n
29: ///
30: /// Q = H(k) . . . H(2) H(1)
31: ///
32: /// as returned by DGELQF.
33: ///
34: ///</summary>
35: public class DORGL2
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 DORGL2(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 DORGL2()
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: /// DORGL2 generates an m by n real matrix Q with orthonormal rows,
92: /// which is defined as the first m rows of a product of k elementary
93: /// reflectors of order n
94: ///
95: /// Q = H(k) . . . H(2) H(1)
96: ///
97: /// as returned by DGELQF.
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. N .GE. M.
107: ///</param>
108: /// <param name="K">
109: /// (input) INTEGER
110: /// The number of elementary reflectors whose product defines the
111: /// matrix Q. M .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 row must contain the vector which defines
116: /// the elementary reflector H(i), for i = 1,2,...,k, as returned
117: /// by DGELQF in the first k rows of its array argument A.
118: /// On exit, the m-by-n matrix Q.
119: ///</param>
120: /// <param name="LDA">
121: /// (input) INTEGER
122: /// The first dimension of the array A. LDA .GE. max(1,M).
123: ///</param>
124: /// <param name="TAU">
125: /// (input) DOUBLE PRECISION array, dimension (K)
126: /// TAU(i) must contain the scalar factor of the elementary
127: /// reflector H(i), as returned by DGELQF.
128: ///</param>
129: /// <param name="WORK">
130: /// (workspace) DOUBLE PRECISION array, dimension (M)
131: ///</param>
132: /// <param name="INFO">
133: /// (output) INTEGER
134: /// = 0: successful exit
135: /// .LT. 0: if INFO = -i, the i-th argument has an illegal value
136: ///</param>
137: public void Run(int M, int N, int K, ref double[] A, int offset_a, int LDA, double[] TAU, int offset_tau
138: , ref double[] WORK, int offset_work, ref int INFO)
139: {
140:
141: #region Array Index Correction
142:
143: int o_a = -1 - LDA + offset_a; int o_tau = -1 + offset_tau; int o_work = -1 + offset_work;
144:
145: #endregion
146:
147:
148: #region Prolog
149:
150: // *
151: // * -- LAPACK routine (version 3.1) --
152: // * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
153: // * November 2006
154: // *
155: // * .. Scalar Arguments ..
156: // * ..
157: // * .. Array Arguments ..
158: // * ..
159: // *
160: // * Purpose
161: // * =======
162: // *
163: // * DORGL2 generates an m by n real matrix Q with orthonormal rows,
164: // * which is defined as the first m rows of a product of k elementary
165: // * reflectors of order n
166: // *
167: // * Q = H(k) . . . H(2) H(1)
168: // *
169: // * as returned by DGELQF.
170: // *
171: // * Arguments
172: // * =========
173: // *
174: // * M (input) INTEGER
175: // * The number of rows of the matrix Q. M >= 0.
176: // *
177: // * N (input) INTEGER
178: // * The number of columns of the matrix Q. N >= M.
179: // *
180: // * K (input) INTEGER
181: // * The number of elementary reflectors whose product defines the
182: // * matrix Q. M >= K >= 0.
183: // *
184: // * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
185: // * On entry, the i-th row must contain the vector which defines
186: // * the elementary reflector H(i), for i = 1,2,...,k, as returned
187: // * by DGELQF in the first k rows of its array argument A.
188: // * On exit, the m-by-n matrix Q.
189: // *
190: // * LDA (input) INTEGER
191: // * The first dimension of the array A. LDA >= max(1,M).
192: // *
193: // * TAU (input) DOUBLE PRECISION array, dimension (K)
194: // * TAU(i) must contain the scalar factor of the elementary
195: // * reflector H(i), as returned by DGELQF.
196: // *
197: // * WORK (workspace) DOUBLE PRECISION array, dimension (M)
198: // *
199: // * INFO (output) INTEGER
200: // * = 0: successful exit
201: // * < 0: if INFO = -i, the i-th argument has an illegal value
202: // *
203: // * =====================================================================
204: // *
205: // * .. Parameters ..
206: // * ..
207: // * .. Local Scalars ..
208: // * ..
209: // * .. External Subroutines ..
210: // * ..
211: // * .. Intrinsic Functions ..
212: // INTRINSIC MAX;
213: // * ..
214: // * .. Executable Statements ..
215: // *
216: // * Test the input arguments
217: // *
218:
219: #endregion
220:
221:
222: #region Body
223:
224: INFO = 0;
225: if (M < 0)
226: {
227: INFO = - 1;
228: }
229: else
230: {
231: if (N < M)
232: {
233: INFO = - 2;
234: }
235: else
236: {
237: if (K < 0 || K > M)
238: {
239: INFO = - 3;
240: }
241: else
242: {
243: if (LDA < Math.Max(1, M))
244: {
245: INFO = - 5;
246: }
247: }
248: }
249: }
250: if (INFO != 0)
251: {
252: this._xerbla.Run("DORGL2", - INFO);
253: return;
254: }
255: // *
256: // * Quick return if possible
257: // *
258: if (M <= 0) return;
259: // *
260: if (K < M)
261: {
262: // *
263: // * Initialise rows k+1:m to rows of the unit matrix
264: // *
265: for (J = 1; J <= N; J++)
266: {
267: for (L = K + 1; L <= M; L++)
268: {
269: A[L+J * LDA + o_a] = ZERO;
270: }
271: if (J > K && J <= M) A[J+J * LDA + o_a] = ONE;
272: }
273: }
274: // *
275: for (I = K; I >= 1; I += - 1)
276: {
277: // *
278: // * Apply H(i) to A(i:m,i:n) from the right
279: // *
280: if (I < N)
281: {
282: if (I < M)
283: {
284: A[I+I * LDA + o_a] = ONE;
285: this._dlarf.Run("Right", M - I, N - I + 1, A, I+I * LDA + o_a, LDA, TAU[I + o_tau]
286: , ref A, I + 1+I * LDA + o_a, LDA, ref WORK, offset_work);
287: }
288: this._dscal.Run(N - I, - TAU[I + o_tau], ref A, I+(I + 1) * LDA + o_a, LDA);
289: }
290: A[I+I * LDA + o_a] = ONE - TAU[I + o_tau];
291: // *
292: // * Set A(i,1:i-1) to zero
293: // *
294: for (L = 1; L <= I - 1; L++)
295: {
296: A[I+L * LDA + o_a] = ZERO;
297: }
298: }
299: return;
300: // *
301: // * End of DORGL2
302: // *
303:
304: #endregion
305:
306: }
307: }
308: }