/*Copyright (C) 1992, 1996 by Thomas Glen Smith. All Rights Reserved.*/
/* decode APL2 V1.0.0 **************************************************
* RITE treated as vectors along its first axis, each vector converted *
* to scalar according to the vector of radices along last axis of LEFT.*
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb decode(left,rite)
Aplcb left,rite;
{
#define Copy(A,B) {A[0]=B[0]; if (datatyp==APLCPLX) A[1]=B[1];}
Errstop; Innrcom; Matchok; Plusp; Plusx; Timesp; Timesx;
void (*plus)(double *, double *, double*);
void (*times)(double *, double *, double*);
int axicnt,bump,datatyp,i,j,k,m,n,p,r,laxicnt,laxis,lbotcnt,lincr,
ltopcnt,raxicnt,rbotcnt,rincr,rtopcnt;
double *dataout,*ldata,*rdata,*ip,*jp,*kp,*mp,*np,radix[2],
wrka[2],wrkb[2],wrkc[2];
static double one[2]={1e0,0e0},zero[2]={0e0,0e0};
Aplcb out;
if (!matchok(&left, &rite, APLCPLX + APLNUMB)) return(NULL);
out = innrcom(0,left,rite,&laxis,&laxicnt,&lbotcnt,<opcnt,
&lincr,&raxicnt,&rbotcnt,&rtopcnt,&rincr,&datatyp,
(char**)&dataout,(char**)&ldata,(char**)&rdata);
if (out == NULL) return(NULL);
switch (datatyp) {
case APLNUMB: plus = plusp; times = timesp; bump=1; break;
case APLCPLX: plus = plusx; times = timesx; bump=2; break;
} /* end switch */
axicnt = raxicnt;
for (i = 0; i < ltopcnt; i++) {
/* ip = ldata + i*axicnt*lincr*bump; */
ip = ldata + i*bump*(lincr ? axicnt : 1);
for (j = 0; j < lbotcnt; j++) {
jp = ip + j*bump;
for (k = 0; k < rtopcnt; k++) {
kp = rdata + k*axicnt*rincr*bump;
for (m = 0; m < rbotcnt; m++) {
mp = kp + (m + axicnt*rincr)*bump;
np = jp + axicnt*lincr*bump;
Copy(radix,one)
Copy(wrka,zero)
for (n = 0; n < axicnt; n++) {
Copy(wrkb,radix)
mp -= rincr*bump;
(*times)(wrkb,mp,wrkc);
Copy(wrkb,wrka)
(*plus)(wrkb,wrkc,wrka);
np -= lincr*bump;
Copy(wrkc,radix)
(*times)(wrkc,np,radix);
}
Copy(dataout,wrka)
dataout += bump;
} } } }
return(errstop(0,left,rite,out));
}