/* Copyright (C) 1995 by Thomas Glen Smith.	All Rights Reserved. */
/* grade2 APL2 V1.0.0 **************************************************
* Called by gradedn2 and gradeup2.                                     *
* Obtains indices that sort an APL variable of character type in		 *
* ascending or descending sequence.							 *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb grade2(left,rite,up)
Aplcb left;
Aplcb rite;
int up;
{
	Aplcopy; Cat; Endoper; Errstop; Getcb; Grade2a; Formati; Indexof;
	Indxsub; Perm; Reshape; Temp; Transpos;
	extern int indxorg;
	Aplcb dimcb,out1=NULL,out2=NULL,out3=NULL;
	int axis=1+indxorg,cols,div,i,j,rows;

	out1 = rite; /* So it'll get freed if premature break from for(;;) */
	for(;;) {
		out3 = transpos(NULL,temp(formati(left,&dimcb)));
			/* If left was 2 3R'abcABC', it w/b 3 2 R'aAbBcC' */
		if (dimcb == NULL) break; /* Error? */
		div = (dimcb->aplcount < 2) ? 1 : *(dimcb->aplptr.aplint);
		endoper(temp(dimcb));
		if (rite->aplrank > 0) {
			for(i = cols = 1, j = rite->aplrank; i < j; i++)
				cols *= *(rite->apldim + i); /* cols = X/1URrite. */
			rows = *(rite->apldim); /* rows = 1YRrite. */
		}
		else rows = cols = 1;
		dimcb = getcb(NULL,2,APLINT+APLTEMP,1,NULL);
		if (dimcb == NULL) break;
		*(dimcb->aplptr.aplint) = rows; /* 1YRrite */
		*(dimcb->aplptr.aplint + 1) = cols; /* X/1URrite */
		out2 = perm(indxsub(rows)); /* 1 2 ... rows */
		if (out2 == NULL) break; /* Error. */
		out1 = perm(cat(cat(
			indexof(out3,reshape(dimcb,rite)),out2,axis),out2,axis));
				/* Rite is reshaped to a matrix, with the final two */
				/* rows consisting of 1 2 ... rows. */
		endoper(temp(out2));
		dimcb = NULL; /* Freed already. */
		if (out1 == NULL) break; /* Error. */
		out2 = aplcopy(out1); /* Make a copy. */
		if (out2 == NULL) break; /* Error. */
		out3 = grade2a(out1,out2,up,rows,cols+2,div);
		break; /* final break from for(;;) */
	} /* end for(;;) */
	return(errstop(0,temp(out1),temp(out2),out3));
}