/* Copyright (C) 1994 by Thomas Glen Smith.  All Rights Reserved. */
/* innrprdx APL2 V1.0.0 ************************************************
* Called by execdotd when one of the arguments to inner product is     *
* character, and the other isn't, and the inner product is of the form *
* F.= or F.^=.  Argument tf contains the result of the character-to-   *
* non-character comparison.  This routine applies opera (F) to tf      *
* to complete the inner product result.                                *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb innrprdx(opera,tf,identity,left,rite)
int tf; /* 1 if form is F.^=, 0 if form is F.= */
void (*opera)(double*,double*,double*);
double identity;
Aplcb left,rite;
{
	Dtacopy; Errstop; Innrcom; Innrprde;
	Aplcb out;
	int datatyp,i,j,k,laxicnt,laxis,lbotcnt,lincr,ltopcnt,m,n,
		raxicnt,rbotcnt,rincr,rtopcnt;
	double *dataout,dtf,wrka,wrkb;
	char *ldata,*rdata;

	datatyp = APLNUMB;
#if APL_DOS
#define DATAOUT_PTR &(char*)dataout
#else
#define DATAOUT_PTR &dataout
#endif
	out = innrcom(2,left,rite,&laxis,
		&laxicnt,&lbotcnt,&ltopcnt,&lincr,
		&raxicnt,&rbotcnt,&rtopcnt,&rincr,
		&datatyp,DATAOUT_PTR,&ldata,&rdata);
	if (out == NULL)
		return(NULL);
	dtf = tf; /* convert to double */
	for (i=0; i<ltopcnt; i++)
		for (j=0; j<lbotcnt; j++)
			for (k=0; k<rtopcnt; k++)
				for (m=0; m < rbotcnt; m++) {
	                    wrka = identity;
					for (n=0; n<raxicnt; n++) {
                              wrkb = wrka;
                              (*opera)(	&dtf, &wrkb, &wrka);
                         }
                         *dataout++ = wrka;
				}
	return(errstop(0,left,rite,out));
}