/* Copyright (C) 1993 by Thomas Glen Smith.  All Rights Reserved. */
/* reducecm APL2 V1.0.0 ************************************************
* Called by ireduces and nreduces.                                     *
* Builds the necessary output APLCB for a reduce or scan operation,    *
* but expects the caller to perform the reduce or scan.                *
***********************************************************************/
#define INCLUDES APLCB+APLMEM
#include "includes.h"
Aplcb reducecm(id,identity,rite,axis,axicnt,botcnt,topcnt,type)
int id; /* 1=reduce, 0=scan */
double *identity; /* identity value */
Aplcb rite; /* operand */
int *axis; /* axis of reduction */
int *axicnt,*botcnt,*topcnt; /* processing variables */
int type; /* data type of output */
{
	Axispre; Errinit; Errstop; Getcb; Imax;
	extern int indxorg;
	int datacnt,*dimin,*dimout,i,j,k,rank;
	Aplcb out=NULL;

	if (errinit())
		return(errstop(0,NULL,rite,NULL));
	if (*axis < 0) /* does caller want the default axis? */
		*axis = rite->aplrank;
	else
 		*axis += (indxorg == 0);
	if (OK!=axispre(rite,*axis,axicnt,botcnt,topcnt))
		return(errstop(0,NULL,rite,NULL));
	if (id)
		datacnt=*topcnt**botcnt; /* reduce */
	else
		datacnt=rite->aplcount; /* scan */
	rank=imax(0,rite->aplrank-id);
     if (datacnt && type == APLCHAR && *axicnt > 1) type = APLINT;
	out=getcb(NULL,datacnt,type+APLTEMP,rank,NULL);
	if (rank > 1) { /* output isn't scalar or vector */
		dimout=out->apldim;
		dimin=rite->apldim;
		for (i=1; i<=rite->aplrank; i++) {
			if (!(id && i==*axis))
				*dimout++=*dimin;
			dimin++;
		}
	}
	if (!datacnt) /* result empty? */
		return(out);
	/* 1 or more elements of output */
	if (rite->aplcount==0 && identity==NULL)
		return(errstop(13,NULL,rite,out)); /* no identity */
	return(out);
}