xref: /csrg-svn/usr.bin/f77/libF77/c_sqrt.c (revision 45967)
110447Sdlw /*
222835Skre  * Copyright (c) 1980 Regents of the University of California.
322835Skre  * All rights reserved.  The Berkeley software License Agreement
422835Skre  * specifies the terms and conditions for redistribution.
522835Skre  *
6*45967Sbostic  *	@(#)c_sqrt.c	5.3	01/15/91
710447Sdlw  */
810447Sdlw 
910447Sdlw #include "complex"
1029962Smckusick #ifdef tahoe
11*45967Sbostic #include <tahoe/math/FP.h>
12*45967Sbostic #endif
1310447Sdlw 
1410447Sdlw c_sqrt(r, z)
1510447Sdlw complex *r, *z;
1610447Sdlw {
1710447Sdlw double mag, sqrt(), cabs();
1810447Sdlw 
1910447Sdlw if( (mag = cabs(z->real, z->imag)) == 0.)
2010447Sdlw 	r->real = r->imag = 0.;
2110447Sdlw else if(z->real > 0)
2210447Sdlw 	{
2310447Sdlw 	r->real = sqrt(0.5 * (mag + z->real) );
2410447Sdlw 	r->imag = z->imag / r->real / 2;
2510447Sdlw 	}
2610447Sdlw else
2710447Sdlw 	{
2810447Sdlw 	r->imag = sqrt(0.5 * (mag - z->real) );
2910447Sdlw 	if(z->imag < 0)
3029962Smckusick #ifndef tahoe
3110447Sdlw 		r->imag = - r->imag;
3229962Smckusick #else tahoe
3329962Smckusick 		*(unsigned long*)&(r->imag) ^= SIGN_BIT;
3429962Smckusick #endif tahoe
3510447Sdlw 	r->real = z->imag / r->imag /2;
3610447Sdlw 	}
3710447Sdlw }
38