/*Copyright (C) 1992, 1994 by Thomas Glen Smith.  All Rights Reserved.*/
/* transpou APL2 V1.0.0 ************************************************
* Called by transpot after left has been checked, the new rank and     *
* dimensions determined, and a factor array used to complete the       *
* transpos has been built.                                             *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb transpou(left,rite,dimcb,factor,newrank)
Aplcb left,rite,dimcb,factor;
int newrank;
{
	Chrcopy; Dtacopy; Endoper; Errstop; Getcb; Idyadic; Indexv; Intcopy;
     Iplus; Ireduce; Itimes; Ivalue; Temp;
     extern int indxorg;
     extern int aplerr;
	int axis,datacnt,datatyp,*dimptr,*dp,i,*ip,iplusid=0,itimesid=1,ix,j,k,
     maxaxis,size;
	char *icp,*ocp;
     Aplcb out;

	datatyp = rite->aplflags & (APLMASK + APLAPL);
	datacnt = ivalue(ireduce(itimes,&itimesid,dimcb,indxorg));
	out = getcb(NULL,datacnt,datatyp + APLTEMP, newrank,NULL);
     if (aplerr) return(errstop(0,left,rite,out));
	ip = intcopy(out->apldim,dimcb->aplptr.aplint,out->aplrank,1);
	dimptr = dimcb->aplptr.aplint; /* output index array ptr */
	for (i = 0; i < dimcb->aplcount; i++)
		*(dimptr + i) = 0; /* initialize index array */
	axis = maxaxis = (dimcb->aplcount - 1);
	icp = rite->aplptr.aplchar; /* input data pointer */
	ocp = out->aplptr.aplchar; /* output data pointer */
	size = out->aplsize;
	ix = 0; /* offset to input element */
	for (i = 0;;) {
		ocp = dtacopy(ocp,icp+ix*size,1,1,datatyp);
		if (out->aplcount == ++i) break;
		do { /* increment output indices */
			j = ++(*(dimptr + axis)); /* bump current index */
			if (j == *(out->apldim + axis))
				*(dimptr + axis--) = 0; /* reset, decrement axis */
			else axis = maxaxis;
		} while (axis < maxaxis) ;
		ix = 0; /* get set to calculate next input index */
		for ( j = 0; j < left->aplcount; j++ ) {
			k = *(left->aplptr.aplint + j) - indxorg; /* k = axis of   */
				/* output to be used on jth axis of input.        */
			ix += (*(dimptr + k) * *(factor->aplptr.aplint + j));
		}
	}
	endoper(temp(factor));
	endoper(temp(dimcb));
	return(errstop(0,temp(left),rite,out));
}