/*Copyright (C) 1992, 1996 by Thomas Glen Smith.  All Rights Reserved.*/
/* transpot APL2 V1.0.0 ************************************************
* Called by transpos to complete the operation after the initial       *
* environment has been established.                                    *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb transpot(left,rite)
Aplcb left,rite;
{
	Errstop;Getcb;Getfact;Idyadic;Ieq;Imax;Imonadic;Indexv;Indxsub;Inot;
	Intcopy;Ior;Iplus;Ireduce;Iscalar;Iscan;Ivalue;Perm;Reshape;Shape;
	Temp;Transpou;Vectin;
     extern int indxorg, aplerr;
	Aplcb dimcb,testcb,factor;
	int axis,*dp,i,iorid=0,*ip,iplusid=0,j,k,m,n,outrank,riterank;
	static int minus_one=-1;
	char *icp,*ocp;

     riterank = rite->aplrank > 1 ? rite->aplrank : 1;
	if (NULL == left) /* monadic form? */
		left = perm(indxsub(-riterank)); /* left = rank, rank-1, etc. */
	else {
		if (left->aplcount != riterank)
			return(errstop(32,left,rite,NULL)); /* bad left length */
		if (NULL == (left = vectin(left))) /* left w/b permanent */
			return(errstop(0,left,rite,NULL)); /* error */
	}
	testcb = perm(reshape(shape(left),iscalar(1))); /* vector of ones */
	endoper(indexv(testcb,left,iscalar(0))); /* 0s = indices used */
	if (aplerr) return(errstop(0,temp(left),temp(testcb),rite));
	if (left->aplcount != ivalue(		/* left m/b a vector equal in  */
		ireduce(iplus,&iplusid,		/* length to the rank of rite, */
			idyadic(ieq,			/* and m/b complete in that if */
				testcb,			/* its items include any int-  */
				iscan(ior,&iorid,	/* eger N, it also includes all*/
					testcb,		/* positive integers less than */
					indxorg)),	/* N.					 */
			indxorg)))
		return(errstop(33,temp(left),temp(testcb),rite));
	outrank = ivalue(ireduce(iplus,&iplusid,
		imonadic(inot,temp(testcb)),indxorg));
	dimcb = getcb(NULL,outrank,APLINT,1,NULL); /* to store new dims. */
	if (dimcb == NULL) return(errstop(0,left,rite,NULL));
	intcopy(dimcb->aplptr.aplint,&minus_one,outrank,0);
	if (rite->aplrank) /* loop only if rite not scalar */
		for (i = 0; i < riterank; i++) {
			m = *(rite->apldim+i); /* Selected dim. of rite. */
			j = *(left->aplptr.aplint + i) - indxorg;
				/* j == index (rel 0) to selected dim. of output. */
			n = *(dimcb->aplptr.aplint + j);
			*(dimcb->aplptr.aplint + j) = (n == -1 || m < n) ? m : n;
				/* If two or more dimensions of rite are mapped into */
				/* the same dimension of output, use the smaller.    */
				/* Generally, dimcb{left{i}}=shape(rite){i} */
		}
	factor = getfact(shape(rite));
	return(transpou(left,rite,dimcb,factor,outrank));
}