/*  -- 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"

/* -----------------------------------------------------------------------   
   \BeginDoc   

   \Name: dsortr   

   \Description:   
    Sort the array X1 in the order specified by WHICH and optionally   
    applies the permutation to the array X2.   

   \Usage:   
    call dsortr   
       ( WHICH, APPLY, N, X1, X2 )   

   \Arguments   
    WHICH   Character*2.  (Input)   
            'LM' -> X1 is sorted into increasing order of magnitude.   
            'SM' -> X1 is sorted into decreasing order of magnitude.   
            'LA' -> X1 is sorted into increasing order of algebraic.   
            'SA' -> X1 is sorted into decreasing order of algebraic.   

    APPLY   Logical.  (Input)   
            APPLY = .TRUE.  -> apply the sorted order to X2.   
            APPLY = .FALSE. -> do not apply the sorted order to X2.   

    N       Integer.  (INPUT)   
            Size of the arrays.   

    X1      Double precision array of length N.  (INPUT/OUTPUT)   
            The array to be sorted.   

    X2      Double precision array of length N.  (INPUT/OUTPUT)   
            Only referenced if APPLY = .TRUE.   

   \EndDoc   

   -----------------------------------------------------------------------   

   \BeginLib   

   \Author   
       Danny Sorensen               Phuong Vu   
       Richard Lehoucq              CRPC / Rice University   
       Dept. of Computational &     Houston, Texas   
       Applied Mathematics   
       Rice University   
       Houston, Texas   

   \Revision history:   
       12/16/93: Version ' 2.1'.   
                 Adapted from the sort routine in LANSO.   

   \SCCS Information: @(#)   
   FILE: sortr.F   SID: 2.3   DATE OF SID: 4/19/96   RELEASE: 2   

   \EndLib   

   -----------------------------------------------------------------------   

   Subroutine */ int igraphdsortr_(char *which, logical *apply, integer *n, 
	doublereal *x1, doublereal *x2)
{
    /* System generated locals */
    integer i__1;
    doublereal d__1, d__2;

    /* Builtin functions */
    integer s_cmp(char *, char *, ftnlen, ftnlen);

    /* Local variables */
    integer i__, j, igap;
    doublereal temp;


/*     %------------------%   
       | Scalar Arguments |   
       %------------------%   


       %-----------------%   
       | Array Arguments |   
       %-----------------%   


       %---------------%   
       | Local Scalars |   
       %---------------%   


       %-----------------------%   
       | Executable Statements |   
       %-----------------------% */

    igap = *n / 2;

    if (s_cmp(which, "SA", (ftnlen)2, (ftnlen)2) == 0) {

/*        X1 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 (x1[j] < x1[j + igap]) {
		temp = x1[j];
		x1[j] = x1[j + igap];
		x1[j + igap] = temp;
		if (*apply) {
		    temp = x2[j];
		    x2[j] = x2[j + igap];
		    x2[j + igap] = temp;
		}
	    } else {
		goto L30;
	    }
	    j -= igap;
	    goto L20;
L30:
	    ;
	}
	igap /= 2;
	goto L10;

    } else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) {

/*        X1 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 = x1[j], abs(d__1)) < (d__2 = x1[j + igap], abs(d__2))) 
		    {
		temp = x1[j];
		x1[j] = x1[j + igap];
		x1[j + igap] = temp;
		if (*apply) {
		    temp = x2[j];
		    x2[j] = x2[j + igap];
		    x2[j + igap] = temp;
		}
	    } else {
		goto L60;
	    }
	    j -= igap;
	    goto L50;
L60:
	    ;
	}
	igap /= 2;
	goto L40;

    } else if (s_cmp(which, "LA", (ftnlen)2, (ftnlen)2) == 0) {

/*        X1 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 (x1[j] > x1[j + igap]) {
		temp = x1[j];
		x1[j] = x1[j + igap];
		x1[j + igap] = temp;
		if (*apply) {
		    temp = x2[j];
		    x2[j] = x2[j + igap];
		    x2[j + igap] = temp;
		}
	    } else {
		goto L90;
	    }
	    j -= igap;
	    goto L80;
L90:
	    ;
	}
	igap /= 2;
	goto L70;

    } else if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) {

/*        X1 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 = x1[j], abs(d__1)) > (d__2 = x1[j + igap], abs(d__2))) 
		    {
		temp = x1[j];
		x1[j] = x1[j + igap];
		x1[j + igap] = temp;
		if (*apply) {
		    temp = x2[j];
		    x2[j] = x2[j + igap];
		    x2[j + igap] = temp;
		}
	    } else {
		goto L120;
	    }
	    j -= igap;
	    goto L110;
L120:
	    ;
	}
	igap /= 2;
	goto L100;
    }

L9000:
    return 0;

/*     %---------------%   
       | End of dsortr |   
       %---------------% */

} /* igraphdsortr_ */

