Mercurial > octave
annotate liboctave/numeric/lo-specfun.cc @ 21139:538b57866b90
consistently use "typename" intead of "class" in template declarations
* Object.h, QtHandlesUtils.cc, QtHandlesUtils.h, ToolBarButton.cc,
ToolBarButton.h, Cell.h, __lin_interpn__.cc, bitfcns.cc, bsxfun.cc,
cellfun.cc, data.cc, filter.cc, gcd.cc, graphics.cc, help.cc, kron.cc,
lookup.cc, ls-mat5.cc, ls-oct-text.h, lu.cc, max.cc, mgorth.cc,
oct-map.cc, oct-map.h, oct-stream.cc, oct-stream.h, octave-link.h,
pr-output.cc, profiler.h, schur.cc, sparse-xdiv.cc, sparse-xpow.cc,
sqrtm.cc, symtab.h, tril.cc, typecast.cc, variables.cc, xdiv.cc,
zfstream.h, __init_fltk__.cc, __magick_read__.cc, chol.cc, qr.cc,
ov-base-diag.cc, ov-base-diag.h, ov-base-int.cc, ov-base-int.h,
ov-base-mat.cc, ov-base-mat.h, ov-base-scalar.cc, ov-base-scalar.h,
ov-base-sparse.cc, ov-base-sparse.h, ov-base.h, ov-classdef.cc,
ov-int-traits.h, ov-java.h, ov-usr-fcn.h, ov.cc, ov.h,
op-dms-template.cc, oct-parse.in.yy, parse.h, pt-mat.cc, Array-b.cc,
Array.cc, Array.h, CDiagMatrix.h, CMatrix.h, CNDArray.h,
DiagArray2.cc, DiagArray2.h, MArray.cc, MArray.h, MDiagArray2.cc,
MDiagArray2.h, MSparse.cc, MSparse.h, MatrixType.cc, Sparse.cc,
Sparse.h, dDiagMatrix.h, dMatrix.h, dNDArray.h, fCDiagMatrix.h,
fCMatrix.h, fCNDArray.h, fDiagMatrix.h, fMatrix.h, fNDArray.h,
idx-vector.cc, idx-vector.h, intNDArray.cc, intNDArray.h, DET.h,
base-aepbal.h, base-lu.cc, base-lu.h, base-qr.cc, base-qr.h,
bsxfun-defs.cc, eigs-base.cc, lo-mappers.h, lo-specfun.cc,
lo-specfun.h, oct-convn.cc, oct-fftw.cc, oct-norm.cc,
sparse-base-chol.cc, sparse-base-chol.h, sparse-base-lu.cc,
sparse-base-lu.h, sparse-dmsolve.cc, mx-inlines.cc,
action-container.h, base-list.h, lo-traits.h, lo-utils.h,
oct-base64.h, oct-binmap.h, oct-cmplx.h, oct-inttypes.cc,
oct-inttypes.h, oct-locbuf.h, oct-refcount.h, oct-sort.cc, oct-sort.h:
Use "typename" instead of "class" in template declarations.
author | John W. Eaton <jwe@octave.org> |
---|---|
date | Sun, 24 Jan 2016 13:50:04 -0500 |
parents | 7cac4e7458f2 |
children | 26f85aa072de |
rev | line source |
---|---|
3146 | 1 /* |
2 | |
19697
4197fc428c7d
maint: Update copyright notices for 2015.
John W. Eaton <jwe@octave.org>
parents:
19410
diff
changeset
|
3 Copyright (C) 1996-2015 John W. Eaton |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
4 Copyright (C) 2007-2010 D. Martin |
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 |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
7 Copyright (C) 2015 Carnë Draug |
3146 | 8 |
9 This file is part of Octave. | |
10 | |
11 Octave is free software; you can redistribute it and/or modify it | |
12 under the terms of the GNU General Public License as published by the | |
7016 | 13 Free Software Foundation; either version 3 of the License, or (at your |
14 option) any later version. | |
3146 | 15 |
16 Octave is distributed in the hope that it will be useful, but WITHOUT | |
17 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or | |
18 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License | |
19 for more details. | |
20 | |
21 You should have received a copy of the GNU General Public License | |
7016 | 22 along with Octave; see the file COPYING. If not, see |
23 <http://www.gnu.org/licenses/>. | |
3146 | 24 |
25 */ | |
26 | |
27 #ifdef HAVE_CONFIG_H | |
28 #include <config.h> | |
29 #endif | |
30 | |
31 #include "Range.h" | |
3220 | 32 #include "CColVector.h" |
33 #include "CMatrix.h" | |
34 #include "dRowVector.h" | |
3146 | 35 #include "dMatrix.h" |
4844 | 36 #include "dNDArray.h" |
37 #include "CNDArray.h" | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
38 #include "fCColVector.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
39 #include "fCMatrix.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
40 #include "fRowVector.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
41 #include "fMatrix.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
42 #include "fNDArray.h" |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
43 #include "fCNDArray.h" |
3146 | 44 #include "f77-fcn.h" |
45 #include "lo-error.h" | |
3220 | 46 #include "lo-ieee.h" |
47 #include "lo-specfun.h" | |
3146 | 48 #include "mx-inlines.cc" |
5701 | 49 #include "lo-mappers.h" |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
50 #include "lo-math.h" |
3146 | 51 |
15696
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
52 #include "Faddeeva.hh" |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
53 |
3146 | 54 extern "C" |
55 { | |
4552 | 56 F77_RET_T |
57 F77_FUNC (zbesj, ZBESJ) (const double&, const double&, const double&, | |
11518 | 58 const octave_idx_type&, const octave_idx_type&, |
59 double*, double*, octave_idx_type&, | |
60 octave_idx_type&); | |
3146 | 61 |
4552 | 62 F77_RET_T |
63 F77_FUNC (zbesy, ZBESY) (const double&, const double&, const double&, | |
11518 | 64 const octave_idx_type&, const octave_idx_type&, |
65 double*, double*, octave_idx_type&, double*, | |
66 double*, octave_idx_type&); | |
3220 | 67 |
4552 | 68 F77_RET_T |
69 F77_FUNC (zbesi, ZBESI) (const double&, const double&, const double&, | |
11518 | 70 const octave_idx_type&, const octave_idx_type&, |
71 double*, double*, octave_idx_type&, | |
72 octave_idx_type&); | |
3146 | 73 |
4552 | 74 F77_RET_T |
75 F77_FUNC (zbesk, ZBESK) (const double&, const double&, const double&, | |
11518 | 76 const octave_idx_type&, const octave_idx_type&, |
77 double*, double*, octave_idx_type&, | |
78 octave_idx_type&); | |
3220 | 79 |
4552 | 80 F77_RET_T |
81 F77_FUNC (zbesh, ZBESH) (const double&, const double&, const double&, | |
11518 | 82 const octave_idx_type&, const octave_idx_type&, |
83 const octave_idx_type&, double*, double*, | |
84 octave_idx_type&, octave_idx_type&); | |
4552 | 85 |
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 (cbesj, cBESJ) (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&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
90 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
91 F77_RET_T |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
92 F77_FUNC (cbesy, CBESY) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
93 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
94 FloatComplex*, octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
95 FloatComplex*, 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 (cbesi, CBESI) (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 (cbesk, CBESK) (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 FloatComplex*, octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
106 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
107 F77_RET_T |
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
|
108 F77_FUNC (cbesh, CBESH) (const FloatComplex&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
109 const octave_idx_type&, const octave_idx_type&, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
110 const octave_idx_type&, FloatComplex*, |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
111 octave_idx_type&, octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
112 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
113 F77_RET_T |
11518 | 114 F77_FUNC (zairy, ZAIRY) (const double&, const double&, |
115 const octave_idx_type&, const octave_idx_type&, | |
116 double&, double&, octave_idx_type&, | |
117 octave_idx_type&); | |
3146 | 118 |
4552 | 119 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
120 F77_FUNC (cairy, CAIRY) (const float&, const float&, const octave_idx_type&, |
11518 | 121 const octave_idx_type&, float&, float&, |
122 octave_idx_type&, 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 |
11518 | 125 F77_FUNC (zbiry, ZBIRY) (const double&, const double&, |
126 const octave_idx_type&, const octave_idx_type&, | |
127 double&, double&, octave_idx_type&); | |
4552 | 128 |
129 F77_RET_T | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
130 F77_FUNC (cbiry, CBIRY) (const float&, const float&, const octave_idx_type&, |
11518 | 131 const octave_idx_type&, float&, float&, |
132 octave_idx_type&); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
133 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
134 F77_RET_T |
4552 | 135 F77_FUNC (xdacosh, XDACOSH) (const double&, double&); |
3220 | 136 |
4552 | 137 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
138 F77_FUNC (xacosh, XACOSH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
139 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
140 F77_RET_T |
4552 | 141 F77_FUNC (xdasinh, XDASINH) (const double&, double&); |
3146 | 142 |
4552 | 143 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
144 F77_FUNC (xasinh, XASINH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
145 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
146 F77_RET_T |
4552 | 147 F77_FUNC (xdatanh, XDATANH) (const double&, double&); |
3146 | 148 |
4552 | 149 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
150 F77_FUNC (xatanh, XATANH) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
151 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
152 F77_RET_T |
4552 | 153 F77_FUNC (xderf, XDERF) (const double&, double&); |
3146 | 154 |
4552 | 155 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
156 F77_FUNC (xerf, XERF) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
157 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
158 F77_RET_T |
4552 | 159 F77_FUNC (xderfc, XDERFC) (const double&, double&); |
3146 | 160 |
4552 | 161 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
162 F77_FUNC (xerfc, XERFC) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
163 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
164 F77_RET_T |
4552 | 165 F77_FUNC (xdbetai, XDBETAI) (const double&, const double&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
166 const double&, double&); |
3146 | 167 |
4552 | 168 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
169 F77_FUNC (xbetai, XBETAI) (const float&, const float&, |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
170 const float&, float&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
171 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
172 F77_RET_T |
4552 | 173 F77_FUNC (xdgamma, XDGAMMA) (const double&, double&); |
3146 | 174 |
4552 | 175 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
176 F77_FUNC (xgamma, XGAMMA) (const float&, float&); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
177 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
178 F77_RET_T |
4552 | 179 F77_FUNC (xgammainc, XGAMMAINC) (const double&, const double&, double&); |
3146 | 180 |
4552 | 181 F77_RET_T |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
182 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
|
183 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
184 F77_RET_T |
4552 | 185 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
|
186 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
187 F77_RET_T |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
188 F77_FUNC (algams, ALGAMS) (const float&, float&, float&); |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
189 |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
190 F77_RET_T |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
191 F77_FUNC (psifn, PSIFN) (const float*, const octave_idx_type&, |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
192 const octave_idx_type&, const octave_idx_type&, |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
193 float*, octave_idx_type*, octave_idx_type*); |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
194 |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
195 F77_RET_T |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
196 F77_FUNC (dpsifn, DPSIFN) (const double*, const octave_idx_type&, |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
197 const octave_idx_type&, const octave_idx_type&, |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
198 double*, octave_idx_type*, octave_idx_type*); |
3146 | 199 } |
200 | |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
201 #if ! defined (HAVE_ACOSH) |
3146 | 202 double |
203 acosh (double x) | |
204 { | |
205 double retval; | |
5278 | 206 F77_XFCN (xdacosh, XDACOSH, (x, retval)); |
3146 | 207 return retval; |
208 } | |
209 #endif | |
210 | |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
211 #if ! defined (HAVE_ACOSHF) |
7789
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 acoshf (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 (xacosh, XACOSH, (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 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
221 #if ! defined (HAVE_ASINH) |
3146 | 222 double |
223 asinh (double x) | |
224 { | |
225 double retval; | |
5278 | 226 F77_XFCN (xdasinh, XDASINH, (x, retval)); |
3146 | 227 return retval; |
228 } | |
229 #endif | |
230 | |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
231 #if ! defined (HAVE_ASINHF) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
232 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
233 asinhf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
234 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
235 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
236 F77_XFCN (xasinh, XASINH, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
237 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
238 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
239 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
240 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
241 #if ! defined (HAVE_ATANH) |
3146 | 242 double |
243 atanh (double x) | |
244 { | |
245 double retval; | |
5278 | 246 F77_XFCN (xdatanh, XDATANH, (x, retval)); |
3146 | 247 return retval; |
248 } | |
249 #endif | |
250 | |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
251 #if ! defined (HAVE_ATANHF) |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
252 float |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
253 atanhf (float x) |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
254 { |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
255 float retval; |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
256 F77_XFCN (xatanh, XATANH, (x, retval)); |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
257 return retval; |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
258 } |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
259 #endif |
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
260 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
261 #if ! defined (HAVE_ERF) |
3146 | 262 double |
263 erf (double x) | |
264 { | |
265 double retval; | |
5278 | 266 F77_XFCN (xderf, XDERF, (x, retval)); |
3146 | 267 return retval; |
268 } | |
269 #endif | |
270 | |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
271 #if ! defined (HAVE_ERFF) |
7789
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 erff (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 (xerf, XERF, (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 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
281 #if ! defined (HAVE_ERFC) |
3146 | 282 double |
283 erfc (double x) | |
284 { | |
285 double retval; | |
5278 | 286 F77_XFCN (xderfc, XDERFC, (x, retval)); |
3146 | 287 return retval; |
288 } | |
289 #endif | |
290 | |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
291 #if ! defined (HAVE_ERFCF) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
292 float |
7914
e998e81224b5
Various compilation fixes for MSVC.
John W. Eaton <jwe@octave.org>
parents:
7789
diff
changeset
|
293 erfcf (float x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
294 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
295 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
296 F77_XFCN (xerfc, XERFC, (x, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
297 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
298 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
299 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
300 |
15696
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
301 // Complex error function from the Faddeeva package |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
302 Complex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
303 erf (const Complex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
304 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
305 return Faddeeva::erf (x); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
306 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
307 FloatComplex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
308 erf (const FloatComplex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
309 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
310 Complex xd (real (x), imag (x)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
311 Complex ret = Faddeeva::erf (xd, std::numeric_limits<float>::epsilon ()); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
312 return FloatComplex (real (ret), imag (ret)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
313 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
314 |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
315 // Complex complementary error function from the Faddeeva package |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
316 Complex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
317 erfc (const Complex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
318 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
319 return Faddeeva::erfc (x); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
320 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
321 FloatComplex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
322 erfc (const FloatComplex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
323 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
324 Complex xd (real (x), imag (x)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
325 Complex ret = Faddeeva::erfc (xd, std::numeric_limits<float>::epsilon ()); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
326 return FloatComplex (real (ret), imag (ret)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
327 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
328 |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
329 // Real and complex scaled complementary error function from Faddeeva package |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
330 float erfcx (float x) { return Faddeeva::erfcx(x); } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
331 double erfcx (double x) { return Faddeeva::erfcx(x); } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
332 Complex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
333 erfcx (const Complex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
334 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
335 return Faddeeva::erfcx (x); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
336 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
337 FloatComplex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
338 erfcx (const FloatComplex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
339 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
340 Complex xd (real (x), imag (x)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
341 Complex ret = Faddeeva::erfcx (xd, std::numeric_limits<float>::epsilon ()); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
342 return FloatComplex (real (ret), imag (ret)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
343 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
344 |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
345 // Real and complex imaginary error function from Faddeeva package |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
346 float erfi (float x) { return Faddeeva::erfi(x); } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
347 double erfi (double x) { return Faddeeva::erfi(x); } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
348 Complex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
349 erfi (const Complex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
350 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
351 return Faddeeva::erfi (x); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
352 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
353 FloatComplex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
354 erfi (const FloatComplex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
355 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
356 Complex xd (real (x), imag (x)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
357 Complex ret = Faddeeva::erfi (xd, std::numeric_limits<float>::epsilon ()); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
358 return FloatComplex (real (ret), imag (ret)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
359 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
360 |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
361 // Real and complex Dawson function (= scaled erfi) from Faddeeva package |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
362 float dawson (float x) { return Faddeeva::Dawson(x); } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
363 double dawson (double x) { return Faddeeva::Dawson(x); } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
364 Complex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
365 dawson (const Complex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
366 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
367 return Faddeeva::Dawson (x); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
368 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
369 FloatComplex |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
370 dawson (const FloatComplex& x) |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
371 { |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
372 Complex xd (real (x), imag (x)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
373 Complex ret = Faddeeva::Dawson (xd, std::numeric_limits<float>::epsilon ()); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
374 return FloatComplex (real (ret), imag (ret)); |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
375 } |
2fac72a256ce
Add complex erf,erfc,erfcx,erfi,dawson routines from Faddeeva package.
Steven G. Johnson <stevenj@alum.mit.edu>
parents:
15271
diff
changeset
|
376 |
3146 | 377 double |
3156 | 378 xgamma (double x) |
3146 | 379 { |
3156 | 380 double result; |
5701 | 381 |
19357
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
382 // Special cases for (near) compatibility with Matlab instead of |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
383 // tgamma. Matlab does not have -0. |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
384 |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
385 if (x == 0) |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
386 result = xnegative_sign (x) ? -octave_Inf : octave_Inf; |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
387 else if ((x < 0 && D_NINT (x) == x) || xisinf (x)) |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
388 result = octave_Inf; |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
389 else if (xisnan (x)) |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
390 result = octave_NaN; |
5701 | 391 else |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
392 { |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
393 #if defined (HAVE_TGAMMA) |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
394 result = tgamma (x); |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
395 #else |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
396 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
|
397 #endif |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
398 } |
6969 | 399 |
3156 | 400 return result; |
3146 | 401 } |
402 | |
403 double | |
3156 | 404 xlgamma (double x) |
3146 | 405 { |
6969 | 406 #if defined (HAVE_LGAMMA) |
407 return lgamma (x); | |
408 #else | |
3156 | 409 double result; |
3146 | 410 double sgngam; |
4497 | 411 |
5701 | 412 if (xisnan (x)) |
413 result = x; | |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
414 else if ((x <= 0 && D_NINT (x) == x) || xisinf (x)) |
5701 | 415 result = octave_Inf; |
5700 | 416 else |
417 F77_XFCN (dlgams, DLGAMS, (x, result, sgngam)); | |
4497 | 418 |
3156 | 419 return result; |
6969 | 420 #endif |
6961 | 421 } |
422 | |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
423 Complex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
424 rc_lgamma (double x) |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
425 { |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
426 double result; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
427 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
428 #if defined (HAVE_LGAMMA_R) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
429 int sgngam; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
430 result = lgamma_r (x, &sgngam); |
7601
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
431 #else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
432 double sgngam; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
433 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
434 if (xisnan (x)) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
435 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
436 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
|
437 result = octave_Inf; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
438 else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
439 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
|
440 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
441 #endif |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
442 |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
443 if (sgngam < 0) |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
444 return result + Complex (0., M_PI); |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
445 else |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
446 return result; |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
447 } |
8a939b217863
Treat negative values to lgamma and beta correctly
David Bateman <dbateman@free.fr>
parents:
7176
diff
changeset
|
448 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
449 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
450 xgamma (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
451 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
452 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
453 |
19357
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
454 // Special cases for (near) compatibility with Matlab instead of |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
455 // tgamma. Matlab does not have -0. |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
456 |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
457 if (x == 0) |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
458 result = xnegative_sign (x) ? -octave_Float_Inf : octave_Float_Inf; |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
459 else if ((x < 0 && D_NINT (x) == x) || xisinf (x)) |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
460 result = octave_Float_Inf; |
c6437824681c
improve Matlab compatibility for gamma function (bug #43551)
John W. Eaton <jwe@octave.org>
parents:
17769
diff
changeset
|
461 else if (xisnan (x)) |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
462 result = octave_Float_NaN; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
463 else |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
464 { |
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
465 #if defined (HAVE_TGAMMA) |
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
466 result = tgammaf (x); |
11327
ef0e995f8c0f
correctly compute gamma for negative integer values when tgamma is available
Marco Atzeri <marco_atzeri@yahoo.it>
parents:
10902
diff
changeset
|
467 #else |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
468 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
|
469 #endif |
17708
f10b7a578e2c
Correct return values of gamma() (see Numerical, item 3 on Projects page).
Craig Hudson <c_hudson_phd@hotmail.com>
parents:
17502
diff
changeset
|
470 } |
7789
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 return result; |
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 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
475 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
476 xlgamma (float x) |
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 #if defined (HAVE_LGAMMAF) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
479 return lgammaf (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
480 #else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
481 float result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
482 float sgngam; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
483 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
484 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
485 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
486 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
|
487 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
488 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
489 F77_XFCN (algams, ALGAMS, (x, result, sgngam)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
490 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
491 return result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
492 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
493 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
494 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
495 FloatComplex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
496 rc_lgamma (float x) |
7789
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 float result; |
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 #if defined (HAVE_LGAMMAF_R) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
501 int sgngam; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
502 result = lgammaf_r (x, &sgngam); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
503 #else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
504 float sgngam; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
505 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
506 if (xisnan (x)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
507 result = x; |
10902
9a64e02e2aad
Validate input arguments for gamma, lgamma.
Tatsuro MATSUOKA <tmacchant@yahoo.co.jp>
parents:
10521
diff
changeset
|
508 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
|
509 result = octave_Float_Inf; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
510 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
511 F77_XFCN (algams, ALGAMS, (x, result, sgngam)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
512 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
513 #endif |
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 if (sgngam < 0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
516 return result + FloatComplex (0., M_PI); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
517 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
518 return result; |
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 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
521 #if ! defined (HAVE_EXPM1) |
7638
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 expm1 (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.1) |
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 ax /= 16; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
532 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
533 // use Taylor series to calculate exp(x)-1. |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
534 double t = ax; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
535 double s = 0; |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
536 for (int i = 2; i < 7; i++) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
537 s += (t *= ax/i); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
538 s += ax; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
539 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
540 // use the identity (a+1)^2-1 = a*(a+2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
541 double e = s; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
542 for (int i = 0; i < 4; i++) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
543 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
544 s *= e + 2; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
545 e *= e + 2; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
546 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
547 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
548 retval = (x > 0) ? s : -s / (1+s); |
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 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
551 retval = exp (x) - 1; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
552 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
553 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
554 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
555 #endif |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
556 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
557 Complex |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
558 expm1 (const Complex& x) |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
559 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
560 Complex retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
561 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
562 if (std:: abs (x) < 1) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
563 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14844
diff
changeset
|
564 double im = x.imag (); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
565 double u = expm1 (x.real ()); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
566 double v = sin (im/2); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
567 v = -2*v*v; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
568 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
|
569 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
570 else |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
571 retval = std::exp (x) - Complex (1); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
572 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
573 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
574 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
575 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
576 #if ! defined (HAVE_EXPM1F) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
577 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
578 expm1f (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
579 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
580 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
581 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
582 float ax = fabs (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 if (ax < 0.1) |
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 ax /= 16; |
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 // use Taylor series to calculate exp(x)-1. |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
589 float t = ax; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
590 float s = 0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
591 for (int i = 2; i < 7; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
592 s += (t *= ax/i); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
593 s += ax; |
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 // 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
|
596 float e = s; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
597 for (int i = 0; i < 4; i++) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
598 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
599 s *= e + 2; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
600 e *= e + 2; |
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 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
603 retval = (x > 0) ? s : -s / (1+s); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
604 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
605 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
606 retval = exp (x) - 1; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
607 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
608 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
609 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
610 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
611 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
612 FloatComplex |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
613 expm1 (const FloatComplex& x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
614 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
615 FloatComplex retval; |
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 if (std:: abs (x) < 1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
618 { |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14844
diff
changeset
|
619 float im = x.imag (); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
620 float u = expm1 (x.real ()); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
621 float v = sin (im/2); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
622 v = -2*v*v; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
623 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
|
624 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
625 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
626 retval = std::exp (x) - FloatComplex (1); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
627 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
628 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
629 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
630 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
631 #if ! defined (HAVE_LOG1P) |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
632 double |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
633 log1p (double x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
634 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
635 double retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
636 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
637 double ax = fabs (x); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
638 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
639 if (ax < 0.2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
640 { |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
641 // approximation log (1+x) ~ 2*sum ((x/(2+x)).^ii ./ ii), ii = 1:2:2n+1 |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
642 double u = x / (2 + x), t = 1, s = 0; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
643 for (int i = 2; i < 12; i += 2) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
644 s += (t *= u*u) / (i+1); |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
645 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
646 retval = 2 * (s + 1) * u; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
647 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
648 else |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
649 retval = gnulib::log (1 + x); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
650 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
651 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
652 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
653 #endif |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
654 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
655 Complex |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
656 log1p (const Complex& x) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
657 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
658 Complex retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
659 |
14846
460a3c6d8bf1
maint: Use Octave coding convention for cuddled parenthis in function calls with empty argument lists.
Rik <octave@nomad.inbox5.com>
parents:
14844
diff
changeset
|
660 double r = x.real (), i = x.imag (); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
661 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
662 if (fabs (r) < 0.5 && fabs (i) < 0.5) |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
663 { |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
664 double u = 2*r + r*r + i*i; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
665 retval = Complex (log1p (u / (1+sqrt (u+1))), |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
666 atan2 (1 + r, i)); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
667 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
668 else |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
669 retval = std::log (Complex (1) + x); |
7638
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
670 |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
671 return retval; |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
672 } |
2df457529cfa
implement expm1 and log1p functions
Jaroslav Hajek <highegg@gmail.com>
parents:
7601
diff
changeset
|
673 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
674 #if ! defined (HAVE_CBRT) |
10414
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
675 double cbrt (double x) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
676 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
677 static const double one_third = 0.3333333333333333333; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
678 if (xfinite (x)) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
679 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
680 // Use pow. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
681 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
|
682 // Correct for better accuracy. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
683 return (x / (y*y) + y + y) / 3; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
684 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
685 else |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
686 return x; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
687 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
688 #endif |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
689 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
690 #if ! defined (HAVE_LOG1PF) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
691 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
692 log1pf (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
693 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
694 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
695 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
696 float ax = fabs (x); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
697 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
698 if (ax < 0.2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
699 { |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
700 // approximation log (1+x) ~ 2*sum ((x/(2+x)).^ii ./ ii), ii = 1:2:2n+1 |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
701 float u = x / (2 + x), t = 1.0f, s = 0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
702 for (int i = 2; i < 12; i += 2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
703 s += (t *= u*u) / (i+1); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
704 |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
705 retval = 2 * (s + 1.0f) * u; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
706 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
707 else |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
708 retval = gnulib::logf (1.0f + x); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
709 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
710 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
711 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
712 #endif |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
713 |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
714 FloatComplex |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
715 log1p (const FloatComplex& x) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
716 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
717 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
718 |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
719 float r = x.real (), i = x.imag (); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
720 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
721 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
|
722 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
723 float u = 2*r + r*r + i*i; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
724 retval = FloatComplex (log1p (u / (1+sqrt (u+1))), |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
725 atan2 (1 + r, i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
726 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
727 else |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
728 retval = std::log (FloatComplex (1) + x); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
729 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
730 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
731 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
732 |
20791
f7084eae3318
maint: Use Octave coding conventions for #if statements.
Rik <rik@octave.org>
parents:
20711
diff
changeset
|
733 #if ! defined (HAVE_CBRTF) |
10414
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
734 float cbrtf (float x) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
735 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
736 static const float one_third = 0.3333333333333333333f; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
737 if (xfinite (x)) |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
738 { |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
739 // Use pow. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
740 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
|
741 // Correct for better accuracy. |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
742 return (x / (y*y) + y + y) / 3; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
743 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
744 else |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
745 return x; |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
746 } |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
747 #endif |
2a8b1db1e2ca
implement built-in cbrt
Jaroslav Hajek <highegg@gmail.com>
parents:
10391
diff
changeset
|
748 |
3220 | 749 static inline Complex |
5275 | 750 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 751 |
752 static inline Complex | |
5275 | 753 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 754 |
755 static inline Complex | |
5275 | 756 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 757 |
758 static inline Complex | |
5275 | 759 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 760 |
761 static inline Complex | |
5275 | 762 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 763 |
764 static inline Complex | |
5275 | 765 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr); |
3220 | 766 |
767 static inline Complex | |
5275 | 768 bessel_return_value (const Complex& val, octave_idx_type ierr) |
3146 | 769 { |
3220 | 770 static const Complex inf_val = Complex (octave_Inf, octave_Inf); |
771 static const Complex nan_val = Complex (octave_NaN, octave_NaN); | |
772 | |
773 Complex retval; | |
774 | |
775 switch (ierr) | |
776 { | |
777 case 0: | |
778 case 3: | |
779 retval = val; | |
780 break; | |
781 | |
782 case 2: | |
783 retval = inf_val; | |
784 break; | |
785 | |
786 default: | |
787 retval = nan_val; | |
788 break; | |
789 } | |
790 | |
3146 | 791 return retval; |
792 } | |
793 | |
4911 | 794 static inline bool |
795 is_integer_value (double x) | |
796 { | |
797 return x == static_cast<double> (static_cast<long> (x)); | |
798 } | |
799 | |
3220 | 800 static inline Complex |
5275 | 801 zbesj (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 802 { |
3220 | 803 Complex retval; |
804 | |
805 if (alpha >= 0.0) | |
806 { | |
807 double yr = 0.0; | |
808 double yi = 0.0; | |
809 | |
5275 | 810 octave_idx_type nz; |
3220 | 811 |
812 double zr = z.real (); | |
813 double zi = z.imag (); | |
814 | |
4506 | 815 F77_FUNC (zbesj, ZBESJ) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
816 | |
817 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
818 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
819 double expz = exp (std::abs (zi)); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
820 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
821 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
822 } |
3220 | 823 |
4490 | 824 if (zi == 0.0 && zr >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
825 yi = 0.0; |
3220 | 826 |
827 retval = bessel_return_value (Complex (yr, yi), ierr); | |
828 } | |
4911 | 829 else if (is_integer_value (alpha)) |
830 { | |
831 // zbesy can overflow as z->0, and cause troubles for generic case below | |
832 alpha = -alpha; | |
833 Complex tmp = zbesj (z, alpha, kode, ierr); | |
19739
3fa35defe495
Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents:
19697
diff
changeset
|
834 if ((static_cast<long> (alpha)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
835 tmp = - tmp; |
4911 | 836 retval = bessel_return_value (tmp, ierr); |
837 } | |
3220 | 838 else |
839 { | |
840 alpha = -alpha; | |
841 | |
842 Complex tmp = cos (M_PI * alpha) * zbesj (z, alpha, kode, ierr); | |
843 | |
844 if (ierr == 0 || ierr == 3) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
845 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
846 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
|
847 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
848 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
849 } |
3220 | 850 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
851 retval = Complex (octave_NaN, octave_NaN); |
3220 | 852 } |
853 | |
3146 | 854 return retval; |
855 } | |
856 | |
3220 | 857 static inline Complex |
5275 | 858 zbesy (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 859 { |
3220 | 860 Complex retval; |
3146 | 861 |
862 if (alpha >= 0.0) | |
863 { | |
3220 | 864 double yr = 0.0; |
865 double yi = 0.0; | |
866 | |
5275 | 867 octave_idx_type nz; |
3220 | 868 |
869 double wr, wi; | |
3146 | 870 |
3220 | 871 double zr = z.real (); |
872 double zi = z.imag (); | |
873 | |
874 ierr = 0; | |
875 | |
876 if (zr == 0.0 && zi == 0.0) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
877 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
878 yr = -octave_Inf; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
879 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
880 } |
3220 | 881 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
882 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
883 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
|
884 &wr, &wi, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
885 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
886 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
887 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
888 double expz = exp (std::abs (zi)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
889 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
890 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
891 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
892 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
893 if (zi == 0.0 && zr >= 0.0) |
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 } |
3146 | 896 |
3220 | 897 return bessel_return_value (Complex (yr, yi), ierr); |
898 } | |
4911 | 899 else if (is_integer_value (alpha - 0.5)) |
900 { | |
901 // zbesy can overflow as z->0, and cause troubles for generic case below | |
902 alpha = -alpha; | |
903 Complex tmp = zbesj (z, alpha, kode, ierr); | |
19739
3fa35defe495
Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents:
19697
diff
changeset
|
904 if ((static_cast<long> (alpha - 0.5)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
905 tmp = - tmp; |
4911 | 906 retval = bessel_return_value (tmp, ierr); |
907 } | |
3220 | 908 else |
909 { | |
910 alpha = -alpha; | |
3146 | 911 |
3220 | 912 Complex tmp = cos (M_PI * alpha) * zbesy (z, alpha, kode, ierr); |
3146 | 913 |
3220 | 914 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
915 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
916 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
|
917 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
918 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
919 } |
3220 | 920 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
921 retval = Complex (octave_NaN, octave_NaN); |
3220 | 922 } |
923 | |
924 return retval; | |
925 } | |
926 | |
927 static inline Complex | |
5275 | 928 zbesi (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 929 { |
930 Complex retval; | |
3146 | 931 |
3220 | 932 if (alpha >= 0.0) |
933 { | |
934 double yr = 0.0; | |
935 double yi = 0.0; | |
936 | |
5275 | 937 octave_idx_type nz; |
3146 | 938 |
3220 | 939 double zr = z.real (); |
940 double zi = z.imag (); | |
941 | |
4506 | 942 F77_FUNC (zbesi, ZBESI) (zr, zi, alpha, 2, 1, &yr, &yi, nz, ierr); |
943 | |
944 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
945 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
946 double expz = exp (std::abs (zr)); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
947 yr *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
948 yi *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
949 } |
3146 | 950 |
4490 | 951 if (zi == 0.0 && zr >= 0.0) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
952 yi = 0.0; |
3220 | 953 |
954 retval = bessel_return_value (Complex (yr, yi), ierr); | |
3146 | 955 } |
14196
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
956 else if (is_integer_value (alpha)) |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
957 { |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
958 // zbesi can overflow as z->0, and cause troubles for generic case below |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
959 alpha = -alpha; |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
960 Complex tmp = zbesi (z, alpha, kode, ierr); |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
961 retval = bessel_return_value (tmp, ierr); |
35ce1eab7400
besseli: use special case for negative integer orders
John W. Eaton <jwe@octave.org>
parents:
14138
diff
changeset
|
962 } |
3146 | 963 else |
3220 | 964 { |
965 alpha = -alpha; | |
966 | |
967 Complex tmp = zbesi (z, alpha, kode, ierr); | |
968 | |
969 if (ierr == 0 || ierr == 3) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
970 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
971 Complex tmp2 = (2.0 / M_PI) * sin (M_PI * alpha) |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
972 * zbesk (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
973 |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
974 if (kode == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
975 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
976 // Compensate for different scaling factor of besk. |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
977 tmp2 *= exp (-z - std::abs (z.real ())); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
978 } |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
979 |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
980 tmp += tmp2; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
981 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
982 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
983 } |
3220 | 984 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
985 retval = Complex (octave_NaN, octave_NaN); |
3220 | 986 } |
987 | |
988 return retval; | |
989 } | |
990 | |
991 static inline Complex | |
5275 | 992 zbesk (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 993 { |
994 Complex retval; | |
995 | |
996 if (alpha >= 0.0) | |
997 { | |
998 double yr = 0.0; | |
999 double yi = 0.0; | |
1000 | |
5275 | 1001 octave_idx_type nz; |
3220 | 1002 |
1003 double zr = z.real (); | |
1004 double zi = z.imag (); | |
1005 | |
1006 ierr = 0; | |
1007 | |
1008 if (zr == 0.0 && zi == 0.0) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1009 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1010 yr = octave_Inf; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1011 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1012 } |
3220 | 1013 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1014 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1015 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
|
1016 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1017 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1018 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1019 Complex expz = exp (-z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1020 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1021 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1022 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1023 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1024 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1025 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1026 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1027 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1028 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1029 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1030 if (zi == 0.0 && zr >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1031 yi = 0.0; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1032 } |
3220 | 1033 |
1034 retval = bessel_return_value (Complex (yr, yi), ierr); | |
1035 } | |
1036 else | |
1037 { | |
1038 Complex tmp = zbesk (z, -alpha, kode, ierr); | |
1039 | |
1040 retval = bessel_return_value (tmp, ierr); | |
1041 } | |
3146 | 1042 |
1043 return retval; | |
1044 } | |
1045 | |
3220 | 1046 static inline Complex |
5275 | 1047 zbesh1 (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3146 | 1048 { |
3220 | 1049 Complex retval; |
3146 | 1050 |
3220 | 1051 if (alpha >= 0.0) |
3146 | 1052 { |
3220 | 1053 double yr = 0.0; |
1054 double yi = 0.0; | |
1055 | |
5275 | 1056 octave_idx_type nz; |
3220 | 1057 |
1058 double zr = z.real (); | |
1059 double zi = z.imag (); | |
3146 | 1060 |
4506 | 1061 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 1, 1, &yr, &yi, nz, ierr); |
1062 | |
1063 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1064 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1065 Complex expz = exp (Complex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1066 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1067 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1068 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1069 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1070 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1071 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1072 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1073 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1074 } |
3146 | 1075 |
3220 | 1076 retval = bessel_return_value (Complex (yr, yi), ierr); |
1077 } | |
1078 else | |
1079 { | |
1080 alpha = -alpha; | |
1081 | |
1082 static const Complex eye = Complex (0.0, 1.0); | |
3146 | 1083 |
3220 | 1084 Complex tmp = exp (M_PI * alpha * eye) * zbesh1 (z, alpha, kode, ierr); |
3146 | 1085 |
3220 | 1086 retval = bessel_return_value (tmp, ierr); |
1087 } | |
3146 | 1088 |
3220 | 1089 return retval; |
1090 } | |
3146 | 1091 |
3220 | 1092 static inline Complex |
5275 | 1093 zbesh2 (const Complex& z, double alpha, int kode, octave_idx_type& ierr) |
3220 | 1094 { |
1095 Complex retval; | |
3146 | 1096 |
3220 | 1097 if (alpha >= 0.0) |
1098 { | |
1099 double yr = 0.0; | |
1100 double yi = 0.0; | |
1101 | |
5275 | 1102 octave_idx_type nz; |
3146 | 1103 |
3220 | 1104 double zr = z.real (); |
1105 double zi = z.imag (); | |
3146 | 1106 |
4506 | 1107 F77_FUNC (zbesh, ZBESH) (zr, zi, alpha, 2, 2, 1, &yr, &yi, nz, ierr); |
1108 | |
1109 if (kode != 2) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1110 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1111 Complex expz = exp (-Complex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1112 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1113 double rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1114 double iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1115 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1116 double tmp = yr*rexpz - yi*iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1117 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1118 yi = yr*iexpz + yi*rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1119 yr = tmp; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1120 } |
3220 | 1121 |
1122 retval = bessel_return_value (Complex (yr, yi), ierr); | |
3146 | 1123 } |
1124 else | |
3220 | 1125 { |
1126 alpha = -alpha; | |
1127 | |
1128 static const Complex eye = Complex (0.0, 1.0); | |
1129 | |
1130 Complex tmp = exp (-M_PI * alpha * eye) * zbesh2 (z, alpha, kode, ierr); | |
1131 | |
1132 retval = bessel_return_value (tmp, ierr); | |
1133 } | |
1134 | |
1135 return retval; | |
1136 } | |
1137 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1138 typedef Complex (*dptr) (const Complex&, double, int, octave_idx_type&); |
3220 | 1139 |
1140 static inline Complex | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1141 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
|
1142 bool scaled, octave_idx_type& ierr) |
3220 | 1143 { |
1144 Complex retval; | |
1145 | |
1146 retval = f (x, alpha, (scaled ? 2 : 1), ierr); | |
1147 | |
1148 return retval; | |
1149 } | |
1150 | |
1151 static inline ComplexMatrix | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1152 do_bessel (dptr f, const char *, double alpha, const ComplexMatrix& x, |
10352 | 1153 bool scaled, Array<octave_idx_type>& ierr) |
3220 | 1154 { |
5275 | 1155 octave_idx_type nr = x.rows (); |
1156 octave_idx_type nc = x.cols (); | |
3220 | 1157 |
1158 ComplexMatrix retval (nr, nc); | |
1159 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1160 ierr.resize (dim_vector (nr, nc)); |
3220 | 1161 |
5275 | 1162 for (octave_idx_type j = 0; j < nc; j++) |
1163 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1164 retval(i,j) = f (x(i,j), alpha, (scaled ? 2 : 1), ierr(i,j)); |
1165 | |
1166 return retval; | |
1167 } | |
1168 | |
1169 static inline ComplexMatrix | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1170 do_bessel (dptr f, const char *, const Matrix& alpha, const Complex& x, |
10352 | 1171 bool scaled, Array<octave_idx_type>& ierr) |
3220 | 1172 { |
5275 | 1173 octave_idx_type nr = alpha.rows (); |
1174 octave_idx_type nc = alpha.cols (); | |
3220 | 1175 |
1176 ComplexMatrix retval (nr, nc); | |
1177 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1178 ierr.resize (dim_vector (nr, nc)); |
3220 | 1179 |
5275 | 1180 for (octave_idx_type j = 0; j < nc; j++) |
1181 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1182 retval(i,j) = f (x, alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
3146 | 1183 |
1184 return retval; | |
1185 } | |
1186 | |
3220 | 1187 static inline ComplexMatrix |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1188 do_bessel (dptr f, const char *fn, const Matrix& alpha, |
10352 | 1189 const ComplexMatrix& x, bool scaled, Array<octave_idx_type>& ierr) |
3146 | 1190 { |
3220 | 1191 ComplexMatrix retval; |
1192 | |
5275 | 1193 octave_idx_type x_nr = x.rows (); |
1194 octave_idx_type x_nc = x.cols (); | |
3220 | 1195 |
5275 | 1196 octave_idx_type alpha_nr = alpha.rows (); |
1197 octave_idx_type alpha_nc = alpha.cols (); | |
3220 | 1198 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1199 if (x_nr != alpha_nr || x_nc != alpha_nc) |
3220 | 1200 (*current_liboctave_error_handler) |
1201 ("%s: the sizes of alpha and x must conform", fn); | |
1202 | |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1203 octave_idx_type nr = x_nr; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1204 octave_idx_type nc = x_nc; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1205 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1206 retval.resize (nr, nc); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1207 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1208 ierr.resize (dim_vector (nr, nc)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1209 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1210 for (octave_idx_type j = 0; j < nc; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1211 for (octave_idx_type i = 0; i < nr; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1212 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1213 |
3220 | 1214 return retval; |
3146 | 1215 } |
1216 | |
4844 | 1217 static inline ComplexNDArray |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1218 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
|
1219 bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1220 { |
1221 dim_vector dv = x.dims (); | |
5275 | 1222 octave_idx_type nel = dv.numel (); |
4844 | 1223 ComplexNDArray retval (dv); |
1224 | |
1225 ierr.resize (dv); | |
1226 | |
5275 | 1227 for (octave_idx_type i = 0; i < nel; i++) |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1228 retval(i) = f (x(i), alpha, (scaled ? 2 : 1), ierr(i)); |
4844 | 1229 |
1230 return retval; | |
1231 } | |
1232 | |
1233 static inline ComplexNDArray | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1234 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
|
1235 bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1236 { |
1237 dim_vector dv = alpha.dims (); | |
5275 | 1238 octave_idx_type nel = dv.numel (); |
4844 | 1239 ComplexNDArray retval (dv); |
1240 | |
1241 ierr.resize (dv); | |
1242 | |
5275 | 1243 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 1244 retval(i) = f (x, alpha(i), (scaled ? 2 : 1), ierr(i)); |
1245 | |
1246 return retval; | |
1247 } | |
1248 | |
1249 static inline ComplexNDArray | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1250 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
|
1251 const ComplexNDArray& x, bool scaled, Array<octave_idx_type>& ierr) |
4844 | 1252 { |
1253 dim_vector dv = x.dims (); | |
1254 ComplexNDArray retval; | |
1255 | |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1256 if (dv != alpha.dims ()) |
4844 | 1257 (*current_liboctave_error_handler) |
1258 ("%s: the sizes of alpha and x must conform", fn); | |
1259 | |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1260 octave_idx_type nel = dv.numel (); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1261 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1262 retval.resize (dv); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1263 ierr.resize (dv); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1264 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1265 for (octave_idx_type i = 0; i < nel; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1266 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1267 |
4844 | 1268 return retval; |
1269 } | |
1270 | |
3220 | 1271 static inline ComplexMatrix |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1272 do_bessel (dptr f, const char *, const RowVector& alpha, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1273 const ComplexColumnVector& x, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1274 Array<octave_idx_type>& ierr) |
3146 | 1275 { |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
1276 octave_idx_type nr = x.numel (); |
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
1277 octave_idx_type nc = alpha.numel (); |
3220 | 1278 |
1279 ComplexMatrix retval (nr, nc); | |
3146 | 1280 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1281 ierr.resize (dim_vector (nr, nc)); |
3220 | 1282 |
5275 | 1283 for (octave_idx_type j = 0; j < nc; j++) |
1284 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 1285 retval(i,j) = f (x(i), alpha(j), (scaled ? 2 : 1), ierr(i,j)); |
1286 | |
1287 return retval; | |
3146 | 1288 } |
1289 | |
3220 | 1290 #define SS_BESSEL(name, fcn) \ |
1291 Complex \ | |
5275 | 1292 name (double alpha, const Complex& x, bool scaled, octave_idx_type& ierr) \ |
3220 | 1293 { \ |
1294 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1295 } | |
1296 | |
1297 #define SM_BESSEL(name, fcn) \ | |
1298 ComplexMatrix \ | |
1299 name (double alpha, const ComplexMatrix& x, bool scaled, \ | |
10352 | 1300 Array<octave_idx_type>& ierr) \ |
3220 | 1301 { \ |
1302 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1303 } | |
1304 | |
1305 #define MS_BESSEL(name, fcn) \ | |
1306 ComplexMatrix \ | |
1307 name (const Matrix& alpha, const Complex& x, bool scaled, \ | |
10352 | 1308 Array<octave_idx_type>& ierr) \ |
3220 | 1309 { \ |
1310 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1311 } | |
1312 | |
1313 #define MM_BESSEL(name, fcn) \ | |
1314 ComplexMatrix \ | |
1315 name (const Matrix& alpha, const ComplexMatrix& x, bool scaled, \ | |
10352 | 1316 Array<octave_idx_type>& ierr) \ |
3220 | 1317 { \ |
1318 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1319 } | |
1320 | |
4844 | 1321 #define SN_BESSEL(name, fcn) \ |
1322 ComplexNDArray \ | |
1323 name (double alpha, const ComplexNDArray& x, bool scaled, \ | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1324 Array<octave_idx_type>& ierr) \ |
4844 | 1325 { \ |
1326 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1327 } | |
1328 | |
1329 #define NS_BESSEL(name, fcn) \ | |
1330 ComplexNDArray \ | |
1331 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
|
1332 Array<octave_idx_type>& ierr) \ |
4844 | 1333 { \ |
1334 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1335 } | |
1336 | |
1337 #define NN_BESSEL(name, fcn) \ | |
1338 ComplexNDArray \ | |
1339 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
|
1340 Array<octave_idx_type>& ierr) \ |
4844 | 1341 { \ |
1342 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1343 } | |
1344 | |
3220 | 1345 #define RC_BESSEL(name, fcn) \ |
1346 ComplexMatrix \ | |
1347 name (const RowVector& alpha, const ComplexColumnVector& x, bool scaled, \ | |
10352 | 1348 Array<octave_idx_type>& ierr) \ |
3220 | 1349 { \ |
1350 return do_bessel (fcn, #name, alpha, x, scaled, ierr); \ | |
1351 } | |
1352 | |
1353 #define ALL_BESSEL(name, fcn) \ | |
1354 SS_BESSEL (name, fcn) \ | |
1355 SM_BESSEL (name, fcn) \ | |
1356 MS_BESSEL (name, fcn) \ | |
1357 MM_BESSEL (name, fcn) \ | |
4844 | 1358 SN_BESSEL (name, fcn) \ |
1359 NS_BESSEL (name, fcn) \ | |
1360 NN_BESSEL (name, fcn) \ | |
3220 | 1361 RC_BESSEL (name, fcn) |
1362 | |
1363 ALL_BESSEL (besselj, zbesj) | |
1364 ALL_BESSEL (bessely, zbesy) | |
1365 ALL_BESSEL (besseli, zbesi) | |
1366 ALL_BESSEL (besselk, zbesk) | |
1367 ALL_BESSEL (besselh1, zbesh1) | |
1368 ALL_BESSEL (besselh2, zbesh2) | |
1369 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1370 #undef ALL_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1371 #undef SS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1372 #undef SM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1373 #undef MS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1374 #undef MM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1375 #undef SN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1376 #undef NS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1377 #undef NN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1378 #undef RC_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1379 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1380 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1381 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
|
1382 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1383 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1384 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
|
1385 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1386 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1387 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
|
1388 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1389 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1390 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
|
1391 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1392 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1393 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
|
1394 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1395 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1396 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
|
1397 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1398 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1399 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
|
1400 { |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1401 static const FloatComplex inf_val = FloatComplex (octave_Float_Inf, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1402 octave_Float_Inf); |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1403 static const FloatComplex nan_val = FloatComplex (octave_Float_NaN, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1404 octave_Float_NaN); |
7789
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 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1407 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1408 switch (ierr) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1409 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1410 case 0: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1411 case 3: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1412 retval = val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1413 break; |
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 case 2: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1416 retval = inf_val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1417 break; |
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 default: |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1420 retval = nan_val; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1421 break; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1422 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1423 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1424 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1425 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1426 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1427 static inline bool |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1428 is_integer_value (float x) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1429 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1430 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
|
1431 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1432 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1433 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1434 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
|
1435 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1436 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1437 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1438 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1439 { |
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
|
1440 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1441 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1442 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1443 |
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
|
1444 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
|
1445 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1446 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1447 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1448 float expz = exp (std::abs (imag (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1449 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1450 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1451 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1452 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
|
1453 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
|
1454 |
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1455 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1456 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1457 else if (is_integer_value (alpha)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1458 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1459 // 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
|
1460 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1461 FloatComplex tmp = cbesj (z, alpha, kode, ierr); |
19739
3fa35defe495
Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents:
19697
diff
changeset
|
1462 if ((static_cast<long> (alpha)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1463 tmp = - tmp; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1464 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1465 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1466 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1467 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1468 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1469 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1470 FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1471 * cbesj (z, alpha, kode, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1472 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1473 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1474 { |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1475 tmp -= sinf (static_cast<float> (M_PI) * alpha) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1476 * cbesy (z, alpha, kode, ierr); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1477 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1478 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1479 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1480 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1481 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
|
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 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1485 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1486 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1487 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1488 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
|
1489 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1490 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1491 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1492 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1493 { |
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
|
1494 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1495 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1496 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1497 |
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
|
1498 FloatComplex w; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1499 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1500 ierr = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1501 |
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
|
1502 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
|
1503 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1504 y = FloatComplex (-octave_Float_Inf, 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1505 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1506 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1507 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1508 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
|
1509 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1510 if (kode != 2) |
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 expz = exp (std::abs (imag (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1513 y *= expz; |
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 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1516 if (imag (z) == 0.0 && real (z) >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1517 y = FloatComplex (y.real (), 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1518 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1519 |
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
|
1520 return bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1521 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1522 else if (is_integer_value (alpha - 0.5)) |
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 // 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
|
1525 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1526 FloatComplex tmp = cbesj (z, alpha, kode, ierr); |
19739
3fa35defe495
Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents:
19697
diff
changeset
|
1527 if ((static_cast<long> (alpha - 0.5)) & 1) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1528 tmp = - tmp; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1529 retval = bessel_return_value (tmp, ierr); |
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 else |
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 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1534 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1535 FloatComplex tmp = cosf (static_cast<float> (M_PI) * alpha) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1536 * cbesy (z, alpha, kode, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1537 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1538 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1539 { |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1540 tmp += sinf (static_cast<float> (M_PI) * alpha) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1541 * cbesj (z, alpha, kode, ierr); |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1542 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1543 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1544 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1545 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1546 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
|
1547 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1548 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1549 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1550 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1551 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1552 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1553 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
|
1554 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1555 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1556 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1557 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1558 { |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1559 FloatComplex y = 0.0; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1560 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1561 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1562 |
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
|
1563 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
|
1564 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1565 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1566 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1567 float expz = exp (std::abs (real (z))); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1568 y *= expz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1569 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1570 |
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
|
1571 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
|
1572 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
|
1573 |
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
|
1574 retval = bessel_return_value (y, ierr); |
7789
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 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1577 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1578 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1579 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1580 FloatComplex tmp = cbesi (z, alpha, kode, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1581 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1582 if (ierr == 0 || ierr == 3) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1583 { |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1584 FloatComplex tmp2 = static_cast<float> (2.0 / M_PI) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1585 * sinf (static_cast<float> (M_PI) * alpha) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1586 * cbesk (z, alpha, kode, ierr); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1587 |
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
1588 if (kode == 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1589 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1590 // Compensate for different scaling factor of besk. |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
1591 tmp2 *= exp (-z - std::abs (z.real ())); |
10314
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 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1594 tmp += tmp2; |
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 retval = bessel_return_value (tmp, ierr); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1597 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1598 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1599 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
|
1600 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1601 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1602 return retval; |
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 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1605 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1606 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
|
1607 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1608 FloatComplex retval; |
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 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1611 { |
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
|
1612 FloatComplex y = 0.0; |
7789
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 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1615 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1616 ierr = 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1617 |
8279
b3734f1cb592
lo-specfun.cc: fix prototypes and calls to cbes{h,i,j,k,y} subroutines
John W. Eaton <jwe@octave.org>
parents:
8278
diff
changeset
|
1618 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
|
1619 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1620 y = FloatComplex (octave_Float_Inf, 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1621 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1622 else |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1623 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1624 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
|
1625 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1626 if (kode != 2) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1627 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1628 FloatComplex expz = exp (-z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1629 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1630 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1631 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1632 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1633 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1634 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1635 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1636 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1637 } |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1638 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1639 if (imag (z) == 0.0 && real (z) >= 0.0) |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1640 y = FloatComplex (y.real (), 0.0); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1641 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1642 |
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
|
1643 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1644 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1645 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1646 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1647 FloatComplex tmp = cbesk (z, -alpha, kode, ierr); |
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 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1650 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1651 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1652 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1653 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1654 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1655 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1656 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
|
1657 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1658 FloatComplex retval; |
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 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1661 { |
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
|
1662 FloatComplex y = 0.0; |
7789
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 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1665 |
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
|
1666 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
|
1667 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1668 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1669 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1670 FloatComplex expz = exp (FloatComplex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1671 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1672 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1673 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1674 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1675 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1676 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1677 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1678 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1679 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1680 |
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
|
1681 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1682 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1683 else |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1684 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1685 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1686 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1687 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
|
1688 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1689 FloatComplex tmp = exp (static_cast<float> (M_PI) * alpha * eye) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1690 * cbesh1 (z, alpha, kode, ierr); |
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 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1693 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1694 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1695 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1696 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1697 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1698 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1699 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
|
1700 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1701 FloatComplex retval; |
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 if (alpha >= 0.0) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1704 { |
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
|
1705 FloatComplex y = 0.0; |
7789
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 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1708 |
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
|
1709 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
|
1710 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1711 if (kode != 2) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1712 { |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1713 FloatComplex expz = exp (-FloatComplex (0.0, 1.0) * z); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1714 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1715 float rexpz = real (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1716 float iexpz = imag (expz); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1717 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1718 float tmp_r = real (y) * rexpz - imag (y) * iexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1719 float tmp_i = real (y) * iexpz + imag (y) * rexpz; |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1720 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1721 y = FloatComplex (tmp_r, tmp_i); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1722 } |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1723 |
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
|
1724 retval = bessel_return_value (y, ierr); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1725 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1726 else |
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 alpha = -alpha; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1729 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1730 static const FloatComplex eye = FloatComplex (0.0, 1.0); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1731 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1732 FloatComplex tmp = exp (-static_cast<float> (M_PI) * alpha * eye) |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1733 * cbesh2 (z, alpha, kode, 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 retval = bessel_return_value (tmp, ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1736 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1737 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1738 return retval; |
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 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1741 typedef FloatComplex (*fptr) (const FloatComplex&, float, int, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1742 octave_idx_type&); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1743 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1744 static inline FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1745 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
|
1746 bool scaled, octave_idx_type& ierr) |
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 FloatComplex retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1749 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1750 retval = f (x, alpha, (scaled ? 2 : 1), ierr); |
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 *, float alpha, const FloatComplexMatrix& x, |
10352 | 1757 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.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1760 octave_idx_type nc = x.cols (); |
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 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1764 ierr.resize (dim_vector (nr, nc)); |
7789
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,j), alpha, (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 static inline FloatComplexMatrix |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1774 do_bessel (fptr f, const char *, const FloatMatrix& alpha, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1775 const FloatComplex& x, |
10352 | 1776 bool scaled, Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1777 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1778 octave_idx_type nr = alpha.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1779 octave_idx_type nc = alpha.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1780 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1781 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1782 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1783 ierr.resize (dim_vector (nr, nc)); |
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 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
|
1786 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
|
1787 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
|
1788 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1789 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1790 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1791 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1792 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1793 do_bessel (fptr f, const char *fn, const FloatMatrix& alpha, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1794 const FloatComplexMatrix& x, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1795 Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1796 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1797 FloatComplexMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1798 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1799 octave_idx_type x_nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1800 octave_idx_type x_nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1801 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1802 octave_idx_type alpha_nr = alpha.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1803 octave_idx_type alpha_nc = alpha.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1804 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1805 if (x_nr != alpha_nr || x_nc != alpha_nc) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1806 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1807 ("%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
|
1808 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1809 octave_idx_type nr = x_nr; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1810 octave_idx_type nc = x_nc; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1811 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1812 retval.resize (nr, nc); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1813 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1814 ierr.resize (dim_vector (nr, nc)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1815 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1816 for (octave_idx_type j = 0; j < nc; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1817 for (octave_idx_type i = 0; i < nr; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1818 retval(i,j) = f (x(i,j), alpha(i,j), (scaled ? 2 : 1), ierr(i,j)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1819 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1820 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1821 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1822 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1823 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1824 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
|
1825 bool scaled, Array<octave_idx_type>& ierr) |
7789
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 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1828 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1829 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1830 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1831 ierr.resize (dv); |
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 for (octave_idx_type i = 0; i < nel; i++) |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1834 retval(i) = f (x(i), alpha, (scaled ? 2 : 1), ierr(i)); |
7789
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 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1837 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1838 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1839 static inline FloatComplexNDArray |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1840 do_bessel (fptr f, const char *, const FloatNDArray& alpha, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1841 const FloatComplex& 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
|
1842 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1843 dim_vector dv = alpha.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1844 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1845 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1846 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1847 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1848 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1849 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
|
1850 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
|
1851 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1852 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1853 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1854 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1855 static inline FloatComplexNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1856 do_bessel (fptr f, const char *fn, const FloatNDArray& alpha, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1857 const FloatComplexNDArray& x, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1858 Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1859 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1860 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1861 FloatComplexNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1862 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1863 if (dv != alpha.dims ()) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1864 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1865 ("%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
|
1866 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1867 octave_idx_type nel = dv.numel (); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1868 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1869 retval.resize (dv); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1870 ierr.resize (dv); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1871 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1872 for (octave_idx_type i = 0; i < nel; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1873 retval(i) = f (x(i), alpha(i), (scaled ? 2 : 1), ierr(i)); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
1874 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1875 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1876 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1877 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1878 static inline FloatComplexMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1879 do_bessel (fptr f, const char *, const FloatRowVector& alpha, |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1880 const FloatComplexColumnVector& x, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
1881 Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1882 { |
20232
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
1883 octave_idx_type nr = x.numel (); |
a9574e3c6e9e
Deprecate Array::length() and Sparse::length() in favour of ::numel().
Carnë Draug <carandraug@octave.org>
parents:
20230
diff
changeset
|
1884 octave_idx_type nc = alpha.numel (); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1885 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1886 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1887 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
1888 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1889 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1890 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
|
1891 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
|
1892 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
|
1893 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1894 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1895 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1896 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1897 #define SS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1898 FloatComplex \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1899 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
|
1900 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1901 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
|
1902 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1903 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1904 #define SM_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1905 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1906 name (float alpha, const FloatComplexMatrix& x, bool scaled, \ |
10352 | 1907 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1908 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1909 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
|
1910 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1911 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1912 #define MS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1913 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1914 name (const FloatMatrix& alpha, const FloatComplex& x, bool scaled, \ |
10352 | 1915 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1916 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1917 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
|
1918 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1919 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1920 #define MM_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1921 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1922 name (const FloatMatrix& alpha, const FloatComplexMatrix& x, bool scaled, \ |
10352 | 1923 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1924 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1925 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
|
1926 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1927 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1928 #define SN_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1929 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1930 name (float alpha, const FloatComplexNDArray& x, bool scaled, \ |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
1931 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1932 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1933 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
|
1934 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1935 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1936 #define NS_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1937 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1938 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
|
1939 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1940 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1941 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
|
1942 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1943 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1944 #define NN_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1945 FloatComplexNDArray \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1946 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
|
1947 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1948 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1949 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
|
1950 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1951 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1952 #define RC_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1953 FloatComplexMatrix \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1954 name (const FloatRowVector& alpha, const FloatComplexColumnVector& x, bool scaled, \ |
10352 | 1955 Array<octave_idx_type>& ierr) \ |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1956 { \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1957 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
|
1958 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1959 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1960 #define ALL_BESSEL(name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1961 SS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1962 SM_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1963 MS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1964 MM_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1965 SN_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1966 NS_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1967 NN_BESSEL (name, fcn) \ |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1968 RC_BESSEL (name, fcn) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1969 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1970 ALL_BESSEL (besselj, cbesj) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1971 ALL_BESSEL (bessely, cbesy) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1972 ALL_BESSEL (besseli, cbesi) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1973 ALL_BESSEL (besselk, cbesk) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1974 ALL_BESSEL (besselh1, cbesh1) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1975 ALL_BESSEL (besselh2, cbesh2) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1976 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1977 #undef ALL_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1978 #undef SS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1979 #undef SM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1980 #undef MS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1981 #undef MM_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1982 #undef SN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1983 #undef NS_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1984 #undef NN_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1985 #undef RC_BESSEL |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
1986 |
3220 | 1987 Complex |
5275 | 1988 airy (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
3146 | 1989 { |
3220 | 1990 double ar = 0.0; |
1991 double ai = 0.0; | |
1992 | |
5275 | 1993 octave_idx_type nz; |
3220 | 1994 |
1995 double zr = z.real (); | |
1996 double zi = z.imag (); | |
3146 | 1997 |
5275 | 1998 octave_idx_type id = deriv ? 1 : 0; |
3220 | 1999 |
4506 | 2000 F77_FUNC (zairy, ZAIRY) (zr, zi, id, 2, ar, ai, nz, ierr); |
2001 | |
2002 if (! scaled) | |
2003 { | |
15018
3d8ace26c5b4
maint: Use Octave coding conventions for cuddled parentheses in liboctave/.
Rik <rik@octave.org>
parents:
14847
diff
changeset
|
2004 Complex expz = exp (- 2.0 / 3.0 * z * sqrt (z)); |
3220 | 2005 |
4506 | 2006 double rexpz = real (expz); |
2007 double iexpz = imag (expz); | |
2008 | |
2009 double tmp = ar*rexpz - ai*iexpz; | |
2010 | |
2011 ai = ar*iexpz + ai*rexpz; | |
2012 ar = tmp; | |
2013 } | |
3220 | 2014 |
4490 | 2015 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
3225 | 2016 ai = 0.0; |
2017 | |
3220 | 2018 return bessel_return_value (Complex (ar, ai), ierr); |
3146 | 2019 } |
2020 | |
3220 | 2021 Complex |
5275 | 2022 biry (const Complex& z, bool deriv, bool scaled, octave_idx_type& ierr) |
3146 | 2023 { |
3220 | 2024 double ar = 0.0; |
2025 double ai = 0.0; | |
2026 | |
2027 double zr = z.real (); | |
2028 double zi = z.imag (); | |
2029 | |
5275 | 2030 octave_idx_type id = deriv ? 1 : 0; |
3220 | 2031 |
4506 | 2032 F77_FUNC (zbiry, ZBIRY) (zr, zi, id, 2, ar, ai, ierr); |
2033 | |
2034 if (! scaled) | |
2035 { | |
2036 Complex expz = exp (std::abs (real (2.0 / 3.0 * z * sqrt (z)))); | |
3220 | 2037 |
4506 | 2038 double rexpz = real (expz); |
2039 double iexpz = imag (expz); | |
2040 | |
2041 double tmp = ar*rexpz - ai*iexpz; | |
2042 | |
2043 ai = ar*iexpz + ai*rexpz; | |
2044 ar = tmp; | |
2045 } | |
3220 | 2046 |
4490 | 2047 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
3225 | 2048 ai = 0.0; |
2049 | |
3220 | 2050 return bessel_return_value (Complex (ar, ai), ierr); |
3146 | 2051 } |
2052 | |
3220 | 2053 ComplexMatrix |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2054 airy (const ComplexMatrix& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2055 Array<octave_idx_type>& ierr) |
3146 | 2056 { |
5275 | 2057 octave_idx_type nr = z.rows (); |
2058 octave_idx_type nc = z.cols (); | |
3220 | 2059 |
2060 ComplexMatrix retval (nr, nc); | |
2061 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2062 ierr.resize (dim_vector (nr, nc)); |
3220 | 2063 |
5275 | 2064 for (octave_idx_type j = 0; j < nc; j++) |
2065 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 2066 retval(i,j) = airy (z(i,j), deriv, scaled, ierr(i,j)); |
2067 | |
2068 return retval; | |
3146 | 2069 } |
2070 | |
3220 | 2071 ComplexMatrix |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2072 biry (const ComplexMatrix& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2073 Array<octave_idx_type>& ierr) |
3146 | 2074 { |
5275 | 2075 octave_idx_type nr = z.rows (); |
2076 octave_idx_type nc = z.cols (); | |
3220 | 2077 |
2078 ComplexMatrix retval (nr, nc); | |
2079 | |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2080 ierr.resize (dim_vector (nr, nc)); |
3220 | 2081 |
5275 | 2082 for (octave_idx_type j = 0; j < nc; j++) |
2083 for (octave_idx_type i = 0; i < nr; i++) | |
3220 | 2084 retval(i,j) = biry (z(i,j), deriv, scaled, ierr(i,j)); |
2085 | |
2086 return retval; | |
3146 | 2087 } |
2088 | |
4844 | 2089 ComplexNDArray |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2090 airy (const ComplexNDArray& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2091 Array<octave_idx_type>& ierr) |
4844 | 2092 { |
2093 dim_vector dv = z.dims (); | |
5275 | 2094 octave_idx_type nel = dv.numel (); |
4844 | 2095 ComplexNDArray retval (dv); |
2096 | |
2097 ierr.resize (dv); | |
2098 | |
5275 | 2099 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
2100 retval(i) = airy (z(i), deriv, scaled, ierr(i)); |
4844 | 2101 |
2102 return retval; | |
2103 } | |
2104 | |
2105 ComplexNDArray | |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2106 biry (const ComplexNDArray& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2107 Array<octave_idx_type>& ierr) |
4844 | 2108 { |
2109 dim_vector dv = z.dims (); | |
5275 | 2110 octave_idx_type nel = dv.numel (); |
4844 | 2111 ComplexNDArray retval (dv); |
2112 | |
2113 ierr.resize (dv); | |
2114 | |
5275 | 2115 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
2116 retval(i) = biry (z(i), deriv, scaled, ierr(i)); |
4844 | 2117 |
2118 return retval; | |
2119 } | |
2120 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2121 FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2122 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
|
2123 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2124 float ar = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2125 float ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2126 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2127 octave_idx_type nz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2128 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2129 float zr = z.real (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2130 float zi = z.imag (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2131 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2132 octave_idx_type id = deriv ? 1 : 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2133 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2134 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
|
2135 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2136 if (! scaled) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2137 { |
19739
3fa35defe495
Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents:
19697
diff
changeset
|
2138 FloatComplex expz = exp (- 2.0f / 3.0f * z * sqrt (z)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2139 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2140 float rexpz = real (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2141 float iexpz = imag (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2142 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2143 float tmp = ar*rexpz - ai*iexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2144 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2145 ai = ar*iexpz + ai*rexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2146 ar = tmp; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2147 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2148 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2149 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2150 ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2151 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2152 return bessel_return_value (FloatComplex (ar, ai), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2153 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2154 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2155 FloatComplex |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2156 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
|
2157 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2158 float ar = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2159 float ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2160 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2161 float zr = z.real (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2162 float zi = z.imag (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2163 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2164 octave_idx_type id = deriv ? 1 : 0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2165 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2166 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
|
2167 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2168 if (! scaled) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2169 { |
19739
3fa35defe495
Adjust spacing of static_cast<> calls to follow Octave coding conventions.
Rik <rik@octave.org>
parents:
19697
diff
changeset
|
2170 FloatComplex expz = exp (std::abs (real (2.0f / 3.0f * z * sqrt (z)))); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2171 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2172 float rexpz = real (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2173 float iexpz = imag (expz); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2174 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2175 float tmp = ar*rexpz - ai*iexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2176 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2177 ai = ar*iexpz + ai*rexpz; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2178 ar = tmp; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2179 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2180 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2181 if (zi == 0.0 && (! scaled || zr >= 0.0)) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2182 ai = 0.0; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2183 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2184 return bessel_return_value (FloatComplex (ar, ai), ierr); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2185 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2186 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2187 FloatComplexMatrix |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2188 airy (const FloatComplexMatrix& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2189 Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2190 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2191 octave_idx_type nr = z.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2192 octave_idx_type nc = z.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2193 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2194 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2195 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2196 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2197 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2198 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
|
2199 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
|
2200 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
|
2201 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2202 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2203 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2204 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2205 FloatComplexMatrix |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2206 biry (const FloatComplexMatrix& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2207 Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2208 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2209 octave_idx_type nr = z.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2210 octave_idx_type nc = z.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2211 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2212 FloatComplexMatrix retval (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2213 |
11574
a83bad07f7e3
attempt better backward compatibility for Array resize functions
John W. Eaton <jwe@octave.org>
parents:
11523
diff
changeset
|
2214 ierr.resize (dim_vector (nr, nc)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2215 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2216 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
|
2217 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
|
2218 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
|
2219 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2220 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2221 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2222 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2223 FloatComplexNDArray |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2224 airy (const FloatComplexNDArray& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2225 Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2226 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2227 dim_vector dv = z.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2228 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2229 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2230 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2231 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2232 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2233 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
2234 retval(i) = airy (z(i), deriv, scaled, ierr(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2235 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2236 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2237 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2238 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2239 FloatComplexNDArray |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2240 biry (const FloatComplexNDArray& z, bool deriv, bool scaled, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2241 Array<octave_idx_type>& ierr) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2242 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2243 dim_vector dv = z.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2244 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2245 FloatComplexNDArray retval (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2246 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2247 ierr.resize (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2248 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2249 for (octave_idx_type i = 0; i < nel; i++) |
14844
5bc9b9cb4362
maint: Use Octave coding conventions for cuddled parenthesis in retval assignments.
Rik <octave@nomad.inbox5.com>
parents:
14817
diff
changeset
|
2250 retval(i) = biry (z(i), deriv, scaled, ierr(i)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2251 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2252 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2253 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2254 |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2255 OCTAVE_NORETURN static void |
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2256 err_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
|
2257 const dim_vector& d3) |
4844 | 2258 { |
2259 std::string d1_str = d1.str (); | |
2260 std::string d2_str = d2.str (); | |
2261 std::string d3_str = d3.str (); | |
2262 | |
2263 (*current_liboctave_error_handler) | |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2264 ("betainc: nonconformant arguments (x is %s, a is %s, b is %s)", |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2265 d1_str.c_str (), d2_str.c_str (), d3_str.c_str ()); |
4844 | 2266 } |
2267 | |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2268 OCTAVE_NORETURN static void |
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2269 err_betaincinv_nonconformant (const dim_vector& d1, const dim_vector& d2, |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2270 const dim_vector& d3) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2271 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2272 std::string d1_str = d1.str (); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2273 std::string d2_str = d2.str (); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2274 std::string d3_str = d3.str (); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2275 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2276 (*current_liboctave_error_handler) |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2277 ("betaincinv: nonconformant arguments (x is %s, a is %s, b is %s)", |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2278 d1_str.c_str (), d2_str.c_str (), d3_str.c_str ()); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2279 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2280 |
3146 | 2281 double |
2282 betainc (double x, double a, double b) | |
2283 { | |
2284 double retval; | |
5700 | 2285 F77_XFCN (xdbetai, XDBETAI, (x, a, b, retval)); |
3146 | 2286 return retval; |
2287 } | |
2288 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2289 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2290 betainc (double x, double a, const Array<double>& b) |
3146 | 2291 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2292 dim_vector dv = b.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2293 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2294 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2295 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2296 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2297 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2298 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2299 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2300 *pretval++ = betainc (x, a, b(i)); |
3146 | 2301 |
2302 return retval; | |
2303 } | |
2304 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2305 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2306 betainc (double x, const Array<double>& a, double b) |
3146 | 2307 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2308 dim_vector dv = a.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2309 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2310 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2311 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2312 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2313 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2314 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2315 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2316 *pretval++ = betainc (x, a(i), b); |
3146 | 2317 |
2318 return retval; | |
2319 } | |
2320 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2321 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2322 betainc (double x, const Array<double>& a, const Array<double>& b) |
4844 | 2323 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2324 Array<double> retval; |
4844 | 2325 dim_vector dv = a.dims (); |
2326 | |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2327 if (dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2328 err_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2329 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2330 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2331 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2332 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2333 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2334 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2335 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2336 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2337 *pretval++ = betainc (x, a(i), b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2338 |
4844 | 2339 return retval; |
2340 } | |
2341 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2342 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2343 betainc (const Array<double>& x, double a, double b) |
3146 | 2344 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2345 dim_vector dv = x.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2346 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2347 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2348 Array<double> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2349 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2350 double *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2351 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2352 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2353 *pretval++ = betainc (x(i), a, b); |
3146 | 2354 |
2355 return retval; | |
2356 } | |
2357 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2358 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2359 betainc (const Array<double>& x, double a, const Array<double>& b) |
3146 | 2360 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2361 Array<double> retval; |
4844 | 2362 dim_vector dv = x.dims (); |
2363 | |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2364 if (dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2365 err_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2366 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2367 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2368 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2369 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2370 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2371 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2372 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2373 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2374 *pretval++ = betainc (x(i), a, b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2375 |
4844 | 2376 return retval; |
2377 } | |
2378 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2379 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2380 betainc (const Array<double>& x, const Array<double>& a, double b) |
4844 | 2381 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2382 Array<double> retval; |
4844 | 2383 dim_vector dv = x.dims (); |
2384 | |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2385 if (dv != a.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2386 err_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2387 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2388 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2389 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2390 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2391 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2392 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2393 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2394 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2395 *pretval++ = betainc (x(i), a(i), b); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2396 |
4844 | 2397 return retval; |
2398 } | |
2399 | |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2400 Array<double> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2401 betainc (const Array<double>& x, const Array<double>& a, const Array<double>& b) |
4844 | 2402 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2403 Array<double> retval; |
4844 | 2404 dim_vector dv = x.dims (); |
2405 | |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2406 if (dv != a.dims () || dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2407 err_betainc_nonconformant (dv, a.dims (), b.dims ()); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2408 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2409 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2410 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2411 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2412 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2413 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2414 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2415 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2416 *pretval++ = betainc (x(i), a(i), b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2417 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2418 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2419 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2420 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2421 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2422 betainc (float x, float a, float b) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2423 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2424 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2425 F77_XFCN (xbetai, XBETAI, (x, a, b, retval)); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2426 return retval; |
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 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2429 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2430 betainc (float x, float a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2431 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2432 dim_vector dv = b.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2433 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2434 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2435 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2436 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2437 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2438 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2439 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2440 *pretval++ = betainc (x, a, b(i)); |
7789
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 return retval; |
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 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2445 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2446 betainc (float x, const Array<float>& a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2447 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2448 dim_vector dv = a.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2449 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2450 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2451 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2452 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2453 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2454 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2455 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2456 *pretval++ = betainc (x, a(i), b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2457 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2458 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2459 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2460 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2461 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2462 betainc (float x, const Array<float>& a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2463 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2464 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2465 dim_vector dv = a.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2466 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2467 if (dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2468 err_betainc_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2469 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2470 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2471 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2472 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2473 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2474 float *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2475 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2476 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2477 *pretval++ = betainc (x, a(i), b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2478 |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2479 return retval; |
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 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2482 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2483 betainc (const Array<float>& x, float a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2484 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2485 dim_vector dv = x.dims (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2486 octave_idx_type nel = dv.numel (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2487 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2488 Array<float> retval (dv); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2489 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2490 float *pretval = retval.fortran_vec (); |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2491 |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2492 for (octave_idx_type i = 0; i < nel; i++) |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2493 *pretval++ = betainc (x(i), a, b); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2494 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2495 return retval; |
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 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2498 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2499 betainc (const Array<float>& x, float a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2500 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2501 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2502 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2503 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2504 if (dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2505 err_betainc_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2506 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2507 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2508 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2509 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2510 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2511 float *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2512 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2513 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2514 *pretval++ = betainc (x(i), a, b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2515 |
7789
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 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2519 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2520 betainc (const Array<float>& x, const Array<float>& a, float b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2521 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2522 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2523 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2524 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2525 if (dv != a.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2526 err_betainc_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2527 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2528 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2529 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2530 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2531 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2532 float *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2533 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2534 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2535 *pretval++ = betainc (x(i), a(i), b); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2536 |
7789
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 |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2540 Array<float> |
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2541 betainc (const Array<float>& x, const Array<float>& a, const Array<float>& b) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2542 { |
14815
95b93a728603
Use Array superclass, rather than Matrix or NDArray, for betainc function.
Rik <octave@nomad.inbox5.com>
parents:
14786
diff
changeset
|
2543 Array<float> retval; |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2544 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2545 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2546 if (dv != a.dims () || dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
2547 err_betainc_nonconformant (dv, a.dims (), b.dims ()); |
4844 | 2548 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2549 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2550 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2551 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2552 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2553 float *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2554 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2555 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2556 *pretval++ = betainc (x(i), a(i), b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
2557 |
4844 | 2558 return retval; |
2559 } | |
2560 | |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2561 // FIXME: there is still room for improvement here... |
3164 | 2562 |
3146 | 2563 double |
4004 | 2564 gammainc (double x, double a, bool& err) |
3146 | 2565 { |
2566 double retval; | |
3164 | 2567 |
4004 | 2568 err = false; |
3164 | 2569 |
4004 | 2570 if (a < 0.0 || x < 0.0) |
18676
5bd1ca29c5f0
Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents:
18084
diff
changeset
|
2571 (*current_liboctave_error_handler) |
5bd1ca29c5f0
Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents:
18084
diff
changeset
|
2572 ("gammainc: A and X must be non-negative"); |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2573 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2574 F77_XFCN (xgammainc, XGAMMAINC, (a, x, retval)); |
3164 | 2575 |
3146 | 2576 return retval; |
2577 } | |
2578 | |
2579 Matrix | |
2580 gammainc (double x, const Matrix& a) | |
2581 { | |
5275 | 2582 octave_idx_type nr = a.rows (); |
2583 octave_idx_type nc = a.cols (); | |
3146 | 2584 |
4004 | 2585 Matrix result (nr, nc); |
2586 Matrix retval; | |
2587 | |
2588 bool err; | |
3146 | 2589 |
5275 | 2590 for (octave_idx_type j = 0; j < nc; j++) |
2591 for (octave_idx_type i = 0; i < nr; i++) | |
4004 | 2592 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2593 result(i,j) = gammainc (x, a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2594 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2595 if (err) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2596 goto done; // FIXME: why not just use return to exit? |
4004 | 2597 } |
2598 | |
2599 retval = result; | |
2600 | |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2601 done: |
3146 | 2602 |
2603 return retval; | |
2604 } | |
2605 | |
2606 Matrix | |
2607 gammainc (const Matrix& x, double a) | |
2608 { | |
5275 | 2609 octave_idx_type nr = x.rows (); |
2610 octave_idx_type nc = x.cols (); | |
3146 | 2611 |
4004 | 2612 Matrix result (nr, nc); |
2613 Matrix retval; | |
2614 | |
2615 bool err; | |
3146 | 2616 |
5275 | 2617 for (octave_idx_type j = 0; j < nc; j++) |
2618 for (octave_idx_type i = 0; i < nr; i++) | |
4004 | 2619 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2620 result(i,j) = gammainc (x(i,j), a, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2621 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2622 if (err) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2623 goto done; // FIXME: why not just use return to exit? |
4004 | 2624 } |
2625 | |
2626 retval = result; | |
2627 | |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2628 done: |
3146 | 2629 |
2630 return retval; | |
2631 } | |
2632 | |
2633 Matrix | |
2634 gammainc (const Matrix& x, const Matrix& a) | |
2635 { | |
4004 | 2636 Matrix result; |
3146 | 2637 Matrix retval; |
2638 | |
5275 | 2639 octave_idx_type nr = x.rows (); |
2640 octave_idx_type nc = x.cols (); | |
3146 | 2641 |
5275 | 2642 octave_idx_type a_nr = a.rows (); |
2643 octave_idx_type a_nc = a.cols (); | |
3146 | 2644 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2645 if (nr != a_nr || nc != a_nc) |
3146 | 2646 (*current_liboctave_error_handler) |
2647 ("gammainc: nonconformant arguments (arg 1 is %dx%d, arg 2 is %dx%d)", | |
2648 nr, nc, a_nr, a_nc); | |
2649 | |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2650 result.resize (nr, nc); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2651 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2652 bool err; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2653 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2654 for (octave_idx_type j = 0; j < nc; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2655 for (octave_idx_type i = 0; i < nr; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2656 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2657 result(i,j) = gammainc (x(i,j), a(i,j), err); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2658 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2659 if (err) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2660 goto done; // FIXME: why not just use return to exit? |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2661 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2662 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2663 retval = result; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2664 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2665 done: |
4004 | 2666 |
3146 | 2667 return retval; |
2668 } | |
2669 | |
4844 | 2670 NDArray |
2671 gammainc (double x, const NDArray& a) | |
2672 { | |
2673 dim_vector dv = a.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2674 octave_idx_type nel = dv.numel (); |
4844 | 2675 |
2676 NDArray retval; | |
2677 NDArray result (dv); | |
2678 | |
2679 bool err; | |
2680 | |
7789
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++) |
4844 | 2682 { |
18084
8e056300994b
Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents:
17769
diff
changeset
|
2683 result(i) = gammainc (x, a(i), err); |
4844 | 2684 |
2685 if (err) | |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2686 goto done; // FIXME: why not just use return to exit? |
4844 | 2687 } |
2688 | |
2689 retval = result; | |
2690 | |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2691 done: |
4844 | 2692 |
2693 return retval; | |
2694 } | |
2695 | |
2696 NDArray | |
2697 gammainc (const NDArray& x, double a) | |
2698 { | |
2699 dim_vector dv = x.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2700 octave_idx_type nel = dv.numel (); |
4844 | 2701 |
2702 NDArray retval; | |
2703 NDArray result (dv); | |
2704 | |
2705 bool err; | |
2706 | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2707 for (octave_idx_type i = 0; i < nel; i++) |
4844 | 2708 { |
18084
8e056300994b
Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents:
17769
diff
changeset
|
2709 result(i) = gammainc (x(i), a, err); |
4844 | 2710 |
2711 if (err) | |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2712 goto done; // FIXME: why not just use return to exit? |
4844 | 2713 } |
2714 | |
2715 retval = result; | |
2716 | |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2717 done: |
4844 | 2718 |
2719 return retval; | |
2720 } | |
2721 | |
2722 NDArray | |
2723 gammainc (const NDArray& x, const NDArray& a) | |
2724 { | |
2725 dim_vector dv = x.dims (); | |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2726 octave_idx_type nel = dv.numel (); |
4844 | 2727 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2728 if (dv != a.dims ()) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2729 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2730 std::string x_str = dv.str (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2731 std::string a_str = a.dims ().str (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2732 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2733 (*current_liboctave_error_handler) |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2734 ("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
|
2735 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
|
2736 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2737 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2738 NDArray retval; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2739 NDArray result (dv); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2740 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2741 bool err; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2742 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2743 for (octave_idx_type i = 0; i < nel; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2744 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2745 result(i) = gammainc (x(i), a(i), err); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2746 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2747 if (err) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2748 goto done; // FIXME: why not just use return to exit? |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2749 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2750 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2751 retval = result; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2752 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2753 done: |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2754 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2755 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2756 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2757 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2758 float |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2759 gammainc (float x, float a, bool& err) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2760 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2761 float retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2762 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2763 err = false; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2764 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2765 if (a < 0.0 || x < 0.0) |
18676
5bd1ca29c5f0
Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents:
18084
diff
changeset
|
2766 (*current_liboctave_error_handler) |
5bd1ca29c5f0
Clean up questionable code bits identified by clang sanitize.
Rik <rik@octave.org>
parents:
18084
diff
changeset
|
2767 ("gammainc: A and X must be non-negative"); |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2768 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2769 F77_XFCN (xsgammainc, XSGAMMAINC, (a, x, retval)); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2770 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2771 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2772 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2773 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2774 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2775 gammainc (float x, const FloatMatrix& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2776 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2777 octave_idx_type nr = a.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2778 octave_idx_type nc = a.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2779 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2780 FloatMatrix result (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2781 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2782 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2783 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2784 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2785 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
|
2786 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
|
2787 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2788 result(i,j) = gammainc (x, a(i,j), err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2789 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2790 if (err) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2791 goto done; // FIXME: why not just use return to exit? |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2792 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2793 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2794 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2795 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2796 done: |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2797 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2798 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2799 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2800 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2801 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2802 gammainc (const FloatMatrix& x, float a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2803 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2804 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2805 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2806 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2807 FloatMatrix result (nr, nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2808 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2809 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2810 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2811 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2812 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
|
2813 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
|
2814 { |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2815 result(i,j) = gammainc (x(i,j), a, err); |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2816 |
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2817 if (err) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2818 goto done; // FIXME: why not just use return to exit? |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2819 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2820 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2821 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2822 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2823 done: |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2824 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2825 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2826 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2827 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2828 FloatMatrix |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2829 gammainc (const FloatMatrix& x, const FloatMatrix& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2830 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2831 FloatMatrix result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2832 FloatMatrix retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2833 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2834 octave_idx_type nr = x.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2835 octave_idx_type nc = x.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2836 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2837 octave_idx_type a_nr = a.rows (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2838 octave_idx_type a_nc = a.cols (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2839 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2840 if (nr != a_nr || nc != a_nc) |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2841 (*current_liboctave_error_handler) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2842 ("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
|
2843 nr, nc, a_nr, a_nc); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2844 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2845 result.resize (nr, nc); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2846 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2847 bool err; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2848 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2849 for (octave_idx_type j = 0; j < nc; j++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2850 for (octave_idx_type i = 0; i < nr; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2851 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2852 result(i,j) = gammainc (x(i,j), a(i,j), err); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2853 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2854 if (err) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2855 goto done; // FIXME: why not just use return to exit? |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2856 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2857 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2858 retval = result; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2859 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2860 done: |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2861 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2862 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2863 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2864 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2865 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2866 gammainc (float x, const FloatNDArray& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2867 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2868 dim_vector dv = a.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2869 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2870 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2871 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2872 FloatNDArray result (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2873 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2874 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2875 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2876 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
|
2877 { |
18084
8e056300994b
Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents:
17769
diff
changeset
|
2878 result(i) = gammainc (x, a(i), err); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2879 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2880 if (err) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2881 goto done; // FIXME: why not just use return to exit? |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2882 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2883 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2884 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2885 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2886 done: |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2887 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2888 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2889 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2890 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2891 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2892 gammainc (const FloatNDArray& x, float a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2893 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2894 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2895 octave_idx_type nel = dv.numel (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2896 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2897 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2898 FloatNDArray result (dv); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2899 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2900 bool err; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2901 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2902 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
|
2903 { |
18084
8e056300994b
Follow coding convention of defining and initializing only 1 variable per line in liboctave.
Rik <rik@octave.org>
parents:
17769
diff
changeset
|
2904 result(i) = gammainc (x(i), a, err); |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2905 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2906 if (err) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2907 goto done; // FIXME: why not just use return to exit? |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2908 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2909 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2910 retval = result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2911 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2912 done: |
7789
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2913 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2914 return retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2915 } |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2916 |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2917 FloatNDArray |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2918 gammainc (const FloatNDArray& x, const FloatNDArray& a) |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2919 { |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2920 dim_vector dv = x.dims (); |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2921 octave_idx_type nel = dv.numel (); |
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 FloatNDArray retval; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2924 FloatNDArray result; |
82be108cc558
First attempt at single precision tyeps
David Bateman <dbateman@free.fr>
parents:
7638
diff
changeset
|
2925 |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2926 if (dv != a.dims ()) |
4844 | 2927 { |
2928 std::string x_str = dv.str (); | |
2929 std::string a_str = a.dims ().str (); | |
2930 | |
2931 (*current_liboctave_error_handler) | |
10314
07ebe522dac2
untabify liboctave C++ sources
John W. Eaton <jwe@octave.org>
parents:
10258
diff
changeset
|
2932 ("gammainc: nonconformant arguments (arg 1 is %s, arg 2 is %s)", |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
2933 x_str.c_str (), a_str.c_str ()); |
4844 | 2934 } |
2935 | |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2936 result.resize (dv); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2937 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2938 bool err; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2939 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2940 for (octave_idx_type i = 0; i < nel; i++) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2941 { |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2942 result(i) = gammainc (x(i), a(i), err); |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2943 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2944 if (err) |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2945 goto done; // FIXME: why not just use return to exit? |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2946 } |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2947 |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2948 retval = result; |
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
2949 |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2950 done: |
4844 | 2951 |
2952 return retval; | |
2953 } | |
2954 | |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2955 |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2956 Complex rc_log1p (double x) |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2957 { |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2958 const double pi = 3.14159265358979323846; |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
2959 return (x < -1.0 |
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
2960 ? Complex (gnulib::log (-(1.0 + x)), pi) |
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
2961 : Complex (log1p (x))); |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2962 } |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2963 |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2964 FloatComplex rc_log1p (float x) |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2965 { |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2966 const float pi = 3.14159265358979323846f; |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
2967 return (x < -1.0f |
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
2968 ? FloatComplex (gnulib::logf (-(1.0f + x)), pi) |
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
2969 : FloatComplex (log1pf (x))); |
9812
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2970 } |
f80c566bc751
improve unary mapper system
Jaroslav Hajek <highegg@gmail.com>
parents:
9732
diff
changeset
|
2971 |
9838 | 2972 // This algorithm is due to P. J. Acklam. |
20453
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
2973 // |
9837
7c70084b125e
improve comment for 9835
Jaroslav Hajek <highegg@gmail.com>
parents:
9835
diff
changeset
|
2974 // See http://home.online.no/~pjacklam/notes/invnorm/ |
20453
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
2975 // |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
2976 // The rational approximation has relative accuracy 1.15e-9 in the whole |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
2977 // region. For doubles, it is refined by a single step of Halley's 3rd |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
2978 // order method. For single precision, the accuracy is already OK, so |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
2979 // we skip it to get faster evaluation. |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2980 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2981 static double do_erfinv (double x, bool refine) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2982 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
2983 // Coefficients of rational approximation. |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2984 static const double a[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2985 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2986 -2.806989788730439e+01, 1.562324844726888e+02, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2987 -1.951109208597547e+02, 9.783370457507161e+01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2988 -2.168328665628878e+01, 1.772453852905383e+00 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2989 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2990 static const double b[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2991 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2992 -5.447609879822406e+01, 1.615858368580409e+02, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2993 -1.556989798598866e+02, 6.680131188771972e+01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2994 -1.328068155288572e+01 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2995 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
2996 static const double c[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2997 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2998 -5.504751339936943e-03, -2.279687217114118e-01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
2999 -1.697592457770869e+00, -1.802933168781950e+00, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3000 3.093354679843505e+00, 2.077595676404383e+00 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3001 }; |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3002 static const double d[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3003 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3004 7.784695709041462e-03, 3.224671290700398e-01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3005 2.445134137142996e+00, 3.754408661907416e+00 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3006 }; |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3007 |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
3008 static const double spi2 = 8.862269254527579e-01; // sqrt(pi)/2. |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3009 static const double pbreak = 0.95150; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3010 double ax = fabs (x), y; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3011 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3012 // Select case. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3013 if (ax <= pbreak) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3014 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3015 // Middle region. |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3016 const double q = 0.5 * x, r = q*q; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3017 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
|
3018 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
|
3019 y = yn / yd; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3020 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3021 else if (ax < 1.0) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3022 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3023 // Tail region. |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3024 const double q = sqrt (-2*gnulib::log (0.5*(1-ax))); |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3025 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
|
3026 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
|
3027 y = yn / yd * signum (-x); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3028 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3029 else if (ax == 1.0) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3030 return octave_Inf * signum (x); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3031 else |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3032 return octave_NaN; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3033 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3034 if (refine) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3035 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3036 // One iteration of Halley's method gives full precision. |
14781
e190f6da40f6
maint: Correct comments and use Octave spacing conventions for erfinv.
Rik <octave@nomad.inbox5.com>
parents:
14771
diff
changeset
|
3037 double u = (erf (y) - x) * spi2 * exp (y*y); |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3038 y -= u / (1 + y*u); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3039 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3040 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3041 return y; |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3042 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3043 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3044 double erfinv (double x) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3045 { |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3046 return do_erfinv (x, true); |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3047 } |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3048 |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3049 float erfinv (float x) |
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3050 { |
11586
12df7854fa7c
strip trailing whitespace from source files
John W. Eaton <jwe@octave.org>
parents:
11574
diff
changeset
|
3051 return do_erfinv (x, false); |
9835
1bb1ed717d2f
implement built-in erfinv
Jaroslav Hajek <highegg@gmail.com>
parents:
9812
diff
changeset
|
3052 } |
10391
59e34bcdff13
implement built-in erfcx
Jaroslav Hajek <highegg@gmail.com>
parents:
10352
diff
changeset
|
3053 |
20453
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3054 // The algorthim for erfcinv is an adaptation of the erfinv algorithm |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3055 // above from P. J. Acklam. It has been modified to run over the |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3056 // different input domain of erfcinv. See the notes for erfinv for an |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3057 // explanation. |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3058 |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3059 static double do_erfcinv (double x, bool refine) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3060 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3061 // Coefficients of rational approximation. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3062 static const double a[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3063 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3064 -2.806989788730439e+01, 1.562324844726888e+02, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3065 -1.951109208597547e+02, 9.783370457507161e+01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3066 -2.168328665628878e+01, 1.772453852905383e+00 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3067 }; |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3068 static const double b[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3069 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3070 -5.447609879822406e+01, 1.615858368580409e+02, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3071 -1.556989798598866e+02, 6.680131188771972e+01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3072 -1.328068155288572e+01 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3073 }; |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3074 static const double c[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3075 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3076 -5.504751339936943e-03, -2.279687217114118e-01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3077 -1.697592457770869e+00, -1.802933168781950e+00, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3078 3.093354679843505e+00, 2.077595676404383e+00 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3079 }; |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3080 static const double d[] = |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3081 { |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3082 7.784695709041462e-03, 3.224671290700398e-01, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3083 2.445134137142996e+00, 3.754408661907416e+00 |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3084 }; |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3085 |
14771
10ed11922f19
maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14770
diff
changeset
|
3086 static const double spi2 = 8.862269254527579e-01; // sqrt(pi)/2. |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3087 static const double pbreak_lo = 0.04850; // 1-pbreak |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3088 static const double pbreak_hi = 1.95150; // 1+pbreak |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3089 double y; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3090 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3091 // Select case. |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3092 if (x >= pbreak_lo && x <= pbreak_hi) |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3093 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3094 // Middle region. |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3095 const double q = 0.5*(1-x), r = q*q; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3096 const double yn = (((((a[0]*r + a[1])*r + a[2])*r + a[3])*r + a[4])*r + a[5])*q; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3097 const double yd = ((((b[0]*r + b[1])*r + b[2])*r + b[3])*r + b[4])*r + 1.0; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3098 y = yn / yd; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3099 } |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3100 else if (x > 0.0 && x < 2.0) |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3101 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3102 // Tail region. |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3103 const double q = (x < 1 |
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3104 ? sqrt (-2*gnulib::log (0.5*x)) |
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3105 : sqrt (-2*gnulib::log (0.5*(2-x)))); |
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3106 |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3107 const double yn = ((((c[0]*q + c[1])*q + c[2])*q + c[3])*q + c[4])*q + c[5]; |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3108 |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3109 const double yd = (((d[0]*q + d[1])*q + d[2])*q + d[3])*q + 1.0; |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3110 |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3111 y = yn / yd; |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3112 |
14786
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3113 if (x < pbreak_lo) |
e70a0c9cada6
Pre-compute bounds (constant folding) for erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14781
diff
changeset
|
3114 y = -y; |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3115 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3116 else if (x == 0.0) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3117 return octave_Inf; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3118 else if (x == 2.0) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3119 return -octave_Inf; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3120 else |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3121 return octave_NaN; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3122 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3123 if (refine) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3124 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3125 // One iteration of Halley's method gives full precision. |
14771
10ed11922f19
maint: code cleanup for new erfcinv function.
Rik <octave@nomad.inbox5.com>
parents:
14770
diff
changeset
|
3126 double u = (erf (y) - (1-x)) * spi2 * exp (y*y); |
14770
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3127 y -= u / (1 + y*u); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3128 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3129 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3130 return y; |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3131 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3132 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3133 double erfcinv (double x) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3134 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3135 return do_erfcinv (x, true); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3136 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3137 |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3138 float erfcinv (float x) |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3139 { |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3140 return do_erfcinv (x, false); |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3141 } |
cb85e836d035
New function: erfcinv (bug #36607)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14197
diff
changeset
|
3142 |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3143 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3144 // Incomplete Beta function ratio |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3145 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3146 // Algorithm based on the one by John Burkardt. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3147 // See http://people.sc.fsu.edu/~jburkardt/cpp_src/asa109/asa109.html |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3148 // |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3149 // The original code is distributed under the GNU LGPL v3 license. |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3150 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3151 // Reference: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3152 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3153 // KL Majumder, GP Bhattacharjee, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3154 // Algorithm AS 63: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3155 // The incomplete Beta Integral, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3156 // Applied Statistics, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3157 // Volume 22, Number 3, 1973, pages 409-411. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3158 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3159 double |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3160 betain (double x, double p, double q, double beta, bool& err) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3161 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3162 double acu = 0.1E-14, ai, cx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3163 bool indx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3164 int ns; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3165 double pp, psq, qq, rx, temp, term, value, xx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3166 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3167 value = x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3168 err = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3169 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3170 // Check the input arguments. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3171 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3172 if ((p <= 0.0 || q <= 0.0) || (x < 0.0 || 1.0 < x)) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3173 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3174 err = true; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3175 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3176 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3177 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3178 // Special cases. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3179 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3180 if (x == 0.0 || x == 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3181 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3182 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3183 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3184 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3185 // Change tail if necessary and determine S. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3186 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3187 psq = p + q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3188 cx = 1.0 - x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3189 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3190 if (p < psq * x) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3191 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3192 xx = cx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3193 cx = x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3194 pp = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3195 qq = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3196 indx = true; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3197 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3198 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3199 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3200 xx = x; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3201 pp = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3202 qq = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3203 indx = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3204 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3205 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3206 term = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3207 ai = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3208 value = 1.0; |
15217
d2220c3def3f
avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents:
15084
diff
changeset
|
3209 ns = static_cast<int> (qq + cx * psq); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3210 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3211 // Use the Soper reduction formula. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3212 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3213 rx = xx / cx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3214 temp = qq - ai; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3215 if (ns == 0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3216 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3217 rx = xx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3218 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3219 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3220 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3221 { |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3222 term *= temp * rx / (pp + ai); |
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3223 value += term; |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3224 temp = fabs (term); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3225 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3226 if (temp <= acu && temp <= acu * value) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3227 { |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3228 value *= exp (pp * gnulib::log (xx) |
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3229 + (qq - 1.0) * gnulib::log (cx) - beta) / pp; |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3230 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3231 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3232 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3233 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3234 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3235 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3236 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3237 |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3238 ai += 1.0; |
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3239 ns -= 1; |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3240 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3241 if (0 <= ns) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3242 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3243 temp = qq - ai; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3244 if (ns == 0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3245 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3246 rx = xx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3247 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3248 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3249 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3250 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3251 temp = psq; |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3252 psq += 1.0; |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3253 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3254 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3255 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3256 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3257 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3258 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3259 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3260 // Inverse of the incomplete Beta function |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3261 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3262 // Algorithm based on the one by John Burkardt. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3263 // See http://people.sc.fsu.edu/~jburkardt/cpp_src/asa109/asa109.html |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3264 // |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3265 // The original code is distributed under the GNU LGPL v3 license. |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3266 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3267 // Reference: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3268 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3269 // GW Cran, KJ Martin, GE Thomas, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3270 // Remark AS R19 and Algorithm AS 109: |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3271 // A Remark on Algorithms AS 63: The Incomplete Beta Integral |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3272 // and AS 64: Inverse of the Incomplete Beta Integeral, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3273 // Applied Statistics, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3274 // Volume 26, Number 1, 1977, pages 111-114. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3275 // |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3276 double |
15217
d2220c3def3f
avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents:
15084
diff
changeset
|
3277 betaincinv (double y, double p, double q) |
d2220c3def3f
avoid C-style cast warning
John W. Eaton <jwe@octave.org>
parents:
15084
diff
changeset
|
3278 { |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3279 double a, acu, adj, fpu, g, h; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3280 int iex; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3281 bool indx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3282 double pp, prev, qq, r, s, sae = -37.0, sq, t, tx, value, w, xin, ycur, yprev; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3283 |
14847
bcf86cc2f1ee
Use xlgamma instead of lgamma in betaincinv for portability across systems.
Rik <octave@nomad.inbox5.com>
parents:
14846
diff
changeset
|
3284 double beta = xlgamma (p) + xlgamma (q) - xlgamma (p + q); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3285 bool err = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3286 fpu = pow (10.0, sae); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3287 value = y; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3288 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3289 // Test for admissibility of parameters. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3290 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3291 if (p <= 0.0 || q <= 0.0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
3292 (*current_liboctave_error_handler) ("betaincinv: wrong parameters"); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3293 if (y < 0.0 || 1.0 < y) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
3294 (*current_liboctave_error_handler) ("betaincinv: wrong parameter Y"); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3295 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3296 if (y == 0.0 || y == 1.0) |
21136
7cac4e7458f2
maint: clean up code around calls to current_liboctave_error_handler.
Rik <rik@octave.org>
parents:
21118
diff
changeset
|
3297 return value; |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3298 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3299 // Change tail if necessary. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3300 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3301 if (0.5 < y) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3302 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3303 a = 1.0 - y; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3304 pp = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3305 qq = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3306 indx = true; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3307 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3308 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3309 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3310 a = y; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3311 pp = p; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3312 qq = q; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3313 indx = false; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3314 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3315 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3316 // Calculate the initial approximation. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3317 |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3318 r = sqrt (- gnulib::log (a * a)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3319 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3320 ycur = r - (2.30753 + 0.27061 * r) / (1.0 + (0.99229 + 0.04481 * r) * r); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3321 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3322 if (1.0 < pp && 1.0 < qq) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3323 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3324 r = (ycur * ycur - 3.0) / 6.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3325 s = 1.0 / (pp + pp - 1.0); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3326 t = 1.0 / (qq + qq - 1.0); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3327 h = 2.0 / (s + t); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3328 w = ycur * sqrt (h + r) / h - (t - s) * (r + 5.0 / 6.0 - 2.0 / (3.0 * h)); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3329 value = pp / (pp + qq * exp (w + w)); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3330 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3331 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3332 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3333 r = qq + qq; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3334 t = 1.0 / (9.0 * qq); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3335 t = r * pow (1.0 - t + ycur * sqrt (t), 3); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3336 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3337 if (t <= 0.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3338 { |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3339 value = 1.0 - exp ((gnulib::log ((1.0 - a) * qq) + beta) / qq); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3340 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3341 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3342 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3343 t = (4.0 * pp + r - 2.0) / t; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3344 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3345 if (t <= 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3346 { |
19375
264ff6bf7475
use gnulib:: namespace for log, logf, localtime, and gmtime
John W. Eaton <jwe@octave.org>
parents:
19358
diff
changeset
|
3347 value = exp ((gnulib::log (a * pp) + beta) / pp); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3348 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3349 else |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3350 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3351 value = 1.0 - 2.0 / (t + 1.0); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3352 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3353 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3354 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3355 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3356 // Solve for X by a modified Newton-Raphson method, |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3357 // using the function BETAIN. |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3358 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3359 r = 1.0 - pp; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3360 t = 1.0 - qq; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3361 yprev = 0.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3362 sq = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3363 prev = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3364 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3365 if (value < 0.0001) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3366 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3367 value = 0.0001; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3368 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3369 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3370 if (0.9999 < value) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3371 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3372 value = 0.9999; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3373 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3374 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3375 iex = std::max (- 5.0 / pp / pp - 1.0 / pow (a, 0.2) - 13.0, sae); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3376 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3377 acu = pow (10.0, iex); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3378 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3379 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3380 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3381 ycur = betain (value, pp, qq, beta, err); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3382 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3383 if (err) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3384 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3385 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3386 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3387 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3388 xin = value; |
18928
161ebb78ac1b
use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents:
18678
diff
changeset
|
3389 ycur = (ycur - a) * exp (beta + r * gnulib::log (xin) |
161ebb78ac1b
use gnulib::log and gnulib::logf functions
John W. Eaton <jwe@octave.org>
parents:
18678
diff
changeset
|
3390 + t * gnulib::log (1.0 - xin)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3391 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3392 if (ycur * yprev <= 0.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3393 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3394 prev = std::max (sq, fpu); |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3395 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3396 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3397 g = 1.0; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3398 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3399 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3400 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3401 for ( ; ; ) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3402 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3403 adj = g * ycur; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3404 sq = adj * adj; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3405 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3406 if (sq < prev) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3407 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3408 tx = value - adj; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3409 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3410 if (0.0 <= tx && tx <= 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3411 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3412 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3413 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3414 } |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3415 g /= 3.0; |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3416 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3417 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3418 if (prev <= acu) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3419 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3420 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3421 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3422 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3423 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3424 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3425 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3426 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3427 if (ycur * ycur <= acu) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3428 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3429 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3430 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3431 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3432 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3433 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3434 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3435 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3436 if (tx != 0.0 && tx != 1.0) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3437 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3438 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3439 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3440 |
20230
e914b5399c67
Use in-place operators in C++ code where possible.
Rik <rik@octave.org>
parents:
20161
diff
changeset
|
3441 g /= 3.0; |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3442 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3443 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3444 if (tx == value) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3445 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3446 break; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3447 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3448 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3449 value = tx; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3450 yprev = ycur; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3451 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3452 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3453 if (indx) |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3454 { |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3455 value = 1.0 - value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3456 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3457 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3458 return value; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3459 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3460 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3461 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3462 betaincinv (double x, double a, const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3463 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3464 dim_vector dv = b.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3465 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3466 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3467 Array<double> retval (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3468 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3469 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3470 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3471 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3472 *pretval++ = betaincinv (x, a, b(i)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3473 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3474 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3475 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3476 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3477 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3478 betaincinv (double x, const Array<double>& a, double b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3479 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3480 dim_vector dv = a.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3481 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3482 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3483 Array<double> retval (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3484 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3485 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3486 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3487 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3488 *pretval++ = betaincinv (x, a(i), b); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3489 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3490 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3491 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3492 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3493 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3494 betaincinv (double x, const Array<double>& a, const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3495 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3496 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3497 dim_vector dv = a.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3498 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3499 if (dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
3500 err_betaincinv_nonconformant (dim_vector (0, 0), dv, b.dims ()); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3501 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3502 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3503 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3504 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3505 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3506 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3507 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3508 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3509 *pretval++ = betaincinv (x, a(i), b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3510 |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3511 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3512 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3513 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3514 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3515 betaincinv (const Array<double>& x, double a, double b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3516 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3517 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3518 octave_idx_type nel = dv.numel (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3519 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3520 Array<double> retval (dv); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3521 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3522 double *pretval = retval.fortran_vec (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3523 |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3524 for (octave_idx_type i = 0; i < nel; i++) |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3525 *pretval++ = betaincinv (x(i), a, b); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3526 |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3527 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3528 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3529 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3530 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3531 betaincinv (const Array<double>& x, double a, const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3532 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3533 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3534 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3535 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3536 if (dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
3537 err_betaincinv_nonconformant (dv, dim_vector (0, 0), b.dims ()); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3538 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3539 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3540 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3541 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3542 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3543 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3544 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3545 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3546 *pretval++ = betaincinv (x(i), a, b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3547 |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3548 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3549 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3550 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3551 Array<double> |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3552 betaincinv (const Array<double>& x, const Array<double>& a, double b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3553 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3554 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3555 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3556 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3557 if (dv != a.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
3558 err_betaincinv_nonconformant (dv, a.dims (), dim_vector (0, 0)); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3559 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3560 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3561 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3562 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3563 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3564 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3565 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3566 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3567 *pretval++ = betaincinv (x(i), a(i), b); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3568 |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3569 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3570 } |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3571 |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3572 Array<double> |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3573 betaincinv (const Array<double>& x, const Array<double>& a, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3574 const Array<double>& b) |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3575 { |
14817
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3576 Array<double> retval; |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3577 dim_vector dv = x.dims (); |
67897baaa05f
Adapt implementation of betaincinv to Octave.
Rik <octave@nomad.inbox5.com>
parents:
14816
diff
changeset
|
3578 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3579 if (dv != a.dims () && dv != b.dims ()) |
21102
dfcb9d74b253
Rename local gripe_XXX functions to err_XXX or warn_XXX.
Rik <rik@octave.org>
parents:
21066
diff
changeset
|
3580 err_betaincinv_nonconformant (dv, a.dims (), b.dims ()); |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3581 |
21118
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3582 octave_idx_type nel = dv.numel (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3583 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3584 retval.resize (dv); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3585 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3586 double *pretval = retval.fortran_vec (); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3587 |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3588 for (octave_idx_type i = 0; i < nel; i++) |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3589 *pretval++ = betaincinv (x(i), a(i), b(i)); |
3ac9f47fb04b
Invert pattern if/code/else/err_XXX to if !/err_XXX/code.
Rik <rik@octave.org>
parents:
21102
diff
changeset
|
3590 |
14816
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3591 return retval; |
0a868d90436b
New function: betaincinv (bug #34364)
Axel Mathéi <axel.mathei@gmail.com>
parents:
14815
diff
changeset
|
3592 } |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3593 |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3594 void |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3595 ellipj (double u, double m, double& sn, double& cn, double& dn, double& err) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3596 { |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3597 static const int Nmax = 16; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3598 double m1, t=0, si_u, co_u, se_u, ta_u, b, c[Nmax], a[Nmax], phi; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3599 int n, Nn, ii; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3600 |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3601 if (m < 0 || m > 1) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3602 { |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19377
diff
changeset
|
3603 (*current_liboctave_warning_with_id_handler) |
20711
7b608fadc663
Make error messages more specific about the variable and problem encountered.
Rik <rik@octave.org>
parents:
20455
diff
changeset
|
3604 ("Octave:ellipj-invalid-m", "ellipj: invalid M value, required value 0 <= M <= 1"); |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19377
diff
changeset
|
3605 |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3606 sn = cn = dn = lo_ieee_nan_value (); |
19410
95c533ed464b
use warning IDs for all warnings in liboctave
John W. Eaton <jwe@octave.org>
parents:
19377
diff
changeset
|
3607 |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3608 return; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3609 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3610 |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3611 double sqrt_eps = sqrt (std::numeric_limits<double>::epsilon ()); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3612 if (m < sqrt_eps) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3613 { |
18678
6113e0c6920b
maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents:
18676
diff
changeset
|
3614 // For small m, (Abramowitz and Stegun, Section 16.13) |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3615 si_u = sin (u); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3616 co_u = cos (u); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3617 t = 0.25*m*(u - si_u*co_u); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3618 sn = si_u - t * co_u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3619 cn = co_u + t * si_u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3620 dn = 1 - 0.5*m*si_u*si_u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3621 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3622 else if ((1 - m) < sqrt_eps) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3623 { |
18678
6113e0c6920b
maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents:
18676
diff
changeset
|
3624 // For m1 = (1-m) small (Abramowitz and Stegun, Section 16.15) |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3625 m1 = 1 - m; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3626 si_u = sinh (u); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3627 co_u = cosh (u); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3628 ta_u = tanh (u); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3629 se_u = 1/co_u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3630 sn = ta_u + 0.25*m1*(si_u*co_u - u)*se_u*se_u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3631 cn = se_u - 0.25*m1*(si_u*co_u - u)*ta_u*se_u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3632 dn = se_u + 0.25*m1*(si_u*co_u + u)*ta_u*se_u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3633 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3634 else |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3635 { |
18678
6113e0c6920b
maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents:
18676
diff
changeset
|
3636 // Arithmetic-Geometric Mean (AGM) algorithm |
6113e0c6920b
maint: Clean up extra spaces before/after parentheses.
Rik <rik@octave.org>
parents:
18676
diff
changeset
|
3637 // (Abramowitz and Stegun, Section 16.4) |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3638 a[0] = 1; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3639 b = sqrt (1 - m); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3640 c[0] = sqrt (m); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3641 for (n = 1; n < Nmax; ++n) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3642 { |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3643 a[n] = (a[n - 1] + b)/2; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3644 c[n] = (a[n - 1] - b)/2; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3645 b = sqrt (a[n - 1]*b); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3646 if (c[n]/a[n] < std::numeric_limits<double>::epsilon ()) break; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3647 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3648 if (n >= Nmax - 1) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3649 { |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3650 err = 1; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3651 return; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3652 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3653 Nn = n; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3654 for (ii = 1; n > 0; ii = ii*2, --n) ; // ii = pow(2,Nn) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3655 phi = ii*a[Nn]*u; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3656 for (n = Nn; n > 0; --n) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3657 { |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3658 phi = (asin ((c[n]/a[n])* sin (phi)) + phi)/2; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3659 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3660 sn = sin (phi); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3661 cn = cos (phi); |
19200
068a3e51b7b8
ellipj: Fix continuity of dn output when cn is near zero (bug #43344)
Mike Miller <mtmiller@ieee.org>
parents:
18928
diff
changeset
|
3662 dn = sqrt (1 - m*sn*sn); |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3663 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3664 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3665 |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3666 void |
17769
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3667 ellipj (const Complex& u, double m, Complex& sn, Complex& cn, Complex& dn, |
49a5a4be04a1
maint: Use GNU style coding conventions for code in liboctave/
Rik <rik@octave.org>
parents:
17744
diff
changeset
|
3668 double& err) |
17502
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3669 { |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3670 double m1 = 1 - m, ss1, cc1, dd1; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3671 |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3672 ellipj (imag (u), m1, ss1, cc1, dd1, err); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3673 if (real (u) == 0) |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3674 { |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3675 // u is pure imag: Jacoby imag. transf. |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3676 sn = Complex (0, ss1/cc1); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3677 cn = 1/cc1; // cn.imag = 0; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3678 dn = dd1/cc1; // dn.imag = 0; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3679 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3680 else |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3681 { |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3682 // u is generic complex |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3683 double ss, cc, dd, ddd; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3684 |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3685 ellipj (real (u), m, ss, cc, dd, err); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3686 ddd = cc1*cc1 + m*ss*ss*ss1*ss1; |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3687 sn = Complex (ss*dd1/ddd, cc*dd*ss1*cc1/ddd); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3688 cn = Complex (cc*cc1/ddd, -ss*dd*ss1*dd1/ddd); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3689 dn = Complex (dd*cc1*dd1/ddd, -m*ss*cc*ss1/ddd); |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3690 } |
578805a293e5
ellipj: Move numerical code into liboctave
Mike Miller <mtmiller@ieee.org>
parents:
15852
diff
changeset
|
3691 } |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3692 |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3693 static const double pi = 3.14159265358979323846; |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3694 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3695 template <typename T> |
20455
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3696 static inline T |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3697 xlog (const T& x) |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3698 { |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3699 return log (x); |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3700 } |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3701 |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3702 template <> |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3703 inline double |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3704 xlog (const double& x) |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3705 { |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3706 return gnulib::log (x); |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3707 } |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3708 |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3709 template <> |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3710 inline float |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3711 xlog (const float& x) |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3712 { |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3713 return gnulib::logf (x); |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3714 } |
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3715 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3716 template <typename T> |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3717 static T |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3718 Lanczos_approximation_psi (const T zc) |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3719 { |
20453
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3720 // Coefficients for C.Lanczos expansion of psi function from XLiFE++ |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3721 // gammaFunctions psi_coef[k] = - (2k+1) * lg_coef[k] (see melina++ |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3722 // gamma functions -1/12, 3/360,-5/1260, 7/1680,-9/1188, |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3723 // 11*691/360360,-13/156, 15*3617/122400, ? , ? |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3724 static const T dg_coeff[10] = { |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3725 -0.83333333333333333e-1, 0.83333333333333333e-2, |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3726 -0.39682539682539683e-2, 0.41666666666666667e-2, |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3727 -0.75757575757575758e-2, 0.21092796092796093e-1, |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3728 -0.83333333333333333e-1, 0.4432598039215686, |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3729 -0.3053954330270122e+1, 0.125318899521531e+2 |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3730 }; |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3731 |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3732 T overz2 = T (1.0) / (zc * zc); |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3733 T overz2k = overz2; |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3734 |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3735 T p = 0; |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3736 for (octave_idx_type k = 0; k < 10; k++, overz2k *= overz2) |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3737 p += dg_coeff[k] * overz2k; |
20455
951019b7afd4
use different approach to avoid gnulib warning
John W. Eaton <jwe@octave.org>
parents:
20453
diff
changeset
|
3738 p += xlog (zc) - T (0.5) / zc; |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3739 return p; |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3740 } |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3741 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3742 template <typename T> |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3743 T |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3744 psi (const T& z) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3745 { |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3746 static const double euler_mascheroni = 0.577215664901532860606512090082402431042; |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3747 |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3748 const bool is_int = (xfloor (z) == z); |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3749 |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3750 T p = 0; |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3751 if (z <= 0) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3752 { |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3753 // limits - zeros of the gamma function |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3754 if (is_int) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3755 p = -octave_Inf; // Matlab returns -Inf for psi (0) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3756 else |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3757 // Abramowitz and Stegun, page 259, eq 6.3.7 |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3758 p = psi (1 - z) - (pi / tan (pi * z)); |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3759 } |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3760 else if (is_int) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3761 { |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3762 // Abramowitz and Stegun, page 258, eq 6.3.2 |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3763 p = - euler_mascheroni; |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3764 for (octave_idx_type k = z - 1; k > 0; k--) |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3765 p += 1.0 / k; |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3766 } |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3767 else if (xfloor (z + 0.5) == z + 0.5) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3768 { |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3769 // Abramowitz and Stegun, page 258, eq 6.3.3 and 6.3.4 |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3770 for (octave_idx_type k = z; k > 0; k--) |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3771 p += 1.0 / (2 * k - 1); |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3772 |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3773 p = - euler_mascheroni - 2 * log (2) + 2 * (p); |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3774 } |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3775 else |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3776 { |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3777 // adapted from XLiFE++ gammaFunctions |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3778 |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3779 T zc = z; |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3780 // Use formula for derivative of LogGamma(z) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3781 if (z < 10) |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3782 { |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3783 const signed char n = 10 - z; |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3784 for (signed char k = n - 1; k >= 0; k--) |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3785 p -= 1.0 / (k + z); |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3786 zc += n; |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3787 } |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3788 p += Lanczos_approximation_psi (zc); |
20154
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3789 } |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3790 |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3791 return p; |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3792 } |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3793 |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3794 // explicit instantiations |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3795 template double psi<double> (const double& z); |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3796 template float psi<float> (const float& z); |
45565ecec019
New function psi to compute the digamma function.
Carnë Draug <carandraug@octave.org>
parents:
19739
diff
changeset
|
3797 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3798 template <typename T> |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3799 std::complex<T> |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3800 psi (const std::complex<T>& z) |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3801 { |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3802 // adapted from XLiFE++ gammaFunctions |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3803 |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3804 typedef typename std::complex<T>::value_type P; |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3805 |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3806 P z_r = z.real (); |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3807 P z_ra = z_r; |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3808 |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3809 std::complex<T> dgam (0.0, 0.0); |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3810 if (z.imag () == 0) |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3811 dgam = std::complex<T> (psi (z_r), 0.0); |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3812 else if (z_r < 0) |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3813 dgam = psi (P (1.0) - z)- (P (pi) / tan (P (pi) * z)); |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3814 else |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3815 { |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3816 // Use formula for derivative of LogGamma(z) |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3817 std::complex<T> z_m = z; |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3818 if (z_ra < 8) |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3819 { |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3820 unsigned char n = 8 - z_ra; |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3821 z_m = z + std::complex<T> (n, 0.0); |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3822 |
20453
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3823 // Recurrence formula. For | Re(z) | < 8, use recursively |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3824 // |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3825 // DiGamma(z) = DiGamma(z+1) - 1/z |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3826 std::complex<T> z_p = z + P (n - 1); |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3827 for (unsigned char k = n; k > 0; k--, z_p -= 1.0) |
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3828 dgam -= P (1.0) / z_p; |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3829 } |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3830 |
20453
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3831 // for | Re(z) | > 8, use derivative of C.Lanczos expansion for |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3832 // LogGamma |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3833 // |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3834 // psi(z) = log(z) - 1/(2z) - 1/12z^2 + 3/360z^4 - 5/1260z^6 |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3835 // + 7/1680z^8 - 9/1188z^10 + ... |
92ac2e05f393
* lo-specfun.cc: Reindent comments.
John W. Eaton <jwe@octave.org>
parents:
20452
diff
changeset
|
3836 // |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3837 // (Abramowitz&Stegun, page 259, formula 6.3.18 |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3838 dgam += Lanczos_approximation_psi (z_m); |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3839 } |
20156
bd565f3e0ecb
psi: refactor to reduce code duplication.
Carnë Draug <carandraug@octave.org>
parents:
20155
diff
changeset
|
3840 return dgam; |
20155
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3841 } |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3842 |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3843 // explicit instantiations |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3844 template Complex psi<double> (const Complex& z); |
1fae49e34a1a
psi: add support for complex numbers.
Carnë Draug <carandraug@octave.org>
parents:
20154
diff
changeset
|
3845 template FloatComplex psi<float> (const FloatComplex& z); |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3846 |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3847 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3848 template <typename T> |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3849 static inline void |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3850 fortran_psifn (const T z, const octave_idx_type n, T* ans, |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3851 octave_idx_type* ierr); |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3852 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3853 template <> |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3854 inline void |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3855 fortran_psifn<double> (const double z, const octave_idx_type n, |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3856 double* ans, octave_idx_type* ierr) |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3857 { |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3858 octave_idx_type flag = 0; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3859 F77_XFCN (dpsifn, DPSIFN, (&z, n, 1, 1, ans, &flag, ierr)); |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3860 } |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3861 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3862 template <> |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3863 inline void |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3864 fortran_psifn<float> (const float z, const octave_idx_type n, |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3865 float* ans, octave_idx_type* ierr) |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3866 { |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3867 octave_idx_type flag = 0; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3868 F77_XFCN (psifn, PSIFN, (&z, n, 1, 1, ans, &flag, ierr)); |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3869 } |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3870 |
21139
538b57866b90
consistently use "typename" intead of "class" in template declarations
John W. Eaton <jwe@octave.org>
parents:
21136
diff
changeset
|
3871 template <typename T> |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3872 T |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3873 psi (const octave_idx_type n, const T z) |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3874 { |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3875 T ans; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3876 octave_idx_type ierr = 0; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3877 fortran_psifn<T> (z, n, &ans, &ierr); |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3878 if (ierr == 0) |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3879 { |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3880 // Remember that psifn and dpsifn return scales values |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3881 // When n is 1: do nothing since ((-1)**(n+1)/gamma(n+1)) == 1 |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3882 // When n is 0: change sign since ((-1)**(n+1)/gamma(n+1)) == -1 |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3883 if (n > 1) |
21066
258c787cd9ce
maint: Use "FIXME:" consistently in code base.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
3884 // FIXME: xgamma here is a killer for our precision since it grows |
258c787cd9ce
maint: Use "FIXME:" consistently in code base.
Rik <rik@octave.org>
parents:
20791
diff
changeset
|
3885 // way too fast. |
20161
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3886 ans = ans / (pow (-1.0, n + 1) / xgamma (double (n+1))); |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3887 else if (n == 0) |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3888 ans = -ans; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3889 } |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3890 else if (ierr == 2) |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3891 ans = - octave_Inf; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3892 else // we probably never get here |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3893 ans = octave_NaN; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3894 |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3895 return ans; |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3896 } |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3897 |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3898 // explicit instantiations |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3899 template double psi<double> (const octave_idx_type n, const double z); |
65e22ba879f0
psi: add support to compute the polygamma function (kth-derivative).
Carnë Draug <carandraug@octave.org>
parents:
20156
diff
changeset
|
3900 template float psi<float> (const octave_idx_type n, const float z); |