/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* ravel2 APL2 V1.0.0 ************************************************** * Ravel2 accepts an axis value, where ravel doesn't. * ***********************************************************************/ #define INCLUDES APLCHDEF+FUNSTRUC+APLCB #include "includes.h" Aplcb ravel2(Aplcb rite, Aplcb axes) { Errstop; Getcb; Intcopy; Integer; Mod; Ravel; int ravelck(int, int); Aplcb ravel2a(Aplcb, Aplcb, int, int, int); extern int aplerr; extern int indxorg; Aplcb out=NULL; int comcnt=0,i,*ip,j,k,lodim=rite->aplrank,m,n,newaxis=1; if (axes == NULL) return(ravel(rite)); for (;;) { if (axes->aplrank > 1) {aplerr = 9; break;} if (axes->aplflags & APLNUMB && axes->aplcount == 1 && mod(*(axes->aplptr.apldata),1.0) != 0.0) { lodim = *(axes->aplptr.apldata); if (ravelck(lodim,rite->aplrank)) break; /* bad axis */ } else if (axes->aplcount == 0) break; /* all set */ else { /* combine axes */ if (axes->aplcount > rite->aplrank) {aplerr = 9; break;} if (!(axes->aplflags & APLINT)) axes = integer(axes); if (aplerr) break; ip = axes->aplptr.aplint; k = lodim = -1; comcnt = m = axes->aplcount; while (m--) { j = *ip++ - indxorg; /* next axis, rel. 0 */ if (ravelck(j,rite->aplrank)) break; if (k >= 0 && k != (j - 1)) {aplerr = 9; break;} k = j; if (lodim == -1) lodim = j; /* save first axis */ newaxis *= *(rite->apldim + j); /* combined axis */ } } break; } return(ravel2a(rite,axes,lodim,comcnt,newaxis)); }