/*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)); }