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: /// DORML2 overwrites the general real m by n matrix C with
27: ///
28: /// Q * C if SIDE = 'L' and TRANS = 'N', or
29: ///
30: /// Q'* C if SIDE = 'L' and TRANS = 'T', or
31: ///
32: /// C * Q if SIDE = 'R' and TRANS = 'N', or
33: ///
34: /// C * Q' if SIDE = 'R' and TRANS = 'T',
35: ///
36: /// where Q is a real orthogonal matrix defined as the product of k
37: /// elementary reflectors
38: ///
39: /// Q = H(k) . . . H(2) H(1)
40: ///
41: /// as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
42: /// if SIDE = 'R'.
43: ///
44: ///</summary>
45: public class DORML2
46: {
47:
48:
49: #region Dependencies
50:
51: LSAME _lsame; DLARF _dlarf; XERBLA _xerbla;
52:
53: #endregion
54:
55:
56: #region Fields
57:
58: const double ONE = 1.0E+0; bool LEFT = false; bool NOTRAN = false; int I = 0; int I1 = 0; int I2 = 0; int I3 = 0;
59: int IC = 0;int JC = 0; int MI = 0; int NI = 0; int NQ = 0; double AII = 0;
60:
61: #endregion
62:
63: public DORML2(LSAME lsame, DLARF dlarf, XERBLA xerbla)
64: {
65:
66:
67: #region Set Dependencies
68:
69: this._lsame = lsame; this._dlarf = dlarf; this._xerbla = xerbla;
70:
71: #endregion
72:
73: }
74:
75: public DORML2()
76: {
77:
78:
79: #region Dependencies (Initialization)
80:
81: LSAME lsame = new LSAME();
82: XERBLA xerbla = new XERBLA();
83: DGEMV dgemv = new DGEMV(lsame, xerbla);
84: DGER dger = new DGER(xerbla);
85: DLARF dlarf = new DLARF(dgemv, dger, lsame);
86:
87: #endregion
88:
89:
90: #region Set Dependencies
91:
92: this._lsame = lsame; this._dlarf = dlarf; this._xerbla = xerbla;
93:
94: #endregion
95:
96: }
97: /// <summary>
98: /// Purpose
99: /// =======
100: ///
101: /// DORML2 overwrites the general real m by n matrix C with
102: ///
103: /// Q * C if SIDE = 'L' and TRANS = 'N', or
104: ///
105: /// Q'* C if SIDE = 'L' and TRANS = 'T', or
106: ///
107: /// C * Q if SIDE = 'R' and TRANS = 'N', or
108: ///
109: /// C * Q' if SIDE = 'R' and TRANS = 'T',
110: ///
111: /// where Q is a real orthogonal matrix defined as the product of k
112: /// elementary reflectors
113: ///
114: /// Q = H(k) . . . H(2) H(1)
115: ///
116: /// as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
117: /// if SIDE = 'R'.
118: ///
119: ///</summary>
120: /// <param name="SIDE">
121: /// (input) CHARACTER*1
122: /// = 'L': apply Q or Q' from the Left
123: /// = 'R': apply Q or Q' from the Right
124: ///</param>
125: /// <param name="TRANS">
126: /// (input) CHARACTER*1
127: /// = 'N': apply Q (No transpose)
128: /// = 'T': apply Q' (Transpose)
129: ///</param>
130: /// <param name="M">
131: /// (input) INTEGER
132: /// The number of rows of the matrix C. M .GE. 0.
133: ///</param>
134: /// <param name="N">
135: /// (input) INTEGER
136: /// The number of columns of the matrix C. N .GE. 0.
137: ///</param>
138: /// <param name="K">
139: /// (input) INTEGER
140: /// The number of elementary reflectors whose product defines
141: /// the matrix Q.
142: /// If SIDE = 'L', M .GE. K .GE. 0;
143: /// if SIDE = 'R', N .GE. K .GE. 0.
144: ///</param>
145: /// <param name="A">
146: /// (input) DOUBLE PRECISION array, dimension
147: /// (LDA,M) if SIDE = 'L',
148: /// (LDA,N) if SIDE = 'R'
149: /// The i-th row must contain the vector which defines the
150: /// elementary reflector H(i), for i = 1,2,...,k, as returned by
151: /// DGELQF in the first k rows of its array argument A.
152: /// A is modified by the routine but restored on exit.
153: ///</param>
154: /// <param name="LDA">
155: /// (input) INTEGER
156: /// The leading dimension of the array A. LDA .GE. max(1,K).
157: ///</param>
158: /// <param name="TAU">
159: /// (input) DOUBLE PRECISION array, dimension (K)
160: /// TAU(i) must contain the scalar factor of the elementary
161: /// reflector H(i), as returned by DGELQF.
162: ///</param>
163: /// <param name="C">
164: /// * Q if SIDE = 'R' and TRANS = 'N', or
165: ///</param>
166: /// <param name="LDC">
167: /// (input) INTEGER
168: /// The leading dimension of the array C. LDC .GE. max(1,M).
169: ///</param>
170: /// <param name="WORK">
171: /// (workspace) DOUBLE PRECISION array, dimension
172: /// (N) if SIDE = 'L',
173: /// (M) if SIDE = 'R'
174: ///</param>
175: /// <param name="INFO">
176: /// (output) INTEGER
177: /// = 0: successful exit
178: /// .LT. 0: if INFO = -i, the i-th argument had an illegal value
179: ///</param>
180: public void Run(string SIDE, string TRANS, int M, int N, int K, ref double[] A, int offset_a
181: , int LDA, double[] TAU, int offset_tau, ref double[] C, int offset_c, int LDC, ref double[] WORK, int offset_work, ref int INFO)
182: {
183:
184: #region Array Index Correction
185:
186: int o_a = -1 - LDA + offset_a; int o_tau = -1 + offset_tau; int o_c = -1 - LDC + offset_c;
187: int o_work = -1 + offset_work;
188:
189: #endregion
190:
191:
192: #region Strings
193:
194: SIDE = SIDE.Substring(0, 1); TRANS = TRANS.Substring(0, 1);
195:
196: #endregion
197:
198:
199: #region Prolog
200:
201: // *
202: // * -- LAPACK routine (version 3.1) --
203: // * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
204: // * November 2006
205: // *
206: // * .. Scalar Arguments ..
207: // * ..
208: // * .. Array Arguments ..
209: // * ..
210: // *
211: // * Purpose
212: // * =======
213: // *
214: // * DORML2 overwrites the general real m by n matrix C with
215: // *
216: // * Q * C if SIDE = 'L' and TRANS = 'N', or
217: // *
218: // * Q'* C if SIDE = 'L' and TRANS = 'T', or
219: // *
220: // * C * Q if SIDE = 'R' and TRANS = 'N', or
221: // *
222: // * C * Q' if SIDE = 'R' and TRANS = 'T',
223: // *
224: // * where Q is a real orthogonal matrix defined as the product of k
225: // * elementary reflectors
226: // *
227: // * Q = H(k) . . . H(2) H(1)
228: // *
229: // * as returned by DGELQF. Q is of order m if SIDE = 'L' and of order n
230: // * if SIDE = 'R'.
231: // *
232: // * Arguments
233: // * =========
234: // *
235: // * SIDE (input) CHARACTER*1
236: // * = 'L': apply Q or Q' from the Left
237: // * = 'R': apply Q or Q' from the Right
238: // *
239: // * TRANS (input) CHARACTER*1
240: // * = 'N': apply Q (No transpose)
241: // * = 'T': apply Q' (Transpose)
242: // *
243: // * M (input) INTEGER
244: // * The number of rows of the matrix C. M >= 0.
245: // *
246: // * N (input) INTEGER
247: // * The number of columns of the matrix C. N >= 0.
248: // *
249: // * K (input) INTEGER
250: // * The number of elementary reflectors whose product defines
251: // * the matrix Q.
252: // * If SIDE = 'L', M >= K >= 0;
253: // * if SIDE = 'R', N >= K >= 0.
254: // *
255: // * A (input) DOUBLE PRECISION array, dimension
256: // * (LDA,M) if SIDE = 'L',
257: // * (LDA,N) if SIDE = 'R'
258: // * The i-th row must contain the vector which defines the
259: // * elementary reflector H(i), for i = 1,2,...,k, as returned by
260: // * DGELQF in the first k rows of its array argument A.
261: // * A is modified by the routine but restored on exit.
262: // *
263: // * LDA (input) INTEGER
264: // * The leading dimension of the array A. LDA >= max(1,K).
265: // *
266: // * TAU (input) DOUBLE PRECISION array, dimension (K)
267: // * TAU(i) must contain the scalar factor of the elementary
268: // * reflector H(i), as returned by DGELQF.
269: // *
270: // * C (input/output) DOUBLE PRECISION array, dimension (LDC,N)
271: // * On entry, the m by n matrix C.
272: // * On exit, C is overwritten by Q*C or Q'*C or C*Q' or C*Q.
273: // *
274: // * LDC (input) INTEGER
275: // * The leading dimension of the array C. LDC >= max(1,M).
276: // *
277: // * WORK (workspace) DOUBLE PRECISION array, dimension
278: // * (N) if SIDE = 'L',
279: // * (M) if SIDE = 'R'
280: // *
281: // * INFO (output) INTEGER
282: // * = 0: successful exit
283: // * < 0: if INFO = -i, the i-th argument had an illegal value
284: // *
285: // * =====================================================================
286: // *
287: // * .. Parameters ..
288: // * ..
289: // * .. Local Scalars ..
290: // * ..
291: // * .. External Functions ..
292: // * ..
293: // * .. External Subroutines ..
294: // * ..
295: // * .. Intrinsic Functions ..
296: // INTRINSIC MAX;
297: // * ..
298: // * .. Executable Statements ..
299: // *
300: // * Test the input arguments
301: // *
302:
303: #endregion
304:
305:
306: #region Body
307:
308: INFO = 0;
309: LEFT = this._lsame.Run(SIDE, "L");
310: NOTRAN = this._lsame.Run(TRANS, "N");
311: // *
312: // * NQ is the order of Q
313: // *
314: if (LEFT)
315: {
316: NQ = M;
317: }
318: else
319: {
320: NQ = N;
321: }
322: if (!LEFT && !this._lsame.Run(SIDE, "R"))
323: {
324: INFO = - 1;
325: }
326: else
327: {
328: if (!NOTRAN && !this._lsame.Run(TRANS, "T"))
329: {
330: INFO = - 2;
331: }
332: else
333: {
334: if (M < 0)
335: {
336: INFO = - 3;
337: }
338: else
339: {
340: if (N < 0)
341: {
342: INFO = - 4;
343: }
344: else
345: {
346: if (K < 0 || K > NQ)
347: {
348: INFO = - 5;
349: }
350: else
351: {
352: if (LDA < Math.Max(1, K))
353: {
354: INFO = - 7;
355: }
356: else
357: {
358: if (LDC < Math.Max(1, M))
359: {
360: INFO = - 10;
361: }
362: }
363: }
364: }
365: }
366: }
367: }
368: if (INFO != 0)
369: {
370: this._xerbla.Run("DORML2", - INFO);
371: return;
372: }
373: // *
374: // * Quick return if possible
375: // *
376: if (M == 0 || N == 0 || K == 0) return;
377: // *
378: if ((LEFT && NOTRAN) || (!LEFT && !NOTRAN))
379: {
380: I1 = 1;
381: I2 = K;
382: I3 = 1;
383: }
384: else
385: {
386: I1 = K;
387: I2 = 1;
388: I3 = - 1;
389: }
390: // *
391: if (LEFT)
392: {
393: NI = N;
394: JC = 1;
395: }
396: else
397: {
398: MI = M;
399: IC = 1;
400: }
401: // *
402: for (I = I1; (I3 >= 0) ? (I <= I2) : (I >= I2); I += I3)
403: {
404: if (LEFT)
405: {
406: // *
407: // * H(i) is applied to C(i:m,1:n)
408: // *
409: MI = M - I + 1;
410: IC = I;
411: }
412: else
413: {
414: // *
415: // * H(i) is applied to C(1:m,i:n)
416: // *
417: NI = N - I + 1;
418: JC = I;
419: }
420: // *
421: // * Apply H(i)
422: // *
423: AII = A[I+I * LDA + o_a];
424: A[I+I * LDA + o_a] = ONE;
425: this._dlarf.Run(SIDE, MI, NI, A, I+I * LDA + o_a, LDA, TAU[I + o_tau]
426: , ref C, IC+JC * LDC + o_c, LDC, ref WORK, offset_work);
427: A[I+I * LDA + o_a] = AII;
428: }
429: return;
430: // *
431: // * End of DORML2
432: // *
433:
434: #endregion
435:
436: }
437: }
438: }