xref: /csrg-svn/usr.bin/f77/libF77/z_sqrt.c (revision 47940)
1*47940Sbostic /*-
2*47940Sbostic  * Copyright (c) 1980 The Regents of the University of California.
3*47940Sbostic  * All rights reserved.
423001Skre  *
5*47940Sbostic  * %sccs.include.proprietary.c%
610554Sdlw  */
710554Sdlw 
8*47940Sbostic #ifndef lint
9*47940Sbostic static char sccsid[] = "@(#)z_sqrt.c	5.4 (Berkeley) 04/12/91";
10*47940Sbostic #endif /* not lint */
11*47940Sbostic 
1210554Sdlw #include "complex"
1329973Smckusick #ifdef tahoe
1445967Sbostic #include <tahoe/math/FP.h>
1529973Smckusick #define cabs zabs
1645967Sbostic #endif
1710554Sdlw 
z_sqrt(r,z)1810554Sdlw z_sqrt(r, z)
1910554Sdlw dcomplex *r, *z;
2010554Sdlw {
2110554Sdlw double mag, sqrt(), cabs();
2210554Sdlw 
2310554Sdlw if( (mag = cabs(z->dreal, z->dimag)) == 0.)
2410554Sdlw 	r->dreal = r->dimag = 0.;
2510554Sdlw else if(z->dreal > 0)
2610554Sdlw 	{
2710554Sdlw 	r->dreal = sqrt(0.5 * (mag + z->dreal) );
2810554Sdlw 	r->dimag = z->dimag / r->dreal / 2;
2910554Sdlw 	}
3010554Sdlw else
3110554Sdlw 	{
3210554Sdlw 	r->dimag = sqrt(0.5 * (mag - z->dreal) );
3310554Sdlw 	if(z->dimag < 0)
3429973Smckusick #ifndef tahoe
3510554Sdlw 		r->dimag = - r->dimag;
3629973Smckusick #else tahoe
3729973Smckusick 		*((long int *)&r->dimag) ^= SIGN_BIT;
3829973Smckusick #endif tahoe
3910554Sdlw 	r->dreal = z->dimag / r->dimag / 2;
4010554Sdlw 	}
4110554Sdlw }
42