/*Copyright (C) 1992, 1995 by Thomas Glen Smith. All Rights Reserved.*/ /* formati APL2 V1.0.0 ************************************************* * Called from form and grade2. Saves the original shape of rite in * * dimcb, then returns rite reshaped as a 2-dimensional matrix. * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb formati(rite,dimcb) Aplcb rite,*dimcb; { Dtacopy; Endoper; Errstop; Getcb; Intcopy; Perm; Shape; Temp; extern int aplerr; Aplcb out=NULL; int dimptr[2],i,*ip,tempsave,type; double *dp; for (;;) { *dimcb = NULL; type = rite->aplflags & (APLMASK | APLAPL); tempsave = rite->aplflags & APLTEMP; if (tempsave) rite->aplflags -= APLTEMP; /* temporarily permanent */ *dimcb = perm(shape(rite)); /* save original shape */ rite->aplflags += tempsave; /* restore temporary flag */ if (aplerr) break; switch (rite->aplrank) { case 0: /* input is scalar */ *dimptr = *(dimptr + 1) = 1; break; case 1: /* input is vector */ *dimptr = 1; *(dimptr + 1) = rite->aplcount; break; case 2: /* input is matrix */ *dimptr = *(rite->apldim); *(dimptr + 1) = *(rite->apldim + 1); break; default: /* input is array */ i = rite->aplrank - 1; ip = rite->apldim; *dimptr = 1; while (i--) *dimptr *= *ip++; *(dimptr + 1) = *ip; break; } /* end switch */ out = getcb(NULL, rite->aplcount, type, 2, NULL); if (aplerr) break; ip = intcopy(out->apldim, dimptr, 2, 1); dp = dtacopy(out->aplptr.apldata, rite->aplptr.apldata, out->aplcount, 1, type); break; /* last break in for(;;) */ } if (aplerr && *dimcb != NULL) { endoper(temp(*dimcb)); *dimcb = NULL; } return(errstop(0,NULL,rite,out)); /* return new rite */ }