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: /// Sort the numbers in D in increasing order (if ID = 'I') or
27: /// in decreasing order (if ID = 'D' ).
28: ///
29: /// Use Quick Sort, reverting to Insertion sort on arrays of
30: /// size .LE. 20. Dimension of STACK limits N to about 2**32.
31: ///
32: ///</summary>
33: public class DLASRT
34: {
35:
36:
37: #region Dependencies
38:
39: LSAME _lsame; XERBLA _xerbla;
40:
41: #endregion
42:
43:
44: #region Fields
45:
46: const int SELECT = 20; int DIR = 0; int ENDD = 0; int I = 0; int J = 0; int START = 0; int STKPNT = 0; double D1 = 0;
47: double D2 = 0;double D3 = 0; double DMNMX = 0; double TMP = 0; int[] STACK = new int[2 * 32]; int o_stack = -3;
48:
49: #endregion
50:
51: public DLASRT(LSAME lsame, XERBLA xerbla)
52: {
53:
54:
55: #region Set Dependencies
56:
57: this._lsame = lsame; this._xerbla = xerbla;
58:
59: #endregion
60:
61: }
62:
63: public DLASRT()
64: {
65:
66:
67: #region Dependencies (Initialization)
68:
69: LSAME lsame = new LSAME();
70: XERBLA xerbla = new XERBLA();
71:
72: #endregion
73:
74:
75: #region Set Dependencies
76:
77: this._lsame = lsame; this._xerbla = xerbla;
78:
79: #endregion
80:
81: }
82: /// <summary>
83: /// Purpose
84: /// =======
85: ///
86: /// Sort the numbers in D in increasing order (if ID = 'I') or
87: /// in decreasing order (if ID = 'D' ).
88: ///
89: /// Use Quick Sort, reverting to Insertion sort on arrays of
90: /// size .LE. 20. Dimension of STACK limits N to about 2**32.
91: ///
92: ///</summary>
93: /// <param name="ID">
94: /// (input) CHARACTER*1
95: /// = 'I': sort D in increasing order;
96: /// = 'D': sort D in decreasing order.
97: ///</param>
98: /// <param name="N">
99: /// (input) INTEGER
100: /// The length of the array D.
101: ///</param>
102: /// <param name="D">
103: /// (input/output) DOUBLE PRECISION array, dimension (N)
104: /// On entry, the array to be sorted.
105: /// On exit, D has been sorted into increasing order
106: /// (D(1) .LE. ... .LE. D(N) ) or into decreasing order
107: /// (D(1) .GE. ... .GE. D(N) ), depending on ID.
108: ///</param>
109: /// <param name="INFO">
110: /// (output) INTEGER
111: /// = 0: successful exit
112: /// .LT. 0: if INFO = -i, the i-th argument had an illegal value
113: ///</param>
114: public void Run(string ID, int N, ref double[] D, int offset_d, ref int INFO)
115: {
116:
117: #region Array Index Correction
118:
119: int o_d = -1 + offset_d;
120:
121: #endregion
122:
123:
124: #region Strings
125:
126: ID = ID.Substring(0, 1);
127:
128: #endregion
129:
130:
131: #region Prolog
132:
133: // *
134: // * -- LAPACK routine (version 3.1) --
135: // * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
136: // * November 2006
137: // *
138: // * .. Scalar Arguments ..
139: // * ..
140: // * .. Array Arguments ..
141: // * ..
142: // *
143: // * Purpose
144: // * =======
145: // *
146: // * Sort the numbers in D in increasing order (if ID = 'I') or
147: // * in decreasing order (if ID = 'D' ).
148: // *
149: // * Use Quick Sort, reverting to Insertion sort on arrays of
150: // * size <= 20. Dimension of STACK limits N to about 2**32.
151: // *
152: // * Arguments
153: // * =========
154: // *
155: // * ID (input) CHARACTER*1
156: // * = 'I': sort D in increasing order;
157: // * = 'D': sort D in decreasing order.
158: // *
159: // * N (input) INTEGER
160: // * The length of the array D.
161: // *
162: // * D (input/output) DOUBLE PRECISION array, dimension (N)
163: // * On entry, the array to be sorted.
164: // * On exit, D has been sorted into increasing order
165: // * (D(1) <= ... <= D(N) ) or into decreasing order
166: // * (D(1) >= ... >= D(N) ), depending on ID.
167: // *
168: // * INFO (output) INTEGER
169: // * = 0: successful exit
170: // * < 0: if INFO = -i, the i-th argument had an illegal value
171: // *
172: // * =====================================================================
173: // *
174: // * .. Parameters ..
175: // * ..
176: // * .. Local Scalars ..
177: // * ..
178: // * .. Local Arrays ..
179: // * ..
180: // * .. External Functions ..
181: // * ..
182: // * .. External Subroutines ..
183: // * ..
184: // * .. Executable Statements ..
185: // *
186: // * Test the input paramters.
187: // *
188:
189: #endregion
190:
191:
192: #region Body
193:
194: INFO = 0;
195: DIR = - 1;
196: if (this._lsame.Run(ID, "D"))
197: {
198: DIR = 0;
199: }
200: else
201: {
202: if (this._lsame.Run(ID, "I"))
203: {
204: DIR = 1;
205: }
206: }
207: if (DIR == - 1)
208: {
209: INFO = - 1;
210: }
211: else
212: {
213: if (N < 0)
214: {
215: INFO = - 2;
216: }
217: }
218: if (INFO != 0)
219: {
220: this._xerbla.Run("DLASRT", - INFO);
221: return;
222: }
223: // *
224: // * Quick return if possible
225: // *
226: if (N <= 1) return;
227: // *
228: STKPNT = 1;
229: STACK[1+1 * 2 + o_stack] = 1;
230: STACK[2+1 * 2 + o_stack] = N;
231: LABEL10:;
232: START = STACK[1+STKPNT * 2 + o_stack];
233: ENDD = STACK[2+STKPNT * 2 + o_stack];
234: STKPNT = STKPNT - 1;
235: if (ENDD - START <= SELECT && ENDD - START > 0)
236: {
237: // *
238: // * Do Insertion sort on D( START:ENDD )
239: // *
240: if (DIR == 0)
241: {
242: // *
243: // * Sort into decreasing order
244: // *
245: for (I = START + 1; I <= ENDD; I++)
246: {
247: for (J = I; J >= START + 1; J += - 1)
248: {
249: if (D[J + o_d] > D[J - 1 + o_d])
250: {
251: DMNMX = D[J + o_d];
252: D[J + o_d] = D[J - 1 + o_d];
253: D[J - 1 + o_d] = DMNMX;
254: }
255: else
256: {
257: goto LABEL30;
258: }
259: }
260: LABEL30:;
261: }
262: // *
263: }
264: else
265: {
266: // *
267: // * Sort into increasing order
268: // *
269: for (I = START + 1; I <= ENDD; I++)
270: {
271: for (J = I; J >= START + 1; J += - 1)
272: {
273: if (D[J + o_d] < D[J - 1 + o_d])
274: {
275: DMNMX = D[J + o_d];
276: D[J + o_d] = D[J - 1 + o_d];
277: D[J - 1 + o_d] = DMNMX;
278: }
279: else
280: {
281: goto LABEL50;
282: }
283: }
284: LABEL50:;
285: }
286: // *
287: }
288: // *
289: }
290: else
291: {
292: if (ENDD - START > SELECT)
293: {
294: // *
295: // * Partition D( START:ENDD ) and stack parts, largest one first
296: // *
297: // * Choose partition entry as median of 3
298: // *
299: D1 = D[START + o_d];
300: D2 = D[ENDD + o_d];
301: I = (START + ENDD) / 2;
302: D3 = D[I + o_d];
303: if (D1 < D2)
304: {
305: if (D3 < D1)
306: {
307: DMNMX = D1;
308: }
309: else
310: {
311: if (D3 < D2)
312: {
313: DMNMX = D3;
314: }
315: else
316: {
317: DMNMX = D2;
318: }
319: }
320: }
321: else
322: {
323: if (D3 < D2)
324: {
325: DMNMX = D2;
326: }
327: else
328: {
329: if (D3 < D1)
330: {
331: DMNMX = D3;
332: }
333: else
334: {
335: DMNMX = D1;
336: }
337: }
338: }
339: // *
340: if (DIR == 0)
341: {
342: // *
343: // * Sort into decreasing order
344: // *
345: I = START - 1;
346: J = ENDD + 1;
347: LABEL60:;
348: LABEL70:;
349: J = J - 1;
350: if (D[J + o_d] < DMNMX) goto LABEL70;
351: LABEL80:;
352: I = I + 1;
353: if (D[I + o_d] > DMNMX) goto LABEL80;
354: if (I < J)
355: {
356: TMP = D[I + o_d];
357: D[I + o_d] = D[J + o_d];
358: D[J + o_d] = TMP;
359: goto LABEL60;
360: }
361: if (J - START > ENDD - J - 1)
362: {
363: STKPNT = STKPNT + 1;
364: STACK[1+STKPNT * 2 + o_stack] = START;
365: STACK[2+STKPNT * 2 + o_stack] = J;
366: STKPNT = STKPNT + 1;
367: STACK[1+STKPNT * 2 + o_stack] = J + 1;
368: STACK[2+STKPNT * 2 + o_stack] = ENDD;
369: }
370: else
371: {
372: STKPNT = STKPNT + 1;
373: STACK[1+STKPNT * 2 + o_stack] = J + 1;
374: STACK[2+STKPNT * 2 + o_stack] = ENDD;
375: STKPNT = STKPNT + 1;
376: STACK[1+STKPNT * 2 + o_stack] = START;
377: STACK[2+STKPNT * 2 + o_stack] = J;
378: }
379: }
380: else
381: {
382: // *
383: // * Sort into increasing order
384: // *
385: I = START - 1;
386: J = ENDD + 1;
387: LABEL90:;
388: LABEL100:;
389: J = J - 1;
390: if (D[J + o_d] > DMNMX) goto LABEL100;
391: LABEL110:;
392: I = I + 1;
393: if (D[I + o_d] < DMNMX) goto LABEL110;
394: if (I < J)
395: {
396: TMP = D[I + o_d];
397: D[I + o_d] = D[J + o_d];
398: D[J + o_d] = TMP;
399: goto LABEL90;
400: }
401: if (J - START > ENDD - J - 1)
402: {
403: STKPNT = STKPNT + 1;
404: STACK[1+STKPNT * 2 + o_stack] = START;
405: STACK[2+STKPNT * 2 + o_stack] = J;
406: STKPNT = STKPNT + 1;
407: STACK[1+STKPNT * 2 + o_stack] = J + 1;
408: STACK[2+STKPNT * 2 + o_stack] = ENDD;
409: }
410: else
411: {
412: STKPNT = STKPNT + 1;
413: STACK[1+STKPNT * 2 + o_stack] = J + 1;
414: STACK[2+STKPNT * 2 + o_stack] = ENDD;
415: STKPNT = STKPNT + 1;
416: STACK[1+STKPNT * 2 + o_stack] = START;
417: STACK[2+STKPNT * 2 + o_stack] = J;
418: }
419: }
420: }
421: }
422: if (STKPNT > 0) goto LABEL10;
423: return;
424: // *
425: // * End of DLASRT
426: // *
427:
428: #endregion
429:
430: }
431: }
432: }