/* Copyright (C) 1992 by Thomas Glen Smith.  All Rights Reserved. */
/* real APL2 V1.0.0 ****************************************************
* Called by form and matinv.                                           *
* Real returns a copy of the APL variable received as input, after     *
* converting to double floating point if the input is integer, and     *
* indicating an error if it is character.                              *
***********************************************************************/
#define INCLUDES APLCB
#include "includes.h"
Aplcb real(rite)
Aplcb rite;
{
	Dabsx; Dblcopy; Errinit; Errstop; Getcb; Intcopy;
	extern int aplerr;
	int i,*ip,rtype;
	double f,*fin,*fout,wrk[2];
	Aplcb out=NULL;

	if (errinit())
		return(errstop(0,NULL,rite,NULL));
	rtype = rite->aplflags & APL_NUMERIC;
	if (rite->aplcount && rtype == 0)
		return(errstop(18,NULL,rite,NULL)); /* can't do char */
	out=getcb(NULL,rite->aplcount,APLTEMP+APLNUMB,rite->aplrank,NULL);
	if (rite->aplrank > 1)
		ip = intcopy(out->apldim,rite->apldim,rite->aplrank,1);
	if (out->aplcount) {
		fout=out->aplptr.apldata;
		switch (rtype) {
			case APLNUMB:
				fout = dblcopy(fout, rite->aplptr.apldata,
					out->aplcount, 1);
				break;
			case APLINT:
				ip = rite->aplptr.aplint;
				for (i=out->aplcount; i>0; i--)
					*fout++=*ip++;
				break;
			case APLCPLX:
				fin = rite->aplptr.apldata;
				for (i=out->aplcount; i>0; i--) {
					if (*(fin+1)==0e0) /* Already real? */
						*fout++ = *fin; /* Yes. */
					else {
						dabsx(fin, wrk);
						*fout++ = *wrk;
					}
					fin += 2;
				}
				break;
			default:
				aplerr = 999; /* internal error */
		} /* end switch */
	}
	return(errstop(0,NULL,rite,out));
}