OLD | NEW |
1 /* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_erfl.c */ | 1 /* origin: OpenBSD /usr/src/lib/libm/src/ld80/e_erfl.c */ |
2 /* | 2 /* |
3 * ==================================================== | 3 * ==================================================== |
4 * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. | 4 * Copyright (C) 1993 by Sun Microsystems, Inc. All rights reserved. |
5 * | 5 * |
6 * Developed at SunPro, a Sun Microsystems, Inc. business. | 6 * Developed at SunPro, a Sun Microsystems, Inc. business. |
7 * Permission to use, copy, modify, and distribute this | 7 * Permission to use, copy, modify, and distribute this |
8 * software is freely granted, provided that this notice | 8 * software is freely granted, provided that this notice |
9 * is preserved. | 9 * is preserved. |
10 * ==================================================== | 10 * ==================================================== |
(...skipping 79 matching lines...) Expand 10 before | Expand all | Expand 10 after Loading... |
90 * erf(x) = sign(x) *(1 - tiny) (raise inexact) | 90 * erf(x) = sign(x) *(1 - tiny) (raise inexact) |
91 * erfc(x) = tiny*tiny (raise underflow) if x > 0 | 91 * erfc(x) = tiny*tiny (raise underflow) if x > 0 |
92 * = 2 - tiny if x<0 | 92 * = 2 - tiny if x<0 |
93 * | 93 * |
94 * 7. Special case: | 94 * 7. Special case: |
95 * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, | 95 * erf(0) = 0, erf(inf) = 1, erf(-inf) = -1, |
96 * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, | 96 * erfc(0) = 1, erfc(inf) = 0, erfc(-inf) = 2, |
97 * erfc/erf(NaN) is NaN | 97 * erfc/erf(NaN) is NaN |
98 */ | 98 */ |
99 | 99 |
100 | |
101 #include "libm.h" | 100 #include "libm.h" |
102 | 101 |
103 #if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 | 102 #if LDBL_MANT_DIG == 53 && LDBL_MAX_EXP == 1024 |
104 long double erfl(long double x) | 103 long double erfl(long double x) { |
105 { | 104 return erf(x); |
106 » return erf(x); | 105 } |
107 } | 106 long double erfcl(long double x) { |
108 long double erfcl(long double x) | 107 return erfc(x); |
109 { | |
110 » return erfc(x); | |
111 } | 108 } |
112 #elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 | 109 #elif LDBL_MANT_DIG == 64 && LDBL_MAX_EXP == 16384 |
113 static const long double | 110 static const long double |
114 erx = 0.845062911510467529296875L, | 111 erx = 0.845062911510467529296875L, |
115 | 112 |
116 /* | 113 /* |
117 * Coefficients for approximation to erf on [0,0.84375] | 114 * Coefficients for approximation to erf on [0,0.84375] |
118 */ | 115 */ |
119 /* 8 * (2/sqrt(pi) - 1) */ | 116 /* 8 * (2/sqrt(pi) - 1) */ |
120 efx8 = 1.0270333367641005911692712249723613735048E0L, | 117 efx8 = 1.0270333367641005911692712249723613735048E0L, |
121 pp[6] = { | 118 pp[6] = |
122 1.122751350964552113068262337278335028553E6L, | 119 { |
123 -2.808533301997696164408397079650699163276E6L, | 120 1.122751350964552113068262337278335028553E6L, |
124 -3.314325479115357458197119660818768924100E5L, | 121 -2.808533301997696164408397079650699163276E6L, |
125 -6.848684465326256109712135497895525446398E4L, | 122 -3.314325479115357458197119660818768924100E5L, |
126 -2.657817695110739185591505062971929859314E3L, | 123 -6.848684465326256109712135497895525446398E4L, |
127 -1.655310302737837556654146291646499062882E2L, | 124 -2.657817695110739185591505062971929859314E3L, |
128 }, | 125 -1.655310302737837556654146291646499062882E2L, |
129 qq[6] = { | 126 }, |
130 8.745588372054466262548908189000448124232E6L, | 127 qq[6] = |
131 3.746038264792471129367533128637019611485E6L, | 128 { |
132 7.066358783162407559861156173539693900031E5L, | 129 8.745588372054466262548908189000448124232E6L, |
133 7.448928604824620999413120955705448117056E4L, | 130 3.746038264792471129367533128637019611485E6L, |
134 4.511583986730994111992253980546131408924E3L, | 131 7.066358783162407559861156173539693900031E5L, |
135 1.368902937933296323345610240009071254014E2L, | 132 7.448928604824620999413120955705448117056E4L, |
136 /* 1.000000000000000000000000000000000000000E0 */ | 133 4.511583986730994111992253980546131408924E3L, |
137 }, | 134 1.368902937933296323345610240009071254014E2L, |
138 | 135 /* 1.000000000000000000000000000000000000000E0 */ |
139 /* | 136 }, |
140 * Coefficients for approximation to erf in [0.84375,1.25] | 137 |
141 */ | 138 /* |
142 /* erf(x+1) = 0.845062911510467529296875 + pa(x)/qa(x) | 139 * Coefficients for approximation to erf in [0.84375,1.25] |
143 -0.15625 <= x <= +.25 | 140 */ |
144 Peak relative error 8.5e-22 */ | 141 /* erf(x+1) = 0.845062911510467529296875 + pa(x)/qa(x) |
145 pa[8] = { | 142 -0.15625 <= x <= +.25 |
146 -1.076952146179812072156734957705102256059E0L, | 143 Peak relative error 8.5e-22 */ |
147 1.884814957770385593365179835059971587220E2L, | 144 pa[8] = |
148 -5.339153975012804282890066622962070115606E1L, | 145 { |
149 4.435910679869176625928504532109635632618E1L, | 146 -1.076952146179812072156734957705102256059E0L, |
150 1.683219516032328828278557309642929135179E1L, | 147 1.884814957770385593365179835059971587220E2L, |
151 -2.360236618396952560064259585299045804293E0L, | 148 -5.339153975012804282890066622962070115606E1L, |
152 1.852230047861891953244413872297940938041E0L, | 149 4.435910679869176625928504532109635632618E1L, |
153 9.394994446747752308256773044667843200719E-2L, | 150 1.683219516032328828278557309642929135179E1L, |
154 }, | 151 -2.360236618396952560064259585299045804293E0L, |
155 qa[7] = { | 152 1.852230047861891953244413872297940938041E0L, |
156 4.559263722294508998149925774781887811255E2L, | 153 9.394994446747752308256773044667843200719E-2L, |
157 3.289248982200800575749795055149780689738E2L, | 154 }, |
158 2.846070965875643009598627918383314457912E2L, | 155 qa[7] = |
159 1.398715859064535039433275722017479994465E2L, | 156 { |
160 6.060190733759793706299079050985358190726E1L, | 157 4.559263722294508998149925774781887811255E2L, |
161 2.078695677795422351040502569964299664233E1L, | 158 3.289248982200800575749795055149780689738E2L, |
162 4.641271134150895940966798357442234498546E0L, | 159 2.846070965875643009598627918383314457912E2L, |
163 /* 1.000000000000000000000000000000000000000E0 */ | 160 1.398715859064535039433275722017479994465E2L, |
164 }, | 161 6.060190733759793706299079050985358190726E1L, |
165 | 162 2.078695677795422351040502569964299664233E1L, |
166 /* | 163 4.641271134150895940966798357442234498546E0L, |
167 * Coefficients for approximation to erfc in [1.25,1/0.35] | 164 /* 1.000000000000000000000000000000000000000E0 */ |
168 */ | 165 }, |
169 /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + ra(x^2)/sa(x^2)) | 166 |
170 1/2.85711669921875 < 1/x < 1/1.25 | 167 /* |
171 Peak relative error 3.1e-21 */ | 168 * Coefficients for approximation to erfc in [1.25,1/0.35] |
172 ra[] = { | 169 */ |
173 1.363566591833846324191000679620738857234E-1L, | 170 /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + ra(x^2)/sa(x^2)) |
174 1.018203167219873573808450274314658434507E1L, | 171 1/2.85711669921875 < 1/x < 1/1.25 |
175 1.862359362334248675526472871224778045594E2L, | 172 Peak relative error 3.1e-21 */ |
176 1.411622588180721285284945138667933330348E3L, | 173 ra[] = |
177 5.088538459741511988784440103218342840478E3L, | 174 { |
178 8.928251553922176506858267311750789273656E3L, | 175 1.363566591833846324191000679620738857234E-1L, |
179 7.264436000148052545243018622742770549982E3L, | 176 1.018203167219873573808450274314658434507E1L, |
180 2.387492459664548651671894725748959751119E3L, | 177 1.862359362334248675526472871224778045594E2L, |
181 2.220916652813908085449221282808458466556E2L, | 178 1.411622588180721285284945138667933330348E3L, |
182 }, | 179 5.088538459741511988784440103218342840478E3L, |
183 sa[] = { | 180 8.928251553922176506858267311750789273656E3L, |
184 -1.382234625202480685182526402169222331847E1L, | 181 7.264436000148052545243018622742770549982E3L, |
185 -3.315638835627950255832519203687435946482E2L, | 182 2.387492459664548651671894725748959751119E3L, |
186 -2.949124863912936259747237164260785326692E3L, | 183 2.220916652813908085449221282808458466556E2L, |
187 -1.246622099070875940506391433635999693661E4L, | 184 }, |
188 -2.673079795851665428695842853070996219632E4L, | 185 sa[] = |
189 -2.880269786660559337358397106518918220991E4L, | 186 { |
190 -1.450600228493968044773354186390390823713E4L, | 187 -1.382234625202480685182526402169222331847E1L, |
191 -2.874539731125893533960680525192064277816E3L, | 188 -3.315638835627950255832519203687435946482E2L, |
192 -1.402241261419067750237395034116942296027E2L, | 189 -2.949124863912936259747237164260785326692E3L, |
193 /* 1.000000000000000000000000000000000000000E0 */ | 190 -1.246622099070875940506391433635999693661E4L, |
194 }, | 191 -2.673079795851665428695842853070996219632E4L, |
195 | 192 -2.880269786660559337358397106518918220991E4L, |
196 /* | 193 -1.450600228493968044773354186390390823713E4L, |
197 * Coefficients for approximation to erfc in [1/.35,107] | 194 -2.874539731125893533960680525192064277816E3L, |
198 */ | 195 -1.402241261419067750237395034116942296027E2L, |
199 /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rb(x^2)/sb(x^2)) | 196 /* 1.000000000000000000000000000000000000000E0 */ |
200 1/6.6666259765625 < 1/x < 1/2.85711669921875 | 197 }, |
201 Peak relative error 4.2e-22 */ | 198 |
202 rb[] = { | 199 /* |
203 -4.869587348270494309550558460786501252369E-5L, | 200 * Coefficients for approximation to erfc in [1/.35,107] |
204 -4.030199390527997378549161722412466959403E-3L, | 201 */ |
205 -9.434425866377037610206443566288917589122E-2L, | 202 /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rb(x^2)/sb(x^2)) |
206 -9.319032754357658601200655161585539404155E-1L, | 203 1/6.6666259765625 < 1/x < 1/2.85711669921875 |
207 -4.273788174307459947350256581445442062291E0L, | 204 Peak relative error 4.2e-22 */ |
208 -8.842289940696150508373541814064198259278E0L, | 205 rb[] = |
209 -7.069215249419887403187988144752613025255E0L, | 206 { |
210 -1.401228723639514787920274427443330704764E0L, | 207 -4.869587348270494309550558460786501252369E-5L, |
211 }, | 208 -4.030199390527997378549161722412466959403E-3L, |
212 sb[] = { | 209 -9.434425866377037610206443566288917589122E-2L, |
213 4.936254964107175160157544545879293019085E-3L, | 210 -9.319032754357658601200655161585539404155E-1L, |
214 1.583457624037795744377163924895349412015E-1L, | 211 -4.273788174307459947350256581445442062291E0L, |
215 1.850647991850328356622940552450636420484E0L, | 212 -8.842289940696150508373541814064198259278E0L, |
216 9.927611557279019463768050710008450625415E0L, | 213 -7.069215249419887403187988144752613025255E0L, |
217 2.531667257649436709617165336779212114570E1L, | 214 -1.401228723639514787920274427443330704764E0L, |
218 2.869752886406743386458304052862814690045E1L, | 215 }, |
219 1.182059497870819562441683560749192539345E1L, | 216 sb[] = |
220 /* 1.000000000000000000000000000000000000000E0 */ | 217 { |
221 }, | 218 4.936254964107175160157544545879293019085E-3L, |
222 /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rc(x^2)/sc(x^2)) | 219 1.583457624037795744377163924895349412015E-1L, |
223 1/107 <= 1/x <= 1/6.6666259765625 | 220 1.850647991850328356622940552450636420484E0L, |
224 Peak relative error 1.1e-21 */ | 221 9.927611557279019463768050710008450625415E0L, |
225 rc[] = { | 222 2.531667257649436709617165336779212114570E1L, |
226 -8.299617545269701963973537248996670806850E-5L, | 223 2.869752886406743386458304052862814690045E1L, |
227 -6.243845685115818513578933902532056244108E-3L, | 224 1.182059497870819562441683560749192539345E1L, |
228 -1.141667210620380223113693474478394397230E-1L, | 225 /* 1.000000000000000000000000000000000000000E0 */ |
229 -7.521343797212024245375240432734425789409E-1L, | 226 }, |
230 -1.765321928311155824664963633786967602934E0L, | 227 /* erfc(1/x) = x exp (-1/x^2 - 0.5625 + rc(x^2)/sc(x^2)) |
231 -1.029403473103215800456761180695263439188E0L, | 228 1/107 <= 1/x <= 1/6.6666259765625 |
232 }, | 229 Peak relative error 1.1e-21 */ |
233 sc[] = { | 230 rc[] = |
234 8.413244363014929493035952542677768808601E-3L, | 231 { |
235 2.065114333816877479753334599639158060979E-1L, | 232 -8.299617545269701963973537248996670806850E-5L, |
236 1.639064941530797583766364412782135680148E0L, | 233 -6.243845685115818513578933902532056244108E-3L, |
237 4.936788463787115555582319302981666347450E0L, | 234 -1.141667210620380223113693474478394397230E-1L, |
238 5.005177727208955487404729933261347679090E0L, | 235 -7.521343797212024245375240432734425789409E-1L, |
239 /* 1.000000000000000000000000000000000000000E0 */ | 236 -1.765321928311155824664963633786967602934E0L, |
| 237 -1.029403473103215800456761180695263439188E0L, |
| 238 }, |
| 239 sc[] = { |
| 240 8.413244363014929493035952542677768808601E-3L, |
| 241 2.065114333816877479753334599639158060979E-1L, |
| 242 1.639064941530797583766364412782135680148E0L, |
| 243 4.936788463787115555582319302981666347450E0L, |
| 244 5.005177727208955487404729933261347679090E0L, |
| 245 /* 1.000000000000000000000000000000000000000E0 */ |
240 }; | 246 }; |
241 | 247 |
242 static long double erfc1(long double x) | 248 static long double erfc1(long double x) { |
243 { | 249 long double s, P, Q; |
244 » long double s,P,Q; | 250 |
245 | 251 s = fabsl(x) - 1; |
246 » s = fabsl(x) - 1; | 252 P = pa[0] + |
247 » P = pa[0] + s * (pa[1] + s * (pa[2] + | 253 s * (pa[1] + |
248 » s * (pa[3] + s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7]))))))
; | 254 s * (pa[2] + |
249 » Q = qa[0] + s * (qa[1] + s * (qa[2] + | 255 s * (pa[3] + |
250 » s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s)))))); | 256 s * (pa[4] + s * (pa[5] + s * (pa[6] + s * pa[7])))))); |
251 » return 1 - erx - P / Q; | 257 Q = qa[0] + |
252 } | 258 s * (qa[1] + |
253 | 259 s * (qa[2] + |
254 static long double erfc2(uint32_t ix, long double x) | 260 s * (qa[3] + s * (qa[4] + s * (qa[5] + s * (qa[6] + s)))))); |
255 { | 261 return 1 - erx - P / Q; |
256 » union ldshape u; | 262 } |
257 » long double s,z,R,S; | 263 |
258 | 264 static long double erfc2(uint32_t ix, long double x) { |
259 » if (ix < 0x3fffa000) /* 0.84375 <= |x| < 1.25 */ | 265 union ldshape u; |
260 » » return erfc1(x); | 266 long double s, z, R, S; |
261 | 267 |
262 » x = fabsl(x); | 268 if (ix < 0x3fffa000) /* 0.84375 <= |x| < 1.25 */ |
263 » s = 1 / (x * x); | 269 return erfc1(x); |
264 » if (ix < 0x4000b6db) { /* 1.25 <= |x| < 2.857 ~ 1/.35 */ | 270 |
265 » » R = ra[0] + s * (ra[1] + s * (ra[2] + s * (ra[3] + s * (ra[4] + | 271 x = fabsl(x); |
266 » » s * (ra[5] + s * (ra[6] + s * (ra[7] + s * ra[8]))))))); | 272 s = 1 / (x * x); |
267 » » S = sa[0] + s * (sa[1] + s * (sa[2] + s * (sa[3] + s * (sa[4] + | 273 if (ix < 0x4000b6db) { /* 1.25 <= |x| < 2.857 ~ 1/.35 */ |
268 » » s * (sa[5] + s * (sa[6] + s * (sa[7] + s * (sa[8] + s))))))
)); | 274 R = ra[0] + |
269 » } else if (ix < 0x4001d555) { /* 2.857 <= |x| < 6.6666259765625 */ | 275 s * (ra[1] + |
270 » » R = rb[0] + s * (rb[1] + s * (rb[2] + s * (rb[3] + s * (rb[4] + | 276 s * (ra[2] + |
271 » » s * (rb[5] + s * (rb[6] + s * rb[7])))))); | 277 s * (ra[3] + |
272 » » S = sb[0] + s * (sb[1] + s * (sb[2] + s * (sb[3] + s * (sb[4] + | 278 s * (ra[4] + |
273 » » s * (sb[5] + s * (sb[6] + s)))))); | 279 s * (ra[5] + |
274 » } else { /* 6.666 <= |x| < 107 (erfc only) */ | 280 s * (ra[6] + s * (ra[7] + s * ra[8]))))))); |
275 » » R = rc[0] + s * (rc[1] + s * (rc[2] + s * (rc[3] + | 281 S = sa[0] + |
276 » » s * (rc[4] + s * rc[5])))); | 282 s * (sa[1] + |
277 » » S = sc[0] + s * (sc[1] + s * (sc[2] + s * (sc[3] + | 283 s * (sa[2] + |
278 » » s * (sc[4] + s)))); | 284 s * (sa[3] + |
279 » } | 285 s * (sa[4] + |
280 » u.f = x; | 286 s * (sa[5] + |
281 » u.i.m &= -1ULL << 40; | 287 s * (sa[6] + |
282 » z = u.f; | 288 s * (sa[7] + s * (sa[8] + s)))))))); |
283 » return expl(-z*z - 0.5625) * expl((z - x) * (z + x) + R / S) / x; | 289 } else if (ix < 0x4001d555) { /* 2.857 <= |x| < 6.6666259765625 */ |
284 } | 290 R = rb[0] + |
285 | 291 s * (rb[1] + |
286 long double erfl(long double x) | 292 s * (rb[2] + |
287 { | 293 s * (rb[3] + |
288 » long double r, s, z, y; | 294 s * (rb[4] + s * (rb[5] + s * (rb[6] + s * rb[7])))))); |
289 » union ldshape u = {x}; | 295 S = sb[0] + |
290 » uint32_t ix = (u.i.se & 0x7fffU)<<16 | u.i.m>>48; | 296 s * (sb[1] + |
291 » int sign = u.i.se >> 15; | 297 s * (sb[2] + |
292 | 298 s * (sb[3] + s * (sb[4] + s * (sb[5] + s * (sb[6] + s)))))); |
293 » if (ix >= 0x7fff0000) | 299 } else { /* 6.666 <= |x| < 107 (erfc only) */ |
294 » » /* erf(nan)=nan, erf(+-inf)=+-1 */ | 300 R = rc[0] + |
295 » » return 1 - 2*sign + 1/x; | 301 s * (rc[1] + s * (rc[2] + s * (rc[3] + s * (rc[4] + s * rc[5])))); |
296 » if (ix < 0x3ffed800) { /* |x| < 0.84375 */ | 302 S = sc[0] + s * (sc[1] + s * (sc[2] + s * (sc[3] + s * (sc[4] + s)))); |
297 » » if (ix < 0x3fde8000) { /* |x| < 2**-33 */ | 303 } |
298 » » » return 0.125 * (8 * x + efx8 * x); /* avoid underflow *
/ | 304 u.f = x; |
299 » » } | 305 u.i.m &= -1ULL << 40; |
300 » » z = x * x; | 306 z = u.f; |
301 » » r = pp[0] + z * (pp[1] + | 307 return expl(-z * z - 0.5625) * expl((z - x) * (z + x) + R / S) / x; |
302 » » z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); | 308 } |
303 » » s = qq[0] + z * (qq[1] + | 309 |
304 » » z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); | 310 long double erfl(long double x) { |
305 » » y = r / s; | 311 long double r, s, z, y; |
306 » » return x + x * y; | 312 union ldshape u = {x}; |
307 » } | 313 uint32_t ix = (u.i.se & 0x7fffU) << 16 | u.i.m >> 48; |
308 » if (ix < 0x4001d555) /* |x| < 6.6666259765625 */ | 314 int sign = u.i.se >> 15; |
309 » » y = 1 - erfc2(ix,x); | 315 |
310 » else | 316 if (ix >= 0x7fff0000) |
311 » » y = 1 - 0x1p-16382L; | 317 /* erf(nan)=nan, erf(+-inf)=+-1 */ |
312 » return sign ? -y : y; | 318 return 1 - 2 * sign + 1 / x; |
313 } | 319 if (ix < 0x3ffed800) { /* |x| < 0.84375 */ |
314 | 320 if (ix < 0x3fde8000) { /* |x| < 2**-33 */ |
315 long double erfcl(long double x) | 321 return 0.125 * (8 * x + efx8 * x); /* avoid underflow */ |
316 { | 322 } |
317 » long double r, s, z, y; | 323 z = x * x; |
318 » union ldshape u = {x}; | 324 r = pp[0] + |
319 » uint32_t ix = (u.i.se & 0x7fffU)<<16 | u.i.m>>48; | 325 z * (pp[1] + z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); |
320 » int sign = u.i.se >> 15; | 326 s = qq[0] + |
321 | 327 z * (qq[1] + z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); |
322 » if (ix >= 0x7fff0000) | 328 y = r / s; |
323 » » /* erfc(nan) = nan, erfc(+-inf) = 0,2 */ | 329 return x + x * y; |
324 » » return 2*sign + 1/x; | 330 } |
325 » if (ix < 0x3ffed800) { /* |x| < 0.84375 */ | 331 if (ix < 0x4001d555) /* |x| < 6.6666259765625 */ |
326 » » if (ix < 0x3fbe0000) /* |x| < 2**-65 */ | 332 y = 1 - erfc2(ix, x); |
327 » » » return 1.0 - x; | 333 else |
328 » » z = x * x; | 334 y = 1 - 0x1p-16382L; |
329 » » r = pp[0] + z * (pp[1] + | 335 return sign ? -y : y; |
330 » » z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); | 336 } |
331 » » s = qq[0] + z * (qq[1] + | 337 |
332 » » z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); | 338 long double erfcl(long double x) { |
333 » » y = r / s; | 339 long double r, s, z, y; |
334 » » if (ix < 0x3ffd8000) /* x < 1/4 */ | 340 union ldshape u = {x}; |
335 » » » return 1.0 - (x + x * y); | 341 uint32_t ix = (u.i.se & 0x7fffU) << 16 | u.i.m >> 48; |
336 » » return 0.5 - (x - 0.5 + x * y); | 342 int sign = u.i.se >> 15; |
337 » } | 343 |
338 » if (ix < 0x4005d600) /* |x| < 107 */ | 344 if (ix >= 0x7fff0000) |
339 » » return sign ? 2 - erfc2(ix,x) : erfc2(ix,x); | 345 /* erfc(nan) = nan, erfc(+-inf) = 0,2 */ |
340 » y = 0x1p-16382L; | 346 return 2 * sign + 1 / x; |
341 » return sign ? 2 - y : y*y; | 347 if (ix < 0x3ffed800) { /* |x| < 0.84375 */ |
| 348 if (ix < 0x3fbe0000) /* |x| < 2**-65 */ |
| 349 return 1.0 - x; |
| 350 z = x * x; |
| 351 r = pp[0] + |
| 352 z * (pp[1] + z * (pp[2] + z * (pp[3] + z * (pp[4] + z * pp[5])))); |
| 353 s = qq[0] + |
| 354 z * (qq[1] + z * (qq[2] + z * (qq[3] + z * (qq[4] + z * (qq[5] + z))))); |
| 355 y = r / s; |
| 356 if (ix < 0x3ffd8000) /* x < 1/4 */ |
| 357 return 1.0 - (x + x * y); |
| 358 return 0.5 - (x - 0.5 + x * y); |
| 359 } |
| 360 if (ix < 0x4005d600) /* |x| < 107 */ |
| 361 return sign ? 2 - erfc2(ix, x) : erfc2(ix, x); |
| 362 y = 0x1p-16382L; |
| 363 return sign ? 2 - y : y * y; |
342 } | 364 } |
343 #elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384 | 365 #elif LDBL_MANT_DIG == 113 && LDBL_MAX_EXP == 16384 |
344 // TODO: broken implementation to make things compile | 366 // TODO: broken implementation to make things compile |
345 long double erfl(long double x) | 367 long double erfl(long double x) { |
346 { | 368 return erf(x); |
347 » return erf(x); | 369 } |
348 } | 370 long double erfcl(long double x) { |
349 long double erfcl(long double x) | 371 return erfc(x); |
350 { | |
351 » return erfc(x); | |
352 } | 372 } |
353 #endif | 373 #endif |
OLD | NEW |