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