git.maemo.org Git - opencv/blob - 3rdparty/lapack/slasrt.c

   1 #include "clapack.h"
   2
   3 /* Subroutine */ int slasrt_(char *id, integer *n, real *d__, integer *info)
   4 {
   5     /* System generated locals */
   6     integer i__1, i__2;
   7
   8     /* Local variables */
   9     integer i__, j;
  10     real d1, d2, d3;
  11     integer dir;
  12     real tmp;
  13     integer endd;
  14     extern logical lsame_(char *, char *);
  15     integer stack[64]   /* was [2][32] */;
  16     real dmnmx;
  17     integer start;
  18     extern /* Subroutine */ int xerbla_(char *, integer *);
  19     integer stkpnt;
  20
  21
  22 /*  -- LAPACK routine (version 3.1) -- */
  23 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
  24 /*     November 2006 */
  25
  26 /*     .. Scalar Arguments .. */
  27 /*     .. */
  28 /*     .. Array Arguments .. */
  29 /*     .. */
  30
  31 /*  Purpose */
  32 /*  ======= */
  33
  34 /*  Sort the numbers in D in increasing order (if ID = 'I') or */
  35 /*  in decreasing order (if ID = 'D' ). */
  36
  37 /*  Use Quick Sort, reverting to Insertion sort on arrays of */
  38 /*  size <= 20. Dimension of STACK limits N to about 2**32. */
  39
  40 /*  Arguments */
  41 /*  ========= */
  42
  43 /*  ID      (input) CHARACTER*1 */
  44 /*          = 'I': sort D in increasing order; */
  45 /*          = 'D': sort D in decreasing order. */
  46
  47 /*  N       (input) INTEGER */
  48 /*          The length of the array D. */
  49
  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. */
  55
  56 /*  INFO    (output) INTEGER */
  57 /*          = 0:  successful exit */
  58 /*          < 0:  if INFO = -i, the i-th argument had an illegal value */
  59
  60 /*  ===================================================================== */
  61
  62 /*     .. Parameters .. */
  63 /*     .. */
  64 /*     .. Local Scalars .. */
  65 /*     .. */
  66 /*     .. Local Arrays .. */
  67 /*     .. */
  68 /*     .. External Functions .. */
  69 /*     .. */
  70 /*     .. External Subroutines .. */
  71 /*     .. */
  72 /*     .. Executable Statements .. */
  73
  74 /*     Test the input paramters. */
  75
  76     /* Parameter adjustments */
  77     --d__;
  78
  79     /* Function Body */
  80     *info = 0;
  81     dir = -1;
  82     if (lsame_(id, "D")) {
  83         dir = 0;
  84     } else if (lsame_(id, "I")) {
  85         dir = 1;
  86     }
  87     if (dir == -1) {
  88         *info = -1;
  89     } else if (*n < 0) {
  90         *info = -2;
  91     }
  92     if (*info != 0) {
  93         i__1 = -(*info);
  94         xerbla_("SLASRT", &i__1);
  95         return 0;
  96     }
  97
  98 /*     Quick return if possible */
  99
 100     if (*n <= 1) {
 101         return 0;
 102     }
 103
 104     stkpnt = 1;
 105     stack[0] = 1;
 106     stack[1] = *n;
 107 L10:
 108     start = stack[(stkpnt << 1) - 2];
 109     endd = stack[(stkpnt << 1) - 1];
 110     --stkpnt;
 111     if (endd - start <= 20 && endd - start > 0) {
 112
 113 /*        Do Insertion sort on D( START:ENDD ) */
 114
 115         if (dir == 0) {
 116
 117 /*           Sort into decreasing order */
 118
 119             i__1 = endd;
 120             for (i__ = start + 1; i__ <= i__1; ++i__) {
 121                 i__2 = start + 1;
 122                 for (j = i__; j >= i__2; --j) {
 123                     if (d__[j] > d__[j - 1]) {
 124                         dmnmx = d__[j];
 125                         d__[j] = d__[j - 1];
 126                         d__[j - 1] = dmnmx;
 127                     } else {
 128                         goto L30;
 129                     }
 130 /* L20: */
 131                 }
 132 L30:
 133                 ;
 134             }
 135
 136         } else {
 137
 138 /*           Sort into increasing order */
 139
 140             i__1 = endd;
 141             for (i__ = start + 1; i__ <= i__1; ++i__) {
 142                 i__2 = start + 1;
 143                 for (j = i__; j >= i__2; --j) {
 144                     if (d__[j] < d__[j - 1]) {
 145                         dmnmx = d__[j];
 146                         d__[j] = d__[j - 1];
 147                         d__[j - 1] = dmnmx;
 148                     } else {
 149                         goto L50;
 150                     }
 151 /* L40: */
 152                 }
 153 L50:
 154                 ;
 155             }
 156
 157         }
 158
 159     } else if (endd - start > 20) {
 160
 161 /*        Partition D( START:ENDD ) and stack parts, largest one first */
 162
 163 /*        Choose partition entry as median of 3 */
 164
 165         d1 = d__[start];
 166         d2 = d__[endd];
 167         i__ = (start + endd) / 2;
 168         d3 = d__[i__];
 169         if (d1 < d2) {
 170             if (d3 < d1) {
 171                 dmnmx = d1;
 172             } else if (d3 < d2) {
 173                 dmnmx = d3;
 174             } else {
 175                 dmnmx = d2;
 176             }
 177         } else {
 178             if (d3 < d2) {
 179                 dmnmx = d2;
 180             } else if (d3 < d1) {
 181                 dmnmx = d3;
 182             } else {
 183                 dmnmx = d1;
 184             }
 185         }
 186
 187         if (dir == 0) {
 188
 189 /*           Sort into decreasing order */
 190
 191             i__ = start - 1;
 192             j = endd + 1;
 193 L60:
 194 L70:
 195             --j;
 196             if (d__[j] < dmnmx) {
 197                 goto L70;
 198             }
 199 L80:
 200             ++i__;
 201             if (d__[i__] > dmnmx) {
 202                 goto L80;
 203             }
 204             if (i__ < j) {
 205                 tmp = d__[i__];
 206                 d__[i__] = d__[j];
 207                 d__[j] = tmp;
 208                 goto L60;
 209             }
 210             if (j - start > endd - j - 1) {
 211                 ++stkpnt;
 212                 stack[(stkpnt << 1) - 2] = start;
 213                 stack[(stkpnt << 1) - 1] = j;
 214                 ++stkpnt;
 215                 stack[(stkpnt << 1) - 2] = j + 1;
 216                 stack[(stkpnt << 1) - 1] = endd;
 217             } else {
 218                 ++stkpnt;
 219                 stack[(stkpnt << 1) - 2] = j + 1;
 220                 stack[(stkpnt << 1) - 1] = endd;
 221                 ++stkpnt;
 222                 stack[(stkpnt << 1) - 2] = start;
 223                 stack[(stkpnt << 1) - 1] = j;
 224             }
 225         } else {
 226
 227 /*           Sort into increasing order */
 228
 229             i__ = start - 1;
 230             j = endd + 1;
 231 L90:
 232 L100:
 233             --j;
 234             if (d__[j] > dmnmx) {
 235                 goto L100;
 236             }
 237 L110:
 238             ++i__;
 239             if (d__[i__] < dmnmx) {
 240                 goto L110;
 241             }
 242             if (i__ < j) {
 243                 tmp = d__[i__];
 244                 d__[i__] = d__[j];
 245                 d__[j] = tmp;
 246                 goto L90;
 247             }
 248             if (j - start > endd - j - 1) {
 249                 ++stkpnt;
 250                 stack[(stkpnt << 1) - 2] = start;
 251                 stack[(stkpnt << 1) - 1] = j;
 252                 ++stkpnt;
 253                 stack[(stkpnt << 1) - 2] = j + 1;
 254                 stack[(stkpnt << 1) - 1] = endd;
 255             } else {
 256                 ++stkpnt;
 257                 stack[(stkpnt << 1) - 2] = j + 1;
 258                 stack[(stkpnt << 1) - 1] = endd;
 259                 ++stkpnt;
 260                 stack[(stkpnt << 1) - 2] = start;
 261                 stack[(stkpnt << 1) - 1] = j;
 262             }
 263         }
 264     }
 265     if (stkpnt > 0) {
 266         goto L10;
 267     }
 268     return 0;
 269
 270 /*     End of SLASRT */
 271
 272 } /* slasrt_ */