/*Copyright (C) 1992, 1994 by Thomas Glen Smith.  All Rights Reserved.*/
/* outrprdp APL2 V1.0.0 ************************************************
* Called by execjota, execjotc, and execjotd.  Differs from outrprd in *
* that it expects oper to be a procedure call rather than a function.  *
* Does outer product for all matching data types, or of mixed data     *
* types where one is convertible to the other, i.e. outrprd will never *
* be invoked with either left or rite of type APLCHAR, and the other   *
* something else.  If left is of type APLCHAR, rite will be also.      *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb outrprdp(oper,left,rite)
void (*oper)();
Aplcb left,rite;
{
	Chrcopy; Dyadrup; Errstop; Getcb; Intcopy; Matchok;
	int cnt,datacnt,datatyp,iw,*ip,jw,otype,rank;
     Aplcb out=NULL;
     char *ldata,*odata,*rdata;
	double wrkd[2];

	if (!matchok(&left,&rite,APLMASK))
		return(NULL);
	datacnt=left->aplcount*rite->aplcount;
	datatyp=left->aplflags & APLMASK;
	otype = (APLCHAR == datatyp) ? APLINT : datatyp;
	rank = left->aplrank + rite->aplrank;
	out = getcb(NULL, datacnt, otype + APLTEMP, rank, NULL);
	if (rank > 1) { /* set dimensions */
		ip = intcopy(out->apldim, left->apldim, left->aplrank, 1);
		ip = intcopy(ip, rite->apldim, rite->aplrank, 1);
	}
	if (datacnt) {
		cnt = 0; /* Count of output elements finished. */
     	odata = out->aplptr.aplchar;
          ldata = left->aplptr.aplchar;
		iw = left->aplcount;
		while(0 < iw--) {
	          rdata = rite->aplptr.aplchar;
			jw = rite->aplcount;
			while(0 < jw--) {
				*(wrkd+1) = 0e0; /* Initialize. */				
               	(*oper)(ldata,rdata,(char*)wrkd);
                    rdata += rite->aplsize;
				if (*(wrkd+1) != 0e0 && otype != APLCPLX) {
					otype = APLCPLX;
					out = dyadrup(out,cnt); /* Convert to complex. */
					odata = out->aplptr.aplchar + cnt * out->aplsize;
				}
				odata = chrcopy(odata,(char*)wrkd,out->aplsize,1);
				cnt++; /* Bump count of elements finished. */
               }
			ldata += left->aplsize;
		}
     }
	return(errstop(0,left,rite,out));
}