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