/* Copyright (C) 1993 by Thomas Glen Smith. All Rights Reserved. */ /* disclosf APL2 V1.0.0 ************************************************ * Called from disclose. Rite is nested (type APLAPL), permanent * ***********************************************************************/ #define INCLUDES APLCB #include "includes.h" Aplcb disclosf(rite, axes, dtype, rank) Aplcb rite; /* Nested operand to be "disclosed." */ Aplcb axes; /* NULL, or vector of axis values. */ int dtype; /* Desired output data type, e.g. APLNUMB. */ int rank; /* Common rank of all the items of rite. */ { Axesok; Errstop; Getcb; Idyadic; Indxsub; Iplus; Iscalar; Temp; extern int aplerr; extern int indxorg; Aplcb disclosg(Aplcb,Aplcb,Aplcb,Aplcb,int); Aplcb ax=NULL, *cb, rx=NULL, wrk; int i,*ip,j,*jp,k,*kp,m,n; for (;;) { if (aplerr) break; if (axes) if (NULL==(axes=axesok(axes, rank, rank + rite->aplrank))) break; else; else axes=idyadic(iplus,iscalar(rite->aplrank),indxsub(rank)); ax = getcb(NULL,rank + rite->aplrank,APLTEMP+APLINT,1,NULL); rx = getcb(NULL, rite->aplrank,APLTEMP+APLINT,1,NULL); if (aplerr) break; ip=ax->aplptr.aplint; /* ax w/b output dimensions. */ i=ax->aplcount; while(i--) *(ip + i) = -1; /* Initialize ax to all -1. */ jp = axes->aplptr.aplint; /* Point to 1st axes value. */ for (i = 0; i < axes->aplcount; i++) { /* Get output dim. */ ip = ax->aplptr.aplint + *jp++ - indxorg; /* Out dim. */ for(cb=rite->aplptr.aplapl, j=rite->aplcount; j; j--) { wrk = *cb++; /* Next nested APLCB from rite. */ if (wrk->aplrank) {/* Don't check scalars. */ k = *(wrk->apldim+i); /* Input dimension. */ m = *ip; /* Output dimension, or -1. */ *ip = (k > m) ? k : m; /* Pick the biggest. */ } } } break; } return(disclosg(rite,axes,ax,rx,dtype)); }