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: /// DGERQ2 computes an RQ factorization of a real m by n matrix A:
27: /// A = R * Q.
28: ///
29: ///</summary>
30: public class DGERQ2
31: {
32:
33:
34: #region Dependencies
35:
36: DLARF _dlarf; DLARFG _dlarfg; XERBLA _xerbla;
37:
38: #endregion
39:
40:
41: #region Fields
42:
43: const double ONE = 1.0E+0; int I = 0; int K = 0; double AII = 0;
44:
45: #endregion
46:
47: public DGERQ2(DLARF dlarf, DLARFG dlarfg, XERBLA xerbla)
48: {
49:
50:
51: #region Set Dependencies
52:
53: this._dlarf = dlarf; this._dlarfg = dlarfg; this._xerbla = xerbla;
54:
55: #endregion
56:
57: }
58:
59: public DGERQ2()
60: {
61:
62:
63: #region Dependencies (Initialization)
64:
65: LSAME lsame = new LSAME();
66: XERBLA xerbla = new XERBLA();
67: DLAMC3 dlamc3 = new DLAMC3();
68: DLAPY2 dlapy2 = new DLAPY2();
69: DNRM2 dnrm2 = new DNRM2();
70: DSCAL dscal = new DSCAL();
71: DGEMV dgemv = new DGEMV(lsame, xerbla);
72: DGER dger = new DGER(xerbla);
73: DLARF dlarf = new DLARF(dgemv, dger, lsame);
74: DLAMC1 dlamc1 = new DLAMC1(dlamc3);
75: DLAMC4 dlamc4 = new DLAMC4(dlamc3);
76: DLAMC5 dlamc5 = new DLAMC5(dlamc3);
77: DLAMC2 dlamc2 = new DLAMC2(dlamc3, dlamc1, dlamc4, dlamc5);
78: DLAMCH dlamch = new DLAMCH(lsame, dlamc2);
79: DLARFG dlarfg = new DLARFG(dlamch, dlapy2, dnrm2, dscal);
80:
81: #endregion
82:
83:
84: #region Set Dependencies
85:
86: this._dlarf = dlarf; this._dlarfg = dlarfg; this._xerbla = xerbla;
87:
88: #endregion
89:
90: }
91: /// <summary>
92: /// Purpose
93: /// =======
94: ///
95: /// DGERQ2 computes an RQ factorization of a real m by n matrix A:
96: /// A = R * Q.
97: ///
98: ///</summary>
99: /// <param name="M">
100: /// (input) INTEGER
101: /// The number of rows of the matrix A. M .GE. 0.
102: ///</param>
103: /// <param name="N">
104: /// (input) INTEGER
105: /// The number of columns of the matrix A. N .GE. 0.
106: ///</param>
107: /// <param name="A">
108: /// (input/output) DOUBLE PRECISION array, dimension (LDA,N)
109: /// On entry, the m by n matrix A.
110: /// On exit, if m .LE. n, the upper triangle of the subarray
111: /// A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
112: /// if m .GE. n, the elements on and above the (m-n)-th subdiagonal
113: /// contain the m by n upper trapezoidal matrix R; the remaining
114: /// elements, with the array TAU, represent the orthogonal matrix
115: /// Q as a product of elementary reflectors (see Further
116: /// Details).
117: ///</param>
118: /// <param name="LDA">
119: /// (input) INTEGER
120: /// The leading dimension of the array A. LDA .GE. max(1,M).
121: ///</param>
122: /// <param name="TAU">
123: /// (output) DOUBLE PRECISION array, dimension (min(M,N))
124: /// The scalar factors of the elementary reflectors (see Further
125: /// Details).
126: ///</param>
127: /// <param name="WORK">
128: /// (workspace) DOUBLE PRECISION array, dimension (M)
129: ///</param>
130: /// <param name="INFO">
131: /// (output) INTEGER
132: /// = 0: successful exit
133: /// .LT. 0: if INFO = -i, the i-th argument had an illegal value
134: ///</param>
135: public void Run(int M, int N, ref double[] A, int offset_a, int LDA, ref double[] TAU, int offset_tau, ref double[] WORK, int offset_work
136: , ref int INFO)
137: {
138:
139: #region Array Index Correction
140:
141: int o_a = -1 - LDA + offset_a; int o_tau = -1 + offset_tau; int o_work = -1 + offset_work;
142:
143: #endregion
144:
145:
146: #region Prolog
147:
148: // *
149: // * -- LAPACK routine (version 3.1) --
150: // * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
151: // * November 2006
152: // *
153: // * .. Scalar Arguments ..
154: // * ..
155: // * .. Array Arguments ..
156: // * ..
157: // *
158: // * Purpose
159: // * =======
160: // *
161: // * DGERQ2 computes an RQ factorization of a real m by n matrix A:
162: // * A = R * Q.
163: // *
164: // * Arguments
165: // * =========
166: // *
167: // * M (input) INTEGER
168: // * The number of rows of the matrix A. M >= 0.
169: // *
170: // * N (input) INTEGER
171: // * The number of columns of the matrix A. N >= 0.
172: // *
173: // * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
174: // * On entry, the m by n matrix A.
175: // * On exit, if m <= n, the upper triangle of the subarray
176: // * A(1:m,n-m+1:n) contains the m by m upper triangular matrix R;
177: // * if m >= n, the elements on and above the (m-n)-th subdiagonal
178: // * contain the m by n upper trapezoidal matrix R; the remaining
179: // * elements, with the array TAU, represent the orthogonal matrix
180: // * Q as a product of elementary reflectors (see Further
181: // * Details).
182: // *
183: // * LDA (input) INTEGER
184: // * The leading dimension of the array A. LDA >= max(1,M).
185: // *
186: // * TAU (output) DOUBLE PRECISION array, dimension (min(M,N))
187: // * The scalar factors of the elementary reflectors (see Further
188: // * Details).
189: // *
190: // * WORK (workspace) DOUBLE PRECISION array, dimension (M)
191: // *
192: // * INFO (output) INTEGER
193: // * = 0: successful exit
194: // * < 0: if INFO = -i, the i-th argument had an illegal value
195: // *
196: // * Further Details
197: // * ===============
198: // *
199: // * The matrix Q is represented as a product of elementary reflectors
200: // *
201: // * Q = H(1) H(2) . . . H(k), where k = min(m,n).
202: // *
203: // * Each H(i) has the form
204: // *
205: // * H(i) = I - tau * v * v'
206: // *
207: // * where tau is a real scalar, and v is a real vector with
208: // * v(n-k+i+1:n) = 0 and v(n-k+i) = 1; v(1:n-k+i-1) is stored on exit in
209: // * A(m-k+i,1:n-k+i-1), and tau in TAU(i).
210: // *
211: // * =====================================================================
212: // *
213: // * .. Parameters ..
214: // * ..
215: // * .. Local Scalars ..
216: // * ..
217: // * .. External Subroutines ..
218: // * ..
219: // * .. Intrinsic Functions ..
220: // INTRINSIC MAX, MIN;
221: // * ..
222: // * .. Executable Statements ..
223: // *
224: // * Test the input arguments
225: // *
226:
227: #endregion
228:
229:
230: #region Body
231:
232: INFO = 0;
233: if (M < 0)
234: {
235: INFO = - 1;
236: }
237: else
238: {
239: if (N < 0)
240: {
241: INFO = - 2;
242: }
243: else
244: {
245: if (LDA < Math.Max(1, M))
246: {
247: INFO = - 4;
248: }
249: }
250: }
251: if (INFO != 0)
252: {
253: this._xerbla.Run("DGERQ2", - INFO);
254: return;
255: }
256: // *
257: K = Math.Min(M, N);
258: // *
259: for (I = K; I >= 1; I += - 1)
260: {
261: // *
262: // * Generate elementary reflector H(i) to annihilate
263: // * A(m-k+i,1:n-k+i-1)
264: // *
265: this._dlarfg.Run(N - K + I, ref A[M - K + I+(N - K + I) * LDA + o_a], ref A, M - K + I+1 * LDA + o_a, LDA, ref TAU[I + o_tau]);
266: // *
267: // * Apply H(i) to A(1:m-k+i-1,1:n-k+i) from the right
268: // *
269: AII = A[M - K + I+(N - K + I) * LDA + o_a];
270: A[M - K + I+(N - K + I) * LDA + o_a] = ONE;
271: this._dlarf.Run("Right", M - K + I - 1, N - K + I, A, M - K + I+1 * LDA + o_a, LDA, TAU[I + o_tau]
272: , ref A, offset_a, LDA, ref WORK, offset_work);
273: A[M - K + I+(N - K + I) * LDA + o_a] = AII;
274: }
275: return;
276: // *
277: // * End of DGERQ2
278: // *
279:
280: #endregion
281:
282: }
283: }
284: }