/* Copyright (C) 1992, 1995 by Thomas Glen Smith.  All Rights Reserved. */
/* grade APL2 V1.0.0 ***************************************************
* Called by both gradeup2 and gradedn2 to obtain indices that sort an  *
* APL variable into ascending or descending sequence.                  *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb grade(rite,up)
Aplcb rite;
int up; /* 1 = ascending, 0 = descending. */
{
	Errinit; Errstop; Gradesub; Indxsub; Isign; Signum;
	extern int indxorg;
	Aplcb out;
	int a,b,datatyp,i,*ip,j,k,l,m,n,*op,p,q,r,t;
	double *dp;

	if (errinit())
		return(errstop(0,NULL,rite,NULL));
	datatyp = rite->aplflags & APL_NUMERIC;
	if (datatyp == 0 || datatyp == APLCPLX) /* Is it real numeric? */
		return(errstop(47,NULL,rite,NULL)); /* Not real numeric. */
	n = (rite->aplrank) ? *(rite->apldim) : rite->aplcount;
	out = indxsub(n); /* n = number of items to sort. */
	if (out->aplcount < 2)
		return(errstop(0,NULL,rite,out));
	r = 1; /* Number of items in each group for comparison. */
	if (rite->aplrank > 1)
		for(i = rite->aplrank - 1; i > 0; i--)
			r *= *(rite->apldim + i);
	ip = (void *) dp = (rite->aplptr.apldata);
	op = out->aplptr.aplint;
	m = n/2;
	while (m) {
		k = n - m;
		for (j=0; j<k; j++) {
			i = j;
			do {
				l = i + m;
				a = *(op + i) - indxorg; /* Relative 0. */
				b = *(op + l) - indxorg; /* Relative 0. */
				p = gradesub(rite,a,b,r);
				if (up) q = (p <= 0);
				else    q = (p >= 0);
				if (q && !(p==0 && a>b)) break; /* sorted */
				*(op+i) = b + indxorg; /* switch */
				*(op+l) = a + indxorg;
				i -= m;
			} while (i >= 0);
		}
		m /= 2;
	}
	return(errstop(0,NULL,rite,out));
}