xref: /csrg-svn/usr.bin/f77/libF77/zabs.c (revision 47940)
1*47940Sbostic /*-
2*47940Sbostic  * Copyright (c) 1980 The Regents of the University of California.
3*47940Sbostic  * All rights reserved.
4*47940Sbostic  *
5*47940Sbostic  * %sccs.include.proprietary.c%
629957Smckusick  */
729957Smckusick 
8*47940Sbostic #ifndef lint
9*47940Sbostic static char sccsid[] = "@(#)zabs.c	5.3 (Berkeley) 04/12/91";
10*47940Sbostic #endif /* not lint */
11*47940Sbostic 
1229975Smckusick #ifdef tahoe
1329957Smckusick /* THIS IS BASED ON TAHOE FP REPRESENTATION */
1429957Smckusick #include <tahoemath/FP.h>
1529957Smckusick 
zabs(real,imag)1629957Smckusick double zabs(real, imag)
1729957Smckusick double real, imag;
1829957Smckusick {
1929957Smckusick double temp, sqrt();
2029957Smckusick 
2129957Smckusick if(real < 0)
2229957Smckusick 	*(long int *)&real ^= SIGN_BIT;
2329957Smckusick if(imag < 0)
2429957Smckusick 	*(long int *)&imag ^= SIGN_BIT;
2529957Smckusick if(imag > real){
2629957Smckusick 	temp = real;
2729957Smckusick 	real = imag;
2829957Smckusick 	imag = temp;
2929957Smckusick }
3029957Smckusick if(imag == 0.)		/* if((real+imag) == real) */
3129957Smckusick 	return(real);
3229957Smckusick 
3329957Smckusick temp = imag/real;
3429957Smckusick temp = real*sqrt(1.0 + temp*temp);  /*overflow!!*/
3529957Smckusick return(temp);
3629957Smckusick }
3729975Smckusick #endif tahoe
38