/* -- translated by f2c (version 20191129).
You must link the resulting object file with libf2c:
on Microsoft Windows system, link with libf2c.lib;
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
or, if you install libf2c.a in a standard place, with -lf2c -lm
-- in that order, at the end of the command line, as in
cc *.o -lf2c -lm
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
http://www.netlib.org/f2c/libf2c.zip
*/
#include "f2c.h"
/* > \brief \b DLASRT sorts numbers in increasing or decreasing order.
=========== DOCUMENTATION ===========
Online html documentation available at
http://www.netlib.org/lapack/explore-html/
> \htmlonly
> Download DLASRT + dependencies
>
> [TGZ]
>
> [ZIP]
>
> [TXT]
> \endhtmlonly
Definition:
===========
SUBROUTINE DLASRT( ID, N, D, INFO )
CHARACTER ID
INTEGER INFO, N
DOUBLE PRECISION D( * )
> \par Purpose:
=============
>
> \verbatim
>
> Sort the numbers in D in increasing order (if ID = 'I') or
> in decreasing order (if ID = 'D' ).
>
> Use Quick Sort, reverting to Insertion sort on arrays of
> size <= 20. Dimension of STACK limits N to about 2**32.
> \endverbatim
Arguments:
==========
> \param[in] ID
> \verbatim
> ID is CHARACTER*1
> = 'I': sort D in increasing order;
> = 'D': sort D in decreasing order.
> \endverbatim
>
> \param[in] N
> \verbatim
> N is INTEGER
> The length of the array D.
> \endverbatim
>
> \param[in,out] D
> \verbatim
> D is DOUBLE PRECISION array, dimension (N)
> On entry, the array to be sorted.
> On exit, D has been sorted into increasing order
> (D(1) <= ... <= D(N) ) or into decreasing order
> (D(1) >= ... >= D(N) ), depending on ID.
> \endverbatim
>
> \param[out] INFO
> \verbatim
> INFO is INTEGER
> = 0: successful exit
> < 0: if INFO = -i, the i-th argument had an illegal value
> \endverbatim
Authors:
========
> \author Univ. of Tennessee
> \author Univ. of California Berkeley
> \author Univ. of Colorado Denver
> \author NAG Ltd.
> \date September 2012
> \ingroup auxOTHERcomputational
=====================================================================
Subroutine */ int igraphdlasrt_(char *id, integer *n, doublereal *d__, integer *
info)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer i__, j;
doublereal d1, d2, d3;
integer dir;
doublereal tmp;
integer endd;
extern logical igraphlsame_(char *, char *);
integer stack[64] /* was [2][32] */;
doublereal dmnmx;
integer start;
extern /* Subroutine */ int igraphxerbla_(char *, integer *, ftnlen);
integer stkpnt;
/* -- LAPACK computational routine (version 3.4.2) --
-- LAPACK is a software package provided by Univ. of Tennessee, --
-- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
September 2012
=====================================================================
Test the input paramters.
Parameter adjustments */
--d__;
/* Function Body */
*info = 0;
dir = -1;
if (igraphlsame_(id, "D")) {
dir = 0;
} else if (igraphlsame_(id, "I")) {
dir = 1;
}
if (dir == -1) {
*info = -1;
} else if (*n < 0) {
*info = -2;
}
if (*info != 0) {
i__1 = -(*info);
igraphxerbla_("DLASRT", &i__1, (ftnlen)6);
return 0;
}
/* Quick return if possible */
if (*n <= 1) {
return 0;
}
stkpnt = 1;
stack[0] = 1;
stack[1] = *n;
L10:
start = stack[(stkpnt << 1) - 2];
endd = stack[(stkpnt << 1) - 1];
--stkpnt;
if (endd - start <= 20 && endd - start > 0) {
/* Do Insertion sort on D( START:ENDD ) */
if (dir == 0) {
/* Sort into decreasing order */
i__1 = endd;
for (i__ = start + 1; i__ <= i__1; ++i__) {
i__2 = start + 1;
for (j = i__; j >= i__2; --j) {
if (d__[j] > d__[j - 1]) {
dmnmx = d__[j];
d__[j] = d__[j - 1];
d__[j - 1] = dmnmx;
} else {
goto L30;
}
/* L20: */
}
L30:
;
}
} else {
/* Sort into increasing order */
i__1 = endd;
for (i__ = start + 1; i__ <= i__1; ++i__) {
i__2 = start + 1;
for (j = i__; j >= i__2; --j) {
if (d__[j] < d__[j - 1]) {
dmnmx = d__[j];
d__[j] = d__[j - 1];
d__[j - 1] = dmnmx;
} else {
goto L50;
}
/* L40: */
}
L50:
;
}
}
} else if (endd - start > 20) {
/* Partition D( START:ENDD ) and stack parts, largest one first
Choose partition entry as median of 3 */
d1 = d__[start];
d2 = d__[endd];
i__ = (start + endd) / 2;
d3 = d__[i__];
if (d1 < d2) {
if (d3 < d1) {
dmnmx = d1;
} else if (d3 < d2) {
dmnmx = d3;
} else {
dmnmx = d2;
}
} else {
if (d3 < d2) {
dmnmx = d2;
} else if (d3 < d1) {
dmnmx = d3;
} else {
dmnmx = d1;
}
}
if (dir == 0) {
/* Sort into decreasing order */
i__ = start - 1;
j = endd + 1;
L60:
L70:
--j;
if (d__[j] < dmnmx) {
goto L70;
}
L80:
++i__;
if (d__[i__] > dmnmx) {
goto L80;
}
if (i__ < j) {
tmp = d__[i__];
d__[i__] = d__[j];
d__[j] = tmp;
goto L60;
}
if (j - start > endd - j - 1) {
++stkpnt;
stack[(stkpnt << 1) - 2] = start;
stack[(stkpnt << 1) - 1] = j;
++stkpnt;
stack[(stkpnt << 1) - 2] = j + 1;
stack[(stkpnt << 1) - 1] = endd;
} else {
++stkpnt;
stack[(stkpnt << 1) - 2] = j + 1;
stack[(stkpnt << 1) - 1] = endd;
++stkpnt;
stack[(stkpnt << 1) - 2] = start;
stack[(stkpnt << 1) - 1] = j;
}
} else {
/* Sort into increasing order */
i__ = start - 1;
j = endd + 1;
L90:
L100:
--j;
if (d__[j] > dmnmx) {
goto L100;
}
L110:
++i__;
if (d__[i__] < dmnmx) {
goto L110;
}
if (i__ < j) {
tmp = d__[i__];
d__[i__] = d__[j];
d__[j] = tmp;
goto L90;
}
if (j - start > endd - j - 1) {
++stkpnt;
stack[(stkpnt << 1) - 2] = start;
stack[(stkpnt << 1) - 1] = j;
++stkpnt;
stack[(stkpnt << 1) - 2] = j + 1;
stack[(stkpnt << 1) - 1] = endd;
} else {
++stkpnt;
stack[(stkpnt << 1) - 2] = j + 1;
stack[(stkpnt << 1) - 1] = endd;
++stkpnt;
stack[(stkpnt << 1) - 2] = start;
stack[(stkpnt << 1) - 1] = j;
}
}
}
if (stkpnt > 0) {
goto L10;
}
return 0;
/* End of DLASRT */
} /* igraphdlasrt_ */