slaord.c
Go to the documentation of this file.
00001 /* slaord.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Subroutine */ int slaord_(char *job, integer *n, real *x, integer *incx)
00017 {
00018     /* System generated locals */
00019     integer i__1;
00020 
00021     /* Local variables */
00022     integer i__, ix, inc;
00023     real temp;
00024     extern logical lsame_(char *, char *);
00025     integer ixnext;
00026 
00027 
00028 /*  -- LAPACK auxiliary routine (version 3.1) -- */
00029 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00030 /*     November 2006 */
00031 
00032 /*     .. Scalar Arguments .. */
00033 /*     .. */
00034 /*     .. Array Arguments .. */
00035 /*     .. */
00036 
00037 /*  Purpose */
00038 /*  ======= */
00039 
00040 /*  SLAORD sorts the elements of a vector x in increasing or decreasing */
00041 /*  order. */
00042 
00043 /*  Arguments */
00044 /*  ========= */
00045 
00046 /*  JOB     (input) CHARACTER */
00047 /*          = 'I':  Sort in increasing order */
00048 /*          = 'D':  Sort in decreasing order */
00049 
00050 /*  N       (input) INTEGER */
00051 /*          The length of the vector X. */
00052 
00053 /*  X       (input/output) REAL array, dimension */
00054 /*                         (1+(N-1)*INCX) */
00055 /*          On entry, the vector of length n to be sorted. */
00056 /*          On exit, the vector x is sorted in the prescribed order. */
00057 
00058 /*  INCX    (input) INTEGER */
00059 /*          The spacing between successive elements of X.  INCX >= 0. */
00060 
00061 /*  ===================================================================== */
00062 
00063 /*     .. Local Scalars .. */
00064 /*     .. */
00065 /*     .. External Functions .. */
00066 /*     .. */
00067 /*     .. Intrinsic Functions .. */
00068 /*     .. */
00069 /*     .. Executable Statements .. */
00070 
00071     /* Parameter adjustments */
00072     --x;
00073 
00074     /* Function Body */
00075     inc = abs(*incx);
00076     if (lsame_(job, "I")) {
00077 
00078 /*        Sort in increasing order */
00079 
00080         i__1 = *n;
00081         for (i__ = 2; i__ <= i__1; ++i__) {
00082             ix = (i__ - 1) * inc + 1;
00083 L10:
00084             if (ix == 1) {
00085                 goto L20;
00086             }
00087             ixnext = ix - inc;
00088             if (x[ix] > x[ixnext]) {
00089                 goto L20;
00090             } else {
00091                 temp = x[ix];
00092                 x[ix] = x[ixnext];
00093                 x[ixnext] = temp;
00094             }
00095             ix = ixnext;
00096             goto L10;
00097 L20:
00098             ;
00099         }
00100 
00101     } else if (lsame_(job, "D")) {
00102 
00103 /*        Sort in decreasing order */
00104 
00105         i__1 = *n;
00106         for (i__ = 2; i__ <= i__1; ++i__) {
00107             ix = (i__ - 1) * inc + 1;
00108 L30:
00109             if (ix == 1) {
00110                 goto L40;
00111             }
00112             ixnext = ix - inc;
00113             if (x[ix] < x[ixnext]) {
00114                 goto L40;
00115             } else {
00116                 temp = x[ix];
00117                 x[ix] = x[ixnext];
00118                 x[ixnext] = temp;
00119             }
00120             ix = ixnext;
00121             goto L30;
00122 L40:
00123             ;
00124         }
00125     }
00126     return 0;
00127 
00128 /*     End of SLAORD */
00129 
00130 } /* slaord_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:11