3 /* Subroutine */ int slasrt_(char *id, integer *n, real *d__, integer *info)
5 /* System generated locals */
14 extern logical lsame_(char *, char *);
15 integer stack[64] /* was [2][32] */;
18 extern /* Subroutine */ int xerbla_(char *, integer *);
22 /* -- LAPACK routine (version 3.1) -- */
23 /* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
26 /* .. Scalar Arguments .. */
28 /* .. Array Arguments .. */
34 /* Sort the numbers in D in increasing order (if ID = 'I') or */
35 /* in decreasing order (if ID = 'D' ). */
37 /* Use Quick Sort, reverting to Insertion sort on arrays of */
38 /* size <= 20. Dimension of STACK limits N to about 2**32. */
43 /* ID (input) CHARACTER*1 */
44 /* = 'I': sort D in increasing order; */
45 /* = 'D': sort D in decreasing order. */
47 /* N (input) INTEGER */
48 /* The length of the array D. */
50 /* D (input/output) REAL array, dimension (N) */
51 /* On entry, the array to be sorted. */
52 /* On exit, D has been sorted into increasing order */
53 /* (D(1) <= ... <= D(N) ) or into decreasing order */
54 /* (D(1) >= ... >= D(N) ), depending on ID. */
56 /* INFO (output) INTEGER */
57 /* = 0: successful exit */
58 /* < 0: if INFO = -i, the i-th argument had an illegal value */
60 /* ===================================================================== */
62 /* .. Parameters .. */
64 /* .. Local Scalars .. */
66 /* .. Local Arrays .. */
68 /* .. External Functions .. */
70 /* .. External Subroutines .. */
72 /* .. Executable Statements .. */
74 /* Test the input paramters. */
76 /* Parameter adjustments */
82 if (lsame_(id, "D")) {
84 } else if (lsame_(id, "I")) {
94 xerbla_("SLASRT", &i__1);
98 /* Quick return if possible */
108 start = stack[(stkpnt << 1) - 2];
109 endd = stack[(stkpnt << 1) - 1];
111 if (endd - start <= 20 && endd - start > 0) {
113 /* Do Insertion sort on D( START:ENDD ) */
117 /* Sort into decreasing order */
120 for (i__ = start + 1; i__ <= i__1; ++i__) {
122 for (j = i__; j >= i__2; --j) {
123 if (d__[j] > d__[j - 1]) {
138 /* Sort into increasing order */
141 for (i__ = start + 1; i__ <= i__1; ++i__) {
143 for (j = i__; j >= i__2; --j) {
144 if (d__[j] < d__[j - 1]) {
159 } else if (endd - start > 20) {
161 /* Partition D( START:ENDD ) and stack parts, largest one first */
163 /* Choose partition entry as median of 3 */
167 i__ = (start + endd) / 2;
172 } else if (d3 < d2) {
180 } else if (d3 < d1) {
189 /* Sort into decreasing order */
196 if (d__[j] < dmnmx) {
201 if (d__[i__] > dmnmx) {
210 if (j - start > endd - j - 1) {
212 stack[(stkpnt << 1) - 2] = start;
213 stack[(stkpnt << 1) - 1] = j;
215 stack[(stkpnt << 1) - 2] = j + 1;
216 stack[(stkpnt << 1) - 1] = endd;
219 stack[(stkpnt << 1) - 2] = j + 1;
220 stack[(stkpnt << 1) - 1] = endd;
222 stack[(stkpnt << 1) - 2] = start;
223 stack[(stkpnt << 1) - 1] = j;
227 /* Sort into increasing order */
234 if (d__[j] > dmnmx) {
239 if (d__[i__] < dmnmx) {
248 if (j - start > endd - j - 1) {
250 stack[(stkpnt << 1) - 2] = start;
251 stack[(stkpnt << 1) - 1] = j;
253 stack[(stkpnt << 1) - 2] = j + 1;
254 stack[(stkpnt << 1) - 1] = endd;
257 stack[(stkpnt << 1) - 2] = j + 1;
258 stack[(stkpnt << 1) - 1] = endd;
260 stack[(stkpnt << 1) - 2] = start;
261 stack[(stkpnt << 1) - 1] = j;