/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* partitn APL2 V1.0.0 *************************************************
* Partition, z#l`Zr.                                                   *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb partitn(left, rite, axes)
Aplcb left,rite,axes;
{
	Errstop; Errinit; Getcb; Intcopy; Integer; Ivalue; Partito;
	extern int aplerr, indxorg;
	Aplcb out=NULL;
	int axis,datacnt,i,*ip,j,k,m;

	for (;;) {
		if (errinit()) break;
		if (axes == NULL)
			axis = rite->aplrank - 1; /* Last axis, relative 0. */
		else {
			axis = ivalue(axes) - indxorg; /* Relative 0. */
			if (axis < 0 || axis >= rite->aplrank)
				aplerr = 3; /* Bad axis. */
			if (aplerr) break;
		}
		if (left->aplcount != *(rite->apldim + axis))
			aplerr = 128; /* Rleft ^= axis. */
		else if (!(left->aplflags & APLINT))
			left = integer(left);
		if (aplerr) break;
		for( i=j=k=0; i < left->aplcount; i++ ) {
			k += (j < (m = *(left->aplptr.aplint + i)));
			j = m;
		} /* k w/b new axis length */
		datacnt = k;
		if (rite->aplrank > 1) /* get out->aplcount. */
			for (i = 0; i < rite->aplrank; i++)
				if (i != axis)
					datacnt *= *(rite->apldim + i);
		out = getcb(NULL,datacnt,APLAPL+APLTEMP,rite->aplrank,NULL);
		if (out == NULL) break;
		if (out->aplrank > 1) { /* Set dimensions. */
			ip = axis ?
				intcopy(out->apldim,rite->apldim,axis,1) :
				out->apldim;
			*ip++ = k; /* Set axis value. */
			i = out->aplrank - axis - 1; /* # dimensions right of axis. */ 
			if (i > 0)
				ip = intcopy(ip, rite->apldim + axis + 1, i, 1);
		}
		return(partito(left,rite,out,axis));
	} /* end for(;;) */
     return(errstop(0,left,rite,out)); /* Get here if error. */
}