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