/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:11 */
/*FOR_C Options SET: ftn=u io=c no=p op=aimnv s=dbov str=l x=f - prototypes */
#include <math.h>
#include "fcrt.h"
#include "ssortp.h"
#include <stdlib.h>
void /*FUNCTION*/ ssortp(
float a[],
long m,
long n,
long p[])
{
	long int cl;
		/* OFFSET Vectors w/subscript range: 1 to dimension */
	float *const A = &a[0] - 1;
	long *const P = &p[0] - 1;
		/* end of OFFSET VECTORS */
 
	/* Copyright (c) 1996 California Institute of Technology, Pasadena, CA.
	 * ALL RIGHTS RESERVED.
	 * Based on Government Sponsored Research NAS7-03001.
	 *>> 1995-11-15 SSORTP  Krogh  SFTRAN => Fortran, removed mult. entry.
	 *>> 1994-10-19 SSORTP  Krogh  Changes to use M77CON
	 *>> 1992-11-23 SSORTP  Snyder  Add entry SSORTQ.
	 *>> 1991-04-02 SSORTP  Snyder  Repair no permutation vector if m-n < 10
	 *>> 1988-11-22 SSORTP  Snyder  Initial code.
	 *--S replaces "?": ?SORTP, ?SORTQ
	 *
	 *     Sort the M:N-vector A.
	 *     A is not disturbed.  P is set so that A(P(J)) is the J'th element
	 *     of the sorted sequence.
	 *     Enter at SSORTQ to use pre-specified permutation vector.
	 *
	 *     To sort an array A' into descending order, let A = -A'
	 *     To sort an array A' into ascending order according to the
	 *     absolute value of the elements let A = ABS(A').
	 *     To sort an array A' into decending order according to the
	 *     absolute value of the elements let A = -ABS(A').
	 * */
	/*--S Next line special: I */
	/*                      Get permutation vector for sorting */
	for (cl = m; cl <= n; cl++)
	{
		P[cl] = cl;
	}
	ssortq( a, m, n, p );
	return;
} /* end of function */
 
void /*FUNCTION*/ ssortq(
float a[],
long m,
long n,
long p[])
{
	long int bl, br, cl, cr, ptemp, stackl[32], stackr[32], stktop;
	float partn;
		/* OFFSET Vectors w/subscript range: 1 to dimension */
	float *const A = &a[0] - 1;
	long *const P = &p[0] - 1;
	long *const Stackl = &stackl[0] - 1;
	long *const Stackr = &stackr[0] - 1;
		/* end of OFFSET VECTORS */
 
	/*--S Next line special: I */
 
	/*     *****     Local Variables     ************************************
	 *
	 * BL      is the left bound of the sub-array to be sorted at the next
	 *         step.
	 * BR      is the right bound of the sub-array to be sorted at the next
	 *         step.
	 * CL      is the current left bound of the unsorted sub-array.
	 * CR      is the current right bound of the unsorted sub-array.
	 * PARTN   is the partition element.
	 * PTEMP   holds elements of P during exchanges.
	 * STACKL  keeps track of the left bounds of sub-arrays waiting to be
	 *         sorted.
	 * STACKR  keeps track of the right bounds of sub-arrays waiting to be
	 *         sorted.
	 * STKTOP  keeps track of the top of the stacks.
	 * */
	/*--S Next line special: I */
 
	/*     *****     Executable Statements     ******************************
	 * */
	if (n - m >= 10)
	{
		stktop = 1;
		Stackl[1] = m;
		Stackr[1] = n;
L_40:
		;
		bl = Stackl[stktop];
		br = Stackr[stktop];
		stktop -= 1;
		/*           Choose a partitioning element.  Use the median of the first,
		 *           middle and last elements.  Sort them so the extreme elements
		 *           can serve as sentinels during partitioning. */
		cl = (bl + br)/2;
		ptemp = P[cl];
		if (A[P[bl]] > A[ptemp])
		{
			P[cl] = P[bl];
			P[bl] = ptemp;
			ptemp = P[cl];
		}
		if (A[P[bl]] > A[P[br]])
		{
			cr = P[bl];
			P[bl] = P[br];
			P[br] = cr;
		}
		if (A[ptemp] > A[P[br]])
		{
			P[cl] = P[br];
			P[br] = ptemp;
			ptemp = P[cl];
		}
		P[cl] = P[br - 1];
		P[br - 1] = ptemp;
		partn = A[ptemp];
		/*           Partition the sub-array around PARTN.  Exclude the above
		 *           considered elements from partitioning because they're al-
		 *           ready in the correct subfiles.  Stop scanning on equality to
		 *           prevent files containing equal values from causing a loop. */
		cl = bl;
		cr = br - 1;
L_80:
		;
L_100:
		cl += 1;
		if (A[P[cl]] < partn)
			goto L_100;
L_120:
		cr -= 1;
		if (A[P[cr]] > partn)
			goto L_120;
		if (cl > cr)
			goto L_150;
		ptemp = P[cl];
		P[cl] = P[cr];
		P[cr] = ptemp;
		goto L_80;
L_150:
		;
		/*           Put sub-arrays on the stack if they're big enough.  Put the
		 *           larger under the smaller, so the smaller will be done next.
		 *           This makes the upper bound of the stack depth log2 (n-m+1).
		 *           (The "Hibbard" modification of quicksort). */
		if (cl - bl > br - cr)
		{
			if (cl - bl > 10)
			{
				stktop += 1;
				Stackl[stktop] = bl;
				Stackr[stktop] = cr;
			}
			if (br - cr > 10)
			{
				stktop += 1;
				Stackl[stktop] = cl;
				Stackr[stktop] = br;
			}
		}
		else
		{
			if (br - cr > 10)
			{
				stktop += 1;
				Stackl[stktop] = cl;
				Stackr[stktop] = br;
			}
			if (cl - bl > 10)
			{
				stktop += 1;
				Stackl[stktop] = bl;
				Stackr[stktop] = cr;
			}
		}
		if (stktop != 0)
			goto L_40;
	}
	/*     Clean up small subfiles using insertion sort on everything. */
	for (cr = m + 1; cr <= n; cr++)
	{
		ptemp = P[cr];
		partn = A[ptemp];
		cl = cr;
L_180:
		if (A[P[cl - 1]] > partn)
		{
			P[cl] = P[cl - 1];
			cl -= 1;
			if (cl > m)
				goto L_180;
		}
		P[cl] = ptemp;
	}
	return;
} /* end of function */