[unix-history] / usr / src / usr.bin / f77 / libF77 / c_sqrt.c

/*
 * Copyright (c) 1980 Regents of the University of California.
 * All rights reserved.  The Berkeley software License Agreement
 * specifies the terms and conditions for redistribution.
 *
 *	@(#)c_sqrt.c	5.2	%G%
 */

#include "complex"
#ifdef tahoe
#include <tahoemath/FP.h>
#endif tahoe

c_sqrt(r, z)
complex *r, *z;
{
double mag, sqrt(), cabs();

if( (mag = cabs(z->real, z->imag)) == 0.)
	r->real = r->imag = 0.;
else if(z->real > 0)
	{
	r->real = sqrt(0.5 * (mag + z->real) );
	r->imag = z->imag / r->real / 2;
	}
else
	{
	r->imag = sqrt(0.5 * (mag - z->real) );
	if(z->imag < 0)
#ifndef tahoe
		r->imag = - r->imag;
#else tahoe
		*(unsigned long*)&(r->imag) ^= SIGN_BIT;
#endif tahoe
	r->real = z->imag / r->imag /2;
	}
}
Commit	Line	Data
c788ff04	1	/*
3bddb6b4 RE	2	* Copyright (c) 1980 Regents of the University of California.
	3	* All rights reserved. The Berkeley software License Agreement
	4	* specifies the terms and conditions for redistribution.
	5	*
af857331	6	* @(#)c_sqrt.c 5.2 %G%
c788ff04 DW	7	*/
	8
	9	#include "complex"
af857331 KM	10	#ifdef tahoe
	11	#include <tahoemath/FP.h>
	12	#endif tahoe
c788ff04 DW	13
	14	c_sqrt(r, z)
	15	complex r, z;
	16	{
	17	double mag, sqrt(), cabs();
	18
	19	if( (mag = cabs(z->real, z->imag)) == 0.)
	20	r->real = r->imag = 0.;
	21	else if(z->real > 0)
	22	{
	23	r->real = sqrt(0.5 * (mag + z->real) );
	24	r->imag = z->imag / r->real / 2;
	25	}
	26	else
	27	{
	28	r->imag = sqrt(0.5 * (mag - z->real) );
	29	if(z->imag < 0)
af857331	30	#ifndef tahoe
c788ff04	31	r->imag = - r->imag;
af857331 KM	32	#else tahoe
	33	(unsigned long)&(r->imag) ^= SIGN_BIT;
	34	#endif tahoe
c788ff04 DW	35	r->real = z->imag / r->imag /2;
	36	}
	37	}