Mercurial > octave-antonio
annotate liboctave/lo-specfun.cc @ 14815:95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
* lo-specfun.h, lo-specfun.cc, betainc.cc: Rewrite betainc functions to use
Array<xxx> for calling and return values.
author | Rik <octave@nomad.inbox5.com> |
---|---|
date | Thu, 28 Jun 2012 09:00:23 -0700 |
parents | e70a0c9cada6 |
children | 0a868d90436b |
rev | line source |
---|---|
3146 | 1 /* |
2 | |
14138
72c96de7a403
maint: update copyright notices for 2012
John W. Eaton <jwe@octave.org>
parents:
11586
diff
changeset
|
3 Copyright (C) 1996-2012 John W. Eaton |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
4 Copyright (C) 2010 Jaroslav Hajek |
10521
4d1fc073fbb7
add some missing copyright stmts
Jaroslav Hajek <highegg@gmail.com>
parents:
10414
diff
changeset
|
5 Copyright (C) 2010 VZLU Prague |
3146 | 6 |
7 This file is part of Octave. | |
8 | |
9 Octave is free software; you can redistribute it and/or modify it | |
10 under the terms of the GNU General Public License as published by the | |
7016 | 11 Free Software Foundation; either version 3 of the License, or (at your |
12 option) any later version. | |
3146 | 13 |
14 Octave is distributed in the hope that it will be useful, but WITHOUT | |
15 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
16 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
17 for more details. | |
18 | |
19 You should have received a copy of the GNU General Public License | |
7016 | 20 along with Octave; see the file COPYING. If not, see |
21 <http://www.gnu.org/licenses/>. | |
3146 | 22 |
23 */ | |
24 | |
25 #ifdef HAVE_CONFIG_H | |
26 #include <config.h> | |
27 #endif | |
28 | |
29 #include "Range.h" | |
3220 | 30 #include "CColVector.h" |
31 #include "CMatrix.h" | |
32 #include "dRowVector.h" | |
3146 | 33 #include "dMatrix.h" |
4844 | 34 #include "dNDArray.h" |
35 #include "CNDArray.h" | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
36 #include "fCColVector.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
37 #include "fCMatrix.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
38 #include "fRowVector.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
39 #include "fMatrix.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
40 #include "fNDArray.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
41 #include "fCNDArray.h" |
3146 | 42 #include "f77-fcn.h" |
43 #include "lo-error.h" | |
3220 | 44 #include "lo-ieee.h" |
45 #include "lo-specfun.h" | |
3146 | 46 #include "mx-inlines.cc" |
5701 | 47 #include "lo-mappers.h" |
3146 | 48 |
4064 | 49 #ifndef M_PI |
50 #define M_PI 3.14159265358979323846 | |
51 #endif | |
52 | |
3146 | 53 extern "C" |
54 { | |
4552 | 55 F77_RET_T |
56 F77_FUNC (zbesj, ZBESJ) (const double&, const double&, const double&, | |
11518 | 57 const octave_idx_type&, const octave_idx_type&, |
58 double*, double*, octave_idx_type&, | |
59 octave_idx_type&); | |
3146 | 60 |
4552 | 61 F77_RET_T |
62 F77_FUNC (zbesy, ZBESY) (const double&, const double&, const double&, | |
11518 | 63 const octave_idx_type&, const octave_idx_type&, |
64 double*, double*, octave_idx_type&, double*, | |
65 double*, octave_idx_type&); | |
3220 | 66 |
4552 | 67 F77_RET_T |
68 F77_FUNC (zbesi, ZBESI) (const double&, const double&, const double&, | |
11518 | 69 const octave_idx_type&, const octave_idx_type&, |
70 double*, double*, octave_idx_type&, | |
71 octave_idx_type&); | |
3146 | 72 |
4552 | 73 F77_RET_T |
74 F77_FUNC (zbesk, ZBESK) (const double&, const double&, const double&, | |
11518 | 75 const octave_idx_type&, const octave_idx_type&, |
76 double*, double*, octave_idx_type&, | |
77 octave_idx_type&); | |
3220 | 78 |
4552 | 79 F77_RET_T |
80 F77_FUNC (zbesh, ZBESH) (const double&, const double&, const double&, | |
11518 | 81 const octave_idx_type&, const octave_idx_type&, |
82 const octave_idx_type&, double*, double*, | |
83 octave_idx_type&, octave_idx_type&); | |
4552 | 84 |
85 F77_RET_T | |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
86 F77_FUNC (cbesj, cBESJ) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
87 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
88 FloatComplex*, octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
89 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
90 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
91 F77_FUNC (cbesy, CBESY) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
92 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
93 FloatComplex*, octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
94 FloatComplex*, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
95 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
96 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
97 F77_FUNC (cbesi, CBESI) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
98 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
99 FloatComplex*, octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
100 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
101 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
102 F77_FUNC (cbesk, CBESK) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
103 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
104 FloatComplex*, octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
105 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
106 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
107 F77_FUNC (cbesh, CBESH) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
108 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
109 const octave_idx_type&, FloatComplex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
110 octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
111 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
112 F77_RET_T |
11518 | 113 F77_FUNC (zairy, ZAIRY) (const double&, const double&, |
114 const octave_idx_type&, const octave_idx_type&, | |
115 double&, double&, octave_idx_type&, | |
116 octave_idx_type&); | |
3146 | 117 |
4552 | 118 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
119 F77_FUNC (cairy, CAIRY) (const float&, const float&, const octave_idx_type&, |
11518 | 120 const octave_idx_type&, float&, float&, |
121 octave_idx_type&, octave_idx_type&); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
122 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
123 F77_RET_T |
11518 | 124 F77_FUNC (zbiry, ZBIRY) (const double&, const double&, |
125 const octave_idx_type&, const octave_idx_type&, | |
126 double&, double&, octave_idx_type&); | |
4552 | 127 |
128 F77_RET_T | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
129 F77_FUNC (cbiry, CBIRY) (const float&, const float&, const octave_idx_type&, |
11518 | 130 const octave_idx_type&, float&, float&, |
131 octave_idx_type&); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
132 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
133 F77_RET_T |
4552 | 134 F77_FUNC (xdacosh, XDACOSH) (const double&, double&); |
3220 | 135 |
4552 | 136 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
137 F77_FUNC (xacosh, XACOSH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
138 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
139 F77_RET_T |
4552 | 140 F77_FUNC (xdasinh, XDASINH) (const double&, double&); |
3146 | 141 |
4552 | 142 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
143 F77_FUNC (xasinh, XASINH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
144 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
145 F77_RET_T |
4552 | 146 F77_FUNC (xdatanh, XDATANH) (const double&, double&); |
3146 | 147 |
4552 | 148 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
149 F77_FUNC (xatanh, XATANH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
150 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
151 F77_RET_T |
4552 | 152 F77_FUNC (xderf, XDERF) (const double&, double&); |
3146 | 153 |
4552 | 154 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
155 F77_FUNC (xerf, XERF) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
156 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
157 F77_RET_T |
4552 | 158 F77_FUNC (xderfc, XDERFC) (const double&, double&); |
3146 | 159 |
4552 | 160 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
161 F77_FUNC (xerfc, XERFC) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
162 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
163 F77_RET_T |
4552 | 164 F77_FUNC (xdbetai, XDBETAI) (const double&, const double&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
165 const double&, double&); |
3146 | 166 |
4552 | 167 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
168 F77_FUNC (xbetai, XBETAI) (const float&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
169 const float&, float&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
170 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
171 F77_RET_T |
4552 | 172 F77_FUNC (xdgamma, XDGAMMA) (const double&, double&); |
3146 | 173 |
4552 | 174 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
175 F77_FUNC (xgamma, XGAMMA) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
176 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
177 F77_RET_T |
4552 | 178 F77_FUNC (xgammainc, XGAMMAINC) (const double&, const double&, double&); |
3146 | 179 |
4552 | 180 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
181 F77_FUNC (xsgammainc, XSGAMMAINC) (const float&, const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
182 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
183 F77_RET_T |
4552 | 184 F77_FUNC (dlgams, DLGAMS) (const double&, double&, double&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
185 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
186 F77_RET_T |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
187 F77_FUNC (algams, ALGAMS) (const float&, float&, float&); |
3146 | 188 } |
189 | |
190 #if !defined (HAVE_ACOSH) | |
191 double | |
192 acosh (double x) | |
193 { | |
194 double retval; | |
5278 | 195 F77_XFCN (xdacosh, XDACOSH, (x, retval)); |
3146 | 196 return retval; |
197 } | |
198 #endif | |
199 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
200 #if !defined (HAVE_ACOSHF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
201 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
202 acoshf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
203 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
204 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
205 F77_XFCN (xacosh, XACOSH, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
206 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
207 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
208 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
209 |
3146 | 210 #if !defined (HAVE_ASINH) |
211 double | |
212 asinh (double x) | |
213 { | |
214 double retval; | |
5278 | 215 F77_XFCN (xdasinh, XDASINH, (x, retval)); |
3146 | 216 return retval; |
217 } | |
218 #endif | |
219 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
220 #if !defined (HAVE_ASINHF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
221 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
222 asinhf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
223 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
224 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
225 F77_XFCN (xasinh, XASINH, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
226 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
227 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
228 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
229 |
3146 | 230 #if !defined (HAVE_ATANH) |
231 double | |
232 atanh (double x) | |
233 { | |
234 double retval; | |
5278 | 235 F77_XFCN (xdatanh, XDATANH, (x, retval)); |
3146 | 236 return retval; |
237 } | |
238 #endif | |
239 | |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
240 #if !defined (HAVE_ATANHF) |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
241 float |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
242 atanhf (float x) |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
243 { |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
244 float retval; |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
245 F77_XFCN (xatanh, XATANH, (x, retval)); |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
246 return retval; |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
247 } |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
248 #endif |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
249 |
3146 | 250 #if !defined (HAVE_ERF) |
251 double | |
252 erf (double x) | |
253 { | |
254 double retval; | |
5278 | 255 F77_XFCN (xderf, XDERF, (x, retval)); |
3146 | 256 return retval; |
257 } | |
258 #endif | |
259 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
260 #if !defined (HAVE_ERFF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
261 float |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
262 erff (float x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
263 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
264 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
265 F77_XFCN (xerf, XERF, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
266 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
267 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
268 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
269 |
3146 | 270 #if !defined (HAVE_ERFC) |
271 double | |
272 erfc (double x) | |
273 { | |
274 double retval; | |
5278 | 275 F77_XFCN (xderfc, XDERFC, (x, retval)); |
3146 | 276 return retval; |
277 } | |
278 #endif | |
279 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
280 #if !defined (HAVE_ERFCF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
281 float |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
282 erfcf (float x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
283 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
284 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
285 F77_XFCN (xerfc, XERFC, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
286 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
287 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
288 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
289 |
3146 | 290 double |
3156 | 291 xgamma (double x) |
3146 | 292 { |
3156 | 293 double result; |
5701 | 294 |
295 if (xisnan (x)) | |
296 result = x; | |
297 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) | |
298 result = octave_Inf; | |
299 else | |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
300 #if defined (HAVE_TGAMMA) |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
301 result = tgamma (x); |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
302 #else |
5701 | 303 F77_XFCN (xdgamma, XDGAMMA, (x, result)); |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
304 #endif |
6969 | 305 |
3156 | 306 return result; |
3146 | 307 } |
308 | |
309 double | |
3156 | 310 xlgamma (double x) |
3146 | 311 { |
6969 | 312 #if defined (HAVE_LGAMMA) |
313 return lgamma (x); | |
314 #else | |
3156 | 315 double result; |
3146 | 316 double sgngam; |
4497 | 317 |
5701 | 318 if (xisnan (x)) |
319 result = x; | |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
320 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
5701 | 321 result = octave_Inf; |
5700 | 322 else |
323 F77_XFCN (dlgams, DLGAMS, (x, result, sgngam)); | |
4497 | 324 |
3156 | 325 return result; |
6969 | 326 #endif |
6961 | 327 } |
328 | |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
329 Complex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
330 rc_lgamma (double x) |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
331 { |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
332 double result; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
333 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
334 #if defined (HAVE_LGAMMA_R) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
335 int sgngam; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
336 result = lgamma_r (x, &sgngam); |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
337 #else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
338 double sgngam; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
339 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
340 if (xisnan (x)) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
341 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
342 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
343 result = octave_Inf; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
344 else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
345 F77_XFCN (dlgams, DLGAMS, (x, result, sgngam)); |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
346 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
347 #endif |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
348 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
349 if (sgngam < 0) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
350 return result + Complex (0., M_PI); |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
351 else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
352 return result; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
353 } |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
354 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
355 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
356 xgamma (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
357 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
358 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
359 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
360 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
361 result = x; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
362 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
363 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
364 else |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
365 #if defined (HAVE_TGAMMAF) |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
366 result = tgammaf (x); |
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
367 #else |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
368 F77_XFCN (xgamma, XGAMMA, (x, result)); |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
369 #endif |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
370 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
371 return result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
372 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
373 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
374 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
375 xlgamma (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
376 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
377 #if defined (HAVE_LGAMMAF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
378 return lgammaf (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
379 #else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
380 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
381 float sgngam; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
382 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
383 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
384 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
385 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
386 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
387 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
388 F77_XFCN (algams, ALGAMS, (x, result, sgngam)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
389 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
390 return result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
391 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
392 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
393 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
394 FloatComplex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
395 rc_lgamma (float x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
396 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
397 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
398 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
399 #if defined (HAVE_LGAMMAF_R) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
400 int sgngam; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
401 result = lgammaf_r (x, &sgngam); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
402 #else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
403 float sgngam; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
404 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
405 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
406 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
407 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
408 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
409 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
410 F77_XFCN (algams, ALGAMS, (x, result, sgngam)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
411 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
412 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
413 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
414 if (sgngam < 0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
415 return result + FloatComplex (0., M_PI); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
416 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
417 return result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
418 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
419 |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
420 #if !defined (HAVE_EXPM1) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
421 double |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
422 expm1 (double x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
423 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
424 double retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
425 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
426 double ax = fabs (x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
427 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
428 if (ax < 0.1) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
429 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
430 ax /= 16; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
431 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
432 // use Taylor series to calculate exp(x)-1. |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
433 double t = ax; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
434 double s = 0; |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
435 for (int i = 2; i < 7; i++) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
436 s += (t *= ax/i); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
437 s += ax; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
438 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
439 // use the identity (a+1)^2-1 = a*(a+2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
440 double e = s; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
441 for (int i = 0; i < 4; i++) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
442 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
443 s *= e + 2; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
444 e *= e + 2; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
445 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
446 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
447 retval = (x > 0) ? s : -s / (1+s); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
448 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
449 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
450 retval = exp (x) - 1; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
451 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
452 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
453 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
454 #endif |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
455 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
456 Complex |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
457 expm1(const Complex& x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
458 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
459 Complex retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
460 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
461 if (std:: abs (x) < 1) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
462 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
463 double im = x.imag(); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
464 double u = expm1 (x.real ()); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
465 double v = sin (im/2); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
466 v = -2*v*v; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
467 retval = Complex (u*v + u + v, (u+1) * sin (im)); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
468 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
469 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
470 retval = std::exp (x) - Complex (1); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
471 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
472 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
473 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
474 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
475 #if !defined (HAVE_EXPM1F) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
476 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
477 expm1f (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
478 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
479 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
480 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
481 float ax = fabs (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
482 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
483 if (ax < 0.1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
484 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
485 ax /= 16; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
486 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
487 // use Taylor series to calculate exp(x)-1. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
488 float t = ax; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
489 float s = 0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
490 for (int i = 2; i < 7; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
491 s += (t *= ax/i); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
492 s += ax; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
493 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
494 // use the identity (a+1)^2-1 = a*(a+2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
495 float e = s; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
496 for (int i = 0; i < 4; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
497 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
498 s *= e + 2; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
499 e *= e + 2; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
500 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
501 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
502 retval = (x > 0) ? s : -s / (1+s); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
503 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
504 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
505 retval = exp (x) - 1; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
506 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
507 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
508 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
509 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
510 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
511 FloatComplex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
512 expm1(const FloatComplex& x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
513 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
514 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
515 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
516 if (std:: abs (x) < 1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
517 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
518 float im = x.imag(); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
519 float u = expm1 (x.real ()); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
520 float v = sin (im/2); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
521 v = -2*v*v; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
522 retval = FloatComplex (u*v + u + v, (u+1) * sin (im)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
523 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
524 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
525 retval = std::exp (x) - FloatComplex (1); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
526 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
527 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
528 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
529 |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
530 #if !defined (HAVE_LOG1P) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
531 double |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
532 log1p (double x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
533 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
534 double retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
535 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
536 double ax = fabs (x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
537 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
538 if (ax < 0.2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
539 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
540 // use approximation log (1+x) ~ 2*sum ((x/(2+x)).^ii ./ ii), ii = 1:2:2n+1 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
541 double u = x / (2 + x), t = 1, s = 0; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
542 for (int i = 2; i < 12; i += 2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
543 s += (t *= u*u) / (i+1); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
544 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
545 retval = 2 * (s + 1) * u; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
546 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
547 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
548 retval = log (1 + x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
549 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
550 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
551 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
552 #endif |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
553 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
554 Complex |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
555 log1p (const Complex& x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
556 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
557 Complex retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
558 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
559 double r = x.real (), i = x.imag(); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
560 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
561 if (fabs (r) < 0.5 && fabs (i) < 0.5) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
562 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
563 double u = 2*r + r*r + i*i; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
564 retval = Complex (log1p (u / (1+sqrt (u+1))), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
565 atan2 (1 + r, i)); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
566 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
567 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
568 retval = std::log (Complex(1) + x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
569 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
570 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
571 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
572 |
10414
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
573 #if !defined (HAVE_CBRT) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
574 double cbrt (double x) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
575 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
576 static const double one_third = 0.3333333333333333333; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
577 if (xfinite (x)) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
578 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
579 // Use pow. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
580 double y = std::pow (std::abs (x), one_third) * signum (x); |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
581 // Correct for better accuracy. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
582 return (x / (y*y) + y + y) / 3; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
583 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
584 else |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
585 return x; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
586 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
587 #endif |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
588 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
589 #if !defined (HAVE_LOG1PF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
590 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
591 log1pf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
592 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
593 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
594 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
595 float ax = fabs (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
596 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
597 if (ax < 0.2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
598 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
599 // use approximation log (1+x) ~ 2*sum ((x/(2+x)).^ii ./ ii), ii = 1:2:2n+1 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
600 float u = x / (2 + x), t = 1, s = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
601 for (int i = 2; i < 12; i += 2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
602 s += (t *= u*u) / (i+1); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
603 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
604 retval = 2 * (s + 1) * u; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
605 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
606 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
607 retval = log (1 + x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
608 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
609 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
610 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
611 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
612 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
613 FloatComplex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
614 log1p (const FloatComplex& x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
615 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
616 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
617 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
618 float r = x.real (), i = x.imag(); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
619 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
620 if (fabs (r) < 0.5 && fabs (i) < 0.5) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
621 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
622 float u = 2*r + r*r + i*i; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
623 retval = FloatComplex (log1p (u / (1+sqrt (u+1))), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
624 atan2 (1 + r, i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
625 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
626 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
627 retval = std::log (FloatComplex(1) + x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
628 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
629 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
630 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
631 |
10414
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
632 #if !defined (HAVE_CBRTF) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
633 float cbrtf (float x) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
634 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
635 static const float one_third = 0.3333333333333333333f; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
636 if (xfinite (x)) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
637 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
638 // Use pow. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
639 float y = std::pow (std::abs (x), one_third) * signum (x); |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
640 // Correct for better accuracy. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
641 return (x / (y*y) + y + y) / 3; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
642 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
643 else |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
644 return x; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
645 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
646 #endif |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
647 |
3220 | 648 static inline Complex |
5275 | 649 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 650 |
651 static inline Complex | |
5275 | 652 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 653 |
654 static inline Complex | |
5275 | 655 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 656 |
657 static inline Complex | |
5275 | 658 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 659 |
660 static inline Complex | |
5275 | 661 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 662 |
663 static inline Complex | |
5275 | 664 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 665 |
666 static inline Complex | |
5275 | 667 bessel_return_value (const Complex& val, octave_idx_type ierr) |
3146 | 668 { |
3220 | 669 static const Complex inf_val = Complex (octave_Inf, octave_Inf); |
670 static const Complex nan_val = Complex (octave_NaN, octave_NaN); | |
671 | |
672 Complex retval; | |
673 | |
674 switch (ierr) | |
675 { | |
676 case 0: | |
677 case 3: | |
678 retval = val; | |
679 break; | |
680 | |
681 case 2: | |
682 retval = inf_val; | |
683 break; | |
684 | |
685 default: | |
686 retval = nan_val; | |
687 break; | |
688 } | |
689 | |
3146 | 690 return retval; |
691 } | |
692 | |
4911 | 693 static inline bool |
694 is_integer_value (double x) | |
695 { | |
696 return x == static_cast<double> (static_cast<long> (x)); | |
697 } | |
698 | |
3220 | 699 static inline Complex |
5275 | 700 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 701 { |
3220 | 702 Complex retval; |
703 | |
704 if (alpha >= 0.0) | |
705 { | |
706 double yr = 0.0; | |
707 double yi = 0.0; | |
708 | |
5275 | 709 octave_idx_type nz; |
3220 | 710 |
711 double zr = z.real (); | |
712 double zi = z.imag (); | |
713 | |
4506 | 714 F77_FUNC (zbesj, ZBESJ) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
715 | |
716 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
717 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
718 double expz = exp (std::abs (zi)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
719 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
720 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
721 } |
3220 | 722 |
4490 | 723 if (zi == 0.0 && zr >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
724 yi = 0.0; |
3220 | 725 |
726 retval = bessel_return_value (Complex (yr, yi), ierr); | |
727 } | |
4911 | 728 else if (is_integer_value (alpha)) |
729 { | |
730 // zbesy can overflow as z->0, and cause troubles for generic case below | |
731 alpha = -alpha; | |
732 Complex tmp = zbesj (z, alpha, kode, ierr); | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
733 if ((static_cast <long> (alpha)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
734 tmp = - tmp; |
4911 | 735 retval = bessel_return_value (tmp, ierr); |
736 } | |
3220 | 737 else |
738 { | |
739 alpha = -alpha; | |
740 | |
741 Complex tmp = cos (M_PI * alpha) * zbesj (z, alpha, kode, ierr); | |
742 | |
743 if (ierr == 0 || ierr == 3) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
744 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
745 tmp -= sin (M_PI * alpha) * zbesy (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
746 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
747 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
748 } |
3220 | 749 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
750 retval = Complex (octave_NaN, octave_NaN); |
3220 | 751 } |
752 | |
3146 | 753 return retval; |
754 } | |
755 | |
3220 | 756 static inline Complex |
5275 | 757 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 758 { |
3220 | 759 Complex retval; |
3146 | 760 |
761 if (alpha >= 0.0) | |
762 { | |
3220 | 763 double yr = 0.0; |
764 double yi = 0.0; | |
765 | |
5275 | 766 octave_idx_type nz; |
3220 | 767 |
768 double wr, wi; | |
3146 | 769 |
3220 | 770 double zr = z.real (); |
771 double zi = z.imag (); | |
772 | |
773 ierr = 0; | |
774 | |
775 if (zr == 0.0 && zi == 0.0) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
776 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
777 yr = -octave_Inf; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
778 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
779 } |
3220 | 780 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
781 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
782 F77_FUNC (zbesy, ZBESY) (zr, zi, alpha, 2, 1, &yr, &yi, nz, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
783 &wr, &wi, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
784 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
785 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
786 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
787 double expz = exp (std::abs (zi)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
788 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
789 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
790 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
791 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
792 if (zi == 0.0 && zr >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
793 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
794 } |
3146 | 795 |
3220 | 796 return bessel_return_value (Complex (yr, yi), ierr); |
797 } | |
4911 | 798 else if (is_integer_value (alpha - 0.5)) |
799 { | |
800 // zbesy can overflow as z->0, and cause troubles for generic case below | |
801 alpha = -alpha; | |
802 Complex tmp = zbesj (z, alpha, kode, ierr); | |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
803 if ((static_cast <long> (alpha - 0.5)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
804 tmp = - tmp; |
4911 | 805 retval = bessel_return_value (tmp, ierr); |
806 } | |
3220 | 807 else |
808 { | |
809 alpha = -alpha; | |
3146 | 810 |
3220 | 811 Complex tmp = cos (M_PI * alpha) * zbesy (z, alpha, kode, ierr); |
3146 | 812 |
3220 | 813 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
814 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
815 tmp += sin (M_PI * alpha) * zbesj (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
816 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
817 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
818 } |
3220 | 819 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
820 retval = Complex (octave_NaN, octave_NaN); |
3220 | 821 } |
822 | |
823 return retval; | |
824 } | |
825 | |
826 static inline Complex | |
5275 | 827 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 828 { |
829 Complex retval; | |
3146 | 830 |
3220 | 831 if (alpha >= 0.0) |
832 { | |
833 double yr = 0.0; | |
834 double yi = 0.0; | |
835 | |
5275 | 836 octave_idx_type nz; |
3146 | 837 |
3220 | 838 double zr = z.real (); |
839 double zi = z.imag (); | |
840 | |
4506 | 841 F77_FUNC (zbesi, ZBESI) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
842 | |
843 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
844 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
845 double expz = exp (std::abs (zr)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
846 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
847 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
848 } |
3146 | 849 |
4490 | 850 if (zi == 0.0 && zr >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
851 yi = 0.0; |
3220 | 852 |
853 retval = bessel_return_value (Complex (yr, yi), ierr); | |
3146 | 854 } |
14196
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
855 else if (is_integer_value (alpha)) |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
856 { |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
857 // zbesi can overflow as z->0, and cause troubles for generic case below |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
858 alpha = -alpha; |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
859 Complex tmp = zbesi (z, alpha, kode, ierr); |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
860 retval = bessel_return_value (tmp, ierr); |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
861 } |
3146 | 862 else |
3220 | 863 { |
864 alpha = -alpha; | |
865 | |
866 Complex tmp = zbesi (z, alpha, kode, ierr); | |
867 | |
868 if (ierr == 0 || ierr == 3) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
869 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
870 Complex tmp2 = (2.0 / M_PI) * sin (M_PI * alpha) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
871 * zbesk (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
872 |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
873 if (kode == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
874 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
875 // Compensate for different scaling factor of besk. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
876 tmp2 *= exp(-z - std::abs(z.real())); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
877 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
878 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
879 tmp += tmp2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
880 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
881 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
882 } |
3220 | 883 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
884 retval = Complex (octave_NaN, octave_NaN); |
3220 | 885 } |
886 | |
887 return retval; | |
888 } | |
889 | |
890 static inline Complex | |
5275 | 891 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 892 { |
893 Complex retval; | |
894 | |
895 if (alpha >= 0.0) | |
896 { | |
897 double yr = 0.0; | |
898 double yi = 0.0; | |
899 | |
5275 | 900 octave_idx_type nz; |
3220 | 901 |
902 double zr = z.real (); | |
903 double zi = z.imag (); | |
904 | |
905 ierr = 0; | |
906 | |
907 if (zr == 0.0 && zi == 0.0) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
908 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
909 yr = octave_Inf; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
910 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
911 } |
3220 | 912 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
913 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
914 F77_FUNC (zbesk, ZBESK) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
915 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
916 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
917 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
918 Complex expz = exp (-z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
919 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
920 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
921 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
922 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
923 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
924 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
925 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
926 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
927 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
928 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
929 if (zi == 0.0 && zr >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
930 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
931 } |
3220 | 932 |
933 retval = bessel_return_value (Complex (yr, yi), ierr); | |
934 } | |
935 else | |
936 { | |
937 Complex tmp = zbesk (z, -alpha, kode, ierr); | |
938 | |
939 retval = bessel_return_value (tmp, ierr); | |
940 } | |
3146 | 941 |
942 return retval; | |
943 } | |
944 | |
3220 | 945 static inline Complex |
5275 | 946 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 947 { |
3220 | 948 Complex retval; |
3146 | 949 |
3220 | 950 if (alpha >= 0.0) |
3146 | 951 { |
3220 | 952 double yr = 0.0; |
953 double yi = 0.0; | |
954 | |
5275 | 955 octave_idx_type nz; |
3220 | 956 |
957 double zr = z.real (); | |
958 double zi = z.imag (); | |
3146 | 959 |
4506 | 960 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 1, 1, &yr, &yi, nz, ierr); |
961 | |
962 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
963 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
964 Complex expz = exp (Complex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
965 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
966 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
967 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
968 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
969 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
970 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
971 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
972 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
973 } |
3146 | 974 |
3220 | 975 retval = bessel_return_value (Complex (yr, yi), ierr); |
976 } | |
977 else | |
978 { | |
979 alpha = -alpha; | |
980 | |
981 static const Complex eye = Complex (0.0, 1.0); | |
3146 | 982 |
3220 | 983 Complex tmp = exp (M_PI * alpha * eye) * zbesh1 (z, alpha, kode, ierr); |
3146 | 984 |
3220 | 985 retval = bessel_return_value (tmp, ierr); |
986 } | |
3146 | 987 |
3220 | 988 return retval; |
989 } | |
3146 | 990 |
3220 | 991 static inline Complex |
5275 | 992 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 993 { |
994 Complex retval; | |
3146 | 995 |
3220 | 996 if (alpha >= 0.0) |
997 { | |
998 double yr = 0.0; | |
999 double yi = 0.0; | |
1000 | |
5275 | 1001 octave_idx_type nz; |
3146 | 1002 |
3220 | 1003 double zr = z.real (); |
1004 double zi = z.imag (); | |
3146 | 1005 |
4506 | 1006 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 2, 1, &yr, &yi, nz, ierr); |
1007 | |
1008 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1009 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1010 Complex expz = exp (-Complex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1011 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1012 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1013 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1014 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1015 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1016 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1017 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1018 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1019 } |
3220 | 1020 |
1021 retval = bessel_return_value (Complex (yr, yi), ierr); | |
3146 | 1022 } |
1023 else | |
3220 | 1024 { |
1025 alpha = -alpha; | |
1026 | |
1027 static const Complex eye = Complex (0.0, 1.0); | |
1028 | |
1029 Complex tmp = exp (-M_PI * alpha * eye) * zbesh2 (z, alpha, kode, ierr); | |
1030 | |
1031 retval = bessel_return_value (tmp, ierr); | |
1032 } | |
1033 | |
1034 return retval; | |
1035 } | |
1036 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1037 typedef Complex (*dptr) (const Complex&, double, int, octave_idx_type&); |
3220 | 1038 |
1039 static inline Complex | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1040 do_bessel (dptr f, const char *, double alpha, const Complex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1041 bool scaled, octave_idx_type& ierr) |
3220 | 1042 { |
1043 Complex retval; | |
1044 | |
1045 retval = f (x, alpha, (scaled ? 2 : 1), ierr); | |
1046 | |
1047 return retval; | |
1048 } | |
1049 | |
1050 static inline ComplexMatrix | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1051 do_bessel (dptr f, const char *, double alpha, const ComplexMatrix& x, |
10352 | 1052 bool scaled, Array<octave_idx_type>& ierr) |
3220 | 1053 { |
5275 | 1054 octave_idx_type nr = x.rows (); |
1055 octave_idx_type nc = x.cols (); | |
3220 | 1056 |
1057 ComplexMatrix retval (nr, nc); | |
1058 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1059 ierr.resize (dim_vector (nr, nc)); |
3220 | 1060 |
5275 | 1061 for (octave_idx_type j = 0; j < nc; j++) |
1062 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1063 retval(i,j) = f (x(i,j), alpha, (scaled ? 2 : 1), ierr(i,j)); |
1064 | |
1065 return retval; | |
1066 } | |
1067 | |
1068 static inline ComplexMatrix | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1069 do_bessel (dptr f, const char *, const Matrix& alpha, const Complex& x, |
10352 | 1070 bool scaled, Array<octave_idx_type>& ierr) |
3220 | 1071 { |
5275 | 1072 octave_idx_type nr = alpha.rows (); |
1073 octave_idx_type nc = alpha.cols (); | |
3220 | 1074 |
1075 ComplexMatrix retval (nr, nc); | |
1076 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1077 ierr.resize (dim_vector (nr, nc)); |
3220 | 1078 |
5275 | 1079 for (octave_idx_type j = 0; j < nc; j++) |
1080 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1081 retval(i,j) = f (x, alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
3146 | 1082 |
1083 return retval; | |
1084 } | |
1085 | |
3220 | 1086 static inline ComplexMatrix |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1087 do_bessel (dptr f, const char *fn, const Matrix& alpha, |
10352 | 1088 const ComplexMatrix& x, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1089 { |
3220 | 1090 ComplexMatrix retval; |
1091 | |
5275 | 1092 octave_idx_type x_nr = x.rows (); |
1093 octave_idx_type x_nc = x.cols (); | |
3220 | 1094 |
5275 | 1095 octave_idx_type alpha_nr = alpha.rows (); |
1096 octave_idx_type alpha_nc = alpha.cols (); | |
3220 | 1097 |
1098 if (x_nr == alpha_nr && x_nc == alpha_nc) | |
1099 { | |
5275 | 1100 octave_idx_type nr = x_nr; |
1101 octave_idx_type nc = x_nc; | |
3220 | 1102 |
1103 retval.resize (nr, nc); | |
1104 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1105 ierr.resize (dim_vector (nr, nc)); |
3220 | 1106 |
5275 | 1107 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1108 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1109 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
3220 | 1110 } |
1111 else | |
1112 (*current_liboctave_error_handler) | |
1113 ("%s: the sizes of alpha and x must conform", fn); | |
1114 | |
1115 return retval; | |
3146 | 1116 } |
1117 | |
4844 | 1118 static inline ComplexNDArray |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1119 do_bessel (dptr f, const char *, double alpha, const ComplexNDArray& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1120 bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1121 { |
1122 dim_vector dv = x.dims (); | |
5275 | 1123 octave_idx_type nel = dv.numel (); |
4844 | 1124 ComplexNDArray retval (dv); |
1125 | |
1126 ierr.resize (dv); | |
1127 | |
5275 | 1128 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 1129 retval(i) = f (x(i), alpha, (scaled ? 2 : 1), ierr(i)); |
1130 | |
1131 return retval; | |
1132 } | |
1133 | |
1134 static inline ComplexNDArray | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1135 do_bessel (dptr f, const char *, const NDArray& alpha, const Complex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1136 bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1137 { |
1138 dim_vector dv = alpha.dims (); | |
5275 | 1139 octave_idx_type nel = dv.numel (); |
4844 | 1140 ComplexNDArray retval (dv); |
1141 | |
1142 ierr.resize (dv); | |
1143 | |
5275 | 1144 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 1145 retval(i) = f (x, alpha(i), (scaled ? 2 : 1), ierr(i)); |
1146 | |
1147 return retval; | |
1148 } | |
1149 | |
1150 static inline ComplexNDArray | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1151 do_bessel (dptr f, const char *fn, const NDArray& alpha, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1152 const ComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1153 { |
1154 dim_vector dv = x.dims (); | |
1155 ComplexNDArray retval; | |
1156 | |
1157 if (dv == alpha.dims ()) | |
1158 { | |
5275 | 1159 octave_idx_type nel = dv.numel (); |
4844 | 1160 |
1161 retval.resize (dv); | |
1162 ierr.resize (dv); | |
1163 | |
5275 | 1164 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1165 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); |
4844 | 1166 } |
1167 else | |
1168 (*current_liboctave_error_handler) | |
1169 ("%s: the sizes of alpha and x must conform", fn); | |
1170 | |
1171 return retval; | |
1172 } | |
1173 | |
3220 | 1174 static inline ComplexMatrix |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1175 do_bessel (dptr f, const char *, const RowVector& alpha, |
10352 | 1176 const ComplexColumnVector& x, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1177 { |
5275 | 1178 octave_idx_type nr = x.length (); |
1179 octave_idx_type nc = alpha.length (); | |
3220 | 1180 |
1181 ComplexMatrix retval (nr, nc); | |
3146 | 1182 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1183 ierr.resize (dim_vector (nr, nc)); |
3220 | 1184 |
5275 | 1185 for (octave_idx_type j = 0; j < nc; j++) |
1186 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1187 retval(i,j) = f (x(i), alpha(j), (scaled ? 2 : 1), ierr(i,j)); |
1188 | |
1189 return retval; | |
3146 | 1190 } |
1191 | |
3220 | 1192 #define SS_BESSEL(name, fcn) \ |
1193 Complex \ | |
5275 | 1194 name (double alpha, const Complex& x, bool scaled, octave_idx_type& ierr) \ |
3220 | 1195 { \ |
1196 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1197 } | |
1198 | |
1199 #define SM_BESSEL(name, fcn) \ | |
1200 ComplexMatrix \ | |
1201 name (double alpha, const ComplexMatrix& x, bool scaled, \ | |
10352 | 1202 Array<octave_idx_type>& ierr) \ |
3220 | 1203 { \ |
1204 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1205 } | |
1206 | |
1207 #define MS_BESSEL(name, fcn) \ | |
1208 ComplexMatrix \ | |
1209 name (const Matrix& alpha, const Complex& x, bool scaled, \ | |
10352 | 1210 Array<octave_idx_type>& ierr) \ |
3220 | 1211 { \ |
1212 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1213 } | |
1214 | |
1215 #define MM_BESSEL(name, fcn) \ | |
1216 ComplexMatrix \ | |
1217 name (const Matrix& alpha, const ComplexMatrix& x, bool scaled, \ | |
10352 | 1218 Array<octave_idx_type>& ierr) \ |
3220 | 1219 { \ |
1220 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1221 } | |
1222 | |
4844 | 1223 #define SN_BESSEL(name, fcn) \ |
1224 ComplexNDArray \ | |
1225 name (double alpha, const ComplexNDArray& x, bool scaled, \ | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1226 Array<octave_idx_type>& ierr) \ |
4844 | 1227 { \ |
1228 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1229 } | |
1230 | |
1231 #define NS_BESSEL(name, fcn) \ | |
1232 ComplexNDArray \ | |
1233 name (const NDArray& alpha, const Complex& x, bool scaled, \ | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1234 Array<octave_idx_type>& ierr) \ |
4844 | 1235 { \ |
1236 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1237 } | |
1238 | |
1239 #define NN_BESSEL(name, fcn) \ | |
1240 ComplexNDArray \ | |
1241 name (const NDArray& alpha, const ComplexNDArray& x, bool scaled, \ | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1242 Array<octave_idx_type>& ierr) \ |
4844 | 1243 { \ |
1244 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1245 } | |
1246 | |
3220 | 1247 #define RC_BESSEL(name, fcn) \ |
1248 ComplexMatrix \ | |
1249 name (const RowVector& alpha, const ComplexColumnVector& x, bool scaled, \ | |
10352 | 1250 Array<octave_idx_type>& ierr) \ |
3220 | 1251 { \ |
1252 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1253 } | |
1254 | |
1255 #define ALL_BESSEL(name, fcn) \ | |
1256 SS_BESSEL (name, fcn) \ | |
1257 SM_BESSEL (name, fcn) \ | |
1258 MS_BESSEL (name, fcn) \ | |
1259 MM_BESSEL (name, fcn) \ | |
4844 | 1260 SN_BESSEL (name, fcn) \ |
1261 NS_BESSEL (name, fcn) \ | |
1262 NN_BESSEL (name, fcn) \ | |
3220 | 1263 RC_BESSEL (name, fcn) |
1264 | |
1265 ALL_BESSEL (besselj, zbesj) | |
1266 ALL_BESSEL (bessely, zbesy) | |
1267 ALL_BESSEL (besseli, zbesi) | |
1268 ALL_BESSEL (besselk, zbesk) | |
1269 ALL_BESSEL (besselh1, zbesh1) | |
1270 ALL_BESSEL (besselh2, zbesh2) | |
1271 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1272 #undef ALL_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1273 #undef SS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1274 #undef SM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1275 #undef MS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1276 #undef MM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1277 #undef SN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1278 #undef NS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1279 #undef NN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1280 #undef RC_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1281 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1282 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1283 cbesj (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1284 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1285 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1286 cbesy (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1287 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1288 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1289 cbesi (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1290 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1291 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1292 cbesk (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1293 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1294 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1295 cbesh1 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1296 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1297 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1298 cbesh2 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1299 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1300 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1301 bessel_return_value (const FloatComplex& val, octave_idx_type ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1302 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1303 static const FloatComplex inf_val = FloatComplex (octave_Float_Inf, octave_Float_Inf); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1304 static const FloatComplex nan_val = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1305 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1306 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1307 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1308 switch (ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1309 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1310 case 0: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1311 case 3: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1312 retval = val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1313 break; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1314 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1315 case 2: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1316 retval = inf_val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1317 break; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1318 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1319 default: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1320 retval = nan_val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1321 break; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1322 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1323 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1324 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1325 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1326 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1327 static inline bool |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1328 is_integer_value (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1329 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1330 return x == static_cast<float> (static_cast<long> (x)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1331 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1332 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1333 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1334 cbesj (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1335 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1336 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1337 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1338 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1339 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1340 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1341 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1342 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1343 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1344 F77_FUNC (cbesj, CBESJ) (z, alpha, 2, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1345 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1346 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1347 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1348 float expz = exp (std::abs (imag (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1349 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1350 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1351 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1352 if (imag (z) == 0.0 && real (z) >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1353 y = FloatComplex (y.real (), 0.0); |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1354 |
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1355 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1356 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1357 else if (is_integer_value (alpha)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1358 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1359 // zbesy can overflow as z->0, and cause troubles for generic case below |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1360 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1361 FloatComplex tmp = cbesj (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1362 if ((static_cast <long> (alpha)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1363 tmp = - tmp; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1364 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1365 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1366 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1367 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1368 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1369 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1370 FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) * cbesj (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1371 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1372 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1373 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1374 tmp -= sinf (static_cast<float> (M_PI) * alpha) * cbesy (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1375 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1376 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1377 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1378 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1379 retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1380 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1381 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1382 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1383 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1384 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1385 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1386 cbesy (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1387 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1388 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1389 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1390 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1391 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1392 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1393 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1394 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1395 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1396 FloatComplex w; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1397 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1398 ierr = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1399 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1400 if (real (z) == 0.0 && imag (z) == 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1401 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1402 y = FloatComplex (-octave_Float_Inf, 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1403 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1404 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1405 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1406 F77_FUNC (cbesy, CBESY) (z, alpha, 2, 1, &y, nz, &w, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1407 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1408 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1409 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1410 float expz = exp (std::abs (imag (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1411 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1412 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1413 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1414 if (imag (z) == 0.0 && real (z) >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1415 y = FloatComplex (y.real (), 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1416 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1417 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1418 return bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1419 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1420 else if (is_integer_value (alpha - 0.5)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1421 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1422 // zbesy can overflow as z->0, and cause troubles for generic case below |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1423 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1424 FloatComplex tmp = cbesj (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1425 if ((static_cast <long> (alpha - 0.5)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1426 tmp = - tmp; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1427 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1428 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1429 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1430 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1431 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1432 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1433 FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) * cbesy (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1434 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1435 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1436 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1437 tmp += sinf (static_cast<float> (M_PI) * alpha) * cbesj (z, alpha, kode, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1438 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1439 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1440 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1441 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1442 retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1443 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1444 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1445 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1446 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1447 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1448 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1449 cbesi (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1450 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1451 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1452 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1453 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1454 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1455 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1456 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1457 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1458 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1459 F77_FUNC (cbesi, CBESI) (z, alpha, 2, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1460 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1461 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1462 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1463 float expz = exp (std::abs (real (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1464 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1465 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1466 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1467 if (imag (z) == 0.0 && real (z) >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1468 y = FloatComplex (y.real (), 0.0); |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1469 |
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1470 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1471 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1472 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1473 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1474 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1475 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1476 FloatComplex tmp = cbesi (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1477 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1478 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1479 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1480 FloatComplex tmp2 = static_cast<float> (2.0 / M_PI) * sinf (static_cast<float> (M_PI) * alpha) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1481 * cbesk (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1482 |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1483 if (kode == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1484 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1485 // Compensate for different scaling factor of besk. |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1486 tmp2 *= exp(-z - std::abs(z.real())); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1487 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1488 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1489 tmp += tmp2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1490 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1491 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1492 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1493 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1494 retval = FloatComplex (octave_Float_NaN, octave_Float_NaN); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1495 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1496 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1497 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1498 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1499 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1500 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1501 cbesk (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1502 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1503 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1504 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1505 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1506 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1507 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1508 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1509 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1510 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1511 ierr = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1512 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1513 if (real (z) == 0.0 && imag (z) == 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1514 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1515 y = FloatComplex (octave_Float_Inf, 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1516 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1517 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1518 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1519 F77_FUNC (cbesk, CBESK) (z, alpha, 2, 1, &y, nz, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1520 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1521 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1522 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1523 FloatComplex expz = exp (-z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1524 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1525 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1526 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1527 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1528 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1529 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1530 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1531 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1532 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1533 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1534 if (imag (z) == 0.0 && real (z) >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1535 y = FloatComplex (y.real (), 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1536 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1537 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1538 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1539 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1540 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1541 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1542 FloatComplex tmp = cbesk (z, -alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1543 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1544 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1545 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1546 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1547 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1548 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1549 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1550 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1551 cbesh1 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1552 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1553 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1554 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1555 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1556 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1557 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1558 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1559 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1560 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1561 F77_FUNC (cbesh, CBESH) (z, alpha, 2, 1, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1562 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1563 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1564 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1565 FloatComplex expz = exp (FloatComplex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1566 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1567 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1568 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1569 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1570 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1571 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1572 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1573 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1574 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1575 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1576 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1577 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1578 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1579 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1580 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1581 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1582 static const FloatComplex eye = FloatComplex (0.0, 1.0); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1583 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1584 FloatComplex tmp = exp (static_cast<float> (M_PI) * alpha * eye) * cbesh1 (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1585 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1586 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1587 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1588 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1589 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1590 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1591 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1592 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1593 cbesh2 (const FloatComplex& z, float alpha, int kode, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1594 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1595 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1596 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1597 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1598 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1599 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1600 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1601 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1602 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1603 F77_FUNC (cbesh, CBESH) (z, alpha, 2, 2, 1, &y, nz, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1604 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1605 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1606 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1607 FloatComplex expz = exp (-FloatComplex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1608 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1609 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1610 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1611 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1612 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1613 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1614 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1615 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1616 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1617 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1618 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1619 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1620 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1621 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1622 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1623 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1624 static const FloatComplex eye = FloatComplex (0.0, 1.0); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1625 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1626 FloatComplex tmp = exp (-static_cast<float> (M_PI) * alpha * eye) * cbesh2 (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1627 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1628 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1629 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1630 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1631 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1632 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1633 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1634 typedef FloatComplex (*fptr) (const FloatComplex&, float, int, octave_idx_type&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1635 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1636 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1637 do_bessel (fptr f, const char *, float alpha, const FloatComplex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1638 bool scaled, octave_idx_type& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1639 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1640 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1641 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1642 retval = f (x, alpha, (scaled ? 2 : 1), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1643 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1644 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1645 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1646 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1647 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1648 do_bessel (fptr f, const char *, float alpha, const FloatComplexMatrix& x, |
10352 | 1649 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1650 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1651 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1652 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1653 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1654 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1655 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1656 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1657 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1658 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1659 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1660 retval(i,j) = f (x(i,j), alpha, (scaled ? 2 : 1), ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1661 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1662 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1663 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1664 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1665 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1666 do_bessel (fptr f, const char *, const FloatMatrix& alpha, const FloatComplex& x, |
10352 | 1667 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1668 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1669 octave_idx_type nr = alpha.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1670 octave_idx_type nc = alpha.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1671 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1672 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1673 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1674 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1675 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1676 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1677 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1678 retval(i,j) = f (x, alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1679 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1680 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1681 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1682 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1683 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1684 do_bessel (fptr f, const char *fn, const FloatMatrix& alpha, |
10352 | 1685 const FloatComplexMatrix& x, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1686 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1687 FloatComplexMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1688 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1689 octave_idx_type x_nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1690 octave_idx_type x_nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1691 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1692 octave_idx_type alpha_nr = alpha.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1693 octave_idx_type alpha_nc = alpha.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1694 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1695 if (x_nr == alpha_nr && x_nc == alpha_nc) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1696 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1697 octave_idx_type nr = x_nr; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1698 octave_idx_type nc = x_nc; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1699 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1700 retval.resize (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1701 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1702 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1703 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1704 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1705 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1706 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1707 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1708 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1709 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1710 ("%s: the sizes of alpha and x must conform", fn); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1711 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1712 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1713 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1714 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1715 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1716 do_bessel (fptr f, const char *, float alpha, const FloatComplexNDArray& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1717 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1718 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1719 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1720 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1721 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1722 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1723 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1724 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1725 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1726 retval(i) = f (x(i), alpha, (scaled ? 2 : 1), ierr(i)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1727 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1728 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1729 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1730 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1731 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1732 do_bessel (fptr f, const char *, const FloatNDArray& alpha, const FloatComplex& x, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1733 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1734 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1735 dim_vector dv = alpha.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1736 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1737 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1738 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1739 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1740 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1741 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1742 retval(i) = f (x, alpha(i), (scaled ? 2 : 1), ierr(i)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1743 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1744 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1745 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1746 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1747 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1748 do_bessel (fptr f, const char *fn, const FloatNDArray& alpha, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1749 const FloatComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1750 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1751 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1752 FloatComplexNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1753 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1754 if (dv == alpha.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1755 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1756 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1757 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1758 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1759 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1760 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1761 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1762 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1763 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1764 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1765 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1766 ("%s: the sizes of alpha and x must conform", fn); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1767 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1768 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1769 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1770 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1771 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1772 do_bessel (fptr f, const char *, const FloatRowVector& alpha, |
10352 | 1773 const FloatComplexColumnVector& x, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1774 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1775 octave_idx_type nr = x.length (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1776 octave_idx_type nc = alpha.length (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1777 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1778 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1779 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1780 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1781 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1782 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1783 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1784 retval(i,j) = f (x(i), alpha(j), (scaled ? 2 : 1), ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1785 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1786 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1787 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1788 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1789 #define SS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1790 FloatComplex \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1791 name (float alpha, const FloatComplex& x, bool scaled, octave_idx_type& ierr) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1792 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1793 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1794 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1795 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1796 #define SM_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1797 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1798 name (float alpha, const FloatComplexMatrix& x, bool scaled, \ |
10352 | 1799 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1800 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1801 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1802 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1803 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1804 #define MS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1805 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1806 name (const FloatMatrix& alpha, const FloatComplex& x, bool scaled, \ |
10352 | 1807 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1808 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1809 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1810 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1811 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1812 #define MM_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1813 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1814 name (const FloatMatrix& alpha, const FloatComplexMatrix& x, bool scaled, \ |
10352 | 1815 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1816 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1817 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1818 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1819 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1820 #define SN_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1821 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1822 name (float alpha, const FloatComplexNDArray& x, bool scaled, \ |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1823 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1824 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1825 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1826 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1827 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1828 #define NS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1829 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1830 name (const FloatNDArray& alpha, const FloatComplex& x, bool scaled, \ |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1831 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1832 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1833 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1834 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1835 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1836 #define NN_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1837 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1838 name (const FloatNDArray& alpha, const FloatComplexNDArray& x, bool scaled, \ |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1839 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1840 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1841 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1842 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1843 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1844 #define RC_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1845 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1846 name (const FloatRowVector& alpha, const FloatComplexColumnVector& x, bool scaled, \ |
10352 | 1847 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1848 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1849 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1850 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1851 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1852 #define ALL_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1853 SS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1854 SM_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1855 MS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1856 MM_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1857 SN_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1858 NS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1859 NN_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1860 RC_BESSEL (name, fcn) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1861 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1862 ALL_BESSEL (besselj, cbesj) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1863 ALL_BESSEL (bessely, cbesy) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1864 ALL_BESSEL (besseli, cbesi) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1865 ALL_BESSEL (besselk, cbesk) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1866 ALL_BESSEL (besselh1, cbesh1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1867 ALL_BESSEL (besselh2, cbesh2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1868 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1869 #undef ALL_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1870 #undef SS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1871 #undef SM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1872 #undef MS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1873 #undef MM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1874 #undef SN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1875 #undef NS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1876 #undef NN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1877 #undef RC_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1878 |
3220 | 1879 Complex |
5275 | 1880 airy (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
3146 | 1881 { |
3220 | 1882 double ar = 0.0; |
1883 double ai = 0.0; | |
1884 | |
5275 | 1885 octave_idx_type nz; |
3220 | 1886 |
1887 double zr = z.real (); | |
1888 double zi = z.imag (); | |
3146 | 1889 |
5275 | 1890 octave_idx_type id = deriv ? 1 : 0; |
3220 | 1891 |
4506 | 1892 F77_FUNC (zairy, ZAIRY) (zr, zi, id, 2, ar, ai, nz, ierr); |
1893 | |
1894 if (! scaled) | |
1895 { | |
1896 Complex expz = exp (- 2.0 / 3.0 * z * sqrt(z)); | |
3220 | 1897 |
4506 | 1898 double rexpz = real (expz); |
1899 double iexpz = imag (expz); | |
1900 | |
1901 double tmp = ar*rexpz - ai*iexpz; | |
1902 | |
1903 ai = ar*iexpz + ai*rexpz; | |
1904 ar = tmp; | |
1905 } | |
3220 | 1906 |
4490 | 1907 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
3225 | 1908 ai = 0.0; |
1909 | |
3220 | 1910 return bessel_return_value (Complex (ar, ai), ierr); |
3146 | 1911 } |
1912 | |
3220 | 1913 Complex |
5275 | 1914 biry (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
3146 | 1915 { |
3220 | 1916 double ar = 0.0; |
1917 double ai = 0.0; | |
1918 | |
1919 double zr = z.real (); | |
1920 double zi = z.imag (); | |
1921 | |
5275 | 1922 octave_idx_type id = deriv ? 1 : 0; |
3220 | 1923 |
4506 | 1924 F77_FUNC (zbiry, ZBIRY) (zr, zi, id, 2, ar, ai, ierr); |
1925 | |
1926 if (! scaled) | |
1927 { | |
1928 Complex expz = exp (std::abs (real (2.0 / 3.0 * z * sqrt (z)))); | |
3220 | 1929 |
4506 | 1930 double rexpz = real (expz); |
1931 double iexpz = imag (expz); | |
1932 | |
1933 double tmp = ar*rexpz - ai*iexpz; | |
1934 | |
1935 ai = ar*iexpz + ai*rexpz; | |
1936 ar = tmp; | |
1937 } | |
3220 | 1938 |
4490 | 1939 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
3225 | 1940 ai = 0.0; |
1941 | |
3220 | 1942 return bessel_return_value (Complex (ar, ai), ierr); |
3146 | 1943 } |
1944 | |
3220 | 1945 ComplexMatrix |
10352 | 1946 airy (const ComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1947 { |
5275 | 1948 octave_idx_type nr = z.rows (); |
1949 octave_idx_type nc = z.cols (); | |
3220 | 1950 |
1951 ComplexMatrix retval (nr, nc); | |
1952 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1953 ierr.resize (dim_vector (nr, nc)); |
3220 | 1954 |
5275 | 1955 for (octave_idx_type j = 0; j < nc; j++) |
1956 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1957 retval(i,j) = airy (z(i,j), deriv, scaled, ierr(i,j)); |
1958 | |
1959 return retval; | |
3146 | 1960 } |
1961 | |
3220 | 1962 ComplexMatrix |
10352 | 1963 biry (const ComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1964 { |
5275 | 1965 octave_idx_type nr = z.rows (); |
1966 octave_idx_type nc = z.cols (); | |
3220 | 1967 |
1968 ComplexMatrix retval (nr, nc); | |
1969 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1970 ierr.resize (dim_vector (nr, nc)); |
3220 | 1971 |
5275 | 1972 for (octave_idx_type j = 0; j < nc; j++) |
1973 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1974 retval(i,j) = biry (z(i,j), deriv, scaled, ierr(i,j)); |
1975 | |
1976 return retval; | |
3146 | 1977 } |
1978 | |
4844 | 1979 ComplexNDArray |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1980 airy (const ComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1981 { |
1982 dim_vector dv = z.dims (); | |
5275 | 1983 octave_idx_type nel = dv.numel (); |
4844 | 1984 ComplexNDArray retval (dv); |
1985 | |
1986 ierr.resize (dv); | |
1987 | |
5275 | 1988 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 1989 retval (i) = airy (z(i), deriv, scaled, ierr(i)); |
1990 | |
1991 return retval; | |
1992 } | |
1993 | |
1994 ComplexNDArray | |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
1995 biry (const ComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1996 { |
1997 dim_vector dv = z.dims (); | |
5275 | 1998 octave_idx_type nel = dv.numel (); |
4844 | 1999 ComplexNDArray retval (dv); |
2000 | |
2001 ierr.resize (dv); | |
2002 | |
5275 | 2003 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 2004 retval (i) = biry (z(i), deriv, scaled, ierr(i)); |
2005 | |
2006 return retval; | |
2007 } | |
2008 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2009 FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2010 airy (const FloatComplex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2011 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2012 float ar = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2013 float ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2014 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2015 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2016 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2017 float zr = z.real (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2018 float zi = z.imag (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2019 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2020 octave_idx_type id = deriv ? 1 : 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2021 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2022 F77_FUNC (cairy, CAIRY) (zr, zi, id, 2, ar, ai, nz, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2023 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2024 if (! scaled) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2025 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2026 FloatComplex expz = exp (- static_cast<float> (2.0 / 3.0) * z * sqrt(z)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2027 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2028 float rexpz = real (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2029 float iexpz = imag (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2030 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2031 float tmp = ar*rexpz - ai*iexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2032 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2033 ai = ar*iexpz + ai*rexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2034 ar = tmp; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2035 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2036 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2037 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2038 ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2039 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2040 return bessel_return_value (FloatComplex (ar, ai), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2041 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2042 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2043 FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2044 biry (const FloatComplex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2045 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2046 float ar = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2047 float ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2048 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2049 float zr = z.real (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2050 float zi = z.imag (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2051 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2052 octave_idx_type id = deriv ? 1 : 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2053 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2054 F77_FUNC (cbiry, CBIRY) (zr, zi, id, 2, ar, ai, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2055 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2056 if (! scaled) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2057 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2058 FloatComplex expz = exp (std::abs (real (static_cast<float> (2.0 / 3.0) * z * sqrt (z)))); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2059 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2060 float rexpz = real (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2061 float iexpz = imag (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2062 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2063 float tmp = ar*rexpz - ai*iexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2064 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2065 ai = ar*iexpz + ai*rexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2066 ar = tmp; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2067 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2068 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2069 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2070 ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2071 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2072 return bessel_return_value (FloatComplex (ar, ai), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2073 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2074 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2075 FloatComplexMatrix |
10352 | 2076 airy (const FloatComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2077 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2078 octave_idx_type nr = z.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2079 octave_idx_type nc = z.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2080 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2081 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2082 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2083 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2084 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2085 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2086 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2087 retval(i,j) = airy (z(i,j), deriv, scaled, ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2088 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2089 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2090 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2091 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2092 FloatComplexMatrix |
10352 | 2093 biry (const FloatComplexMatrix& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2094 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2095 octave_idx_type nr = z.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2096 octave_idx_type nc = z.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2097 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2098 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2099 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2100 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2101 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2102 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2103 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2104 retval(i,j) = biry (z(i,j), deriv, scaled, ierr(i,j)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2105 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2106 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2107 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2108 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2109 FloatComplexNDArray |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2110 airy (const FloatComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2111 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2112 dim_vector dv = z.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2113 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2114 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2115 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2116 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2117 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2118 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2119 retval (i) = airy (z(i), deriv, scaled, ierr(i)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2120 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2121 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2122 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2123 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2124 FloatComplexNDArray |
9732
b4fdfee405b5
remove ArrayN<T> + fix nonhom. diag-scalar ops
Jaroslav Hajek <highegg@gmail.com>
parents:
8920
diff
changeset
|
2125 biry (const FloatComplexNDArray& z, bool deriv, bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2126 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2127 dim_vector dv = z.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2128 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2129 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2130 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2131 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2132 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2133 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2134 retval (i) = biry (z(i), deriv, scaled, ierr(i)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2135 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2136 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2137 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2138 |
3146 | 2139 static void |
5275 | 2140 gripe_betainc_nonconformant (octave_idx_type r1, octave_idx_type c1, octave_idx_type r2, octave_idx_type c2, octave_idx_type r3, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2141 octave_idx_type c3) |
3146 | 2142 { |
2143 (*current_liboctave_error_handler) | |
2144 ("betainc: nonconformant arguments (x is %dx%d, a is %dx%d, b is %dx%d)", | |
2145 r1, c1, r2, c2, r3, c3); | |
2146 } | |
2147 | |
4844 | 2148 static void |
2149 gripe_betainc_nonconformant (const dim_vector& d1, const dim_vector& d2, | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2150 const dim_vector& d3) |
4844 | 2151 { |
2152 std::string d1_str = d1.str (); | |
2153 std::string d2_str = d2.str (); | |
2154 std::string d3_str = d3.str (); | |
2155 | |
2156 (*current_liboctave_error_handler) | |
2157 ("betainc: nonconformant arguments (x is %s, a is %s, b is %s)", | |
2158 d1_str.c_str (), d2_str.c_str (), d3_str.c_str ()); | |
2159 } | |
2160 | |
3146 | 2161 double |
2162 betainc (double x, double a, double b) | |
2163 { | |
2164 double retval; | |
5700 | 2165 F77_XFCN (xdbetai, XDBETAI, (x, a, b, retval)); |
3146 | 2166 return retval; |
2167 } | |
2168 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2169 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2170 betainc (double x, double a, const Array<double>& b) |
3146 | 2171 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2172 dim_vector dv = b.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2173 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2174 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2175 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2176 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2177 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2178 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2179 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2180 *pretval++ = betainc (x, a, b(i)); |
3146 | 2181 |
2182 return retval; | |
2183 } | |
2184 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2185 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2186 betainc (double x, const Array<double>& a, double b) |
3146 | 2187 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2188 dim_vector dv = a.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2189 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2190 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2191 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2192 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2193 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2194 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2195 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2196 *pretval++ = betainc (x, a(i), b); |
3146 | 2197 |
2198 return retval; | |
2199 } | |
2200 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2201 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2202 betainc (double x, const Array<double>& a, const Array<double>& b) |
4844 | 2203 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2204 Array<double> retval; |
4844 | 2205 dim_vector dv = a.dims (); |
2206 | |
2207 if (dv == b.dims ()) | |
2208 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2209 octave_idx_type nel = dv.numel (); |
4844 | 2210 |
2211 retval.resize (dv); | |
2212 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2213 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2214 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2215 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2216 *pretval++ = betainc (x, a(i), b(i)); |
4844 | 2217 } |
2218 else | |
10258 | 2219 gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2220 |
4844 | 2221 return retval; |
2222 } | |
2223 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2224 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2225 betainc (const Array<double>& x, double a, double b) |
3146 | 2226 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2227 dim_vector dv = x.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2228 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2229 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2230 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2231 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2232 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2233 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2234 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2235 *pretval++ = betainc (x(i), a, b); |
3146 | 2236 |
2237 return retval; | |
2238 } | |
2239 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2240 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2241 betainc (const Array<double>& x, double a, const Array<double>& b) |
3146 | 2242 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2243 Array<double> retval; |
4844 | 2244 dim_vector dv = x.dims (); |
2245 | |
2246 if (dv == b.dims ()) | |
2247 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2248 octave_idx_type nel = dv.numel (); |
4844 | 2249 |
2250 retval.resize (dv); | |
2251 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2252 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2253 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2254 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2255 *pretval++ = betainc (x(i), a, b(i)); |
4844 | 2256 } |
2257 else | |
10258 | 2258 gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2259 |
4844 | 2260 return retval; |
2261 } | |
2262 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2263 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2264 betainc (const Array<double>& x, const Array<double>& a, double b) |
4844 | 2265 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2266 Array<double> retval; |
4844 | 2267 dim_vector dv = x.dims (); |
2268 | |
2269 if (dv == a.dims ()) | |
2270 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2271 octave_idx_type nel = dv.numel (); |
4844 | 2272 |
2273 retval.resize (dv); | |
2274 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2275 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2276 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2277 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2278 *pretval++ = betainc (x(i), a(i), b); |
4844 | 2279 } |
2280 else | |
10258 | 2281 gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2282 |
4844 | 2283 return retval; |
2284 } | |
2285 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2286 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2287 betainc (const Array<double>& x, const Array<double>& a, const Array<double>& b) |
4844 | 2288 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2289 Array<double> retval; |
4844 | 2290 dim_vector dv = x.dims (); |
2291 | |
2292 if (dv == a.dims () && dv == b.dims ()) | |
2293 { | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2294 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2295 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2296 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2297 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2298 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2299 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2300 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2301 *pretval++ = betainc (x(i), a(i), b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2302 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2303 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2304 gripe_betainc_nonconformant (dv, a.dims (), b.dims ()); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2305 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2306 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2307 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2308 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2309 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2310 betainc (float x, float a, float b) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2311 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2312 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2313 F77_XFCN (xbetai, XBETAI, (x, a, b, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2314 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2315 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2316 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2317 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2318 betainc (float x, float a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2319 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2320 dim_vector dv = b.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2321 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2322 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2323 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2324 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2325 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2326 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2327 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2328 *pretval++ = betainc (x, a, b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2329 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2330 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2331 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2332 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2333 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2334 betainc (float x, const Array<float>& a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2335 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2336 dim_vector dv = a.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2337 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2338 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2339 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2340 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2341 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2342 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2343 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2344 *pretval++ = betainc (x, a(i), b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2345 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2346 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2347 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2348 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2349 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2350 betainc (float x, const Array<float>& a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2351 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2352 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2353 dim_vector dv = a.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2354 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2355 if (dv == b.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2356 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2357 octave_idx_type nel = dv.numel (); |
4844 | 2358 |
2359 retval.resize (dv); | |
2360 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2361 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2362 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2363 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2364 *pretval++ = betainc (x, a(i), b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2365 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2366 else |
10258 | 2367 gripe_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2368 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2369 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2370 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2371 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2372 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2373 betainc (const Array<float>& x, float a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2374 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2375 dim_vector dv = x.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2376 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2377 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2378 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2379 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2380 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2381 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2382 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2383 *pretval++ = betainc (x(i), a, b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2384 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2385 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2386 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2387 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2388 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2389 betainc (const Array<float>& x, float a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2390 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2391 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2392 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2393 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2394 if (dv == b.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2395 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2396 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2397 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2398 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2399 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2400 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2401 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2402 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2403 *pretval++ = betainc (x(i), a, b(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2404 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2405 else |
10258 | 2406 gripe_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2407 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2408 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2409 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2410 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2411 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2412 betainc (const Array<float>& x, const Array<float>& a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2413 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2414 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2415 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2416 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2417 if (dv == a.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2418 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2419 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2420 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2421 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2422 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2423 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2424 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2425 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2426 *pretval++ = betainc (x(i), a(i), b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2427 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2428 else |
10258 | 2429 gripe_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2430 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2431 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2432 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2433 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2434 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2435 betainc (const Array<float>& x, const Array<float>& a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2436 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2437 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2438 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2439 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2440 if (dv == a.dims () && dv == b.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2441 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2442 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2443 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2444 retval.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2445 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2446 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2447 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2448 for (octave_idx_type i = 0; i < nel; i++) |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2449 *pretval++ = betainc (x(i), a(i), b(i)); |
4844 | 2450 } |
2451 else | |
2452 gripe_betainc_nonconformant (dv, a.dims (), b.dims ()); | |
2453 | |
2454 return retval; | |
2455 } | |
2456 | |
5775 | 2457 // FIXME -- there is still room for improvement here... |
3164 | 2458 |
3146 | 2459 double |
4004 | 2460 gammainc (double x, double a, bool& err) |
3146 | 2461 { |
2462 double retval; | |
3164 | 2463 |
4004 | 2464 err = false; |
3164 | 2465 |
4004 | 2466 if (a < 0.0 || x < 0.0) |
2467 { | |
2468 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2469 ("gammainc: A and X must be non-negative"); |
4004 | 2470 |
2471 err = true; | |
2472 } | |
2473 else | |
5278 | 2474 F77_XFCN (xgammainc, XGAMMAINC, (a, x, retval)); |
3164 | 2475 |
3146 | 2476 return retval; |
2477 } | |
2478 | |
2479 Matrix | |
2480 gammainc (double x, const Matrix& a) | |
2481 { | |
5275 | 2482 octave_idx_type nr = a.rows (); |
2483 octave_idx_type nc = a.cols (); | |
3146 | 2484 |
4004 | 2485 Matrix result (nr, nc); |
2486 Matrix retval; | |
2487 | |
2488 bool err; | |
3146 | 2489 |
5275 | 2490 for (octave_idx_type j = 0; j < nc; j++) |
2491 for (octave_idx_type i = 0; i < nr; i++) | |
4004 | 2492 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2493 result(i,j) = gammainc (x, a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2494 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2495 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2496 goto done; |
4004 | 2497 } |
2498 | |
2499 retval = result; | |
2500 | |
2501 done: | |
3146 | 2502 |
2503 return retval; | |
2504 } | |
2505 | |
2506 Matrix | |
2507 gammainc (const Matrix& x, double a) | |
2508 { | |
5275 | 2509 octave_idx_type nr = x.rows (); |
2510 octave_idx_type nc = x.cols (); | |
3146 | 2511 |
4004 | 2512 Matrix result (nr, nc); |
2513 Matrix retval; | |
2514 | |
2515 bool err; | |
3146 | 2516 |
5275 | 2517 for (octave_idx_type j = 0; j < nc; j++) |
2518 for (octave_idx_type i = 0; i < nr; i++) | |
4004 | 2519 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2520 result(i,j) = gammainc (x(i,j), a, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2521 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2522 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2523 goto done; |
4004 | 2524 } |
2525 | |
2526 retval = result; | |
2527 | |
2528 done: | |
3146 | 2529 |
2530 return retval; | |
2531 } | |
2532 | |
2533 Matrix | |
2534 gammainc (const Matrix& x, const Matrix& a) | |
2535 { | |
4004 | 2536 Matrix result; |
3146 | 2537 Matrix retval; |
2538 | |
5275 | 2539 octave_idx_type nr = x.rows (); |
2540 octave_idx_type nc = x.cols (); | |
3146 | 2541 |
5275 | 2542 octave_idx_type a_nr = a.rows (); |
2543 octave_idx_type a_nc = a.cols (); | |
3146 | 2544 |
2545 if (nr == a_nr && nc == a_nc) | |
2546 { | |
4004 | 2547 result.resize (nr, nc); |
2548 | |
2549 bool err; | |
3146 | 2550 |
5275 | 2551 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2552 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2553 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2554 result(i,j) = gammainc (x(i,j), a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2555 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2556 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2557 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2558 } |
4004 | 2559 |
2560 retval = result; | |
3146 | 2561 } |
2562 else | |
2563 (*current_liboctave_error_handler) | |
2564 ("gammainc: nonconformant arguments (arg 1 is %dx%d, arg 2 is %dx%d)", | |
2565 nr, nc, a_nr, a_nc); | |
2566 | |
4004 | 2567 done: |
2568 | |
3146 | 2569 return retval; |
2570 } | |
2571 | |
4844 | 2572 NDArray |
2573 gammainc (double x, const NDArray& a) | |
2574 { | |
2575 dim_vector dv = a.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2576 octave_idx_type nel = dv.numel (); |
4844 | 2577 |
2578 NDArray retval; | |
2579 NDArray result (dv); | |
2580 | |
2581 bool err; | |
2582 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2583 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 2584 { |
2585 result (i) = gammainc (x, a(i), err); | |
2586 | |
2587 if (err) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2588 goto done; |
4844 | 2589 } |
2590 | |
2591 retval = result; | |
2592 | |
2593 done: | |
2594 | |
2595 return retval; | |
2596 } | |
2597 | |
2598 NDArray | |
2599 gammainc (const NDArray& x, double a) | |
2600 { | |
2601 dim_vector dv = x.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2602 octave_idx_type nel = dv.numel (); |
4844 | 2603 |
2604 NDArray retval; | |
2605 NDArray result (dv); | |
2606 | |
2607 bool err; | |
2608 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2609 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 2610 { |
2611 result (i) = gammainc (x(i), a, err); | |
2612 | |
2613 if (err) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2614 goto done; |
4844 | 2615 } |
2616 | |
2617 retval = result; | |
2618 | |
2619 done: | |
2620 | |
2621 return retval; | |
2622 } | |
2623 | |
2624 NDArray | |
2625 gammainc (const NDArray& x, const NDArray& a) | |
2626 { | |
2627 dim_vector dv = x.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2628 octave_idx_type nel = dv.numel (); |
4844 | 2629 |
2630 NDArray retval; | |
2631 NDArray result; | |
2632 | |
2633 if (dv == a.dims ()) | |
2634 { | |
2635 result.resize (dv); | |
2636 | |
2637 bool err; | |
2638 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2639 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2640 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2641 result (i) = gammainc (x(i), a(i), err); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2642 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2643 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2644 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2645 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2646 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2647 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2648 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2649 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2650 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2651 std::string x_str = dv.str (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2652 std::string a_str = a.dims ().str (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2653 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2654 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2655 ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2656 x_str.c_str (), a_str. c_str ()); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2657 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2658 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2659 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2660 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2661 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2662 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2663 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2664 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2665 gammainc (float x, float a, bool& err) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2666 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2667 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2668 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2669 err = false; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2670 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2671 if (a < 0.0 || x < 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2672 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2673 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2674 ("gammainc: A and X must be non-negative"); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2675 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2676 err = true; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2677 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2678 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2679 F77_XFCN (xsgammainc, XSGAMMAINC, (a, x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2680 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2681 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2682 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2683 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2684 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2685 gammainc (float x, const FloatMatrix& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2686 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2687 octave_idx_type nr = a.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2688 octave_idx_type nc = a.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2689 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2690 FloatMatrix result (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2691 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2692 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2693 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2694 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2695 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2696 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2697 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2698 result(i,j) = gammainc (x, a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2699 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2700 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2701 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2702 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2703 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2704 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2705 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2706 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2707 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2708 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2709 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2710 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2711 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2712 gammainc (const FloatMatrix& x, float a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2713 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2714 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2715 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2716 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2717 FloatMatrix result (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2718 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2719 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2720 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2721 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2722 for (octave_idx_type j = 0; j < nc; j++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2723 for (octave_idx_type i = 0; i < nr; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2724 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2725 result(i,j) = gammainc (x(i,j), a, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2726 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2727 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2728 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2729 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2730 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2731 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2732 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2733 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2734 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2735 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2736 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2737 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2738 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2739 gammainc (const FloatMatrix& x, const FloatMatrix& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2740 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2741 FloatMatrix result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2742 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2743 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2744 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2745 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2746 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2747 octave_idx_type a_nr = a.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2748 octave_idx_type a_nc = a.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2749 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2750 if (nr == a_nr && nc == a_nc) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2751 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2752 result.resize (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2753 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2754 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2755 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2756 for (octave_idx_type j = 0; j < nc; j++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2757 for (octave_idx_type i = 0; i < nr; i++) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2758 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2759 result(i,j) = gammainc (x(i,j), a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2760 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2761 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2762 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2763 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2764 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2765 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2766 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2767 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2768 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2769 ("gammainc: nonconformant arguments (arg 1 is %dx%d, arg 2 is %dx%d)", |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2770 nr, nc, a_nr, a_nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2771 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2772 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2773 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2774 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2775 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2776 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2777 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2778 gammainc (float x, const FloatNDArray& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2779 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2780 dim_vector dv = a.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2781 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2782 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2783 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2784 FloatNDArray result (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2785 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2786 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2787 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2788 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2789 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2790 result (i) = gammainc (x, a(i), err); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2791 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2792 if (err) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2793 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2794 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2795 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2796 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2797 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2798 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2799 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2800 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2801 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2802 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2803 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2804 gammainc (const FloatNDArray& x, float a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2805 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2806 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2807 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2808 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2809 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2810 FloatNDArray result (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2811 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2812 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2813 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2814 for (octave_idx_type i = 0; i < nel; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2815 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2816 result (i) = gammainc (x(i), a, err); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2817 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2818 if (err) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2819 goto done; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2820 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2821 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2822 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2823 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2824 done: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2825 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2826 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2827 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2828 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2829 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2830 gammainc (const FloatNDArray& x, const FloatNDArray& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2831 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2832 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2833 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2834 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2835 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2836 FloatNDArray result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2837 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2838 if (dv == a.dims ()) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2839 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2840 result.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2841 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2842 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2843 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2844 for (octave_idx_type i = 0; i < nel; i++) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2845 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2846 result (i) = gammainc (x(i), a(i), err); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2847 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2848 if (err) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2849 goto done; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2850 } |
4844 | 2851 |
2852 retval = result; | |
2853 } | |
2854 else | |
2855 { | |
2856 std::string x_str = dv.str (); | |
2857 std::string a_str = a.dims ().str (); | |
2858 | |
2859 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2860 ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2861 x_str.c_str (), a_str. c_str ()); |
4844 | 2862 } |
2863 | |
2864 done: | |
2865 | |
2866 return retval; | |
2867 } | |
2868 | |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2869 |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2870 Complex rc_log1p (double x) |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2871 { |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2872 const double pi = 3.14159265358979323846; |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2873 return x < -1.0 ? Complex (log (-(1.0 + x)), pi) : Complex (log1p (x)); |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2874 } |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2875 |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2876 FloatComplex rc_log1p (float x) |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2877 { |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2878 const float pi = 3.14159265358979323846f; |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2879 return x < -1.0f ? FloatComplex (logf (-(1.0f + x)), pi) : FloatComplex (log1pf (x)); |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2880 } |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2881 |
9838 | 2882 // This algorithm is due to P. J. Acklam. |
9837
7c70084b125e
improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents:
9835
diff
changeset
|
2883 // See http://home.online.no/~pjacklam/notes/invnorm/ |
7c70084b125e
improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents:
9835
diff
changeset
|
2884 // The rational approximation has relative accuracy 1.15e-9 in the whole region. |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
2885 // For doubles, it is refined by a single step of Halley's 3rd order method. |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2886 // For single precision, the accuracy is already OK, so we skip it to get |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2887 // faster evaluation. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2888 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2889 static double do_erfinv (double x, bool refine) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2890 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2891 // Coefficients of rational approximation. |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2892 static const double a[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2893 { -2.806989788730439e+01, 1.562324844726888e+02, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2894 -1.951109208597547e+02, 9.783370457507161e+01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2895 -2.168328665628878e+01, 1.772453852905383e+00 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2896 static const double b[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2897 { -5.447609879822406e+01, 1.615858368580409e+02, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2898 -1.556989798598866e+02, 6.680131188771972e+01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2899 -1.328068155288572e+01 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2900 static const double c[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2901 { -5.504751339936943e-03, -2.279687217114118e-01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2902 -1.697592457770869e+00, -1.802933168781950e+00, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2903 3.093354679843505e+00, 2.077595676404383e+00 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2904 static const double d[] = |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2905 { 7.784695709041462e-03, 3.224671290700398e-01, |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2906 2.445134137142996e+00, 3.754408661907416e+00 }; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2907 |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
2908 static const double spi2 = 8.862269254527579e-01; // sqrt(pi)/2. |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2909 static const double pbreak = 0.95150; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2910 double ax = fabs (x), y; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2911 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2912 // Select case. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2913 if (ax <= pbreak) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2914 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2915 // Middle region. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2916 const double q = 0.5 * x, r = q*q; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2917 const double yn = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2918 const double yd = ((((b[0]*r + b[1])*r + b[2])*r + b[3])*r + b[4])*r + 1.0; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2919 y = yn / yd; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2920 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2921 else if (ax < 1.0) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2922 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2923 // Tail region. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2924 const double q = sqrt (-2*log (0.5*(1-ax))); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2925 const double yn = ((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5]; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2926 const double yd = (((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2927 y = yn / yd * signum (-x); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2928 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2929 else if (ax == 1.0) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2930 return octave_Inf * signum (x); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2931 else |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2932 return octave_NaN; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2933 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2934 if (refine) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2935 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2936 // One iteration of Halley's method gives full precision. |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
2937 double u = (erf (y) - x) * spi2 * exp (y*y); |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2938 y -= u / (1 + y*u); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2939 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2940 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2941 return y; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2942 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2943 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2944 double erfinv (double x) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2945 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2946 return do_erfinv (x, true); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2947 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2948 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2949 float erfinv (float x) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2950 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2951 return do_erfinv (x, false); |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2952 } |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
2953 |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2954 // The algorthim for erfcinv is an adaptation of the erfinv algorithm above |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2955 // from P. J. Acklam. It has been modified to run over the different input |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2956 // domain of erfcinv. See the notes for erfinv for an explanation. |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2957 |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2958 static double do_erfcinv (double x, bool refine) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2959 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2960 // Coefficients of rational approximation. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2961 static const double a[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2962 { -2.806989788730439e+01, 1.562324844726888e+02, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2963 -1.951109208597547e+02, 9.783370457507161e+01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2964 -2.168328665628878e+01, 1.772453852905383e+00 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2965 static const double b[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2966 { -5.447609879822406e+01, 1.615858368580409e+02, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2967 -1.556989798598866e+02, 6.680131188771972e+01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2968 -1.328068155288572e+01 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2969 static const double c[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2970 { -5.504751339936943e-03, -2.279687217114118e-01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2971 -1.697592457770869e+00, -1.802933168781950e+00, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2972 3.093354679843505e+00, 2.077595676404383e+00 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2973 static const double d[] = |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2974 { 7.784695709041462e-03, 3.224671290700398e-01, |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2975 2.445134137142996e+00, 3.754408661907416e+00 }; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2976 |
14771
10ed11922f19
maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14770
diff
changeset
|
2977 static const double spi2 = 8.862269254527579e-01; // sqrt(pi)/2. |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2978 static const double pbreak_lo = 0.04850; // 1-pbreak |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2979 static const double pbreak_hi = 1.95150; // 1+pbreak |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2980 double y; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2981 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2982 // Select case. |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2983 if (x >= pbreak_lo && x <= pbreak_hi) |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2984 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2985 // Middle region. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2986 const double q = 0.5*(1-x), r = q*q; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2987 const double yn = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2988 const double yd = ((((b[0]*r + b[1])*r + b[2])*r + b[3])*r + b[4])*r + 1.0; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2989 y = yn / yd; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2990 } |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2991 else if (x > 0.0 && x < 2.0) |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2992 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2993 // Tail region. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2994 const double q = x < 1 ? sqrt (-2*log (0.5*x)) : sqrt (-2*log (0.5*(2-x))); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2995 const double yn = ((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5]; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2996 const double yd = (((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
2997 y = yn / yd; |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2998 if (x < pbreak_lo) |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
2999 y = -y; |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3000 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3001 else if (x == 0.0) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3002 return octave_Inf; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3003 else if (x == 2.0) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3004 return -octave_Inf; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3005 else |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3006 return octave_NaN; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3007 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3008 if (refine) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3009 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3010 // One iteration of Halley's method gives full precision. |
14771
10ed11922f19
maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14770
diff
changeset
|
3011 double u = (erf (y) - (1-x)) * spi2 * exp (y*y); |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3012 y -= u / (1 + y*u); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3013 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3014 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3015 return y; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3016 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3017 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3018 double erfcinv (double x) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3019 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3020 return do_erfcinv (x, true); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3021 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3022 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3023 float erfcinv (float x) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3024 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3025 return do_erfcinv (x, false); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3026 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3027 |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3028 // Implementation based on the Fortran code by W.J.Cody |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3029 // see http://www.netlib.org/specfun/erf. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3030 // Templatized and simplified workflow. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3031 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3032 // FIXME: Maybe this should be globally visible. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3033 static inline float erfc (float x) { return erfcf (x); } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3034 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3035 template <class T> |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3036 static T |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3037 erfcx_impl (T x) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3038 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3039 static const T c[] = |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3040 { |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3041 5.64188496988670089e-1,8.88314979438837594, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3042 6.61191906371416295e+1,2.98635138197400131e+2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3043 8.81952221241769090e+2,1.71204761263407058e+3, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3044 2.05107837782607147e+3,1.23033935479799725e+3, |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3045 2.15311535474403846e-8 |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3046 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3047 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3048 static const T d[] = |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3049 { |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3050 1.57449261107098347e+1,1.17693950891312499e+2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3051 5.37181101862009858e+2,1.62138957456669019e+3, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3052 3.29079923573345963e+3,4.36261909014324716e+3, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3053 3.43936767414372164e+3,1.23033935480374942e+3 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3054 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3055 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3056 static const T p[] = |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3057 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3058 3.05326634961232344e-1,3.60344899949804439e-1, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3059 1.25781726111229246e-1,1.60837851487422766e-2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3060 6.58749161529837803e-4,1.63153871373020978e-2 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3061 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3062 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3063 static const T q[] = |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3064 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3065 2.56852019228982242,1.87295284992346047, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3066 5.27905102951428412e-1,6.05183413124413191e-2, |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3067 2.33520497626869185e-3 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3068 }; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3069 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3070 static const T sqrpi = 5.6418958354775628695e-1; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3071 static const T xhuge = sqrt (1.0 / std::numeric_limits<T>::epsilon ()); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3072 static const T xneg = -sqrt (log (std::numeric_limits<T>::max ()/2.0)); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3073 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3074 double y = fabs (x), result; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3075 if (x < xneg) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3076 result = octave_Inf; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3077 else if (y <= 0.46875) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3078 result = std::exp (x*x) * erfc (x); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3079 else |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3080 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3081 if (y <= 4.0) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3082 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3083 double xnum = c[8]*y, xden = y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3084 for (int i = 0; i < 7; i++) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3085 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3086 xnum = (xnum + c[i]) * y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3087 xden = (xden + d[i]) * y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3088 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3089 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3090 result = (xnum + c[7]) / (xden + d[7]); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3091 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3092 else if (y <= xhuge) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3093 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3094 double y2 = 1/(y*y), xnum = p[5]*y2, xden = y2; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3095 for (int i = 0; i < 4; i++) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3096 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3097 xnum = (xnum + p[i]) * y2; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3098 xden = (xden + q[i]) * y2; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3099 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3100 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3101 result = y2 * (xnum + p[4]) / (xden + q[4]); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3102 result = (sqrpi - result) / y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3103 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3104 else |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3105 result = sqrpi / y; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3106 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3107 // Fix up negative argument. |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3108 if (x < 0) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3109 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3110 double y2 = ceil (x / 16.0) * 16.0, del = (x-y2)*(x+y2); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3111 result = 2*(std::exp(y2*y2) * std::exp(del)) - result; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3112 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3113 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3114 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3115 return result; |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3116 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3117 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3118 double erfcx (double x) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3119 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3120 return erfcx_impl (x); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3121 } |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3122 |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3123 float erfcx (float x) |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3124 { |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3125 return erfcx_impl (x); |
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3126 } |