Abdelrahman Said
289 lines
6.2 KiB
C
289 lines
6.2 KiB
C
/* -- translated by f2c (version 20240504).
|
|
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"
|
|
|
|
/* Table of constant values */
|
|
|
|
static integer c__1 = 1;
|
|
|
|
/* -----------------------------------------------------------------------
|
|
\BeginDoc
|
|
|
|
\Name: dsesrt
|
|
|
|
\Description:
|
|
Sort the array X in the order specified by WHICH and optionally
|
|
apply the permutation to the columns of the matrix A.
|
|
|
|
\Usage:
|
|
call dsesrt
|
|
( WHICH, APPLY, N, X, NA, A, LDA)
|
|
|
|
\Arguments
|
|
WHICH Character*2. (Input)
|
|
'LM' -> X is sorted into increasing order of magnitude.
|
|
'SM' -> X is sorted into decreasing order of magnitude.
|
|
'LA' -> X is sorted into increasing order of algebraic.
|
|
'SA' -> X is sorted into decreasing order of algebraic.
|
|
|
|
APPLY Logical. (Input)
|
|
APPLY = .TRUE. -> apply the sorted order to A.
|
|
APPLY = .FALSE. -> do not apply the sorted order to A.
|
|
|
|
N Integer. (INPUT)
|
|
Dimension of the array X.
|
|
|
|
X Double precision array of length N. (INPUT/OUTPUT)
|
|
The array to be sorted.
|
|
|
|
NA Integer. (INPUT)
|
|
Number of rows of the matrix A.
|
|
|
|
A Double precision array of length NA by N. (INPUT/OUTPUT)
|
|
|
|
LDA Integer. (INPUT)
|
|
Leading dimension of A.
|
|
|
|
\EndDoc
|
|
|
|
-----------------------------------------------------------------------
|
|
|
|
\BeginLib
|
|
|
|
\Routines
|
|
dswap Level 1 BLAS that swaps the contents of two vectors.
|
|
|
|
\Authors
|
|
Danny Sorensen Phuong Vu
|
|
Richard Lehoucq CRPC / Rice University
|
|
Dept. of Computational & Houston, Texas
|
|
Applied Mathematics
|
|
Rice University
|
|
Houston, Texas
|
|
|
|
\Revision history:
|
|
12/15/93: Version ' 2.1'.
|
|
Adapted from the sort routine in LANSO and
|
|
the ARPACK code dsortr
|
|
|
|
\SCCS Information: @(#)
|
|
FILE: sesrt.F SID: 2.3 DATE OF SID: 4/19/96 RELEASE: 2
|
|
|
|
\EndLib
|
|
|
|
-----------------------------------------------------------------------
|
|
|
|
Subroutine */ int igraphdsesrt_(char *which, logical *apply, integer *n,
|
|
doublereal *x, integer *na, doublereal *a, integer *lda)
|
|
{
|
|
/* System generated locals */
|
|
integer a_dim1, a_offset, i__1;
|
|
doublereal d__1, d__2;
|
|
|
|
/* Builtin functions */
|
|
integer s_cmp(char *, char *, ftnlen, ftnlen);
|
|
|
|
/* Local variables */
|
|
integer i__, j, igap;
|
|
doublereal temp;
|
|
extern /* Subroutine */ int igraphdswap_(integer *, doublereal *, integer *,
|
|
doublereal *, integer *);
|
|
|
|
|
|
/* %------------------%
|
|
| Scalar Arguments |
|
|
%------------------%
|
|
|
|
|
|
%-----------------%
|
|
| Array Arguments |
|
|
%-----------------%
|
|
|
|
|
|
%---------------%
|
|
| Local Scalars |
|
|
%---------------%
|
|
|
|
|
|
%----------------------%
|
|
| External Subroutines |
|
|
%----------------------%
|
|
|
|
|
|
%-----------------------%
|
|
| Executable Statements |
|
|
%-----------------------%
|
|
|
|
Parameter adjustments */
|
|
a_dim1 = *lda;
|
|
a_offset = 1 + a_dim1 * 0;
|
|
a -= a_offset;
|
|
|
|
/* Function Body */
|
|
igap = *n / 2;
|
|
|
|
if (s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) == 0) {
|
|
|
|
/* X is sorted into decreasing order of algebraic. */
|
|
|
|
L10:
|
|
if (igap == 0) {
|
|
goto L9000;
|
|
}
|
|
i__1 = *n - 1;
|
|
for (i__ = igap; i__ <= i__1; ++i__) {
|
|
j = i__ - igap;
|
|
L20:
|
|
|
|
if (j < 0) {
|
|
goto L30;
|
|
}
|
|
|
|
if (x[j] < x[j + igap]) {
|
|
temp = x[j];
|
|
x[j] = x[j + igap];
|
|
x[j + igap] = temp;
|
|
if (*apply) {
|
|
igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) *
|
|
a_dim1 + 1], &c__1);
|
|
}
|
|
} else {
|
|
goto L30;
|
|
}
|
|
j -= igap;
|
|
goto L20;
|
|
L30:
|
|
;
|
|
}
|
|
igap /= 2;
|
|
goto L10;
|
|
|
|
} else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) {
|
|
|
|
/* X is sorted into decreasing order of magnitude. */
|
|
|
|
L40:
|
|
if (igap == 0) {
|
|
goto L9000;
|
|
}
|
|
i__1 = *n - 1;
|
|
for (i__ = igap; i__ <= i__1; ++i__) {
|
|
j = i__ - igap;
|
|
L50:
|
|
|
|
if (j < 0) {
|
|
goto L60;
|
|
}
|
|
|
|
if ((d__1 = x[j], abs(d__1)) < (d__2 = x[j + igap], abs(d__2))) {
|
|
temp = x[j];
|
|
x[j] = x[j + igap];
|
|
x[j + igap] = temp;
|
|
if (*apply) {
|
|
igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) *
|
|
a_dim1 + 1], &c__1);
|
|
}
|
|
} else {
|
|
goto L60;
|
|
}
|
|
j -= igap;
|
|
goto L50;
|
|
L60:
|
|
;
|
|
}
|
|
igap /= 2;
|
|
goto L40;
|
|
|
|
} else if (s_cmp(which, "LA", (ftnlen)2, (ftnlen)2) == 0) {
|
|
|
|
/* X is sorted into increasing order of algebraic. */
|
|
|
|
L70:
|
|
if (igap == 0) {
|
|
goto L9000;
|
|
}
|
|
i__1 = *n - 1;
|
|
for (i__ = igap; i__ <= i__1; ++i__) {
|
|
j = i__ - igap;
|
|
L80:
|
|
|
|
if (j < 0) {
|
|
goto L90;
|
|
}
|
|
|
|
if (x[j] > x[j + igap]) {
|
|
temp = x[j];
|
|
x[j] = x[j + igap];
|
|
x[j + igap] = temp;
|
|
if (*apply) {
|
|
igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) *
|
|
a_dim1 + 1], &c__1);
|
|
}
|
|
} else {
|
|
goto L90;
|
|
}
|
|
j -= igap;
|
|
goto L80;
|
|
L90:
|
|
;
|
|
}
|
|
igap /= 2;
|
|
goto L70;
|
|
|
|
} else if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) {
|
|
|
|
/* X is sorted into increasing order of magnitude. */
|
|
|
|
L100:
|
|
if (igap == 0) {
|
|
goto L9000;
|
|
}
|
|
i__1 = *n - 1;
|
|
for (i__ = igap; i__ <= i__1; ++i__) {
|
|
j = i__ - igap;
|
|
L110:
|
|
|
|
if (j < 0) {
|
|
goto L120;
|
|
}
|
|
|
|
if ((d__1 = x[j], abs(d__1)) > (d__2 = x[j + igap], abs(d__2))) {
|
|
temp = x[j];
|
|
x[j] = x[j + igap];
|
|
x[j + igap] = temp;
|
|
if (*apply) {
|
|
igraphdswap_(na, &a[j * a_dim1 + 1], &c__1, &a[(j + igap) *
|
|
a_dim1 + 1], &c__1);
|
|
}
|
|
} else {
|
|
goto L120;
|
|
}
|
|
j -= igap;
|
|
goto L110;
|
|
L120:
|
|
;
|
|
}
|
|
igap /= 2;
|
|
goto L100;
|
|
}
|
|
|
|
L9000:
|
|
return 0;
|
|
|
|
/* %---------------%
|
|
| End of dsesrt |
|
|
%---------------% */
|
|
|
|
} /* igraphdsesrt_ */
|
|
|