xref: /csrg-svn/usr.bin/f77/libF77/c_sqrt.c (revision 47940)
1*47940Sbostic /*-
2*47940Sbostic  * Copyright (c) 1980 The Regents of the University of California.
3*47940Sbostic  * All rights reserved.
422835Skre  *
5*47940Sbostic  * %sccs.include.proprietary.c%
610447Sdlw  */
710447Sdlw 
8*47940Sbostic #ifndef lint
9*47940Sbostic static char sccsid[] = "@(#)c_sqrt.c	5.4 (Berkeley) 04/12/91";
10*47940Sbostic #endif /* not lint */
11*47940Sbostic 
1210447Sdlw #include "complex"
1329962Smckusick #ifdef tahoe
1445967Sbostic #include <tahoe/math/FP.h>
1545967Sbostic #endif
1610447Sdlw 
c_sqrt(r,z)1710447Sdlw c_sqrt(r, z)
1810447Sdlw complex *r, *z;
1910447Sdlw {
2010447Sdlw double mag, sqrt(), cabs();
2110447Sdlw 
2210447Sdlw if( (mag = cabs(z->real, z->imag)) == 0.)
2310447Sdlw 	r->real = r->imag = 0.;
2410447Sdlw else if(z->real > 0)
2510447Sdlw 	{
2610447Sdlw 	r->real = sqrt(0.5 * (mag + z->real) );
2710447Sdlw 	r->imag = z->imag / r->real / 2;
2810447Sdlw 	}
2910447Sdlw else
3010447Sdlw 	{
3110447Sdlw 	r->imag = sqrt(0.5 * (mag - z->real) );
3210447Sdlw 	if(z->imag < 0)
3329962Smckusick #ifndef tahoe
3410447Sdlw 		r->imag = - r->imag;
3529962Smckusick #else tahoe
3629962Smckusick 		*(unsigned long*)&(r->imag) ^= SIGN_BIT;
3729962Smckusick #endif tahoe
3810447Sdlw 	r->real = z->imag / r->imag /2;
3910447Sdlw 	}
4010447Sdlw }
41