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