/* Copyright (C) 1994 by Thomas Glen Smith.	All Rights Reserved. */
/* circulat APL2 V1.0.0 ************************************************
* Called by circulax.                                                  *
* Circle functions, complex numbers, non-trig., pos. key codes.        *
***********************************************************************/
#define INCLUDES MATH+TRIGKEYS
#include "includes.h"
void circulat(left,rrr,ret)
double *left,*rrr,*ret;
{
	Dabsx; Minusx; Powerx; Timesx;
	extern int aplerr;
	int ileft;
	double wa[2],wb[2],x,y;
	static double half=.5,negone[2]={-1.0,0.0};

	switch (ileft = (int) *left) {
		case  12: /* Phase r */
			GETXY /* x = *rrr, y = *(rrr+1) */
			*(ret+1) = 0.0;
			if (x == 0.0 || y == 0.0) *ret = 0.0;
			else *ret = atan(y/x);
			break;
		case  11:	/* Imaginary R */
			ASGX(ret,*(rrr+1),0e0); /* Assign to ret. */
			break;
		case  10:	/* | r */
			dabsx(rrr,ret);
			break;
		case  9:	/* real part of r */
			ASGX(ret,*rrr,0e0); /* Assign to ret. */
			break;
		case  8:	/* (-1_r*2)*.5 for x>0 y>0, x=0 y>1, x<0 y>=0  */
				/* _(-1_r*2)*.5 otherwise. */
			timesx(rrr,rrr,wa);			/* r*2 */
			minusx(negone,wa,wb);		/* -1_r*2 */
			powerx(wb,&half,ret);		/* (-1_r*2)*.5 */
			GETXY
			if (!((x > 0.0 && y > 0.0) || (x == 0.0 && y > 1.0) ||
				(x <  0.0 && y >= 0.0)))
				PREFIX_MINUS(ret); /* _(-1_r*2)*.5 */
			break;
		case  4:	/* (1+r*2)*.5 */
			timesx(rrr,rrr,wa);				/* r*2 */
			ASGX(wb, 1.0 + *wa, *(wa + 1));	/* 1+r*2 */
			powerx(wb,&half,ret);				/* (1+r*2)*.5 */
			GETXY
			if (!((x >= 0.0) || (-1.0 < x && x < 0.0 && y == 1.0))) {
				ASGX(ret, -*ret, -*(ret+1)); /* _(1+r*2)*.5 */
			}
			break;
		case  0:	/* (1_r*2)*.5 */
			timesx(rrr,rrr,wa);			/* r*2 */
			ASGX(wb, 1.0 - *wa, *(wa+1)) /* 1_r*2 */
			powerx(wb,&half,ret);			/* (1_r*2)*.5 */
			break;
		default: aplerr = 85; return; /* left invalid */
	} /* end switch */
}