-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathcrlibm.CUF
181 lines (164 loc) · 3.46 KB
/
crlibm.CUF
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
module crlibm
interface
#ifdef GPU
attributes(device) &
#endif
function exp_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: exp_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function log_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: log_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function log10_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: log10_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function atan_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: atan_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function tan_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: tan_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function sin_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: sin_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function cos_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: cos_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function sinh_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: sinh_rn
double precision, value :: x
end function
#ifdef GPU
attributes(device) &
#endif
function cosh_rn(x) bind(C)
use iso_c_binding
implicit none
double precision :: cosh_rn
double precision, value :: x
end function
end interface
contains
#ifdef GPU
attributes(device) &
#endif
function asin_rn(x) bind(C)
implicit none
double precision :: asin_rn
double precision, value :: x
double precision :: pi2
data pi2 /1.5707963267948966d0/
if (x.ne.x) then ! NaN
asin_rn=x
return
endif
if (abs(x).eq.1.0d0) then
asin_rn=sign(pi2,x)
else
! asin_rn=atan_rn(x/sqrt(1.0d0-x*x))
! Try using (1-x)*(1+x) in case x is very small.........
! or close to 1.....write a test program!!!
asin_rn=atan_rn(x/sqrt((1.0d0-x)*(1.0d0+x)))
endif
end
#ifdef GPU
attributes(device) &
#endif
function acos_rn(x) bind(C)
implicit none
double precision :: acos_rn
double precision, value :: x
double precision :: pi,pi2
data pi /3.1415926535897932d0/
data pi2 /1.5707963267948966d0/
if (x.ne.x) then ! NaN
acos_rn=x
elseif (abs(x).eq.0.0d0) then
acos_rn=pi2
else
! acos_rn=atan_rn(sqrt(1.0d0-x*x)/x)
! Try using (1-x)*(1+x) in case x is very small.........
! or close to 1.....write a test program!!!
acos_rn=atan_rn(sqrt((1.0d0-x)*(1.0d0+x))/x)
if (x.lt.0.0d0) then
acos_rn=pi+acos_rn
endif
endif
end
#ifdef GPU
attributes(device) &
#endif
function atan2_rn(y,x) bind(C)
implicit none
double precision :: atan2_rn
double precision, value :: y,x
double precision :: pi,pi2
data pi /3.1415926535897932d0/
data pi2 /1.5707963267948966d0/
if (x.eq.0d0) then
if (y.eq.0d0) then
! Should get me a NaN
atan2_rn=atan_rn(y/x)
else
atan2_rn=sign(pi2,y)
endif
else
if (y.eq.0d0) then
if (x.gt.0d0) then
atan2_rn=0d0
else
atan2_rn=pi
endif
else
atan2_rn=atan_rn(y/x)
if (x.lt.0d0) then
atan2_rn=sign(pi,y)+atan2_rn
endif
endif
endif
end
end module crlibm