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 auxiliary routine (version 3.1) --
21: /// Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
22: /// November 2006
23: /// Purpose
24: /// =======
25: ///
26: /// DLASCL multiplies the M by N real matrix A by the real scalar
27: /// CTO/CFROM. This is done without over/underflow as long as the final
28: /// result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
29: /// A may be full, upper triangular, lower triangular, upper Hessenberg,
30: /// or banded.
31: ///
32: ///</summary>
33: public class DLASCL
34: {
35:
36:
37: #region Dependencies
38:
39: LSAME _lsame; DLAMCH _dlamch; XERBLA _xerbla;
40:
41: #endregion
42:
43:
44: #region Fields
45:
46: const double ZERO = 0.0E0; const double ONE = 1.0E0; bool DONE = false; int I = 0; int ITYPE = 0; int J = 0; int K1 = 0;
47: int K2 = 0;int K3 = 0; int K4 = 0; double BIGNUM = 0; double CFROM1 = 0; double CFROMC = 0; double CTO1 = 0;
48: double CTOC = 0;double MUL = 0; double SMLNUM = 0;
49:
50: #endregion
51:
52: public DLASCL(LSAME lsame, DLAMCH dlamch, XERBLA xerbla)
53: {
54:
55:
56: #region Set Dependencies
57:
58: this._lsame = lsame; this._dlamch = dlamch; this._xerbla = xerbla;
59:
60: #endregion
61:
62: }
63:
64: public DLASCL()
65: {
66:
67:
68: #region Dependencies (Initialization)
69:
70: LSAME lsame = new LSAME();
71: DLAMC3 dlamc3 = new DLAMC3();
72: XERBLA xerbla = new XERBLA();
73: DLAMC1 dlamc1 = new DLAMC1(dlamc3);
74: DLAMC4 dlamc4 = new DLAMC4(dlamc3);
75: DLAMC5 dlamc5 = new DLAMC5(dlamc3);
76: DLAMC2 dlamc2 = new DLAMC2(dlamc3, dlamc1, dlamc4, dlamc5);
77: DLAMCH dlamch = new DLAMCH(lsame, dlamc2);
78:
79: #endregion
80:
81:
82: #region Set Dependencies
83:
84: this._lsame = lsame; this._dlamch = dlamch; this._xerbla = xerbla;
85:
86: #endregion
87:
88: }
89: /// <summary>
90: /// Purpose
91: /// =======
92: ///
93: /// DLASCL multiplies the M by N real matrix A by the real scalar
94: /// CTO/CFROM. This is done without over/underflow as long as the final
95: /// result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
96: /// A may be full, upper triangular, lower triangular, upper Hessenberg,
97: /// or banded.
98: ///
99: ///</summary>
100: /// <param name="TYPE">
101: /// (input) CHARACTER*1
102: /// TYPE indices the storage type of the input matrix.
103: /// = 'G': A is a full matrix.
104: /// = 'L': A is a lower triangular matrix.
105: /// = 'U': A is an upper triangular matrix.
106: /// = 'H': A is an upper Hessenberg matrix.
107: /// = 'B': A is a symmetric band matrix with lower bandwidth KL
108: /// and upper bandwidth KU and with the only the lower
109: /// half stored.
110: /// = 'Q': A is a symmetric band matrix with lower bandwidth KL
111: /// and upper bandwidth KU and with the only the upper
112: /// half stored.
113: /// = 'Z': A is a band matrix with lower bandwidth KL and upper
114: /// bandwidth KU.
115: ///</param>
116: /// <param name="KL">
117: /// (input) INTEGER
118: /// The lower bandwidth of A. Referenced only if TYPE = 'B',
119: /// 'Q' or 'Z'.
120: ///</param>
121: /// <param name="KU">
122: /// (input) INTEGER
123: /// The upper bandwidth of A. Referenced only if TYPE = 'B',
124: /// 'Q' or 'Z'.
125: ///</param>
126: /// <param name="CFROM">
127: /// (input) DOUBLE PRECISION
128: ///</param>
129: /// <param name="CTO">
130: /// (input) DOUBLE PRECISION
131: /// The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
132: /// without over/underflow if the final result CTO*A(I,J)/CFROM
133: /// can be represented without over/underflow. CFROM must be
134: /// nonzero.
135: ///</param>
136: /// <param name="M">
137: /// (input) INTEGER
138: /// The number of rows of the matrix A. M .GE. 0.
139: ///</param>
140: /// <param name="N">
141: /// (input) INTEGER
142: /// The number of columns of the matrix A. N .GE. 0.
143: ///</param>
144: /// <param name="A">
145: /// (input/output) DOUBLE PRECISION array, dimension (LDA,N)
146: /// The matrix to be multiplied by CTO/CFROM. See TYPE for the
147: /// storage type.
148: ///</param>
149: /// <param name="LDA">
150: /// (input) INTEGER
151: /// The leading dimension of the array A. LDA .GE. max(1,M).
152: ///</param>
153: /// <param name="INFO">
154: /// (output) INTEGER
155: /// 0 - successful exit
156: /// .LT.0 - if INFO = -i, the i-th argument had an illegal value.
157: ///</param>
158: public void Run(string TYPE, int KL, int KU, double CFROM, double CTO, int M
159: , int N, ref double[] A, int offset_a, int LDA, ref int INFO)
160: {
161:
162: #region Array Index Correction
163:
164: int o_a = -1 - LDA + offset_a;
165:
166: #endregion
167:
168:
169: #region Strings
170:
171: TYPE = TYPE.Substring(0, 1);
172:
173: #endregion
174:
175:
176: #region Prolog
177:
178: // *
179: // * -- LAPACK auxiliary routine (version 3.1) --
180: // * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
181: // * November 2006
182: // *
183: // * .. Scalar Arguments ..
184: // * ..
185: // * .. Array Arguments ..
186: // * ..
187: // *
188: // * Purpose
189: // * =======
190: // *
191: // * DLASCL multiplies the M by N real matrix A by the real scalar
192: // * CTO/CFROM. This is done without over/underflow as long as the final
193: // * result CTO*A(I,J)/CFROM does not over/underflow. TYPE specifies that
194: // * A may be full, upper triangular, lower triangular, upper Hessenberg,
195: // * or banded.
196: // *
197: // * Arguments
198: // * =========
199: // *
200: // * TYPE (input) CHARACTER*1
201: // * TYPE indices the storage type of the input matrix.
202: // * = 'G': A is a full matrix.
203: // * = 'L': A is a lower triangular matrix.
204: // * = 'U': A is an upper triangular matrix.
205: // * = 'H': A is an upper Hessenberg matrix.
206: // * = 'B': A is a symmetric band matrix with lower bandwidth KL
207: // * and upper bandwidth KU and with the only the lower
208: // * half stored.
209: // * = 'Q': A is a symmetric band matrix with lower bandwidth KL
210: // * and upper bandwidth KU and with the only the upper
211: // * half stored.
212: // * = 'Z': A is a band matrix with lower bandwidth KL and upper
213: // * bandwidth KU.
214: // *
215: // * KL (input) INTEGER
216: // * The lower bandwidth of A. Referenced only if TYPE = 'B',
217: // * 'Q' or 'Z'.
218: // *
219: // * KU (input) INTEGER
220: // * The upper bandwidth of A. Referenced only if TYPE = 'B',
221: // * 'Q' or 'Z'.
222: // *
223: // * CFROM (input) DOUBLE PRECISION
224: // * CTO (input) DOUBLE PRECISION
225: // * The matrix A is multiplied by CTO/CFROM. A(I,J) is computed
226: // * without over/underflow if the final result CTO*A(I,J)/CFROM
227: // * can be represented without over/underflow. CFROM must be
228: // * nonzero.
229: // *
230: // * M (input) INTEGER
231: // * The number of rows of the matrix A. M >= 0.
232: // *
233: // * N (input) INTEGER
234: // * The number of columns of the matrix A. N >= 0.
235: // *
236: // * A (input/output) DOUBLE PRECISION array, dimension (LDA,N)
237: // * The matrix to be multiplied by CTO/CFROM. See TYPE for the
238: // * storage type.
239: // *
240: // * LDA (input) INTEGER
241: // * The leading dimension of the array A. LDA >= max(1,M).
242: // *
243: // * INFO (output) INTEGER
244: // * 0 - successful exit
245: // * <0 - if INFO = -i, the i-th argument had an illegal value.
246: // *
247: // * =====================================================================
248: // *
249: // * .. Parameters ..
250: // * ..
251: // * .. Local Scalars ..
252: // * ..
253: // * .. External Functions ..
254: // * ..
255: // * .. Intrinsic Functions ..
256: // INTRINSIC ABS, MAX, MIN;
257: // * ..
258: // * .. External Subroutines ..
259: // * ..
260: // * .. Executable Statements ..
261: // *
262: // * Test the input arguments
263: // *
264:
265: #endregion
266:
267:
268: #region Body
269:
270: INFO = 0;
271: // *
272: if (this._lsame.Run(TYPE, "G"))
273: {
274: ITYPE = 0;
275: }
276: else
277: {
278: if (this._lsame.Run(TYPE, "L"))
279: {
280: ITYPE = 1;
281: }
282: else
283: {
284: if (this._lsame.Run(TYPE, "U"))
285: {
286: ITYPE = 2;
287: }
288: else
289: {
290: if (this._lsame.Run(TYPE, "H"))
291: {
292: ITYPE = 3;
293: }
294: else
295: {
296: if (this._lsame.Run(TYPE, "B"))
297: {
298: ITYPE = 4;
299: }
300: else
301: {
302: if (this._lsame.Run(TYPE, "Q"))
303: {
304: ITYPE = 5;
305: }
306: else
307: {
308: if (this._lsame.Run(TYPE, "Z"))
309: {
310: ITYPE = 6;
311: }
312: else
313: {
314: ITYPE = - 1;
315: }
316: }
317: }
318: }
319: }
320: }
321: }
322: // *
323: if (ITYPE == - 1)
324: {
325: INFO = - 1;
326: }
327: else
328: {
329: if (CFROM == ZERO)
330: {
331: INFO = - 4;
332: }
333: else
334: {
335: if (M < 0)
336: {
337: INFO = - 6;
338: }
339: else
340: {
341: if (N < 0 || (ITYPE == 4 && N != M) || (ITYPE == 5 && N != M))
342: {
343: INFO = - 7;
344: }
345: else
346: {
347: if (ITYPE <= 3 && LDA < Math.Max(1, M))
348: {
349: INFO = - 9;
350: }
351: else
352: {
353: if (ITYPE >= 4)
354: {
355: if (KL < 0 || KL > Math.Max(M - 1, 0))
356: {
357: INFO = - 2;
358: }
359: else
360: {
361: if (KU < 0 || KU > Math.Max(N - 1, 0) || ((ITYPE == 4 || ITYPE == 5) && KL != KU))
362: {
363: INFO = - 3;
364: }
365: else
366: {
367: if ((ITYPE == 4 && LDA < KL + 1) || (ITYPE == 5 && LDA < KU + 1) || (ITYPE == 6 && LDA < 2 * KL + KU + 1))
368: {
369: INFO = - 9;
370: }
371: }
372: }
373: }
374: }
375: }
376: }
377: }
378: }
379: // *
380: if (INFO != 0)
381: {
382: this._xerbla.Run("DLASCL", - INFO);
383: return;
384: }
385: // *
386: // * Quick return if possible
387: // *
388: if (N == 0 || M == 0) return;
389: // *
390: // * Get machine parameters
391: // *
392: SMLNUM = this._dlamch.Run("S");
393: BIGNUM = ONE / SMLNUM;
394: // *
395: CFROMC = CFROM;
396: CTOC = CTO;
397: // *
398: LABEL10:;
399: CFROM1 = CFROMC * SMLNUM;
400: CTO1 = CTOC / BIGNUM;
401: if (Math.Abs(CFROM1) > Math.Abs(CTOC) && CTOC != ZERO)
402: {
403: MUL = SMLNUM;
404: DONE = false;
405: CFROMC = CFROM1;
406: }
407: else
408: {
409: if (Math.Abs(CTO1) > Math.Abs(CFROMC))
410: {
411: MUL = BIGNUM;
412: DONE = false;
413: CTOC = CTO1;
414: }
415: else
416: {
417: MUL = CTOC / CFROMC;
418: DONE = true;
419: }
420: }
421: // *
422: if (ITYPE == 0)
423: {
424: // *
425: // * Full matrix
426: // *
427: for (J = 1; J <= N; J++)
428: {
429: for (I = 1; I <= M; I++)
430: {
431: A[I+J * LDA + o_a] = A[I+J * LDA + o_a] * MUL;
432: }
433: }
434: // *
435: }
436: else
437: {
438: if (ITYPE == 1)
439: {
440: // *
441: // * Lower triangular matrix
442: // *
443: for (J = 1; J <= N; J++)
444: {
445: for (I = J; I <= M; I++)
446: {
447: A[I+J * LDA + o_a] = A[I+J * LDA + o_a] * MUL;
448: }
449: }
450: // *
451: }
452: else
453: {
454: if (ITYPE == 2)
455: {
456: // *
457: // * Upper triangular matrix
458: // *
459: for (J = 1; J <= N; J++)
460: {
461: for (I = 1; I <= Math.Min(J, M); I++)
462: {
463: A[I+J * LDA + o_a] = A[I+J * LDA + o_a] * MUL;
464: }
465: }
466: // *
467: }
468: else
469: {
470: if (ITYPE == 3)
471: {
472: // *
473: // * Upper Hessenberg matrix
474: // *
475: for (J = 1; J <= N; J++)
476: {
477: for (I = 1; I <= Math.Min(J + 1, M); I++)
478: {
479: A[I+J * LDA + o_a] = A[I+J * LDA + o_a] * MUL;
480: }
481: }
482: // *
483: }
484: else
485: {
486: if (ITYPE == 4)
487: {
488: // *
489: // * Lower half of a symmetric band matrix
490: // *
491: K3 = KL + 1;
492: K4 = N + 1;
493: for (J = 1; J <= N; J++)
494: {
495: for (I = 1; I <= Math.Min(K3, K4 - J); I++)
496: {
497: A[I+J * LDA + o_a] = A[I+J * LDA + o_a] * MUL;
498: }
499: }
500: // *
501: }
502: else
503: {
504: if (ITYPE == 5)
505: {
506: // *
507: // * Upper half of a symmetric band matrix
508: // *
509: K1 = KU + 2;
510: K3 = KU + 1;
511: for (J = 1; J <= N; J++)
512: {
513: for (I = Math.Max(K1 - J, 1); I <= K3; I++)
514: {
515: A[I+J * LDA + o_a] = A[I+J * LDA + o_a] * MUL;
516: }
517: }
518: // *
519: }
520: else
521: {
522: if (ITYPE == 6)
523: {
524: // *
525: // * Band matrix
526: // *
527: K1 = KL + KU + 2;
528: K2 = KL + 1;
529: K3 = 2 * KL + KU + 1;
530: K4 = KL + KU + 1 + M;
531: for (J = 1; J <= N; J++)
532: {
533: for (I = Math.Max(K1 - J, K2); I <= Math.Min(K3, K4 - J); I++)
534: {
535: A[I+J * LDA + o_a] = A[I+J * LDA + o_a] * MUL;
536: }
537: }
538: // *
539: }
540: }
541: }
542: }
543: }
544: }
545: }
546: // *
547: if (!DONE) goto LABEL10;
548: // *
549: return;
550: // *
551: // * End of DLASCL
552: // *
553:
554: #endregion
555:
556: }
557: }
558: }