/*Translated by FOR_C, v3.4.2 (-), on 07/09/115 at 08:30:07 */
/*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 "gsortp.h"
#include <stdlib.h>
void /*FUNCTION*/ gsortp(
long (*compar)(long,long),
long n,
long p[])
{
	long int bl, br, cl, cr, myn, partn, ptemp, stackl[32], stackr[32],
	 stktop;
		/* OFFSET Vectors w/subscript range: 1 to dimension */
	long *const P = &p[0] - 1;
	long *const Stackl = &stackl[0] - 1;
	long *const Stackr = &stackr[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.
	 *>> 1998-01-20  GSORTP  Snyder  Allow not initializing P.
	 *>> 1996-05-01  GSORTP  Krogh   Changes to use .C. and C%%.
	 *>> 1995-11-17  GSORTP  Krogh   Converted SFTRAN to Fortran 77.
	 *>> 1991-04-02  GSORTP  Snyder  Repair no permutation vector if m-n < 10
	 *>> 1988-11-22  GSORTP  Snyder  Initial code.
	 *
	 *     Sort an N-vector of objects of unknown type and organization.
	 *     P is set so that the P(J)'th element of the original sequence is
	 *     the J'th element of the sorted sequence.  The order is defined by
	 *     the integer function COMPAR.  An invocation COMPAR(I,J) should
	 *     return -1 if the I'th element of the data is to preceed the J'th
	 *     element in the sorted sequence, +1 if the J'th element is to
	 *     preceed the I'th element in the sorted sequence, and 0 if the I'th
	 *     and J'th elements are the same.
	 *
	 *     This subprogram is unaware of the data, and cannot manipulate it.
	 *     It is the caller's responsibility to make the data known to the
	 *     COMPAR function.
	 * */
 
	/*     *****     Local Variables     ************************************
	 *
	 * BL      Left bound of the sub-array to be sorted at the next step.
	 * BR      Right bound of the sub array to be sorted at the next step.
	 * CL      Current left bound of the unsorted sub-array.
	 * CR      Current right bound of the unsorted sub-array.
	 * MYN     My N.
	 * 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.
	 * */
 
	/*     *****     Executable Statements     ******************************
	 * */
	for (cl = 1; cl <= n; cl++)
	{
		P[cl] = cl;
	}
	myn = labs( n );
	if (myn >= 10)
	{
		stktop = 1;
		Stackl[1] = 1;
		Stackr[1] = myn;
		/*           Start until loop */
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;
		partn = P[cl];
         if ((*compar)( P[bl], partn ) > 0 ){
		P[cl] = P[bl];
		/*            if (compar(p(bl),partn).gt.0) then */
		P[bl] = partn;
		partn = P[cl];
         }
         if ((*compar)( P[bl], P[br] ) > 0 ){
		ptemp = P[bl];
		/*            end if
		 *            if (compar(p(bl),p(br)).gt.0) then */
		P[bl] = P[br];
		P[br] = ptemp;
         }
         if ((*compar)( partn, P[br] ) > 0 ){
		P[cl] = P[br];
		/*            end if
		 *            if (compar(partn,p(br)).gt.0) then */
		P[br] = partn;
		partn = P[cl];
         }
		P[cl] = P[br - 1];
		/*            end if */
		P[br - 1] = partn;
		/*           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;
		/*              Start forever block */
L_60:
		;
L_80:
		cl += 1;
               if ((*compar)( P[cl], partn ) < 0) goto L_80;
L_100:
		cr -= 1;
		/*                  if (compar(p(cl),partn) .lt. 0) go to 80 */
               if ((*compar)( P[cr], partn ) > 0) goto L_100;
		if (cl > cr)
			goto L_120;
		/*                  if (compar(p(cr),partn) .gt. 0) go to 100 */
		ptemp = P[cl];
		P[cl] = P[cr];
		P[cr] = ptemp;
		goto L_60;
		/*              End forever block */
L_120:
		;
		/*           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 (myn).
		 *           (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;
			}
		}
		/*           End until loop */
		if (stktop != 0)
			goto L_40;
	}
	/*     Clean up small subfiles by using insertion sort on everything. */
	for (cr = 2; cr <= myn; cr++)
	{
		ptemp = P[cr];
		cl = cr;
L_140:
		;
      if ((*compar)( P[cl - 1], ptemp ) > 0) {
		P[cl] = P[cl - 1];
		/*         if (compar(p(cl-1),ptemp).gt.0) then */
		cl -= 1;
		if (cl > 1)
			goto L_140;
      }
		P[cl] = ptemp;
		/*         end if */
	}
	return;
} /* end of function */