xref: /csrg-svn/usr.bin/f77/libF77/r_tan.c (revision 29970)
110538Sdlw /*
222970Skre  * Copyright (c) 1980 Regents of the University of California.
322970Skre  * All rights reserved.  The Berkeley software License Agreement
422970Skre  * specifies the terms and conditions for redistribution.
522970Skre  *
6*29970Smckusick  *	@(#)r_tan.c	5.3	11/03/86
710538Sdlw  */
810538Sdlw 
9*29970Smckusick #ifndef tahoe
1023854Sjerry float r_tan(x)
1110538Sdlw float *x;
1210538Sdlw {
1310538Sdlw double tan();
1410538Sdlw return( tan(*x) );
1510538Sdlw }
16*29970Smckusick 
17*29970Smckusick #else tahoe
18*29970Smckusick 
19*29970Smckusick /*
20*29970Smckusick 	SINGLE PRECISION floating point tangent
21*29970Smckusick 
22*29970Smckusick 	sin/cos is used after argument reduction to [0,pi/4] range.
23*29970Smckusick 	since x is in this range, tan(x) is in [0,1] range and
24*29970Smckusick 	no overflow can occur here.
25*29970Smckusick */
26*29970Smckusick 
27*29970Smckusick #include <errno.h>
28*29970Smckusick 
29*29970Smckusick int	errno;
30*29970Smckusick static double invpi = 1.27323954473516268;  /* 4/pi */
31*29970Smckusick 
32*29970Smckusick float
33*29970Smckusick r_tan(parg)
34*29970Smckusick float *parg;
35*29970Smckusick {
36*29970Smckusick 	double arg;
37*29970Smckusick 	fortran float sin(), cos();
38*29970Smckusick 	double modf();
39*29970Smckusick 	float flmax_();
40*29970Smckusick 	double temp, e, x, xsq;
41*29970Smckusick 	int sign;
42*29970Smckusick 	int flag, i;
43*29970Smckusick 
44*29970Smckusick 	arg = *parg;
45*29970Smckusick 	flag = 0;
46*29970Smckusick 	sign = 1.;
47*29970Smckusick 	if(arg < 0.){		/* tan(-arg) = -tan(arg) */
48*29970Smckusick 		arg = -arg;
49*29970Smckusick 		sign = -1.;
50*29970Smckusick 	}
51*29970Smckusick 	arg = arg*invpi;   /*overflow?*/
52*29970Smckusick 	x = modf(arg,&e);
53*29970Smckusick 	i = e;
54*29970Smckusick 	switch(i%4) {
55*29970Smckusick 	case 1:			/* 2nd octant: tan(x) = 1/tan(1-x) */
56*29970Smckusick 		x = 1. - x;
57*29970Smckusick 		flag = 1;
58*29970Smckusick 		break;
59*29970Smckusick 
60*29970Smckusick 	case 2:			/* 3rd octant: tan(x) = -1/tan(x) */
61*29970Smckusick 		sign = - sign;
62*29970Smckusick 		flag = 1;
63*29970Smckusick 		break;
64*29970Smckusick 
65*29970Smckusick 	case 3:			/* 4th octant: tan(x) = -tan(1-x) */
66*29970Smckusick 		x = 1. - x;
67*29970Smckusick 		sign = - sign;
68*29970Smckusick 		break;
69*29970Smckusick 
70*29970Smckusick 	case 0:			/* 1st octant */
71*29970Smckusick 		break;
72*29970Smckusick 	}
73*29970Smckusick 	x = x/invpi;
74*29970Smckusick 
75*29970Smckusick 	temp = sin(x)/cos(x);
76*29970Smckusick 
77*29970Smckusick 	if(flag == 1) {
78*29970Smckusick 		if(temp == 0.) {	/* check for singular "point" */
79*29970Smckusick 			errno = ERANGE;
80*29970Smckusick 			if (sign>0)
81*29970Smckusick 				return(flmax_());
82*29970Smckusick 			return(-flmax_());
83*29970Smckusick 		}
84*29970Smckusick 		temp = 1./temp;
85*29970Smckusick 	}
86*29970Smckusick 	return(sign*temp);
87*29970Smckusick }
88*29970Smckusick 
89*29970Smckusick #endif tahoe
90