/* Copyright (C) 1993 by Thomas Glen Smith.	All Rights Reserved. */
/* preducet APL2 V1.0.0 ************************************************
* Called from preduces to finish processing when rite not empty, and   *
* out->aplcount > 0.                                                   *
***********************************************************************/
#define INCLUDES APLCB+APLDERIV+FUNSTRUC+FUNCODES
#include "includes.h"
void preducet(id,axicnt,botcnt,topcnt,itype,otype,rite,out,oper,identp)
int id;		/* 1=reduce, 0=scan */
int axicnt;	/* Count of elements along axis in rite */
int botcnt;	/* Count of elements below axis in rite */
int topcnt;	/* Count of elements above axis in rite */
int itype;	/* Data type of rite. */
int otype;	/* Data type of out. */
Aplcb rite;	/* nested APL variable */
Aplcb out;
SCALAR_PROC oper;
char *identp;	/* Pointer to identity value. */
{
	Allcopy; Dtacopy;
	extern int aplerr;
	int iw,isize,jw,kw,osize,mw,nw,pw,qw,rw;
	double wrka[2],wrkb[2];
	char *icp,*idata,*kp,*odata,*tdata;

	nw = (id) ? 1 : axicnt; /* nw == 1 if reduce, axicnt if scan */
	odata = out->aplptr.aplchar;
	osize = out->aplsize;
	idata = rite->aplptr.aplchar;
	isize = rite->aplsize;
	for (iw = 0; iw < topcnt; iw++) {
		pw = iw * botcnt * axicnt;
		icp = idata + pw * isize;
		for (jw = 0; jw < botcnt; jw++)
			for (mw = nw; mw > 0; mw--) {
				kp = icp+(jw+(axicnt-mw)*botcnt)*isize;
				tdata = dtacopy(wrka,kp,1,0,itype);
				if (1 < (rw = axicnt - mw + 1))
					for (kw = 1; kw < rw; kw++) {
						kp -= botcnt * isize;
						oper(kp, wrka, wrkb);
						if (itype == otype) {
							wrka[0] = wrkb[0];
							wrka[1] = wrkb[1];
						}
						else tdata = allcopy(wrka, wrkb,
							1,0,itype,otype);
					}
				if (id)  /* reduce */
					odata = dtacopy(odata,wrka,1,0,otype);
				else { /* bypass bug in compiler */
					qw = (pw+jw+(axicnt-mw)*botcnt)*osize;
					tdata = dtacopy(odata+qw,wrka,1,0,otype);
				}
			}
	}
}